From: Chris Hanson Date: Thu, 13 Apr 1995 23:27:21 +0000 (+0000) Subject: Reorganize slightly. X-Git-Tag: 20090517-FFI~6461 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2c486a645ae5f900752d71c029c7cbf6d68eb12f;p=mit-scheme.git Reorganize slightly. --- diff --git a/v7/src/edwin/key-w32.scm b/v7/src/edwin/key-w32.scm index 65d5471cb..130ab7f17 100644 --- a/v7/src/edwin/key-w32.scm +++ b/v7/src/edwin/key-w32.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: key-w32.scm,v 1.1 1994/10/25 01:46:12 adams Exp $ +;;; $Id: key-w32.scm,v 1.2 1995/04/13 23:27:21 cph Exp $ ;;; -;;; Copyright (c) 1991-1992 Massachusetts Institute of Technology +;;; Copyright (c) 1991-95 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -41,122 +41,12 @@ ;;; Package: (edwin win32-keys) (declare (usual-integrations)) + +(define (initialize-package!) + (set! end (make-special-key 'END 0)) + unspecific) -;; This constructs a vector mapping VK_* codes (integers 0..255) to special key -;; names (symbols). -;; It doesn not include keys that are affected by the Win32 API TranslateMessage, -;; which are: any printing character, backspace, enter, escape, tab - -(let-syntax - ((make-translation-vector - (lambda () - (let ((v (make-vector 256 #F))) - (for-each (lambda (def) - (if (not (null? (cddr def))) - (vector-set! v (second def) (third def)))) - '(;;VK_name code special-key name - (VK_LBUTTON #x01) - (VK_RBUTTON #x02) - (VK_CANCEL #x03) - (VK_MBUTTON #x04) - - (VK_BACK #x08) - (VK_TAB #x09) - - (VK_CLEAR #x0C) - (VK_RETURN #x0D) - - (VK_SHIFT #x10) - (VK_CONTROL #x11) - (VK_MENU #x12) - (VK_PAUSE #x13 stop) - (VK_CAPITAL #x14) - - (VK_ESCAPE #x1B) - - (VK_SPACE #x20) - (VK_PRIOR #x21 prior) - (VK_NEXT #x22 next) - (VK_END #x23 end) - (VK_HOME #x24 home) - (VK_LEFT #x25 left) - (VK_UP #x26 up) - (VK_RIGHT #x27 right) - (VK_DOWN #x28 down) - (VK_SELECT #x29 select) - (VK_PRINT #x2A print) - (VK_EXECUTE #x2B) - (VK_SNAPSHOT #x2C) - (VK_INSERT #x2D insertchar) - (VK_DELETE #x2E deletechar) - (VK_HELP #x2F) - - (VK_NUMPAD0 #x60) - (VK_NUMPAD1 #x61) - (VK_NUMPAD2 #x62) - (VK_NUMPAD3 #x63) - (VK_NUMPAD4 #x64) - (VK_NUMPAD5 #x65) - (VK_NUMPAD6 #x66) - (VK_NUMPAD7 #x67) - (VK_NUMPAD8 #x68) - (VK_NUMPAD9 #x69) - (VK_MULTIPLY #x6A) - (VK_ADD #x6B) - (VK_SEPARATOR #x6C) - (VK_SUBTRACT #x6D) - (VK_DECIMAL #x6E) - (VK_DIVIDE #x6F) - (VK_F1 #x70 f1) - (VK_F2 #x71 f2) - (VK_F3 #x72 f3) - (VK_F4 #x73 f4) - (VK_F5 #x74 f5) - (VK_F6 #x75 f6) - (VK_F7 #x76 f7) - (VK_F8 #x77 f8) - (VK_F9 #x78 f9) - (VK_F10 #x79 f10) - (VK_F11 #x7A f11) - (VK_F12 #x7B f12) - (VK_F13 #x7C f13) - (VK_F14 #x7D f14) - (VK_F15 #x7E f15) - (VK_F16 #x7F f16) - (VK_F17 #x80 f17) - (VK_F18 #x81 f18) - (VK_F19 #x82 f19) - (VK_F20 #x83 f20) - (VK_F21 #x84 f21) - (VK_F22 #x85 f22) - (VK_F23 #x86 f23) - (VK_F24 #x87 f24) - - (VK_NUMLOCK #x90) - (VK_SCROLL #x91) - - (VK_LSHIFT #xA0) - (VK_RSHIFT #xA1) - (VK_LCONTROL #xA2) - (VK_RCONTROL #xA3) - (VK_LMENU #xA4) - (VK_RMENU #xA5) - - (VK_ATTN #xF6) - (VK_CRSEL #xF7) - (VK_EXSEL #xF8) - (VK_EREOF #xF9) - (VK_PLAY #xFA) - (VK_ZOOM #xFB) - (VK_NONAME #xFC) - (VK_PA1 #xFD) - (VK_OEM_CLEAR #xFE))) - v)))) - - (define win32-key-translation-vector (make-translation-vector))) - -(define (vk-code->name vk-code) - (vector-ref win32-key-translation-vector vk-code)) +(define end) (define (win32-make-special-key keysym bucky-bits) (cond ((vk-code->name keysym) @@ -164,8 +54,114 @@ (make-special-key name bucky-bits))) (else #F))) -(define end) +(define (vk-code->name vk-code) + (vector-ref win32-key-translation-vector vk-code)) -(define (initialize-package!) - (set! end (make-special-key 'end 0)) - unspecific) +;; This constructs a vector mapping VK_* codes (integers 0..255) to +;; special key names (symbols). It doesn not include keys that are +;; affected by the Win32 API TranslateMessage, which are: any printing +;; character, backspace, enter, escape, tab + +(define win32-key-translation-vector + (let ((v (make-vector 256 #f))) + (for-each (lambda (def) + (if (not (null? (cddr def))) + (vector-set! v (second def) (third def)))) + '(;;VK_name code special-key name + (VK_LBUTTON #x01) + (VK_RBUTTON #x02) + (VK_CANCEL #x03) + (VK_MBUTTON #x04) + + (VK_BACK #x08) + (VK_TAB #x09) + + (VK_CLEAR #x0C) + (VK_RETURN #x0D) + + (VK_SHIFT #x10) + (VK_CONTROL #x11) + (VK_MENU #x12) + (VK_PAUSE #x13 stop) + (VK_CAPITAL #x14) + + (VK_ESCAPE #x1B) + + (VK_SPACE #x20) + (VK_PRIOR #x21 prior) + (VK_NEXT #x22 next) + (VK_END #x23 end) + (VK_HOME #x24 home) + (VK_LEFT #x25 left) + (VK_UP #x26 up) + (VK_RIGHT #x27 right) + (VK_DOWN #x28 down) + (VK_SELECT #x29 select) + (VK_PRINT #x2A print) + (VK_EXECUTE #x2B) + (VK_SNAPSHOT #x2C) + (VK_INSERT #x2D insertchar) + (VK_DELETE #x2E deletechar) + (VK_HELP #x2F) + + (VK_NUMPAD0 #x60) + (VK_NUMPAD1 #x61) + (VK_NUMPAD2 #x62) + (VK_NUMPAD3 #x63) + (VK_NUMPAD4 #x64) + (VK_NUMPAD5 #x65) + (VK_NUMPAD6 #x66) + (VK_NUMPAD7 #x67) + (VK_NUMPAD8 #x68) + (VK_NUMPAD9 #x69) + (VK_MULTIPLY #x6A) + (VK_ADD #x6B) + (VK_SEPARATOR #x6C) + (VK_SUBTRACT #x6D) + (VK_DECIMAL #x6E) + (VK_DIVIDE #x6F) + (VK_F1 #x70 f1) + (VK_F2 #x71 f2) + (VK_F3 #x72 f3) + (VK_F4 #x73 f4) + (VK_F5 #x74 f5) + (VK_F6 #x75 f6) + (VK_F7 #x76 f7) + (VK_F8 #x77 f8) + (VK_F9 #x78 f9) + (VK_F10 #x79 f10) + (VK_F11 #x7A f11) + (VK_F12 #x7B f12) + (VK_F13 #x7C f13) + (VK_F14 #x7D f14) + (VK_F15 #x7E f15) + (VK_F16 #x7F f16) + (VK_F17 #x80 f17) + (VK_F18 #x81 f18) + (VK_F19 #x82 f19) + (VK_F20 #x83 f20) + (VK_F21 #x84 f21) + (VK_F22 #x85 f22) + (VK_F23 #x86 f23) + (VK_F24 #x87 f24) + + (VK_NUMLOCK #x90) + (VK_SCROLL #x91) + + (VK_LSHIFT #xA0) + (VK_RSHIFT #xA1) + (VK_LCONTROL #xA2) + (VK_RCONTROL #xA3) + (VK_LMENU #xA4) + (VK_RMENU #xA5) + + (VK_ATTN #xF6) + (VK_CRSEL #xF7) + (VK_EXSEL #xF8) + (VK_EREOF #xF9) + (VK_PLAY #xFA) + (VK_ZOOM #xFB) + (VK_NONAME #xFC) + (VK_PA1 #xFD) + (VK_OEM_CLEAR #xFE))) + v)) \ No newline at end of file