home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / term / sun.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  11KB  |  295 lines
  1. ;; keybinding for standard default sunterm keys
  2. ;; Copyright (C) 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. ;;  Jeff Peck, Sun Microsystems Inc  <peck@sun.com>
  22.  
  23. (defun ignore-key ()
  24.   "interactive version of ignore"
  25.   (interactive)
  26.   (ignore))
  27.  
  28. (defun unbound-key ()
  29.   "filler for compound keymaps"
  30.   (interactive)
  31.   (error "unbound-key"))
  32.  
  33. (defun scroll-down-in-place (n)
  34.   (interactive "p")
  35.   (previous-line n)
  36.   (scroll-down n))
  37.  
  38. (defun scroll-up-in-place (n)
  39.   (interactive "p")
  40.   (next-line n)
  41.   (scroll-up n))
  42.  
  43. (defun kill-region-and-unmark (beg end)
  44.   "Like kill-region, but pops the mark [which equals point, anyway.]"
  45.   (interactive "r")
  46.   (kill-region beg end)
  47.   (setq this-command 'kill-region-and-unmark)
  48.   (set-mark-command t))
  49.  
  50. (defun prev-complex-command ()
  51.   "Select Previous-complex-command"
  52.   (interactive)
  53.   (if (zerop (minibuffer-depth))
  54.       (repeat-complex-command 1)
  55.     (previous-complex-command 1)))
  56.  
  57. (defun rerun-prev-command ()
  58.   "Repeat Previous-complex-command."
  59.   (interactive)
  60.   (eval (nth 0 command-history)))
  61.  
  62. (defvar grep-arg nil "Default arg for RE-search")
  63.  
  64. (defun prev-search-command-arg ()
  65.   ;; if previous minibuf command specified a search string, return it.
  66.   ;; this way, a call to M-x re-search-forward can pass its arg.
  67.   (let* ((command (car command-history))
  68.      (command-name (symbol-name (car command)))
  69.      (search-arg (car (cdr command)))
  70.      (search-command 
  71.       (and command-name (string-match "search" command-name))))
  72.     (and search-command (stringp search-arg) search-arg)))
  73.  
  74. (defun grep-arg (&optional prompt)
  75.   "helper function used by research-{backward,forward}"
  76.   (if (memq last-command '(research-forward research-backward)) grep-arg
  77.     (let ((this-command this-command)    ; save this binding from read-string
  78.       (default (or (prev-search-command-arg)
  79.                search-last-regexp
  80.                grep-arg)))
  81.       (read-string (or prompt "Regexp arg: ") default))))
  82.  
  83. (defun research-forward ()
  84.   "Repeat regexp search forward, using previous search arg if available."
  85.   (interactive)                ;
  86.   (if (re-search-forward (grep-arg "Regexp search: "))
  87.       (setq search-last-regexp grep-arg)))
  88.  
  89. (defun research-backward ()
  90.   "Repeat regexp search backward, using previous search arg if available."
  91.   (interactive)                ;
  92.   (if (re-search-backward (grep-arg "Regexp search backward: "))
  93.       (setq search-last-regexp grep-arg)))
  94.  
  95. ;;;
  96. ;;; handle sun's extra function keys
  97. ;;; this version for those who run with standard .ttyswrc and no emacstool
  98. ;;;
  99. ;;; sunview picks up expose and open on the way UP, 
  100. ;;; so we ignore them on the way down
  101. ;;;
  102.  
  103. (defvar sun-esc-bracket nil
  104.   "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
  105.  
  106. (defvar sun-raw-map (make-sparse-keymap) "*Keymap for ESC-[ encoded keyboard")
  107.  
  108. (define-key sun-raw-map "208z" 'unbound-key)        ; R3
  109. (define-key sun-raw-map "209z" 'unbound-key)        ; R3
  110. (define-key sun-raw-map "210z" 'backward-page)        ; R3
  111. (define-key sun-raw-map "213z" 'forward-page)        ; R6
  112. (define-key sun-raw-map "214z" 'beginning-of-buffer)    ; R7
  113. (define-key sun-raw-map "216z" 'scroll-down)        ; R9
  114. (define-key sun-raw-map "215z" 'previous-line)        ; R8  (up-arrow)
  115. (define-key sun-raw-map "217z" 'backward-char)        ; R10 (rt-arrow)
  116. (define-key sun-raw-map "219z" 'forward-char)        ; R12 (dn-arrow)
  117. (define-key sun-raw-map "221z" 'next-line)        ; R14 (lf-arrow)
  118. (define-key sun-raw-map "218z" 'recenter)               ; R11
  119. (define-key sun-raw-map "220z" 'end-of-buffer)        ; R13
  120. (define-key sun-raw-map "222z" 'scroll-up)        ; R15
  121. (define-key sun-raw-map "193z" 'redraw-display)        ; Again    L1
  122. (define-key sun-raw-map "194z" 'list-buffers)        ; Props    L2
  123. (define-key sun-raw-map "195z" 'undo)            ; Undo    L3
  124. (define-key sun-raw-map "196z" 'ignore-key)        ; Expose-down    L4
  125. (define-key sun-raw-map "197z" 'sun-select-region)    ; Put    L5
  126. (define-key sun-raw-map "198z" 'ignore-key)        ; Open-down    L6
  127. (define-key sun-raw-map "199z" 'sun-yank-selection)    ; Get    L7
  128. (define-key sun-raw-map "200z" 'exchange-point-and-mark); Find    L8
  129. (define-key sun-raw-map "201z" 'kill-region-and-unmark)    ; Delete    L9
  130. (define-key sun-raw-map "225z" 'toggle-selective-display); T2
  131. (define-key sun-raw-map "226z" 'scroll-down-in-place)    ; T3
  132. (define-key sun-raw-map "227z" 'scroll-up-in-place)    ; T4
  133. (define-key sun-raw-map "228z" 'shell)            ; T5
  134. (define-key sun-raw-map "229z" 'shrink-window)        ; T6
  135. (define-key sun-raw-map "230z" 'enlarge-window)        ; T7
  136.  
  137. (if sun-esc-bracket
  138.     (progn
  139.       (define-key esc-map "[" sun-raw-map)        ; Install sun-raw-map
  140.       (define-key esc-map "[A" 'previous-line )        ; R8
  141.       (define-key esc-map "[B" 'next-line)        ; R14
  142.       (define-key esc-map "[C" 'forward-char)        ; R12
  143.       (define-key esc-map "[D" 'backward-char)        ; R10
  144.       (define-key esc-map "[[" 'backward-paragraph)    ; the original esc-[
  145.       ))
  146.  
  147. ;;; Since .emacs gets loaded before this file, a hook is supplied
  148. ;;; for you to put your own bindings in.
  149.  
  150. (defvar sun-raw-map-hooks nil
  151.   "List of forms to evaluate after setting sun-raw-map.")
  152.  
  153. (let ((hooks sun-raw-map-hooks))
  154.   (while hooks
  155.     (eval (car hooks))
  156.     (setq hooks (cdr hooks))
  157.     ))
  158.  
  159.  
  160. ;;; This section adds defintions for the emacstool users
  161. ;;; emacstool event filter converts function keys to C-x*{c}{lrt}
  162. ;;;
  163. ;;; for example the Open key (L7) would be encoded as "\C-x*gl"
  164. ;;; the control, meta, and shift keys modify the character {lrt}
  165. ;;; note that (unshifted) C-l is ",",  C-r is "2", and C-t is "4"
  166. ;;;
  167. ;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT.
  168. ;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys)
  169. ;;; as ANSI escape sequences.  Use the shell command 
  170. ;;; % setkeys noarrows
  171. ;;; if you want these to come through for emacstool.
  172. ;;;
  173. ;;; If you are not using EmacsTool, 
  174. ;;; you can also use this by creating a .ttyswrc file to do the conversion.
  175. ;;; but it won't include the CONTROL, META, or SHIFT keys!
  176. ;;;
  177.  
  178. ;;; Note:  al (STOP), el (EXPOSE) and gl (OPEN) are trapped by EmacsTool, 
  179. ;;; so they never make it here.
  180.  
  181. (defvar meta-flag t)
  182.  
  183. (defvar suntool-map (make-sparse-keymap)
  184.   "*Keymap for Emacstool bindings.")
  185.  
  186. (define-key suntool-map "ar" 'unbound-key)        ; R1
  187. (define-key suntool-map "br" 'unbound-key)        ; R2
  188. (define-key suntool-map "hr" 'previous-line)        ; R8  (up-arrow)
  189. (define-key suntool-map "jr" 'backward-char)        ; R10 (rt-arrow)
  190. (define-key suntool-map "lr" 'forward-char)        ; R12 (dn-arrow)
  191. (define-key suntool-map "nr" 'next-line)        ; R14 (lf-arrow)
  192. (define-key suntool-map "gr" 'beginning-of-buffer)    ; r7
  193. (define-key suntool-map "iR" 'backward-page)        ; R9
  194. (define-key suntool-map "ir" 'scroll-down)        ; r9
  195. (define-key suntool-map "kr" 'recenter)            ; r11
  196. (define-key suntool-map "mr" 'end-of-buffer)        ; r13
  197. (define-key suntool-map "oR" 'forward-page)        ; R15
  198. (define-key suntool-map "or" 'scroll-up)        ; r15
  199. (define-key suntool-map "b\M-L" 'rerun-prev-command)    ; M-AGAIN
  200. (define-key suntool-map "b\M-l" 'prev-complex-command)    ; M-Again
  201. (define-key suntool-map "bl" 'redraw-display)        ; Again    L1
  202. (define-key suntool-map "cl" 'list-buffers)        ; Props    L2
  203. (define-key suntool-map "dl" 'undo)            ; Undo    L3
  204. (define-key suntool-map "el" 'ignore-key)        ; Expose-Top    L4
  205. (define-key suntool-map "fl" 'sun-select-region)    ; Put    L5
  206. (define-key suntool-map "f," 'copy-region-as-kill)    ; C-Put    L5
  207. (define-key suntool-map "gl" 'ignore-key)        ; Open-Open    L6
  208. (define-key suntool-map "hl" 'sun-yank-selection)    ; Get    L7
  209. (define-key suntool-map "h," 'yank)            ; C-Get
  210. ;; interactive regexp search                ; Find    L8
  211. (define-key suntool-map "iL" 're-isearch-forward)    ; FIND (shift-Find)
  212. (define-key suntool-map "i\M-L" 're-isearch-backward)    ; M-FIND (M-shift-Find)
  213. ;; non-interactive versions: 
  214. ;; search again, using previous search arg as regexp.
  215. (define-key suntool-map "il" 'research-forward)        ; Find
  216. (define-key suntool-map "i\M-l" 'research-backward)    ; M-Find
  217. ;; supply new arg
  218. (define-key suntool-map "i," 're-search-forward)    ; C-Find
  219. (define-key suntool-map "i\M-," 're-search-backward)    ; C-M-Find
  220.  
  221. (define-key suntool-map "jL" 'yank)            ; DELETE  L9      
  222. (define-key suntool-map "jl" 'kill-region-and-unmark)    ; Delete
  223. (define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete
  224. (define-key suntool-map "j," 
  225.   '(lambda () (interactive) (pop-mark 1)))        ; C-Delete
  226.  
  227. (define-key suntool-map "bt" 'toggle-selective-display)     ; t2
  228. (define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n)))
  229. (define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n)))
  230. (define-key suntool-map "ct" 'scroll-down-in-place)        ; t3
  231. (define-key suntool-map "dt" 'scroll-up-in-place)        ; t4
  232. (define-key suntool-map "et" 'shell)                ; t5
  233. (define-key suntool-map "fT" 'shrink-window-horizontally)    ; T6
  234. (define-key suntool-map "gT" 'enlarge-window-horizontally)    ; T7
  235. (define-key suntool-map "ft" 'shrink-window)            ; t6
  236. (define-key suntool-map "gt" 'enlarge-window)            ; t7
  237. (define-key ctl-x-map "*" suntool-map)
  238.  
  239. ;;; Since .emacs gets loaded before this file, a hook is supplied
  240. ;;; for you to put your own bindings in.
  241.  
  242. ;;; Example:
  243. ;(setq suntool-map-hooks '(            ; not your usual hook list
  244. ;  (define-key suntool-map "c\M-l" 'browse)     ; Meta-Props
  245. ;  (define-key suntool-map "dr" 'goto-line)     ; R4
  246. ;  (define-key suntool-map "d2" 'what-line)     ; Control-R4
  247. ;  ))
  248.  
  249. (defvar suntool-map-hooks nil
  250.   "List of forms to evaluate after setting suntool-map.")
  251.  
  252. (let ((hooks suntool-map-hooks))
  253.   (while hooks
  254.     (eval (car hooks))
  255.     (setq hooks (cdr hooks))
  256.     ))
  257.  
  258. ;;;
  259. ;;; If running under emacstool, arrange to call suspend-emacstool
  260. ;;; instead of suspend-emacs.
  261. ;;;
  262. ;;; First mouse blip is a clue that we are in emacstool.
  263. ;;;
  264. ;;; C-x C-@ is the mouse command prefix.
  265.  
  266. (autoload 'sun-mouse-handler "sun-mouse" 
  267.       "Sun Emacstool handler for mouse blips (not loaded)." t)
  268.  
  269. (defun emacstool-init ()
  270.   "Set up Emacstool window, if you know you are in an emacstool."
  271.   ;; Make sure sun-mouse and sun-fns are loaded.
  272.   (require 'sun-fns)
  273.   (define-key ctl-x-map "\C-@" 'sun-mouse-handler)
  274.  
  275.   (if (< (sun-window-init) 0)
  276.       (message "Not a Sun Window")
  277.     (progn
  278.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map)
  279.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map)
  280.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map))
  281.       (send-string-to-terminal
  282.        (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\"))
  283.     ))
  284.  
  285. (defun sun-mouse-once ()
  286.   "Converts to emacstool and sun-mouse-handler on first mouse hit."
  287.   (interactive)
  288.   (emacstool-init)
  289.   (sun-mouse-handler)            ; Now, execute this mouse blip.
  290.   )
  291. (define-key ctl-x-map "\C-@" 'sun-mouse-once)
  292.  
  293. ;;; If Emacstool is being nice, and informs us of its presence:
  294. (if (getenv "IN_EMACSTOOL") (emacstool-init))
  295.