home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / editors / demacs-5.arj / IBMPC.EL < prev    next >
Text File  |  1991-12-13  |  6KB  |  172 lines
  1. ;; ibmpc.el: IBM PC cursor key and function key mapping
  2. ;;
  3. ;; Edition History:
  4. ;; 1.1 91/11/20 Halca.HIRANO creation
  5. ;; 1.2 91/11/28 Manabu Higashida
  6. ;; 1.3 91/12/12 Toshihiko SHIMOKAWA
  7. ;;
  8.  
  9. ;; Copyright (C) 1991 Free Software Foundation, Inc.
  10.  
  11. ;; This file is part of GNU Emacs.
  12.  
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  15. ;; accepts responsibility to anyone for the consequences of using it
  16. ;; or for whether it serves any particular purpose or works at all,
  17. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  18. ;; License for full details.
  19.  
  20. ;; Everyone is granted permission to copy, modify and redistribute
  21. ;; GNU Emacs, but only under the conditions described in the
  22. ;; GNU Emacs General Public License.   A copy of this license is
  23. ;; supposed to have been given to you along with GNU Emacs so you
  24. ;; can know your rights and responsibilities.  It should be in a
  25. ;; file named COPYING.  Among other things, the copyright notice
  26. ;; and this notice must be preserved on all copies.
  27.  
  28. ;;
  29.  
  30. (defun ibmpc-assign-special-key ()
  31.   (send-string-to-terminal "\e[0;71;\"\e<\"p")    ; Home       -> M-<
  32.   (send-string-to-terminal "\e[0;72;\"\"p")    ; UpArrow    -> C-p
  33.   (send-string-to-terminal "\e[0;73;\"\ev\"p")    ; PgUp       -> M-v
  34.   (send-string-to-terminal "\e[0;75;\"\"p")    ; LeftArrow  -> C-b
  35.   (send-string-to-terminal "\e[0;77;\"\"p")    ; RightArrow -> C-f
  36.   (send-string-to-terminal "\e[0;79;\"\e>\"p")    ; End        -> M->
  37.   (send-string-to-terminal "\e[0;80;\"\"p")    ; DownArrow  -> C-n
  38.   (send-string-to-terminal "\e[0;81;\"\"p")    ; PgDn       -> C-v
  39. ; (send-string-to-terminal "\e[0;82;0;82p")    ; Ins
  40.   (send-string-to-terminal "\e[0;83;\"\"p")    ; Del        -> DEL
  41.   )
  42.  
  43. (defun ibmpc-cancel-special-key ()
  44.   (send-string-to-terminal "\e[0;71;0;71p")    ; Home
  45.   (send-string-to-terminal "\e[0;72;0;72p")    ; UpArrow
  46.   (send-string-to-terminal "\e[0;73;0;73p")    ; PgUp
  47.   (send-string-to-terminal "\e[0;75;0;75p")    ; LeftArrow
  48.   (send-string-to-terminal "\e[0;77;0;77p")    ; RightArrow
  49.   (send-string-to-terminal "\e[0;79;0;79p")    ; End
  50.   (send-string-to-terminal "\e[0;80;0;80p")    ; DownArrow
  51.   (send-string-to-terminal "\e[0;81;0;81p")    ; PgDn
  52. ; (send-string-to-terminal "\e[0;82;0;82p")    ; Ins
  53.   (send-string-to-terminal "\e[0;83;0;83p")    ; Del
  54.   )
  55.  
  56. ;;
  57.  
  58. (defvar ibmpc-map (make-keymap)
  59.   "The ibmpc-map maps the function keys on the IBMPC keyboard.")
  60.  
  61. ;; function keys
  62.  
  63. (define-key ibmpc-map ";" 'help-for-help)         ; f1
  64. (define-key ibmpc-map "T" 'describe-mode)        ; shift-f1
  65. (define-key ibmpc-map "^" 'describe-key)        ; ctrl-f1
  66.  
  67. (define-key ibmpc-map "<" 'other-window)        ; f2
  68. (define-key ibmpc-map "U" 'switch-to-buffer)        ; shift-f2
  69. (define-key ibmpc-map "_" 'list-buffers)        ; ctrl-f2
  70.  
  71. (define-key ibmpc-map "=" 'delete-other-windows)    ; f3
  72. (define-key ibmpc-map "V" 'delete-window)        ; s-f3
  73. (define-key ibmpc-map "`" 'scroll-other-window)        ; c-f3
  74.  
  75. (define-key ibmpc-map ">" 'split-window-vertically)    ; f4
  76. (define-key ibmpc-map "W" 'enlarge-window)        ; s-f4
  77. (define-key ibmpc-map "a" 'shrink-window)        ; c-f4
  78.  
  79. (define-key ibmpc-map "?" 'split-window-horizontally)    ; f5
  80. (define-key ibmpc-map "X" 'enlarge-window-horizontally) ; s-f5
  81. (define-key ibmpc-map "b" 'shrink-window-horizontally)    ; c-f5
  82.  
  83. (define-key ibmpc-map "@" 'copy-region-as-kill)        ; f6
  84. (define-key ibmpc-map "Y" 'kill-region)            ; s-f6
  85. (define-key ibmpc-map "c" 'yank)            ; c-f6
  86.  
  87. (define-key ibmpc-map "A" 'goto-line)            ; f7
  88. (define-key ibmpc-map "Z" 'isearch-forward)        ; s-f7
  89. (define-key ibmpc-map "d" 'query-replace)        ; c-f7
  90.  
  91. (define-key ibmpc-map "B" 'find-file)            ; f8
  92. (define-key ibmpc-map "[" 'save-buffer)            ; s-f8
  93. (define-key ibmpc-map "e" 'write-file)            ; c-f8
  94.  
  95. (define-key ibmpc-map "C" 'dired)            ; f9
  96. (define-key ibmpc-map "\\" 'compile)            ; s-f9
  97. (define-key ibmpc-map "e" 'repeat-complex-command)    ; c-f9
  98.  
  99. (define-key ibmpc-map "D" 'shell-command)        ; f10
  100. (define-key ibmpc-map "]" 'suspend-emacs)        ; s-f10
  101. (define-key ibmpc-map "g" 'save-buffers-kill-emacs)    ; c-f10
  102.  
  103. ;; cursor key
  104.  
  105. (define-key ibmpc-map "R" 'set-mark-command)        ; insert
  106. (define-key ibmpc-map "\C-@" 'set-mark-command)        ; original ^@
  107.  
  108. (define-key global-map "\C-@" ibmpc-map)
  109.  
  110. (defvar ibmpc-map-hooks nil
  111.  "List of forms to evaluate after setting ibmpc-map.")
  112.  
  113. (let ((hooks ibmpc-map-hooks))
  114.   (while hooks
  115.     (eval (car hooks))
  116.     (setq hooks (cdr hooks))))
  117.  
  118. ;;
  119. ;; function key label support functions
  120. ;;
  121. (defvar console-is-with-function-key-label nil
  122.  "If value is t, the console consists of emacs windows and function key label.")
  123.  
  124. (defun redraw-display-with-function-key-label ()
  125.   (redraw-display)
  126.   (put-function-key-label))
  127.  
  128. (defun recenter-with-function-key-label (&optional arg) "\
  129.   recenter and display function key label."
  130.   (interactive)
  131.   (recenter arg)
  132.   (put-function-key-label))
  133.  
  134. (defun setup-console-with-function-key-label ()
  135.   (delete-other-windows)
  136.   (enlarge-window 100)
  137.   (shrink-window 4)
  138.   (message "")
  139.   (redraw-display-with-function-key-label)
  140.   (send-string-to-terminal "\e[1;1f"))
  141.   
  142. (defun put-function-key-label ()
  143.   (save-excursion
  144.     (message "")
  145.     (send-string-to-terminal
  146.       (format "\e[%d;1f\
  147.  | F.1 |  F.2  |  F.3  |  F.4   |  F.5   | F.6 |  F.7  | F.8  | F.9  | F.10   |\n\
  148.  |help | nextW | delOW |splitWH |splitWV |copy | goto  | read |dired |command |\n\
  149. s|mode |switchW| delW  |largeWH |largeWV |kill |search | save | make |suspend |\n\
  150. c|key  |buffers|scrlOW |shrnkWH |shrnkWV |yank |replace|write |repeat| quit   |" (- (screen-height) 3))))
  151.   nil)
  152.  
  153. (defun erase-system-function-key-label ()
  154.  "Erase system function key label."
  155.  t)
  156.  
  157. (defun appear-system-function-key-label ()
  158.  "Appear system function key label."
  159.  t)
  160.  
  161.  
  162.  
  163.  
  164. (if console-is-with-function-key-label
  165.     (progn
  166.       (global-set-key "\C-l" 'recenter-with-function-key-label)
  167.       (setup-console-with-function-key-label)))
  168.  
  169. (ibmpc-assign-special-key)
  170. ;(setq meta-flag t)        ; enable meta by ATL keys
  171.                 ; this can be enabled by termcap switch ':km:'
  172.