Annotation of 43BSDReno/contrib/emacs-18.55/lisp/term/sun.el, revision 1.1.1.1

1.1       root        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  <[email protected]>
                     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))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.