Annotation of GNUtools/emacs/lisp/term/sun.el, revision 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 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  <[email protected]>
        !            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))

unix.superglobalmegacorp.com

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