home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 6 / FreshFish_September1994.bin / bbs / gnu / emacs-18.59-src.lha / GNU / src / amiga / emacs-18.59 / lisp / term / sun.el < prev    next >
Encoding:
Text File  |  1992-10-22  |  13.1 KB  |  334 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 free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but 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 GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. ;;  Jeff Peck, Sun Microsystems Inc  <peck@sun.com>
  21. ;;    Mar, 91        better integration with X windows
  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 on-window-line-p (n)
  34.   (save-excursion
  35.     (beginning-of-line 1)
  36.     (let ((p (point)))
  37.       (move-to-window-line n)
  38.       (equal (point) p))))
  39.  
  40. (defun scroll-down-in-place (n)
  41.   (interactive "p")
  42.   (if (on-window-line-p 0)
  43.       (progn (scroll-down n) (previous-line n))
  44.       (previous-line n) (scroll-down n)))
  45.  
  46. (defun scroll-up-in-place (n)
  47.   (interactive "p")
  48.   (if (on-window-line-p -1)
  49.       (progn (scroll-up n) (next-line n))
  50.       (next-line n) (scroll-up n)))
  51.  
  52. (defun kill-region-and-unmark (beg end)
  53.   "Like kill-region, but pops the mark [which equals point, anyway.]"
  54.   (interactive "r")
  55.   (kill-region beg end)
  56.   (setq this-command 'kill-region-and-unmark)
  57.   (set-mark-command t))
  58.  
  59. (defun rerun-prev-command ()
  60.   "Repeat Previous-complex-command."
  61.   (interactive)
  62.   (eval (nth 0 command-history)))
  63.  
  64. (defvar grep-arg nil "Default arg for RE-search")
  65.  
  66. ;; not sure this all works... or works at all...
  67. (defun search-command-arg ()
  68.   ;; if previous minibuf command specified a search string, return it.
  69.   ;; this way, a call to M-x re-search-forward can pass its arg.
  70.   (let* ((command (car command-history))
  71.      (command-name (symbol-name (car command)))
  72.      (search-arg (car (cdr command)))
  73.      (search-command 
  74.       (and command-name (string-match "search" command-name))))
  75.     (and search-command (stringp search-arg) search-arg)))
  76.  
  77. (defun grep-arg (&optional prompt)
  78.   "helper function used by research-{backward,forward}"
  79.   (if (memq last-command '(research-forward research-backward)) grep-arg
  80.     (let ((this-command this-command)    ; save this binding from read-string
  81.       (default (or (search-command-arg)
  82.                search-last-regexp
  83.                grep-arg)))
  84.       (read-string (or prompt "Regexp arg: ") default))))
  85.  
  86. (defun research-forward ()
  87.   "Repeat regexp search forward, using previous search arg if available."
  88.   (interactive)                ;
  89.   (if (re-search-forward (grep-arg "Regexp search: "))
  90.       (setq search-last-regexp grep-arg)))
  91.  
  92. (defun research-backward ()
  93.   "Repeat regexp search backward, using previous search arg if available."
  94.   (interactive)                ;
  95.   (if (re-search-backward (grep-arg "Regexp search backward: "))
  96.       (setq search-last-regexp grep-arg)))
  97.  
  98. (defun help-for-dummies ()
  99.   (interactive)
  100.   (let ((char ?\C-h))
  101.     (if (or (= char ?\C-h) (= char ??))
  102.     (save-window-excursion
  103.       (switch-to-buffer "*Help*")
  104.       (erase-buffer)
  105.       (insert (documentation 'help-for-help))
  106.       (goto-char (point-min))
  107.       (while (memq char '(?\C-h ?? ?\C-v ?\ ?\177 ?\M-v))
  108.         (if (memq char '(?\C-v ?\ ))
  109.         (scroll-up))
  110.         (if (memq char '(?\177 ?\M-v))
  111.         (scroll-down))
  112.         (message "A B C F I K L M N S T V W C-c C-d C-n C-w%s: "
  113.              (if (pos-visible-in-window-p (point-max))
  114.              "" " or Space to scroll"))
  115.         (let ((cursor-in-echo-area t))
  116.           (setq char (read-char))))))
  117.     (let ((defn (cdr (assq (downcase char) (cdr help-map)))))
  118.       (if defn (call-interactively defn) (ding)))))
  119.  
  120. ;;;
  121. ;;; handle sun's extra function keys
  122. ;;; this version for those who run with standard .ttyswrc and no emacstool
  123. ;;;
  124. ;;; sunview picks up expose and open on the way UP, 
  125. ;;; so we ignore them on the way down
  126. ;;;
  127.  
  128. ;;; Since .emacs gets loaded before this file, a hook is supplied
  129. ;;; for you to put your own bindings in. Example:
  130. ;(setq sun-esc-bracket t)
  131. ;(setq sun-raw-map-hooks '(            ; not your usual hook list
  132. ;  (define-key sun-raw-map "211z" 'goto-line)     ; R4
  133. ;  (define-key sun-raw-map "212z" 'other-window)    ; R5
  134. ;  (define-key sun-raw-map "213z" 'scroll-other-window)    ; R6
  135. ;  ))
  136.  
  137. (defvar sun-esc-bracket nil
  138.   "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
  139.  
  140. (defvar sun-raw-map (make-sparse-keymap) "*Keymap for ESC-[ encoded keyboard")
  141.  
  142. (define-key sun-raw-map "208z" 'unbound-key)        ; R1
  143. (define-key sun-raw-map "209z" 'unbound-key)        ; R2
  144. (define-key sun-raw-map "210z" 'backward-page)        ; R3
  145. (define-key sun-raw-map "213z" 'forward-page)        ; R6
  146. (define-key sun-raw-map "214z" 'beginning-of-buffer)    ; R7
  147. (define-key sun-raw-map "216z" 'scroll-down)        ; R9
  148. (define-key sun-raw-map "215z" 'previous-line)        ; R8  (up-arrow)
  149. (define-key sun-raw-map "217z" 'backward-char)        ; R10 (rt-arrow)
  150. (define-key sun-raw-map "219z" 'forward-char)        ; R12 (dn-arrow)
  151. (define-key sun-raw-map "221z" 'next-line)        ; R14 (lf-arrow)
  152. (define-key sun-raw-map "218z" 'recenter)               ; R11
  153. (define-key sun-raw-map "220z" 'end-of-buffer)        ; R13
  154. (define-key sun-raw-map "222z" 'scroll-up)        ; R15
  155. (define-key sun-raw-map "193z" 'redraw-display)        ; Again    L1
  156. (define-key sun-raw-map "194z" 'list-buffers)        ; Props    L2
  157. (define-key sun-raw-map "195z" 'undo)            ; Undo    L3
  158. (define-key sun-raw-map "196z" 'ignore-key)        ; Expose-down    L4
  159. (define-key sun-raw-map "197z" 'sun-select-region)    ; Put    L5
  160. (define-key sun-raw-map "198z" 'ignore-key)        ; Open-down    L6
  161. (define-key sun-raw-map "199z" 'sun-yank-selection)    ; Get    L7
  162. (define-key sun-raw-map "200z" 'exchange-point-and-mark); Find    L8
  163. (define-key sun-raw-map "201z" 'kill-region-and-unmark)    ; Delete    L9
  164. (define-key sun-raw-map "207z" 'help-for-help)        ; Help Key on Type-4 KBD
  165. (define-key sun-raw-map "225z" 'toggle-selective-display); T2
  166. (define-key sun-raw-map "226z" 'scroll-down-in-place)    ; T3
  167. (define-key sun-raw-map "227z" 'scroll-up-in-place)    ; T4
  168. (define-key sun-raw-map "228z" 'shell)            ; T5
  169. (define-key sun-raw-map "229z" 'shrink-window)        ; T6
  170. (define-key sun-raw-map "230z" 'enlarge-window)        ; T7
  171.  
  172. (if sun-esc-bracket
  173.     (progn
  174.       (define-key esc-map "[" sun-raw-map)        ; Install sun-raw-map
  175.       (define-key esc-map "[A" 'previous-line )        ; R8
  176.       (define-key esc-map "[B" 'next-line)        ; R14
  177.       (define-key esc-map "[C" 'forward-char)        ; R12
  178.       (define-key esc-map "[D" 'backward-char)        ; R10
  179.       (define-key esc-map "[[" 'backward-paragraph)    ; the original esc-[
  180.       ))
  181.  
  182. ;;; Since .emacs gets loaded before this file, a hook is supplied
  183. ;;; for you to put your own bindings in.
  184.  
  185. (defvar sun-raw-map-hooks nil
  186.   "List of forms to evaluate after setting sun-raw-map.
  187. This list is processed by: (mapcar 'eval sun-raw-map-hooks)")
  188.  
  189. (mapcar 'eval sun-raw-map-hooks)
  190.  
  191. ;;; This section adds defintions for the emacstool users
  192. ;;; emacstool event filter converts function keys to C-x*{c}{lrt}
  193. ;;;
  194. ;;; for example the Open key (L7) would be encoded as "\C-x*gl"
  195. ;;; the control, meta, and shift keys modify the character {lrt}
  196. ;;; note that (unshifted) C-l is ",",  C-r is "2", and C-t is "4"
  197. ;;;
  198. ;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT.
  199. ;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys)
  200. ;;; as ANSI escape sequences.  Use the shell command 
  201. ;;; % setkeys noarrows
  202. ;;; if you want these to come through for emacstool.
  203. ;;;
  204. ;;; If you are not using EmacsTool, 
  205. ;;; you can also use this by creating a .ttyswrc file to do the conversion.
  206. ;;; but it won't include the CONTROL, META, or SHIFT keys!
  207. ;;;
  208.  
  209. ;;; Note:  al (STOP), el (EXPOSE) and gl (OPEN) are trapped by EmacsTool, 
  210. ;;; so they never make it here.
  211.  
  212. (defvar meta-flag t)
  213.  
  214. (defvar suntool-map (make-sparse-keymap)
  215.   "*Keymap for Emacstool bindings.")
  216.  
  217. (define-key suntool-map "ar" 'unbound-key)        ; R1
  218. (define-key suntool-map "br" 'unbound-key)        ; R2
  219. (define-key suntool-map "hr" 'previous-line)        ; R8  (up-arrow)
  220. (define-key suntool-map "jr" 'backward-char)        ; R10 (rt-arrow)
  221. (define-key suntool-map "lr" 'forward-char)        ; R12 (dn-arrow)
  222. (define-key suntool-map "nr" 'next-line)        ; R14 (lf-arrow)
  223. (define-key suntool-map "gr" 'beginning-of-buffer)    ; r7
  224. (define-key suntool-map "iR" 'backward-page)        ; R9
  225. (define-key suntool-map "ir" 'scroll-down)        ; r9
  226. (define-key suntool-map "kr" 'recenter)            ; r11
  227. (define-key suntool-map "mr" 'end-of-buffer)        ; r13
  228. (define-key suntool-map "oR" 'forward-page)        ; R15
  229. (define-key suntool-map "or" 'scroll-up)        ; r15
  230. (define-key suntool-map "b\M-L" 'rerun-prev-command)    ; M-AGAIN
  231. (define-key suntool-map "b\M-l" 'repeat-complex-command); M-Again
  232. (define-key repeat-complex-command-map "\C-x*b\M-l" 'previous-complex-command)
  233. (define-key suntool-map "bl" 'redraw-display)        ; Again    L1
  234. (define-key suntool-map "cl" 'list-buffers)        ; Props    L2
  235. (define-key suntool-map "dl" 'undo)            ; Undo    L3
  236. (define-key suntool-map "el" 'ignore-key)        ; Expose-Top    L4
  237. (define-key suntool-map "fl" 'sun-select-region)    ; Put        L5
  238. (define-key suntool-map "f," 'copy-region-as-kill)    ; C-Put        L5
  239. (define-key suntool-map "gl" 'ignore-key)        ; Open-Open    L6
  240. (define-key suntool-map "hl" 'sun-yank-selection)    ; Get        L7
  241. (define-key suntool-map "h\M-l" 'sunview-yank-any-selection) ; M-Get    L7
  242. (define-key suntool-map "h," 'yank)            ; C-Get
  243. ;; interactive regexp search                ; Find    L8
  244. (define-key suntool-map "iL" 're-isearch-forward)    ; FIND (shift-Find)
  245. (define-key suntool-map "i\M-L" 're-isearch-backward)    ; M-FIND (M-shift-Find)
  246. ;; non-interactive versions: 
  247. ;; search again, using previous search arg as regexp.
  248. (define-key suntool-map "il" 'research-forward)        ; Find
  249. (define-key suntool-map "i\M-l" 'research-backward)    ; M-Find
  250. ;; supply new arg
  251. (define-key suntool-map "i," 're-search-forward)    ; C-Find
  252. (define-key suntool-map "i\M-," 're-search-backward)    ; C-M-Find
  253.  
  254. (define-key suntool-map "jL" 'yank)            ; DELETE  L9      
  255. (define-key suntool-map "jl" 'kill-region-and-unmark)    ; Delete
  256. (define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete
  257. (define-key suntool-map "j," 
  258.   '(lambda () (interactive) (pop-mark 1)))        ; C-Delete
  259. (define-key suntool-map "pl" 'describe-mode)         ; Help
  260. (define-key suntool-map "p\M-l" 'command-apropos)     ; M-Help
  261. (define-key suntool-map "pL" 'describe-bindings)     ; HELP
  262. ;; Oops, Help is preempted by Xview, may need to modify xvetool
  263. (define-key suntool-map "p," 'help-for-help)         ; C-Help
  264. (define-key suntool-map "p," 'help-for-dummies)         ; C-Help
  265.  
  266. (define-key suntool-map "bt" 'toggle-selective-display)     ; t2
  267. (define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n)))
  268. (define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n)))
  269. (define-key suntool-map "ct" 'scroll-down-in-place)        ; t3
  270. (define-key suntool-map "dt" 'scroll-up-in-place)        ; t4
  271. (define-key suntool-map "et" 'shell)                ; t5
  272. (define-key suntool-map "fT" 'shrink-window-horizontally)    ; T6
  273. (define-key suntool-map "gT" 'enlarge-window-horizontally)    ; T7
  274. (define-key suntool-map "ft" 'shrink-window)            ; t6
  275. (define-key suntool-map "gt" 'enlarge-window)            ; t7
  276. (define-key ctl-x-map "*" suntool-map)
  277.  
  278. ;;; Since .emacs gets loaded before this file, a hook is supplied
  279. ;;; for you to put your own bindings in.
  280.  
  281. ;;; Example:
  282. ;(setq suntool-map-hooks '(            ; not your usual hook list
  283. ;  (define-key suntool-map "c\M-l" 'browse)     ; Meta-Props
  284. ;  (define-key suntool-map "dr" 'goto-line)     ; R4
  285. ;  (define-key suntool-map "d2" 'what-line)     ; Control-R4
  286. ;  ))
  287.  
  288. (defvar suntool-map-hooks nil
  289.   "List of forms to evaluate after setting suntool-map.
  290. This variable is processed by: (mapcar 'eval suntool-map-hooks)")
  291.  
  292. (mapcar 'eval suntool-map-hooks)
  293.  
  294. ;;;
  295. ;;; If running under emacstool, arrange to call suspend-emacstool
  296. ;;; instead of suspend-emacs.
  297. ;;;
  298. ;;; First mouse blip is a clue that we are in emacstool.
  299. ;;;
  300. ;;; C-x C-@ is the mouse command prefix.
  301.  
  302. (autoload 'sun-mouse-handler "sun-mouse" 
  303.       "Sun Emacstool handler for mouse blips (not loaded)." t)
  304.  
  305. (defun sun-mouse-once ()
  306.   "Converts to emacstool and sun-mouse-handler on first mouse hit."
  307.   (interactive)
  308.   (emacstool-init)
  309.   (sun-mouse-handler)            ; Now, execute this mouse blip.
  310.   )
  311. (if (not window-system)            ; don't do this for X!
  312.     (define-key ctl-x-map "\C-@" 'sun-mouse-once))
  313.  
  314. (defun emacstool-init ()
  315.   "Set up Emacstool window, if you know you are in an emacstool."
  316.   ;; Make sure sun-mouse and sun-fns are loaded.
  317.   (require 'sun-fns)
  318.   (define-key ctl-x-map "\C-@" 'sun-mouse-handler)
  319.  
  320.   (if (fboundp 'sun-window-init) ()
  321.       (error "SunWindows support not compiled in: #define HAVE_SUN_WINDOWS in config.h"))
  322.   (if (and (not (getenv "DISPLAY")) (< (sun-window-init) 0))
  323.       (message "Not a SunView Window"))
  324.   (progn
  325.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map)
  326.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map)
  327.       (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map)
  328.       (send-string-to-terminal
  329.        (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\")))
  330.   )
  331.  
  332. ;;; If Emacstool is being nice, and informs us of its presence:
  333. (if (getenv "IN_EMACSTOOL") (emacstool-init))
  334.