;;; -*- Mode:Common-Lisp; Package:TV; Base:10.; Cold-Load: t; -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ; Copyright (c) 1987-1989 Texas Instruments Incorporated All Rights Reserved ;;; ;;; Edit History ;;; ;;; Patch ;;; Date Author Number Description ;;;--------------------------------------------------------------------------------- ;;; 01-18-88 ab -- o Original, derived from Mac-window VARIABLES ;;; and KEYBOARD files. ;;; 2-25-88 DNG o Added BEEP function (previously in "LOAD-BAND;BEEP"). ;;; 03-17-88 ked 4.41 o Add multiple character output mapping tables. ;;;############################################################### ;;; ;;; MAC Keyboard Definitions ;;; ;;;############################################################### ;;; Mac key modifier definition ;;; ;;; The Mac key modifier is a 16-bit integer with the following bits defined: (DEFCONSTANT Mac-CONTROL-bit 12 "Bit in Mac key modifier indicating CONTROL key down.") (DEFCONSTANT Mac-OPTION-bit 11 "Bit in Mac key modifier indicating OPTION key down.") (DEFCONSTANT Mac-CAPSLOCK-bit 10 "Bit in Mac key modifier indicating CAPS LOCK key down.") (DEFCONSTANT Mac-SHIFT-bit 9 "Bit in Mac key modifier indicating SHIFT key down.") (DEFCONSTANT Mac-COMMAND-bit 8 "Bit in Mac key modifier indicating COMMAND key down.") (DEFCONSTANT Mac-MOUSE-bit 7 "Bit in Mac key modifier indicating MOUSE key up.") (DEFCONSTANT Mac-AUTOKEY-bit 5 "Bit in Mac key modifier indicating MOUSE key up.") (DEFCONSTANT Mac-Window-Activate-bit 0 "Bit in Mac key modifier indicating window is being activated down.") ;;; LISPM key modifier definition ;;; ;;; The LISPM has two variables sys:kbd-left-shifts and sys:kbd-right-shifts ;;; which are used to appropriately modify the conversion of a scan-code to ;;; a software defined key. These variables have the following bits defined: (DEFCONSTANT lispm-shift-bit 0 "Bit in the si:kbd-left-shifts variable indicating the SHIFT key is down.") (DEFCONSTANT lispm-greek-bit 1 "Bit in the si:kbd-left-shifts variable indicating the SYMBOL key is down.") (DEFCONSTANT lispm-top-bit 2 "Bit in the si:kbd-left-shifts variable indicating the TOP key is down.") (DEFCONSTANT lispm-capslock-bit 3 "Bit in the si:kbd-left-shifts variable indicating the CAPS LOCK key is down.") (DEFCONSTANT lispm-control-bit 4 "Bit in the si:kbd-left-shifts variable indicating the CONTROL key is down.") (DEFCONSTANT lispm-meta-bit 5 "Bit in the si:kbd-left-shifts variable indicating the META key is down.") (DEFCONSTANT lispm-super-bit 6 "Bit in the si:kbd-left-shifts variable indicating the SUPER key is down.") (DEFCONSTANT lispm-hyper-bit 7 "Bit in the si:kbd-left-shifts variable indicating the HYPER key is down.") (DEFCONSTANT lispm-altlock-bit 8 "Bit in the si:kbd-left-shifts variable indicating the ALT LOCK key is down.") (DEFCONSTANT lispm-modelock-bit 9 "Bit in the si:kbd-left-shifts variable indicating the MODE LOCK key is down.") (DEFCONSTANT lispm-repeat-bit 10 "Bit in the si:kbd-left-shifts variable indicating the REPEAT key is down.") ;;; ;;; This table is indexed by a 5 bit integer of the form #bCOLSD where: ;;; C = 1 for Mac control key down ;;; O = 1 for Mac option key down ;;; L = 1 for Mac caps lock key down ;;; S = 1 for Mac shift key down ;;; D = 1 for Mac command key down ;;; ;;; It returns to a 7 bit integer in the form #bHSMCL0GT where: ;;; H = 1 for LISPM hyper key down ;;; S = 1 for LISPM super key down ;;; M = 1 for LISPM meta key down ;;; C = 1 for LISPM control key down ;;; L = 1 for LISPM capslock key down ;;; G = 1 for LISPM Greek (symbol) key down ;;; T = 1 for LISPM shift key down ;;; (DEFVAR mac-kbd-modifier-table (MAKE-ARRAY 32. :initial-contents ;; LISPM shift-code Mac-modifier-code ;; hsmcl0gt colsd '(#b00000000 ;#b00000 #b01000000 ;#b00001 #b00000001 ;#b00010 #b01000001 ;#b00011 #b00001000 ;#b00100 #b01001000 ;#b00101 #b00001001 ;#b00110 #b01001001 ;#b00111 #b00100000 ;#b01000 #b10000000 ;#b01001 #b00100001 ;#b01010 #b10000001 ;#b01011 #b00101000 ;#b01100 #b10001000 ;#b01101 #b00101001 ;#b01110 -- #b10001001 ;#b01111 #b00010000 ;#b10000 #b00000010 ;#b10001 #b00010001 ;#b10010 #b00000011 ;#b10011 #b00011000 ;#b10100 #b00001010 ;#b10101 #b00011001 ;#b10110 #b00001011 ;#b10111 #b00110000 ;#b11000 #b10010000 ;#b11001 #b00110001 ;#b11010 #b10010001 ;#b11011 #b00111000 ;#b11100 #b10011000 ;#b11101 #b00111001 ;#b11110 #b10011001 ;#b11111 ))) (DEFVAR mac-kbd-modifier-table-zmacs-mode (MAKE-ARRAY 32. :initial-contents ;; LISPM shift-code Mac-modifier-code ;; hsmcl0gt colsd '(#b00000000 ;#b00000 #b00010000 ;#b00001 #b00000001 ;#b00010 #b00010001 ;#b00011 #b00001000 ;#b00100 #b00011000 ;#b00101 #b00001001 ;#b00110 #b00011001 ;#b00111 #b00100000 ;#b01000 #b00110000 ;#b01001 #b00100001 ;#b01010 #b00110001 ;#b01011 #b00101000 ;#b01100 #b00111000 ;#b01101 #b00101001 ;#b01110 -- #b00111001 ;#b01111 #b01000000 ;#b10000 #b00000010 ;#b10001 #b01000001 ;#b10010 #b00000011 ;#b10011 #b01001000 ;#b10100 #b00001010 ;#b10101 #b01001001 ;#b10110 #b00001011 ;#b10111 #b10000000 ;#b11000 #b10010000 ;#b11001 #b10000001 ;#b11010 #b10010001 ;#b11011 #b10001000 ;#b11100 #b10011000 ;#b11101 #b10001001 ;#b11110 #b10011001 ;#b11111 ))) si:(DEFVAR *kbd-zmacs-mode* nil "If t then the Mac command key is the LISPM control key and the Mac control key is the LISPM super key. This is for people who are used to the Explorer keyboard layout.") #| Each row of the keyboard table corresponds to one key. The columns in a particular row are what are generated when a specific combination of shifting keys is pressed. These translations are: Column Shifting key Example keystroke Resulting character 1 none L l 2 SHIFT SHIFT-L L 3 SYMBOL SYMBOL-L  (double arrow) 4 SYMBOL-SHIFT symbol-SHIFT-L  (lambda) 5 unused column 6 repeating flag Note that column 5 is unused and can be removed. It is present for historical reasons only. Column 6 is a flag used by the code which generates repeating characters (i.e. typo-matic). If the value in this column is 0 then that key, when held down, will not repeat. Otherwise the key is repeating. This way one can make sure that certain characters (e.g. SYSTEM) will not repeat. |# (DEFPARAMETER mac-extended-kbd-descriptor '((nil nil #\ #\ #xC000 1) ; 0 #x 0 (nil nil #\ #\ #xC000 1) ; 1 #x 1 (nil nil #\ #\ #xC000 1) ; 2 #x 2 (nil nil #\ #\ #xC000 1) ; 3 #x 3 (nil nil #\ #\ #xC000 1) ; 4 #x 4 (nil nil #\ #\ #xC000 1) ; 5 #x 5 (nil nil #\ #\ #xC000 1) ; 6 #x 6 (nil nil #\ #\ #xC000 1) ; 7 #x 7 (nil nil #\ #\ #xC000 1) ; 8 #x 8 (nil nil #\ #\ #xC000 1) ; 9 #x 9 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 10 #x A (nil nil #\ #\ #xC000 1) ; 11 #x B (nil nil #\ #\ #xC000 1) ; 12 #x C (nil nil #\ #\ #xC000 1) ; 13 #x D (nil nil #\ #\ #xC000 1) ; 14 #x E (nil nil #\ #\ #xC000 1) ; 15 #x F (nil nil #\ #\ #xC000 1) ; 16 #x10 (nil nil #\ #\ #xC000 1) ; 17 #x11 (nil nil #\ #\ #xC000 1) ; 18 #x12 (nil nil #\ #\ #xC000 1) ; 19 #x13 (nil nil #\ #\ #xC000 1) ; 20 #x14 (nil nil #\ #\ #xC000 1) ; 21 #x15 (nil nil #\ #\ #xC000 1) ; 22 #x16 (nil nil #\ #\ #xC000 1) ; 23 #x17 (nil nil #\ #\ #xC000 1) ; 24 #x18 (nil nil #\ #\ #xC000 1) ; 25 #x19 (nil nil #\ #\ #xC000 1) ; 26 #x1A (nil nil #\ #\ #xC000 1) ; 27 #x1B (nil nil #\ #\ #xC000 1) ; 28 #x1C (nil nil #\ #\ #xC000 1) ; 29 #x1D (nil nil #\] #\ #xC000 1) ; 30 #x1E (nil nil #\ #\ #xC000 1) ; 31 #x1F (nil nil #\ #\ #xC000 1) ; 32 #x20 (nil nil #\ #\ #xC000 1) ; 33 #x21 (nil nil #\ #\ #xC000 1) ; 34 #x22 (nil nil #\ #\ #xC000 1) ; 35 #x23 (#\NEWLINE #\NEWLINE #\NEWLINE #\NEWLINE #xC000 1) ; 36 #x24 (nil nil #\ #\ #xC000 1) ; 37 #x25 (nil nil #\ #\ #xC000 1) ; 38 #x26 (nil nil #\ #\ #xC000 1) ; 39 #x27 (nil nil #\ #\ #xC000 1) ; 40 #x28 (nil nil #\ #\ #xC000 1) ; 41 #x29 (nil nil #\| #\ #xC000 1) ; 42 #x2A (nil nil #\ #\ #xC000 1) ; 43 #x2B (nil nil #\ #\ #xC000 1) ; 44 #x2C (nil nil #\ #\ #xC000 1) ; 45 #x2D (nil nil #\ #\ #xC000 1) ; 46 #x2E (nil nil #\ #\ #xC000 1) ; 47 #x2F (#\TAB #\TAB #\TAB #\TAB #xC000 1) ; 48 #x30 (#\SPACE #\SPACE #\SPACE #\SPACE #xC000 1) ; 49 #x31 (nil nil #\ #\ #xC000 1) ; 50 #x32 (#\RUBOUT #\RUBOUT #\RUBOUT #\RUBOUT #xC000 1) ; 51 #x33 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 52 #x34 (#\ESCAPE #\ESCAPE #xC000 #\ #xC000 0) ; 53 #x35 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 54 #x36 (32773 32773 32773 32773 32773 0) ; 55 #x37 (32768 32768 32768 32768 32768 0) ; 56 #x38 (32771 32771 32771 32771 32771 0) ; 57 #x39 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 58 #x3A (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 59 #x3B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 60 #x3C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 61 #x3D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 62 #x3E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 63 #x3F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 64 #x40 (keypad keypad #\ #\ #xC000 1) ; 65 #x41 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 66 #x42 (nil nil #\ #\ #xC000 1) ; 67 #x43 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 68 #x44 (keypad keypad #\ #\ #xC000 1) ; 69 #x45 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 70 #x46 (#\K-SPACE #\K-TAB #\K-TAB #\ #xC000 1) ; 71 #x47 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 72 #x48 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 73 #x49 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 74 #x4A (nil nil #\ #\ #xC000 1) ; 75 #x4B (#\K-ENTER #\K-ENTER #\K-ENTER #\K-ENTER #xC000 1) ; 76 #x4C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 77 #x4D (keypad keypad #\ #\ #xC000 1) ; 78 #x4E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 79 #x4F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 80 #x50 (keypad keypad #\K-EQUAL #\ #xC000 1) ; 81 #x51 (keypad keypad #\ #\ #xC000 1) ; 82 #x52 (keypad keypad #\ #\ #xC000 1) ; 83 #x53 (keypad keypad #\ #\ #xC000 1) ; 84 #x54 (keypad keypad #\ #\ #xC000 1) ; 85 #x55 (keypad keypad #\ #\ #xC000 1) ; 86 #x56 (keypad keypad #\ #\ #xC000 1) ; 87 #x57 (keypad keypad #\ #\ #xC000 1) ; 88 #x58 (keypad keypad #\ #\ #xC000 1) ; 89 #x59 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 90 #x5A (keypad keypad #\ #\ #xC000 1) ; 91 #x5B (keypad keypad #\ #\ #xC000 1) ; 92 #x5C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 93 #x5D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 94 #x5E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 95 #x5F (#\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM 0) ; 96 #x60 (#\NETWORK #\NETWORK #\NETWORK #\NETWORK #\NETWORK 0) ; 97 #x61 (#\STATUS #\STATUS #\STATUS #\STATUS #\STATUS 0) ; 98 #x62 (#\F3 #\F3 #\F3 #\F3 #xC000 0) ; 99 #x63 (#\TERM #\TERM #\TERM #\TERM #\TERM 0) ;100 #x64 (#\PAGE #\PAGE #\PAGE #\PAGE #\PAGE 0) ;101 #x65 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;102 #x66 (#\UNDO #\UNDO #\UNDO #\UNDO #\UNDO 0) ;103 #x67 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;104 #x68 (#\ABORT #\ABORT #\ABORT #\ABORT #\ABORT 0) ;105 #x69 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;106 #x6A (#\BREAK #\BREAK #\BREAK #\BREAK #\BREAK 0) ;107 #x6B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;108 #x6C (#\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT 0) (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;110 #x6E (#\END #\END #\END #\END #\END 0) ;111 #x6F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;112 #x70 (#\RESUME #\RESUME #\RESUME #\RESUME #\RESUME 0) ;113 #x71 (#\HELP nil #\CALL #xC000 #xC000 0) ;114 #x72 (nil nil #\CENTER-ARROW #\MACRO #xC000 1) ;115 #x73 (nil nil #\HOLD-OUTPUT #\STOP-OUTPUT #xC000 1) ;116 #x74 (#\LINEFEED nil #xC000 #xC000 #xC000 1) ;117 #x75 (#\F4 #\F4 #\F4 #\F4 #xC000 0) ;118 #x76 (nil nil #xC000 #xC000 #xC000 1) ;119 #x77 (#\F2 #\F2 #\F2 #\F2 #xC000 0) ;120 #x78 (nil nil #xC000 #xC000 #xC000 1) ;121 #x79 (#\F1 #\F1 #\F1 #\F1 #xC000 0) ;122 #x7A (#\ #xC000 #xC000 #xC000 #xC000 1) ;123 #x7B (#\ #xC000 #xC000 #xC000 #xC000 1) ;124 #x7C (#\ #xC000 #xC000 #xC000 #xC000 1) ;125 #x7D (#\ #xC000 #xC000 #xC000 #xC000 1) ;126 #x7E ; (#\ #xC000 #xC000 #xC000 #xC000 1) ;123 #x7B ; (#\ #xC000 #xC000 #xC000 #xC000 1) ;124 #x7C ; (#\ #xC000 #xC000 #xC000 #xC000 1) ;125 #x7D ; (#\ #xC000 #xC000 #xC000 #xC000 1) ;126 #x7E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;127 #x7F ) "This is a mapping of Mac extended keyboard scan-codes to LISPM characters used to build kbd-mac-table. #xC000 means generate no character.") (DEFPARAMETER mac-standard-kbd-descriptor '((#\a #\A #\ #\ #xC000 1) ; 0 #x 0 (#\s #\S #\ #\ #xC000 1) ; 1 #x 1 (#\d #\D #\ #\ #xC000 1) ; 2 #x 2 (#\f #\F #\ #\ #xC000 1) ; 3 #x 3 (#\h #\H #\ #\ #xC000 1) ; 4 #x 4 (#\g #\G #\ #\ #xC000 1) ; 5 #x 5 (#\z #\Z #\ #\ #xC000 1) ; 6 #x 6 (#\x #\X #\ #\ #xC000 1) ; 7 #x 7 (#\c #\C #\ #\ #xC000 1) ; 8 #x 8 (#\v #\V #\ #\ #xC000 1) ; 9 #x 9 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 10 #x A (#\b #\B #\ #\ #xC000 1) ; 11 #x B (#\q #\Q #\ #\ #xC000 1) ; 12 #x C (#\w #\W #\ #\ #xC000 1) ; 13 #x D (#\e #\E #\ #\ #xC000 1) ; 14 #x E (#\r #\R #\ #\ #xC000 1) ; 15 #x F (#\y #\Y #\ #\ #xC000 1) ; 16 #x10 (#\t #\T #\ #\ #xC000 1) ; 17 #x11 (#\1 #\! #\ #\ #xC000 1) ; 18 #x12 (#\2 #\@ #\ #\ #xC000 1) ; 19 #x13 (#\3 #\# #\ #\ #xC000 1) ; 20 #x14 (#\4 #\$ #\ #\ #xC000 1) ; 21 #x15 (#\6 #\^ #\ #\ #xC000 1) ; 22 #x16 (#\5 #\% #\ #\ #xC000 1) ; 23 #x17 (#\= #\+ #\ #\ #xC000 1) ; 24 #x18 (#\9 #\( #\ #\ #xC000 1) ; 25 #x19 (#\7 #\& #\ #\ #xC000 1) ; 26 #x1A (#\- #\_ #\ #\ #xC000 1) ; 27 #x1B (#\8 #\* #\ #\ #xC000 1) ; 28 #x1C (#\0 #\) #\ #\ #xC000 1) ; 29 #x1D (#\) #\] #\] #\ #xC000 1) ; 30 #x1E (#\o #\O #\ #\ #xC000 1) ; 31 #x1F (#\u #\U #\ #\ #xC000 1) ; 32 #x20 (#\( #\[ #\ #\ #xC000 1) ; 33 #x21 (#\i #\I #\ #\ #xC000 1) ; 34 #x22 (#\p #\P #\ #\ #xC000 1) ; 35 #x23 (#\NEWLINE #\NEWLINE #\NEWLINE #\NEWLINE #xC000 1) ; 36 #x24 (#\l #\L #\ #\ #xC000 1) ; 37 #x25 (#\j #\J #\ #\ #xC000 1) ; 38 #x26 (#\' #\" #\ #\ #xC000 1) ; 39 #x27 (#\k #\K #\ #\ #xC000 1) ; 40 #x28 (#\; #\: #\ #\ #xC000 1) ; 41 #x29 (#\\ #\| #\| #\ #xC000 1) ; 42 #x2A (#\, #\< #\ #\ #xC000 1) ; 43 #x2B (#\/ #\? #\ #\ #xC000 1) ; 44 #x2C (#\n #\N #\ #\ #xC000 1) ; 45 #x2D (#\m #\M #\ #\ #xC000 1) ; 46 #x2E (#\. #\> #\ #\ #xC000 1) ; 47 #x2F (#\TAB #\TAB #\TAB #\TAB #xC000 1) ; 48 #x30 (#\SPACE #\SPACE #\SPACE #\SPACE #xC000 1) ; 49 #x31 (#\` #\~ #\ #\ #xC000 1) ; 50 #x32 (#\RUBOUT #\RUBOUT #\RUBOUT #\RUBOUT #xC000 1) ; 51 #x33 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 52 #x34 (#\ESCAPE #\ESCAPE #xC000 #\ #xC000 0) ; 53 #x35 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 54 #x36 (32773 32773 32773 32773 32773 0) ; 55 #x37 (32768 32768 32768 32768 32768 0) ; 56 #x38 (32772 32772 32772 32772 32772 0) ; 57 #x39 (32769 32769 32769 32769 32769 0) ; 58 #x3A (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 59 #x3B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 60 #x3C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 61 #x3D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 62 #x3E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 63 #x3F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 64 #x40 (#\BREAK #\BREAK #\BREAK #\BREAK #\BREAK 0) ; 65 #x41 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 66 #x42 (#\TERM #\TERM #\TERM #\TERM #\TERM 0) ; 67 #x43 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 68 #x44 (#\END #\END #\END #\END #\END 0) ; 69 #x45 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 70 #x46 (#\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM 0) ; 71 #x47 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 72 #x48 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 73 #x49 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 74 #x4A (#\STATUS #\STATUS #\STATUS #\STATUS #\STATUS 0) ; 75 #x4B (#\RESUME #\RESUME #\RESUME #\RESUME #\RESUME 0) ; 76 #x4C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 77 #x4D (#\HELP #\HELP #\CALL #xC000 #xC000 0) ; 78 #x4E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 79 #x4F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 80 #x50 (#\NETWORK #\NETWORK #\NETWORK #\NETWORK #\NETWORK 0) ; 81 #x51 (#\ABORT #\ABORT #\ABORT #\ABORT #\ABORT 0) ; 82 #x52 (#\MOUSE-L #\MOUSE-L #\MOUSE-L #\MOUSE-L #xC000 0) ; 83 #x53 (#\MOUSE-M #\MOUSE-M #\MOUSE-M #\MOUSE-M #xC000 0) ; 84 #x54 (#\MOUSE-R #\MOUSE-R #\MOUSE-R #\MOUSE-R #xC000 0) ; 85 #x55 (#\LINEFEED #\LINEFEED #\LINEFEED #\LINEFEED #xC000 1) ; 86 #x56 (#\` #\{ #\ #\ #xC000 1) ; 87 #x57 (#\~ #\} #\} #\ #xC000 1) ; 88 #x58 (#\PAGE #\PAGE #\PAGE #\PAGE #\PAGE 0) ; 89 #x59 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 90 #x5A (#\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT 0) ; 91 #x5B (#\UNDO #\UNDO #\UNDO #\UNDO #\UNDO 0) ; 92 #x5C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 93 #x5D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 94 #x5E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 95 #x5F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 96 #x60 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 97 #x61 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 98 #x62 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 99 #x63 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;100 #x64 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;101 #x65 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;102 #x66 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;103 #x67 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;104 #x68 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;105 #x69 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;106 #x6A (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;107 #x6B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;108 #x6C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;109 #x6D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;110 #x6E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;111 #x6F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;112 #x70 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;113 #x71 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;114 #x72 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;115 #x73 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;116 #x74 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;117 #x75 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;118 #x76 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;119 #x77 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;120 #x78 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;121 #x79 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;122 #x7A (#\ #xC000 #xC000 #xC000 #xC000 1) ;123 #x7B (#\ #xC000 #xC000 #xC000 #xC000 1) ;124 #x7C (#\ #xC000 #xC000 #xC000 #xC000 1) ;125 #x7D (#\ #xC000 #xC000 #xC000 #xC000 1) ;126 #x7E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;127 #x7F ) "This is a mapping of Mac standard keyboard scan-codes to LISPM characters used to build kbd-mac-table.#xC000 means generate no character.") (DEFPARAMETER mac-new-kbd-descriptor '((nil nil #\ #\ #xC000 1) ; 0 #x 0 a (nil nil #\ #\ #xC000 1) ; 1 #x 1 s (nil nil #\ #\ #xC000 1) ; 2 #x 2 d (nil nil #\ #\ #xC000 1) ; 3 #x 3 f (nil nil #\ #\ #xC000 1) ; 4 #x 4 h (nil nil #\ #\ #xC000 1) ; 5 #x 5 g (nil nil #\ #\ #xC000 1) ; 6 #x 6 z (nil nil #\ #\ #xC000 1) ; 7 #x 7 x (nil nil #\ #\ #xC000 1) ; 8 #x 8 c (nil nil #\ #\ #xC000 1) ; 9 #x 9 v (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 10 #x A (nil nil #\ #\ #xC000 1) ; 11 #x B b (nil nil #\ #\ #xC000 1) ; 12 #x C q (nil nil #\ #\ #xC000 1) ; 13 #x D w (nil nil #\ #\ #xC000 1) ; 14 #x E e (nil nil #\ #\ #xC000 1) ; 15 #x F r (nil nil #\ #\ #xC000 1) ; 16 #x10 y (nil nil #\ #\ #xC000 1) ; 17 #x11 t (nil nil #\ #\ #xC000 1) ; 18 #x12 1 (nil nil #\ #\ #xC000 1) ; 19 #x13 2 (nil nil #\ #\ #xC000 1) ; 20 #x14 3 (nil nil #\ #\ #xC000 1) ; 21 #x15 4 (nil nil #\ #\ #xC000 1) ; 22 #x16 6 (nil nil #\ #\ #xC000 1) ; 23 #x17 5 (nil nil #\ #\ #xC000 1) ; 24 #x18 = (nil nil #\ #\ #xC000 1) ; 25 #x19 9 (nil nil #\ #\ #xC000 1) ; 26 #x1A 7 (nil nil #\ #\ #xC000 1) ; 27 #x1B - (nil nil #\ #\ #xC000 1) ; 28 #x1C 8 (nil nil #\ #\ #xC000 1) ; 29 #x1D 0 (nil nil #\] #\ #xC000 1) ; 30 #x1E ) (nil nil #\ #\ #xC000 1) ; 31 #x1F o (nil nil #\ #\ #xC000 1) ; 32 #x20 u (nil nil #\ #\ #xC000 1) ; 33 #x21 ( (nil nil #\ #\ #xC000 1) ; 34 #x22 i (nil nil #\ #\ #xC000 1) ; 35 #x23 p (#\NEWLINE #\NEWLINE #\NEWLINE #\NEWLINE #xC000 1) ; 36 #x24 (nil nil #\ #\ #xC000 1) ; 37 #x25 l (nil nil #\ #\ #xC000 1) ; 38 #x26 j (nil nil #\ #\ #xC000 1) ; 39 #x27 ' (nil nil #\ #\ #xC000 1) ; 40 #x28 k (nil nil #\ #\ #xC000 1) ; 41 #x29 ; (nil nil #\| #\ #xC000 1) ; 42 #x2A \ (nil nil #\ #\ #xC000 1) ; 43 #x2B , (nil nil #\ #\ #xC000 1) ; 44 #x2C / (nil nil #\ #\ #xC000 1) ; 45 #x2D n (nil nil #\ #\ #xC000 1) ; 46 #x2E m (nil nil #\ #\ #xC000 1) ; 47 #x2F . (#\TAB #\TAB #\TAB #\TAB #xC000 1) ; 48 #x30 (nil nil #\SPACE #\SPACE #xC000 1) ; 49 #x31 (nil nil #\ #\ #xC000 1) ; 50 #x32 ` (#\RUBOUT #\RUBOUT #\RUBOUT #\RUBOUT #xC000 1) ; 51 #x33 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 52 #x34 (#\ESCAPE #\ESCAPE #xC000 #\ #xC000 0) ; 53 #x35 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 54 #x36 (32773 32773 32773 32773 32773 0) ; 55 #x37 (32768 32768 32768 32768 32768 0) ; 56 #x38 (32771 32771 32771 32771 32771 0) ; 57 #x39 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 58 #x3A (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 59 #x3B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 60 #x3C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 61 #x3D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 62 #x3E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 63 #x3F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 64 #x40 (keypad keypad #\ #\ #xC000 1) ; 65 #x41 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 66 #x42 (nil nil #xC000 #\ #xC000 1) ; 67 #x43 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 68 #x44 (keypad keypad #\ #\ #xc000 1) ; 69 #x45 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 70 #x46 (#\K-SPACE #\K-TAB #\K-TAB #\ #xC000 1) ; 71 #x47 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 72 #x48 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 73 #x49 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 74 #x4A (nil nil #\k-space #\ #xc000 1) ; 75 #x4B (#\K-ENTER #\K-ENTER #\K-ENTER #\K-ENTER #xC000 1) ; 76 #x4C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 77 #x4D (keypad keypad #\ #\ #xc000 1) ; 78 #x4E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 79 #x4F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 80 #x50 (keypad keypad #\ #\ #xC000 1) ; 81 #x51 (keypad keypad #\ #\ #xc000 1) ; 82 #x52 (keypad keypad #\ #\ #xc000 1) ; 83 #x53 (keypad keypad #\ #\ #xc000 1) ; 84 #x54 (keypad keypad #\ #\ #xc000 1) ; 85 #x55 (keypad keypad #\ #\ #xc000 1) ; 86 #x56 (keypad keypad #\ #\ #xc000 1) ; 87 #x57 (keypad keypad #\ #\ #xc000 1) ; 88 #x58 (keypad keypad #\ #\ #xc000 1) ; 89 #x59 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 90 #x5A (keypad keypad #\ #\ #xc000 1) ; 91 #x5B (keypad keypad #\ #\ #xc000 1) ; 92 #x5C (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 93 #x5D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 94 #x5E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ; 95 #x5F (#\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM #\SYSTEM 0) ; 96 #x60 (#\NETWORK #\NETWORK #\NETWORK #\NETWORK #\NETWORK 0) ; 97 #x61 (#\STATUS #\STATUS #\STATUS #\STATUS #\STATUS 0) ; 98 #x62 (#\F3 #\F3 #\F3 #\F3 #xC000 0) ; 99 #x63 (#\TERM #\TERM #\TERM #\TERM #\TERM 0) ;100 #x64 (#\PAGE #\PAGE #\PAGE #\PAGE #\PAGE 0) ;101 #x65 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;102 #x66 (#\UNDO #\UNDO #\UNDO #\UNDO #\UNDO 0) ;103 #x67 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;104 #x68 (#\ABORT #\ABORT #\ABORT #\ABORT #\ABORT 0) ;105 #x69 (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;106 #x6A (#\BREAK #\BREAK #\BREAK #\BREAK #\BREAK 0) ;107 #x6B (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;108 #x6C (#\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT #\CLEAR-INPUT 0) ;109 #x6D (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;110 #x6E (#\END #\END #\END #\END #\END 0) ;111 #x6F (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;112 #x70 (#\RESUME #\RESUME #\RESUME #\RESUME #\RESUME 0) ;113 #x71 (#\HELP nil #\CALL #xC000 #xC000 0) ;114 #x72 (nil nil #\CENTER-ARROW #\MACRO #xC000 1) ;115 #x73 (nil nil #\HOLD-OUTPUT #\STOP-OUTPUT #xC000 1) ;116 #x74 (#\LINEFEED nil #xC000 #xC000 #xC000 1) ;117 #x75 (#\F4 #\F4 #\F4 #\F4 #xC000 0) ;118 #x76 (nil nil #xC000 #xC000 #xC000 1) ;119 #x77 (#\F2 #\F2 #\F2 #\F2 #xC000 0) ;120 #x78 (nil nil #xC000 #xC000 #xC000 1) ;121 #x79 (#\F1 #\F1 #\F1 #\F1 #xC000 0) ;122 #x7A (#\ #xC000 #xC000 #xC000 #xC000 1) ;123 #x7B (#\ #xC000 #xC000 #xC000 #xC000 1) ;124 #x7C (#\ #xC000 #xC000 #xC000 #xC000 1) ;125 #x7D (#\ #xC000 #xC000 #xC000 #xC000 1) ;126 #x7E (#xC000 #xC000 #xC000 #xC000 #xC000 0) ;127 #x7F ) "This is a mapping of Mac standard keyboard scan-codes to LISPM characters used to build kbd-mac-table.#xC000 means generate no character.") (DEFUN kbd-make-mac-table (descriptor) "Converts a list describing the keyboard mapping into an array" (LOOP with array = (MAKE-ARRAY '(6 128) :area permanent-storage-area :element-type t) for j from 0 to (1- (ARRAY-DIMENSION array 1)) for row = (ELT descriptor j) do (LOOP for i from 0 to (1- (ARRAY-DIMENSION array 0)) do (SETF (AREF array i j) (ELT row i))) finally (RETURN array))) (DEFPARAMETER kbd-mac-table (WHEN (addin-p) (kbd-make-mac-table mac-new-kbd-descriptor)) "Direct translation of Mac scan code to a LISP character") (DEFPARAMETER *Mac-to-Explorer-char-map* (MAKE-ARRAY 256. :element-type '(unsigned-byte 8) :initial-contents ;; 0 1 2 3 4 5 6 7 8 9 A B C D E F #x'(00 01 02 03 04 05 06 08 88 89 8D 09 8C 8D 0A 0B ;0 0C 0D 10 11 12 13 14 15 16 17 18 19 1E 1F 80 81 ;1 20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F ;2 30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F ;3 40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F ;4 50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F ;5 60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F ;6 70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E 87 ;7 C4 C5 C7 C9 D1 D6 DC E1 E0 E2 E4 E3 E5 E7 E9 E8 ;8 EA EB ED EC EE EF F1 F3 F2 F4 F6 F5 FA F9 FB FC ;9 82 B0 A2 A3 A7 83 B6 DF AE A9 84 B4 A8 1A C6 D8 ;A 0E B1 1C 1D A5 B5 0F 85 86 07 7F AA BA 8B E6 F8 ;B BF A1 AC 8E 8F 90 91 AB BB 92 A0 C0 C3 D5 93 94 ;C 95 96 97 98 99 9A F7 1B FF 9B 9C 9D 9E 9F A4 A6 ;D AD AF B2 B3 B7 B8 B9 BC BD BE C1 C2 C8 CA CB CC ;E CD CE CF D0 D2 D3 D4 D7 D9 DA DB DD DE F0 FD FE)) ;F "Table for mapping Mac keyboard ASCII characters to Explorer character codes") ;;;; ;;;; Added keyboard handling routines ;;;; (DEFUN kbd-convert-mac (mac-scan-code &optional (ctl-chars-uppercase t)) "Keystroke conversion routine to support the Mac keyboard. Similar to the LISPM kbd-convert-ti by returning the same values. Note the repeatable flag will always be nil since Mac keyboard does repeating automatically. Mac-scan-code is a 32 bit integer of the form #b000C OLSD M0E0 000W UKKK KKKK AAAA AAAA: U = 1 for down, 0 for up K = 7-bit mac keyboard scan code A = 8-bit ASCIII code [already altered by modifiers] C = 1 for control key down O = 1 for option key down L = 1 for caps lock key down S = 1 for shift key down D = 1 for command key down M = 1 for mouse key up E = 1 indicates it was caused by an autokey event. W = 1 for window activated" (DECLARE (SPECIAL kbd-mac-table lispm-capslock-bit lispm-shift-bit lispm-greek-bit)) (LET* ((key-down (LOGBITP 15 mac-scan-code)) (char (LDB (BYTE 7. 8.) mac-scan-code)) (repeatable (NOT (ZEROP (AREF kbd-mac-table 5 char)))) (autokey (LOGBITP 21 mac-scan-code))) (WHEN (AND key-down ;If down code do it. Ignore up transitions if you see one. (OR repeatable ;Also it must either be repeatable (NOT autokey))) ;or not caused by an autokey (LET* ((kbd-shifts (AREF (IF si:*kbd-zmacs-mode* mac-kbd-modifier-table-zmacs-mode mac-kbd-modifier-table) (LDB (BYTE 5 24.) mac-scan-code))) (char-in-table (AREF kbd-mac-table ; take the character code in the mapping table (COND ((LOGBITP lispm-greek-bit kbd-shifts) ;SYMBOL (+ (LOGAND (EXPT 2 lispm-shift-bit) kbd-shifts) 2)) ;SYMBOL-SHIFT (same as GREEK) ((LOGBITP lispm-shift-bit kbd-shifts) 1) ;SHIFT (t 0)) ;UNSHIFTED char)) (soft-char (CASE char-in-table (nil (code-char (AREF *Mac-to-Explorer-char-map* (LDB (BYTE 8. 0.) mac-scan-code)))) ('keypad (code-char (AREF *Mac-to-Explorer-char-map* (LDB (BYTE 8. 0.) mac-scan-code)) char-keypad-bit)) (otherwise char-in-table))) (hyper-super-meta-ctrl (LDB (BYTE 4 4) kbd-shifts))) ;;A real key depression. Check for caps-lock. (IF (AND ctl-chars-uppercase (NOT (ZEROP hyper-super-meta-ctrl))) ; mac always sends upper case when caps lock down. (unless (AND (LOGBITP lispm-capslock-bit kbd-shifts) (NOT (LOGBITP lispm-shift-bit kbd-shifts))) (IF (<= #\a soft-char #\z) (DECF soft-char #o40) ;Control characters always uppercase, (IF (<= #\A soft-char #\Z) ;unless Shift is typed (INCF soft-char #o40)))) ;; Except for control chars for which Shift is reversed, ;; consider the shift-lock key. (AND (LOGBITP lispm-capslock-bit kbd-shifts) ;Caps lock (IF (AND si:shift-lock-xors (LOGBITP lispm-shift-bit kbd-shifts)) (IF (<= #\A soft-char #\Z) (INCF soft-char #o40)) (IF (<= #\a soft-char #\z) (DECF soft-char #o40))))) (VALUES (si:%logdpb hyper-super-meta-ctrl si:%%kbd-control-meta soft-char) nil) ;Repeatable-flag...Repeating done by Mac so return NIL )))) ;;; ;;; Function for inspecting Mac keycodes. Useful when mapping a new keyboard. ;;; (DEFUN mac-key () "Waits for a key to be pressed on the Mac then prints out its keycode." (PROCESS-WAIT "Mac Keyboard" #'(lambda () (OR *ignore-commands-for-the-Mac* (SEND *mac* :kbd-character-available-p)))) (LET* ((keycode (UNLESS *ignore-commands-for-the-Mac* (SEND *mac* :kbd-get-character))) (key (LDB (BYTE 7 8) keycode)) (ascii (LDB (BYTE 8 0) keycode)) (modifier (LDB (BYTE 16 16) keycode)) (control (LOGBITP Mac-control-bit modifier)) (option (LOGBITP Mac-option-bit modifier)) (caps (LOGBITP Mac-capslock-bit modifier)) (shift (LOGBITP Mac-shift-bit modifier)) (command (LOGBITP Mac-command-bit modifier)) (mouse (NULL (LOGBITP Mac-mouse-bit modifier))) (autokey (LOGBITP Mac-autokey-bit modifier)) (window (LOGBITP Mac-window-activate-bit modifier))) (FORMAT t "~%Key = ~d. #x~2,48x~%Keycode = ~8,48x~%ASCII = ~a #x~2,48x~%Control = ~a~%Option = ~a~%Caplock = ~a~%Shift = ~a~%Command = ~a~%Mouse = ~a~%AutoKey = ~a~%Window = ~a" key key keycode (CHARACTER ascii) ascii control option caps shift command mouse autokey window))) ;;; ;;; Character output mapping tables ;;; (DEFCONSTANT NonP #xFF "A Mac nonprinting characteer") ;; Mapping for CPTFONT and BIGfont: (DEFPARAMETER *Explorer-to-Mac-char-code-map* (MAKE-ARRAY 256. :element-type '(unsigned-byte 8) :initial-contents ;; 0 1 2 3 4 5 6 7 8 9 A B C D E F #x(LIST F3 D9 F4 A7 5E C2 F5 B9 F6 F7 F8 DA B1 EE B0 B6 ;0 EF F0 F1 F2 EA EB E1 DB DC DD AD D7 B2 B3 DE DF ;1 20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F ;2 30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F ;3 40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F ;4 50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F ;5 60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F ;6 70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E BA ;7 NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP ;8 NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP NonP ;9 CA C1 A2 A3 E0 B4 E2 A4 AC A9 BB C7 C2 C9 A8 D0 ;A A1 B1 E5 E6 AB B5 A6 F3 2C E4 BC C8 E7 E8 E9 C0 ;B CB 41 41 CC 80 81 AE 82 45 83 45 45 49 49 49 49 ;C FC 84 4F 4F 4F CD 85 EC AF 55 55 55 86 59 FA F9 ;D 88 87 89 8B 8A 8C BE 8D 8F 8E 90 91 93 92 94 95 ;E FD 96 98 97 99 9B 9A D6 BF 9D 9C 9E 9F 79 FB D8)) ;F "This table maps an Explorer character code to the Mac character code which would generate the similar screen image. This version is used for displaying the special CPTFONT with the Lisp Machine character glyphs.") ;;; The Explorer to Mac mapping table -- X means that there is no exactly ;;; corresponding character on the Mac character set, so the character is ;;; mapped to something which, wherever possible, has some similarity of ;;; appearance or meaning.) This mapping is used by NFS and by the window ;;; system when writing using Macintosh Times or Helvetica fonts. (Note that ;;; not all of the Macintosh fonts include the glyphs for character codes D9 ;;; through FF, and that CPTFONT is handled separately using a customized font ;;; for the Lisp Machine character set.) ;;; 00 10 20 30 40 50 60 70 80 90 A0 B0 C0 D0 E0 F0 ;;; 00 X 0 @ P ` p X X X ;;; 01 X X ! 1 A Q a q X X ;;; 02 X X " 2 B R b r X X X ;;; 03 X X # 3 C S c s X X X ;;; 04 X X $ 4 D T d t X X X ;;; 05 X X % 5 E U e u X X ;;; 06 X X & 6 F V f v X X X ;;; 07  X ' 7 G W g w X X X X ;;; 08 X X ( 8 H X h x X X ;;; 09 X X ) 9 I Y i y X X ;;; 0A X  * : J Z j z X ;;; 0B X  + ; K [ k { X X ;;; 0C X  , < L \ l | X X ;;; 0D X  - = M ] m } X X X X ;;; 0E  X . > N ^ n ~ X X X X X ;;; 0F  X / ? O _ o  X X X (DEFPARAMETER *Explorer-to-mac-character-code-map* (MAKE-ARRAY 256. :element-type '(unsigned-byte 8) :initial-contents ;; 0 1 2 3 4 5 6 7 8 9 A B C D E F #x'(A5 FE F0 FD F6 F7 CF B9 C4 C3 C6 A0 E0 B7 B0 B6 ;0 D2 D3 BD C9 DF CE B8 D1 DC DD AD D7 B2 B3 C5 F9 ;1 20 21 22 23 24 25 26 27 28 29 2A 2B 2C 2D 2E 2F ;2 30 31 32 33 34 35 36 37 38 39 3A 3B 3C 3D 3E 3F ;3 40 41 42 43 44 45 46 47 48 49 4A 4B 4C 4D 4E 4F ;4 50 51 52 53 54 55 56 57 58 59 5A 5B 5C 5D 5E 5F ;5 60 61 62 63 64 65 66 67 68 69 6A 6B 6C 6D 6E 6F ;6 70 71 72 73 74 75 76 77 78 79 7A 7B 7C 7D 7E BA ;7 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ;8 10 11 12 13 14 15 16 17 18 19 1A 1B 1C 1D 1E 1F ;9 CA C1 A2 A3 DB B4 DA A4 AC A9 BB C7 C2 D0 A8 F8 ;A A1 B1 E2 E3 AB B5 A6 E1 FC F5 BC C8 D4 E4 D5 C0 ;B CB E7 E5 CC 80 81 AE 82 E9 83 E6 E8 ED EA EB EC ;C DE 84 F1 EE EF CD 85 FA AF F4 F2 F3 86 D9 FB A7 ;D 88 87 89 8B 8A 8C BE 8D 8F 8E 90 91 93 92 94 95 ;E 7F 96 98 97 99 9B 9A D6 BF 9D 9C 9E 9F FF AA D8)) ;F ;; 0 1 2 3 4 5 6 7 8 9 A B C D E F "This table maps an Explorer character code to the Mac character code which would generate the similar screen image. This version is used by the window system when writing using Macintosh Times or Helvetica fonts, and is used by NFS when writing to a Macintosh file." ) ;;; The Mac to Explorer mapping table is the exact inverse. ;;; 00 10 20 30 40 50 60 70 80 90 A0 B0 C0 D0 E0 F0 ;;; 00 X 0 @ P ` p X  X X ;;; 01 X X ! 1 A Q a q X ;;; 02 X X " 2 B R b r  X X ;;; 03 X X # 3 C S c s  X X X ;;; 04 X X $ 4 D T d t X X X ;;; 05 X X % 5 E U e u X X X ;;; 06 X X & 6 F V f v  X X ;;; 07 X X ' 7 G W g w X  X ;;; 08 X ( 8 H X h x X ;;; 09 X ) 9 I Y i y  X X X ;;; 0A X * : J Z j z X  X ;;; 0B X X + ; K [ k { X ;;; 0C X , < L \ l | X ;;; 0D X - = M ] m }  X X X ;;; 0E X X . > N ^ n ~ X X X ;;; 0F X X / ? O _ o X X X (DEFPARAMETER *Mac-to-Explorer-character-code-map* (let ((table (MAKE-ARRAY 256. :element-type '(unsigned-byte 8)))) (dotimes (i 256.) (setf (aref table (aref *Explorer-to-mac-character-code-map* i)) i)) table) "This table maps a Macintosh character code to the corresponding Explorer character code.") (DEFSUBST EXPLORER-TO-MAC-CHAR-CODE (CODE) "Convert an Explorer character code to the equivalent Macintosh code." (THE (UNSIGNED-BYTE 8) (AREF *Explorer-to-mac-character-code-map* CODE))) (DEFSUBST MAC-TO-EXPLORER-CHAR-CODE (CODE) "Convert a Macintosh character code to the equivalent Explorer code." (THE (UNSIGNED-BYTE 8) (AREF *Mac-to-Explorer-character-code-map* CODE))) ;;ab 10/14/88. Use Explorer mapping for Bigfont as well as cptfont. (DEFUN Explorer-to-Mac-char-code-map (font &aux name) "Returns the correct mapping table to use depending on the FONT. This currently uses *Explorer-to-Mac-char-code-map* for CPTFont and *Explorer-to-Mac-character-code-map* for all others." ;; This is a function because we may someday want to add more fonts which ;; which would support the full Explorer character set. (IF (OR (EQ (SETQ name (tv:font-name font)) 'fonts:mac-cptfont) (EQ name 'fonts:mac-bigfnt)) *Explorer-to-Mac-char-code-map* *Explorer-to-Mac-character-code-map*)) (DEFUN print-microExplorer-character-set () (FORMAT t "~% ") (LOOP for i from 0 to 255 by 16 do (FORMAT t "~2x " i)) (LOOP for i from 0 to 15 do (FORMAT t "~&~2,48x " i) (loop for j from 0 to 255 by 16 do (FORMAT t "~a " (IF (= #xFF (AREF *Explorer-to-Mac-char-code-map* (+ i j))) #\space (CHARACTER (+ i j))))))) ;; This version of BEEP is for use in a microExplorer kernel band. [If the ;; window system is loaded, it gets redefined by "SYS:WINDOW;SOUND".] ;; 1/23/88 DNG - Original. (DEFVAR BEEP T) (DEFUN BEEP (&OPTIONAL BEEP-TYPE STREAM) "Ring the bell. BEEP-TYPE says why the beep is being done. See *BEEP-TYPES* BEEP-TYPE may also be a beep-function. See *BEEPING-FUNCTIONS* Works via the :BEEP operation on STREAM if STREAM supports it. The value of the BEEP global variable controls what this function does: NIL Always quiet :SILENT Always quiet :t Beep. Default beep-type is TV:DEFAULT-BEEP Anything else is used as the default beep-type." (unless (or (eq beep 'nil) (eq beep ':silent)) (send (if (and stream (SEND stream :operation-handled-p :BEEP)) stream sys:cold-load-stream) :BEEP beep-type)))