summaryrefslogtreecommitdiff
path: root/packages/rtl-console/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/rtl-console/src')
-rw-r--r--packages/rtl-console/src/amicommon/keyboard.pp2
-rw-r--r--packages/rtl-console/src/amicommon/video.pp9
-rw-r--r--packages/rtl-console/src/go32v2/keyboard.pp2
-rw-r--r--packages/rtl-console/src/go32v2/video.pp30
-rw-r--r--packages/rtl-console/src/inc/keyboard.inc154
-rw-r--r--packages/rtl-console/src/inc/keybrdh.inc104
-rw-r--r--packages/rtl-console/src/inc/video.inc520
-rw-r--r--packages/rtl-console/src/inc/videoh.inc74
-rw-r--r--packages/rtl-console/src/msdos/keyboard.pp2
-rw-r--r--packages/rtl-console/src/msdos/video.pp30
-rw-r--r--packages/rtl-console/src/netware/keyboard.pp2
-rw-r--r--packages/rtl-console/src/netware/video.pp29
-rw-r--r--packages/rtl-console/src/netwlibc/keyboard.pp2
-rw-r--r--packages/rtl-console/src/netwlibc/video.pp29
-rw-r--r--packages/rtl-console/src/os2commn/keyboard.pp2
-rw-r--r--packages/rtl-console/src/os2commn/video.pp29
-rw-r--r--packages/rtl-console/src/unix/convert.inc73
-rw-r--r--packages/rtl-console/src/unix/keyboard.pp1266
-rw-r--r--packages/rtl-console/src/unix/unixkvmbase.pp51
-rw-r--r--packages/rtl-console/src/unix/video.pp482
-rw-r--r--packages/rtl-console/src/win/keyboard.pp466
-rw-r--r--packages/rtl-console/src/win/video.pp381
-rw-r--r--packages/rtl-console/src/win/winevent.pp2
-rw-r--r--packages/rtl-console/src/win16/keyboard.pp2
-rw-r--r--packages/rtl-console/src/win16/video.pp29
25 files changed, 2150 insertions, 1622 deletions
diff --git a/packages/rtl-console/src/amicommon/keyboard.pp b/packages/rtl-console/src/amicommon/keyboard.pp
index c6f5239258..6f3acb7773 100644
--- a/packages/rtl-console/src/amicommon/keyboard.pp
+++ b/packages/rtl-console/src/amicommon/keyboard.pp
@@ -624,6 +624,8 @@ const
// TranslateKeyEvent : @SysTranslateKeyEvent;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
diff --git a/packages/rtl-console/src/amicommon/video.pp b/packages/rtl-console/src/amicommon/video.pp
index f591bb5690..f06e75b7b1 100644
--- a/packages/rtl-console/src/amicommon/video.pp
+++ b/packages/rtl-console/src/amicommon/video.pp
@@ -55,7 +55,7 @@ var
implementation
uses
- exec, agraphics;
+ exec, agraphics, graphemebreakproperty, eastasianwidth, charset;
procedure SysUpdateScreen(Force: Boolean); forward;
@@ -849,6 +849,7 @@ end;
const
SysVideoDriver : TVideoDriver = (
InitDriver : @SysInitVideo;
+ InitEnhancedDriver : Nil;
DoneDriver : @SysDoneVideo;
UpdateScreen : @SysUpdateScreen;
ClearScreen : @SysClearScreen;
@@ -858,7 +859,11 @@ const
SetCursorPos : @SysSetCursorPos;
GetCursorType : @SysGetCursorType;
SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
{$ifdef Amiga68k}
function CreateRastport: PRastPort;
diff --git a/packages/rtl-console/src/go32v2/keyboard.pp b/packages/rtl-console/src/go32v2/keyboard.pp
index aee69f0386..829a4d070a 100644
--- a/packages/rtl-console/src/go32v2/keyboard.pp
+++ b/packages/rtl-console/src/go32v2/keyboard.pp
@@ -68,6 +68,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
begin
diff --git a/packages/rtl-console/src/go32v2/video.pp b/packages/rtl-console/src/go32v2/video.pp
index 8733a162a0..52460cf85a 100644
--- a/packages/rtl-console/src/go32v2/video.pp
+++ b/packages/rtl-console/src/go32v2/video.pp
@@ -27,7 +27,8 @@ implementation
uses
mouse,
- go32;
+ go32,
+ graphemebreakproperty,eastasianwidth,charset;
{$i video.inc}
@@ -305,17 +306,22 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
- DoneDriver : @SysDoneVideo;
- UpdateScreen : @SysUpdateScreen;
- ClearScreen : Nil;
- SetVideoMode : @SysSetVideoMode;
- GetVideoModeCount : @SysGetVideoModeCount;
- GetVideoModeData : @SysGetVideoModedata;
- SetCursorPos : @SysSetCursorPos;
- GetCursorType : @SysGetCursorType;
- SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : Nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
initialization
diff --git a/packages/rtl-console/src/inc/keyboard.inc b/packages/rtl-console/src/inc/keyboard.inc
index 5a35b53f1f..c8b3916078 100644
--- a/packages/rtl-console/src/inc/keyboard.inc
+++ b/packages/rtl-console/src/inc/keyboard.inc
@@ -82,6 +82,68 @@ begin
end;
+{ Converts an Extended 101/102-Keyboard function scan code (as returned by int
+ 16h, AH=10h/11h) to a standard 101/102-Keyboard function scan code (as would
+ be returned by int 16h, AH=00h/01h). However, keys that are not returned by
+ the standard keyboard function (e.g. F11, F12, etc.) are still let through.
+ Only those that return different codes are converted. }
+function ConvertExtendedToStandardScanCode(ScanCode: Word): Word;
+begin
+ if (ScanCode and $FF)=$E0 then
+ ConvertExtendedToStandardScanCode:=ScanCode and $FF00
+ else
+ case ScanCode of
+ { Numpad Enter -> Regular Enter }
+ $E00D:
+ ConvertExtendedToStandardScanCode:=$1C0D;
+ { Ctrl + Numpad Enter -> Ctrl + Regular Enter }
+ $E00A:
+ ConvertExtendedToStandardScanCode:=$1C0A;
+ { Numpad '/' -> Regular '/' }
+ $E02F:
+ ConvertExtendedToStandardScanCode:=$352F;
+ else
+ ConvertExtendedToStandardScanCode:=ScanCode;
+ end;
+end;
+
+
+function ConvertEnhancedToLegacyShiftState(const ShiftState: TEnhancedShiftState): Byte;
+begin
+ ConvertEnhancedToLegacyShiftState:=0;
+ if essAlt in ShiftState then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or kbAlt;
+ if essCtrl in ShiftState then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or kbCtrl;
+ if essShift in ShiftState then
+ begin
+ if ([essLeftShift,essRightShift]*ShiftState)=[] then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or kbShift
+ else
+ begin
+ if essLeftShift in ShiftState then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or kbLeftShift;
+ if essRightShift in ShiftState then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or kbRightShift;
+ end;
+ end;
+ { AltGr triggers both kbAlt and kbCtrl in the legacy shift state }
+ if essAltGr in ShiftState then
+ ConvertEnhancedToLegacyShiftState:=ConvertEnhancedToLegacyShiftState or (kbAlt or kbCtrl);
+end;
+
+
+function ConvertToLegacyKeyEvent(const KeyEvent: TEnhancedKeyEvent): TKeyEvent;
+begin
+ if KeyEvent=NilEnhancedKeyEvent then
+ ConvertToLegacyKeyEvent:=0
+ else
+ ConvertToLegacyKeyEvent:=(kbPhys shl 24) or
+ ConvertExtendedToStandardScanCode(KeyEvent.VirtualScanCode) or
+ (ConvertEnhancedToLegacyShiftState(KeyEvent.ShiftState) shl 16);
+end;
+
+
function GetKeyEvent: TKeyEvent;
begin
@@ -93,6 +155,8 @@ begin
end;
If Assigned(CurrentKeyBoardDriver.GetKeyEvent) Then
GetKeyEvent:=CurrentKeyBoardDriver.GetKeyEvent()
+ else if Assigned(CurrentKeyboardDriver.GetEnhancedKeyEvent) then
+ GetKeyEvent:=ConvertToLegacyKeyEvent(CurrentKeyboardDriver.GetEnhancedKeyEvent())
else
GetKeyEvent:=0;
end;
@@ -110,6 +174,8 @@ begin
// PollKeyEvent procedure
// to avoid problems if that procedure is called directly PM
end
+ else if Assigned(CurrentKeyboardDriver.PollEnhancedKeyEvent) then
+ PollKeyEvent:=ConvertToLegacyKeyEvent(CurrentKeyboardDriver.PollEnhancedKeyEvent())
else
PollKeyEvent:=0;
end;
@@ -154,6 +220,94 @@ begin
TranslateKeyEventUnicode:=DefaultTranslateKeyEventUnicode(KeyEvent);
end;
+function ConvertToEnhancedKeyEvent(KeyEvent: TKeyEvent): TEnhancedKeyEvent;
+var
+ TranslatedKeyEvent: TKeyEvent;
+ ShiftState: Byte;
+begin
+ ConvertToEnhancedKeyEvent:=NilEnhancedKeyEvent;
+ if KeyEvent=0 then
+ exit;
+ ConvertToEnhancedKeyEvent.ShiftState:=[];
+ ShiftState:=GetKeyEventShiftState(KeyEvent);
+ if (kbAlt and ShiftState)<>0 then
+ Include(ConvertToEnhancedKeyEvent.ShiftState,essAlt);
+ if (kbCtrl and ShiftState)<>0 then
+ Include(ConvertToEnhancedKeyEvent.ShiftState,essCtrl);
+ if (kbShift and ShiftState)<>0 then
+ begin
+ Include(ConvertToEnhancedKeyEvent.ShiftState,essShift);
+ if (kbLeftShift and ShiftState)<>0 then
+ Include(ConvertToEnhancedKeyEvent.ShiftState,essLeftShift);
+ if (kbRightShift and ShiftState)<>0 then
+ Include(ConvertToEnhancedKeyEvent.ShiftState,essRightShift);
+ end;
+ case GetKeyEventFlags(KeyEvent) of
+ kbASCII:
+ ConvertToEnhancedKeyEvent.AsciiChar:=GetKeyEventChar(KeyEvent);
+ kbUniCode:
+ ConvertToEnhancedKeyEvent.UnicodeChar:=WideChar(GetKeyEventUniCode(KeyEvent));
+ kbFnKey:
+ ConvertToEnhancedKeyEvent.VirtualKeyCode:=GetKeyEventCode(KeyEvent);
+ kbPhys:
+ ConvertToEnhancedKeyEvent.VirtualScanCode:=KeyEvent and $ffff;
+ end;
+ TranslatedKeyEvent:=TranslateKeyEvent(KeyEvent);
+ case GetKeyEventFlags(TranslatedKeyEvent) of
+ kbASCII:
+ ConvertToEnhancedKeyEvent.AsciiChar:=GetKeyEventChar(TranslatedKeyEvent);
+ kbUniCode:
+ ConvertToEnhancedKeyEvent.UnicodeChar:=WideChar(GetKeyEventUniCode(TranslatedKeyEvent));
+ kbFnKey:
+ ConvertToEnhancedKeyEvent.VirtualKeyCode:=GetKeyEventCode(TranslatedKeyEvent);
+ kbPhys:
+ ConvertToEnhancedKeyEvent.VirtualScanCode:=TranslatedKeyEvent and $ffff;
+ end;
+ { todo: set ConvertToEnhancedKeyEvent.Flags }
+ if (ConvertToEnhancedKeyEvent.UnicodeChar=WideChar(0)) and
+ (ConvertToEnhancedKeyEvent.AsciiChar>=#0) and
+ (ConvertToEnhancedKeyEvent.AsciiChar<=#127) then
+ ConvertToEnhancedKeyEvent.UnicodeChar:=WideChar(ConvertToEnhancedKeyEvent.AsciiChar);
+ { todo: maybe also convert extended ASCII (>=#128) codes to Unicode as well
+ (according to the console code page) }
+end;
+
+function DefaultGetEnhancedKeyEvent: TEnhancedKeyEvent;
+begin
+ DefaultGetEnhancedKeyEvent:=ConvertToEnhancedKeyEvent(GetKeyEvent);
+end;
+
+function GetEnhancedKeyEvent: TEnhancedKeyEvent;
+begin
+ if Assigned(CurrentKeyBoardDriver.GetEnhancedKeyEvent) then
+ GetEnhancedKeyEvent:=CurrentKeyBoardDriver.GetEnhancedKeyEvent()
+ else
+ GetEnhancedKeyEvent:=DefaultGetEnhancedKeyEvent;
+end;
+
+function DefaultPollEnhancedKeyEvent: TEnhancedKeyEvent;
+begin
+ DefaultPollEnhancedKeyEvent:=ConvertToEnhancedKeyEvent(PollKeyEvent);
+end;
+
+function PollEnhancedKeyEvent: TEnhancedKeyEvent;
+begin
+ if Assigned(CurrentKeyBoardDriver.PollEnhancedKeyEvent) then
+ PollEnhancedKeyEvent:=CurrentKeyBoardDriver.PollEnhancedKeyEvent()
+ else
+ PollEnhancedKeyEvent:=DefaultPollEnhancedKeyEvent;
+end;
+
+operator = (const a, b: TEnhancedKeyEvent) res: Boolean;
+begin
+ res:=(a.VirtualKeyCode = b.VirtualKeyCode) and
+ (a.VirtualScanCode = b.VirtualScanCode) and
+ (a.UnicodeChar = b.UnicodeChar) and
+ (a.AsciiChar = b.AsciiChar) and
+ (a.ShiftState = b.ShiftState) and
+ (a.Flags = b.Flags);
+end;
+
type
TTranslationEntry = packed record
Min, Max: Byte;
diff --git a/packages/rtl-console/src/inc/keybrdh.inc b/packages/rtl-console/src/inc/keybrdh.inc
index 327550d4ba..5bea6d4c5a 100644
--- a/packages/rtl-console/src/inc/keybrdh.inc
+++ b/packages/rtl-console/src/inc/keybrdh.inc
@@ -54,8 +54,96 @@ type
dependent. System dependent constants may be defined to cover those, with
possibily having the same name (but different value). }
-{ System independent function key codes }
+ TEnhancedShiftStateElement = (
+ essShift, { either Left or Right Shift is pressed }
+ essLeftShift,
+ essRightShift,
+ essCtrl, { either Left or Right Ctrl is pressed }
+ essLeftCtrl,
+ essRightCtrl,
+ essAlt, { either Left or Right Alt is pressed, but *not* AltGr }
+ essLeftAlt,
+ essRightAlt, { only on keyboard layouts, without AltGr }
+ essAltGr, { only on keyboard layouts, with AltGr instead of Right Alt }
+ essCapsLockPressed,
+ essCapsLockOn,
+ essNumLockPressed,
+ essNumLockOn,
+ essScrollLockPressed,
+ essScrollLockOn
+ );
+ TEnhancedShiftState = set of TEnhancedShiftStateElement;
+ { Note: not all consoles are able to distinguish between Left and Right Shift,
+ Ctrl and Alt.
+
+ Valid examples:
+ [essShift] - Either Left or Right Shift is
+ pressed. Console is NOT able to
+ distinguish between Left and Right
+ Shift.
+ [essShift,essLeftShift] - Left Shift is pressed. Console CAN
+ distinguish between Left and Right
+ Shift.
+ [essShift,essRightShift] - Right shift is pressed. Console CAN
+ distinguish between Left and Right
+ Shift.
+ [essShift,essLeftShift,essRightShift] - Both Left Shift and Right Shift are
+ pressed. Console CAN distinguish
+ between Left and Right Shift.
+
+ Invalid examples (it is a bug, if a console driver ever generates these):
+ [essLeftShift] - missing essShift
+ [essRightShift] - missing essShift
+ [essLeftShift,essRightShift] - missing essShift
+
+ Exactly the same principle applies to essCtrl, essLeftCtrl and essRightCtrl.
+
+ For Alt, it depends on whether the current keyboard layout has a Right Alt
+ or an AltGr key. If it's Right Alt, then essAltGr will not be seen, and the
+ same principle described above applies to essAlt, essLeftAlt and
+ essRightAlt. If the keyboard layout has an AltGr key, instead of Right Alt,
+ then essRightAlt is not generated. The AltGr key generates only essAltGr,
+ without essAlt, so for keyboards with AltGr instead of Right Alt:
+
+ [essAltGr] - AltGr is pressed.
+ [essAlt,essLeftAlt] - Left Alt is pressed.
+ [essAlt,essLeftAlt, essAltGr] - Both Left Alt and AltGr are pressed.
+ [essAlt,essAltGr] - Both (usually Left) Alt and AltGr are pressed, but the
+ console is unable to distinguish between Left Alt and
+ Right Alt (if it existed and was not marked AltGr - in
+ theory it is possible for someone to make a keyboard
+ with three separate keys: Left Alt, Right Alt and AltGr).
+ [essAlt,essLeftAlt,essRightAlt,essAltGr] - The keyboard has three separate
+ keys: Left Alt, Right Alt and
+ AltGr and they are all pressed.
+
+ Note that Windows handles AltGr internally as Left Ctrl+Right Alt, which we
+ detect and convert to essAltGr, but this makes it impossible to distinguish
+ between Left Ctrl+AltGr and only AltGr, since there's no way to tell whether
+ the Left Ctrl that Windows report is dummy or real, so we always assume it's
+ dummy and remove it from the shift state, if AltGr was pressed.
+ }
+
+ TEnhancedKeyEvent = record
+ VirtualKeyCode: Word; { device-independent identifier of the key }
+ VirtualScanCode: Word; { device-dependent value, generated by the keyboard }
+ UnicodeChar: WideChar; { the translated Unicode character }
+ AsciiChar: Char; { the translated ASCII character }
+ ShiftState: TEnhancedShiftState;
+ Flags: Byte;
+ end;
+
const
+{ The Nil value for the enhanced key event }
+ NilEnhancedKeyEvent: TEnhancedKeyEvent = (
+ VirtualKeyCode: 0;
+ VirtualScanCode: 0;
+ UnicodeChar: #0;
+ AsciiChar: #0;
+ ShiftState: [];
+ Flags: 0;
+ );
+{ System independent function key codes }
kbdF1 = $FF01;
kbdF2 = $FF02;
kbdF3 = $FF03;
@@ -135,6 +223,8 @@ Type
GetShiftState : Function : Byte;
TranslateKeyEvent : Function (KeyEvent: TKeyEvent): TKeyEvent;
TranslateKeyEventUniCode : Function (KeyEvent: TKeyEvent): TKeyEvent;
+ GetEnhancedKeyEvent : Function : TEnhancedKeyEvent;
+ PollEnhancedKeyEvent : Function : TEnhancedKeyEvent;
end;
procedure InitKeyboard;
@@ -200,3 +290,15 @@ Function FunctionKeyName (KeyCode : Word) : String;
Function KeyEventToString(KeyEvent : TKeyEvent) : String;
{ Returns a string representation of the pressed key }
+function GetEnhancedKeyEvent: TEnhancedKeyEvent;
+{ Returns the last keyevent, and waits for one if not available }
+
+function PollEnhancedKeyEvent: TEnhancedKeyEvent;
+{ Checks if a keyevent is available, and returns it if one is found. If no
+ event is pending, it returns 0 }
+
+function ConvertEnhancedToLegacyShiftState(const ShiftState: TEnhancedShiftState): Byte;
+{ Converts an enhanced shift state (as in TEnhancedKeyEvent.ShiftState) to a
+ legacy shift state (as returned by GetShiftState or GetKeyEventShiftState) }
+
+operator = (const a, b: TEnhancedKeyEvent) res: Boolean;
diff --git a/packages/rtl-console/src/inc/video.inc b/packages/rtl-console/src/inc/video.inc
index 841a56d569..110091aa59 100644
--- a/packages/rtl-console/src/inc/video.inc
+++ b/packages/rtl-console/src/inc/video.inc
@@ -11,6 +11,86 @@
**********************************************************************}
+const
+ convert_lowascii_to_Unicode:array[#0..#31] of WideChar=(
+ #8199,#9786,#9787,#9829,#9830,#9827,#9824,#8226,
+ #9688,#9675,#9689,#9794,#9792,#9834,#9835,#9788,
+ #9658,#9668,#8597,#8252,#0182,#0167,#9644,#8616,
+ #8593,#8595,#8594,#8592,#8735,#8596,#9650,#9660
+ );
+
+{ TEnhancedVideoCell }
+
+operator = (const a,b : TEnhancedVideoCell) res: Boolean;
+begin
+ res:=(a.Attribute=b.Attribute) and (a.ExtendedGraphemeCluster = b.ExtendedGraphemeCluster);
+end;
+
+function TEnhancedVideoCell.GetAttribute: Byte;
+begin
+ GetAttribute := Byte(FAttributes);
+end;
+
+procedure TEnhancedVideoCell.SetAttribute(Attr: Byte);
+begin
+ FAttributes := (FAttributes and $FF00) or Attr;
+end;
+
+function TEnhancedVideoCell.GetExtendedGraphemeCluster: UnicodeString;
+begin
+ if (FAttributes and $8000) = 0 then
+ GetExtendedGraphemeCluster := EGC_SingleChar
+ else
+ GetExtendedGraphemeCluster := UnicodeString(EGC_WideStr);
+end;
+
+procedure TEnhancedVideoCell.SetExtendedGraphemeCluster(const AExtendedGraphemeCluster: UnicodeString);
+begin
+ if Length(AExtendedGraphemeCluster) = 1 then
+ begin
+ if (FAttributes and $8000) <> 0 then
+ begin
+ FAttributes := FAttributes and $7FFF;
+ UnicodeString(EGC_WideStr) := '';
+ end;
+ EGC_SingleChar := AExtendedGraphemeCluster[1];
+ end
+ else
+ begin
+ if (FAttributes and $8000) = 0 then
+ begin
+ FAttributes := FAttributes or $8000;
+ EGC_WideStr := nil;
+ end;
+ UnicodeString(EGC_WideStr) := AExtendedGraphemeCluster;
+ end;
+end;
+
+class operator TEnhancedVideoCell.Initialize(var evc: TEnhancedVideoCell);
+begin
+ evc.FAttributes := 0;
+end;
+
+class operator TEnhancedVideoCell.Finalize(var evc: TEnhancedVideoCell);
+begin
+ if (evc.FAttributes and $8000) <> 0 then
+ UnicodeString(evc.EGC_WideStr) := '';
+end;
+
+Procedure fpc_UnicodeStr_Incr_Ref(S : Pointer); external name 'FPC_UNICODESTR_INCR_REF';
+
+class operator TEnhancedVideoCell.AddRef(var evc: TEnhancedVideoCell);
+begin
+ if (evc.FAttributes and $8000) <> 0 then
+ fpc_UnicodeStr_Incr_Ref(evc.EGC_WideStr);
+end;
+
+class operator TEnhancedVideoCell.Copy(constref aSrc: TEnhancedVideoCell; var aDst: TEnhancedVideoCell);
+begin
+ aDst.ExtendedGraphemeCluster := aSrc.ExtendedGraphemeCluster;
+ aDst.Attribute := aSrc.Attribute;
+end;
+
Const
LockUpdateScreen : Integer = 0;
@@ -35,22 +115,26 @@ end;
Var
CurrentVideoDriver : TVideoDriver;
NextVideoMode : TVideoMode;
+ CurrentLegacy2EnhancedTranslationCodePage: TSystemCodePage;
Const
VideoInitialized : Boolean = False;
+ EnhancedVideoInitialized : Boolean = False;
DriverInitialized : Boolean = False;
NextVideoModeSet : Boolean = False;
Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
{ Sets the videodriver to be used }
begin
- If Not VideoInitialized then
- Begin
- CurrentVideoDriver:=Driver;
+ if (not VideoInitialized) and (not EnhancedVideoInitialized) then
+ begin
+ CurrentVideoDriver:=Driver;
DriverInitialized:=true;
NextVideoModeSet:=false;
- End;
- SetVideoDriver:=Not VideoInitialized;
+ SetVideoDriver:=true;
+ end
+ else
+ SetVideoDriver:=false;
end;
Procedure GetVideoDriver (Var Driver : TVideoDriver);
@@ -68,49 +152,47 @@ Procedure FreeVideoBuf;
begin
if (VideoBuf<>Nil) then
begin
- FreeMem(VideoBuf);
- FreeMem(OldVideoBuf);
- VideoBuf:=Nil;
- OldVideoBuf:=Nil;
- VideoBufSize:=0;
+ FreeMem(VideoBuf);
+ FreeMem(OldVideoBuf);
+ VideoBuf:=Nil;
+ OldVideoBuf:=Nil;
+ VideoBufSize:=0;
end;
end;
-(*
-Procedure AssignVideoBuf (OldCols, OldRows : Word);
-
-Var NewVideoBuf,NewOldVideoBuf : PVideoBuf;
- I,C,R,NewVideoBufSize : longint;
- s:word;
+procedure FreeEnhancedVideoBuf;
+begin
+ SetLength(EnhancedVideoBuf,0);
+ SetLength(OldEnhancedVideoBuf,0);
+end;
+procedure EnhancedVideoBufResize(var Buf: TEnhancedVideoBuf; OldCols, OldRows : Word);
+var
+ NewVideoBufSize : SizeUInt;
+ NewBuf: TEnhancedVideoBuf;
+ Y, X, YS, XS: Integer;
begin
- S:=sizeOf(TVideoCell);
- NewVideoBufSize:=ScreenWidth*ScreenHeight*s;
- GetMem(NewVideoBuf,NewVideoBufSize);
- GetMem(NewOldVideoBuf,NewVideoBufSize);
- // Move contents of old videobuffers to new if there are any.
- if (VideoBuf<>Nil) then
+ NewVideoBufSize:=ScreenWidth*ScreenHeight;
+ if OldCols<>ScreenWidth then
begin
- If (ScreenWidth<OldCols) then
- C:=ScreenWidth
- else
- C:=OldCols;
- If (ScreenHeight<OldRows) then
- R:=ScreenHeight
- else
- R:=OldRows;
- For I:=0 to R-1 do
- begin
- Move(VideoBuf^[I*OldCols],NewVideoBuf^[I*ScreenWidth],S*C);
- Move(OldVideoBuf^[I*OldCols],NewOldVideoBuf^[I*ScreenWidth],S*C);
- end;
- end;
- FreeVideoBuf;
- VideoBufSize:=NewVideoBufSize;
- VideoBuf:=NewVideoBuf;
- OldVideoBuf:=NewOldVideoBuf;
+ SetLength(NewBuf,NewVideoBufSize);
+ if OldRows<ScreenHeight then
+ YS := OldRows
+ else
+ YS := ScreenHeight;
+ if OldCols<ScreenWidth then
+ XS := OldCols
+ else
+ XS := ScreenWidth;
+ for Y := 0 to YS-1 do
+ for X := 0 to XS-1 do
+ NewBuf[Y*ScreenWidth+X]:=Buf[Y*OldCols+X];
+ Buf:=NewBuf;
+ end
+ else
+ SetLength(Buf,NewVideoBufSize);
end;
-*)
+
Procedure AssignVideoBuf (OldCols, OldRows : Word);
var NewVideoBuf,NewOldVideoBuf:PVideoBuf;
@@ -118,32 +200,40 @@ var NewVideoBuf,NewOldVideoBuf:PVideoBuf;
NewVideoBufSize : longint;
begin
- NewVideoBufSize:=ScreenWidth*ScreenHeight*sizeof(TVideoCell);
- GetMem(NewVideoBuf,NewVideoBufSize);
- GetMem(NewOldVideoBuf,NewVideoBufSize);
- {Move contents of old videobuffers to new if there are any.}
- if VideoBuf<>nil then
+ if VideoInitialized or Assigned(CurrentVideoDriver.InitDriver) then
begin
- if ScreenWidth<OldCols then
- OldCols:=ScreenWidth;
- if ScreenHeight<OldRows then
- OldRows:=ScreenHeight;
- old_rowstart:=0;
- new_rowstart:=0;
- while oldrows>0 do
+ NewVideoBufSize:=ScreenWidth*ScreenHeight*sizeof(TVideoCell);
+ GetMem(NewVideoBuf,NewVideoBufSize);
+ GetMem(NewOldVideoBuf,NewVideoBufSize);
+ {Move contents of old videobuffers to new if there are any.}
+ if VideoBuf<>nil then
begin
- move(VideoBuf^[old_rowstart],NewVideoBuf^[new_rowstart],OldCols*sizeof(TVideoCell));
- move(OldVideoBuf^[old_rowstart],NewOldVideoBuf^[new_rowstart],OldCols*sizeof(TVideoCell));
- inc(old_rowstart,OldCols);
- inc(new_rowstart,ScreenWidth);
- dec(OldRows);
+ if ScreenWidth<OldCols then
+ OldCols:=ScreenWidth;
+ if ScreenHeight<OldRows then
+ OldRows:=ScreenHeight;
+ old_rowstart:=0;
+ new_rowstart:=0;
+ while oldrows>0 do
+ begin
+ move(VideoBuf^[old_rowstart],NewVideoBuf^[new_rowstart],OldCols*sizeof(TVideoCell));
+ move(OldVideoBuf^[old_rowstart],NewOldVideoBuf^[new_rowstart],OldCols*sizeof(TVideoCell));
+ inc(old_rowstart,OldCols);
+ inc(new_rowstart,ScreenWidth);
+ dec(OldRows);
+ end;
end;
+ FreeVideoBuf;
+ { FreeVideoBuf sets VideoBufSize to 0 }
+ VideoBufSize:=NewVideoBufSize;
+ VideoBuf:=NewVideoBuf;
+ OldVideoBuf:=NewOldVideoBuf;
+ end;
+ if EnhancedVideoInitialized or Assigned(CurrentVideoDriver.InitEnhancedDriver) then
+ begin
+ EnhancedVideoBufResize(EnhancedVideoBuf,OldCols,OldRows);
+ EnhancedVideoBufResize(OldEnhancedVideoBuf,OldCols,OldRows);
end;
- FreeVideoBuf;
- { FreeVideoBuf sets VideoBufSize to 0 }
- VideoBufSize:=NewVideoBufSize;
- VideoBuf:=NewVideoBuf;
- OldVideoBuf:=NewOldVideoBuf;
end;
Procedure InitVideo;
@@ -151,7 +241,12 @@ Procedure InitVideo;
begin
if not VideoInitialized then
begin
- if Assigned(CurrentVideoDriver.InitDriver) then
+ if Assigned(CurrentVideoDriver.InitEnhancedDriver) then
+ begin
+ CurrentLegacy2EnhancedTranslationCodePage := 437;
+ CurrentVideoDriver.InitEnhancedDriver;
+ end
+ else if Assigned(CurrentVideoDriver.InitDriver) then
CurrentVideoDriver.InitDriver;
if errorcode=viook then
begin
@@ -174,28 +269,194 @@ begin
If Assigned(CurrentVideoDriver.DoneDriver) then
CurrentVideoDriver.DoneDriver;
FreeVideoBuf;
+ FreeEnhancedVideoBuf;
VideoInitialized:=False;
end;
end;
+procedure InitEnhancedVideo;
+begin
+ if not EnhancedVideoInitialized then
+ begin
+ if Assigned(CurrentVideoDriver.InitEnhancedDriver) then
+ CurrentVideoDriver.InitEnhancedDriver
+ else if Assigned(CurrentVideoDriver.InitDriver) then
+ CurrentVideoDriver.InitDriver;
+ if errorcode=viook then
+ begin
+ EnhancedVideoInitialized:=true;
+ if NextVideoModeSet then
+ SetVideoMode(NextVideoMode)
+ else
+ AssignVideoBuf(0,0);
+ ClearScreen;
+ end;
+ end;
+end;
+
+procedure DoneEnhancedVideo;
+begin
+ if EnhancedVideoInitialized then
+ begin
+ if Assigned(CurrentVideoDriver.DoneDriver) then
+ CurrentVideoDriver.DoneDriver;
+ FreeVideoBuf;
+ FreeEnhancedVideoBuf;
+ EnhancedVideoInitialized:=False;
+ end;
+end;
+
+function ExtendedGraphemeCluster2LegacyChar(const EGC: UnicodeString; CodePage: TSystemCodePage): Char;
+
+ function GenConvert: Char;
+ var
+ tmpS: RawByteString;
+ begin
+ tmpS:=UTF8Encode(EGC);
+ System.SetCodePage(tmpS,CodePage,True);
+ if Length(tmpS)=1 then
+ Result:=tmpS[1]
+ else
+ Result:='?';
+ end;
+
+var
+ Ch: Char;
+begin
+ if (Length(EGC) = 1) then
+ begin
+ for Ch:=Low(convert_lowascii_to_Unicode) to High(convert_lowascii_to_Unicode) do
+ if convert_lowascii_to_Unicode[Ch]=EGC[1] then
+ begin
+ Result:=Ch;
+ exit;
+ end;
+ case Ord(EGC[1]) of
+ 32..126:
+ Result:=Chr(Ord(EGC[1]));
+ $2302:
+ Result:=#127;
+ else
+ Result:=GenConvert;
+ end
+ end
+ else
+ Result:=GenConvert;
+end;
+
+function LegacyChar2ExtendedGraphemeCluster(const Ch: Char): UnicodeString;
+var
+ tmpS: RawByteString;
+begin
+ if Ch<=#31 then
+ Result:=convert_lowascii_to_Unicode[Ch]
+ else if Ch=#127 then
+ Result:=#$2302
+ else
+ begin
+ SetLength(tmpS, 1);
+ tmpS[1]:=Ch;
+ System.SetCodePage(tmpS,CurrentLegacy2EnhancedTranslationCodePage,False);
+ Result:=tmpS;
+ end;
+end;
+
+procedure Enhanced2Legacy;
+var
+ I: Integer;
+ CodePage: TSystemCodePage;
+begin
+ CodePage:=GetActiveCodePage();
+ { todo: optimize this }
+ for I := 0 to Length(EnhancedVideoBuf)-1 do
+ begin
+ with EnhancedVideoBuf[I] do
+ VideoBuf^[I]:=(Attribute shl 8) or Ord(ExtendedGraphemeCluster2LegacyChar(ExtendedGraphemeCluster,CodePage));
+ with OldEnhancedVideoBuf[I] do
+ OldVideoBuf^[I]:=(Attribute shl 8) or Ord(ExtendedGraphemeCluster2LegacyChar(ExtendedGraphemeCluster,CodePage));
+ end;
+end;
+
+procedure Legacy2Enhanced;
+var
+ I: Integer;
+begin
+ { todo: optimize this }
+ for I := 0 to Length(EnhancedVideoBuf)-1 do
+ begin
+ with EnhancedVideoBuf[I] do
+ begin
+ Attribute:=Byte(VideoBuf^[I] shr 8);
+ ExtendedGraphemeCluster:=LegacyChar2ExtendedGraphemeCluster(Chr(Byte(VideoBuf^[I])));
+ end;
+ with OldEnhancedVideoBuf[I] do
+ begin
+ Attribute:=Byte(OldVideoBuf^[I] shr 8);
+ ExtendedGraphemeCluster:=LegacyChar2ExtendedGraphemeCluster(Chr(Byte(OldVideoBuf^[I])));
+ end;
+ end;
+end;
+
Procedure UpdateScreen (Force : Boolean);
begin
- If (LockUpdateScreen<=0) and
+ if (LockUpdateScreen<=0) and
Assigned(CurrentVideoDriver.UpdateScreen) then
+ begin
+ if EnhancedVideoInitialized and Assigned(CurrentVideoDriver.InitDriver) then
+ Enhanced2Legacy
+ else if VideoInitialized and Assigned(CurrentVideoDriver.InitEnhancedDriver) then
+ Legacy2Enhanced;
CurrentVideoDriver.UpdateScreen(Force);
+ end;
end;
-Procedure ClearScreen;
-
-begin
+procedure ClearScreen;
+const
+ DefaultChar=#32;
// Should this not be the current color ?
- FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
- If Assigned(CurrentVideoDriver.ClearScreen) then
- CurrentVideoDriver.ClearScreen
- else
- UpdateScreen(True);
- FillWord(OldVideoBuf^,VideoBufSize shr 1,$0720);
+ DefaultAttr=7;
+var
+ I: Integer;
+begin
+ if VideoInitialized then
+ begin
+ FillWord(VideoBuf^,VideoBufSize shr 1,(DefaultAttr shl 8) or Ord(DefaultChar));
+ If Assigned(CurrentVideoDriver.ClearScreen) then
+ begin
+ if Assigned(CurrentVideoDriver.InitEnhancedDriver) then
+ Legacy2Enhanced;
+ CurrentVideoDriver.ClearScreen;
+ end
+ else
+ UpdateScreen(True);
+ FillWord(OldVideoBuf^,VideoBufSize shr 1,(DefaultAttr shl 8) or Ord(DefaultChar));
+ end
+ else if EnhancedVideoInitialized then
+ begin
+ { todo: optimize }
+ for I:=0 to Length(EnhancedVideoBuf)-1 do
+ with EnhancedVideoBuf[I] do
+ begin
+ Attribute:=DefaultAttr;
+ ExtendedGraphemeCluster:=DefaultChar;
+ end;
+ If Assigned(CurrentVideoDriver.ClearScreen) then
+ begin
+ if Assigned(CurrentVideoDriver.InitDriver) then
+ Enhanced2Legacy;
+ CurrentVideoDriver.ClearScreen;
+ end
+ else
+ UpdateScreen(True);
+ { todo: optimize }
+ for I:=0 to Length(EnhancedVideoBuf)-1 do
+ with OldEnhancedVideoBuf[I] do
+ begin
+ Attribute:=DefaultAttr;
+ ExtendedGraphemeCluster:=DefaultChar;
+ end;
+ end;
end;
Procedure SetCursorType (NewType : Word);
@@ -229,6 +490,115 @@ begin
GetCapabilities:=0;
end;
+function ExtendedGraphemeClusterDisplayWidth(const EGC: UnicodeString): Integer;
+var
+ FirstCodePoint: UCS4Char;
+begin
+ if Length(EGC) > 0 then
+ begin
+ FirstCodePoint:=UCS4Char(EGC[1]);
+ if (FirstCodePoint>=$D800) and (FirstCodePoint<=$DBFF) and (Length(EGC)>=2) and
+ (Ord(EGC[2])>=$DC00) and (Ord(EGC[2])<=$DFFF) then
+ begin
+ FirstCodePoint := $10000+((FirstCodePoint-$D800) shl 10) or (Ord(EGC[2])-$DC00);
+ end;
+ { todo: handle emoji + modifiers }
+ case GetEastAsianWidth(FirstCodePoint) of
+ eawW, eawF:
+ Result := 2;
+ else
+ Result := 1;
+ end;
+ end
+ else
+ Result := 0;
+end;
+
+function StringDisplayWidth(const S: UnicodeString): Integer;
+var
+ EGC: UnicodeString;
+begin
+ Result:=0;
+ for EGC in TUnicodeStringExtendedGraphemeClustersEnumerator.Create(S) do
+ Inc(Result, ExtendedGraphemeClusterDisplayWidth(EGC));
+end;
+
+function GetActiveCodePage: TSystemCodePage;
+begin
+ if EnhancedVideoInitialized then
+ Result := CurrentLegacy2EnhancedTranslationCodePage
+ else if VideoInitialized and Assigned(CurrentVideoDriver.GetActiveCodePage) then
+ Result := CurrentVideoDriver.GetActiveCodePage()
+ else
+ Result := DefaultSystemCodePage;
+end;
+
+{ disallowed codepages (variable length), code points larger than an 8-bit byte, etc. }
+function IsDisallowedCodePage(CodePage: TSystemCodePage): Boolean;
+const
+ CP_UTF32LE=12000;
+ CP_UTF32BE=12001;
+begin
+ Result:=(CodePage=CP_ACP) or (CodePage=CP_OEMCP) or (CodePage=CP_NONE) or
+ (CodePage=CP_UTF8) or (CodePage=CP_UTF7) or
+ (CodePage=CP_UTF16) or (CodePage=CP_UTF16BE) or
+ (CodePage=CP_UTF32LE) or (CodePage=CP_UTF32BE);
+end;
+
+procedure ActivateCodePage(CodePage: TSystemCodePage);
+begin
+ if IsDisallowedCodePage(CodePage) then
+ exit;
+ if EnhancedVideoInitialized then
+ CurrentLegacy2EnhancedTranslationCodePage := CodePage
+ else if VideoInitialized and Assigned(CurrentVideoDriver.ActivateCodePage) then
+ CurrentVideoDriver.ActivateCodePage(CodePage);
+end;
+
+var
+ SupportedCodePagesCount: Integer = -1;
+ SupportedCodePages: array of TSystemCodePage;
+
+procedure InitSupportedCodePages;
+var
+ CP: TSystemCodePage;
+begin
+ SetLength(SupportedCodePages, 0);
+ for CP:=Low(TSystemCodePage) to High(TSystemCodePage) do
+ if (not IsDisallowedCodePage(CP)) and MappingAvailable(CP) then
+ begin
+ SetLength(SupportedCodePages,Length(SupportedCodePages)+1);
+ SupportedCodePages[High(SupportedCodePages)]:=CP;
+ end;
+end;
+
+function GetSupportedCodePageCount: Integer;
+begin
+ if EnhancedVideoInitialized then
+ begin
+ if SupportedCodePagesCount = -1 then
+ InitSupportedCodePages;
+ Result := SupportedCodePagesCount;
+ end
+ else if VideoInitialized and Assigned(CurrentVideoDriver.GetSupportedCodePageCount) then
+ Result := CurrentVideoDriver.GetSupportedCodePageCount()
+ else
+ Result := 1;
+end;
+
+function GetSupportedCodePage(Index: Integer): TSystemCodePage;
+begin
+ if EnhancedVideoInitialized then
+ begin
+ if SupportedCodePagesCount = -1 then
+ InitSupportedCodePages;
+ Result := SupportedCodePages[Index];
+ end
+ else if VideoInitialized and Assigned(CurrentVideoDriver.GetSupportedCodePage) then
+ Result := CurrentVideoDriver.GetSupportedCodePage(Index)
+ else
+ Result := DefaultSystemCodePage;
+end;
{ ---------------------------------------------------------------------
General functions
@@ -251,7 +621,7 @@ begin
SetVideoMode:=DriverInitialized;
if not DriverInitialized then
exit;
- If VideoInitialized then
+ If VideoInitialized or EnhancedVideoInitialized then
begin
OldC:=ScreenWidth;
OldR:=ScreenHeight;
diff --git a/packages/rtl-console/src/inc/videoh.inc b/packages/rtl-console/src/inc/videoh.inc
index 5ef02d20d0..8487f4fe0f 100644
--- a/packages/rtl-console/src/inc/videoh.inc
+++ b/packages/rtl-console/src/inc/videoh.inc
@@ -11,6 +11,9 @@
**********************************************************************}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
type
PVideoMode = ^TVideoMode;
TVideoMode = record
@@ -25,18 +28,47 @@ type
TVideoBuf = array[0..{$ifdef CPU16}16382{$else}32759{$endif}] of TVideoCell;
PVideoBuf = ^TVideoBuf;
+ TEnhancedVideoCell = record
+ private
+ class operator Initialize(var evc: TEnhancedVideoCell);
+ class operator Finalize(var evc: TEnhancedVideoCell);
+ class operator AddRef(var evc: TEnhancedVideoCell);
+ class operator Copy(constref aSrc: TEnhancedVideoCell; var aDst: TEnhancedVideoCell);
+ function GetExtendedGraphemeCluster: UnicodeString;
+ procedure SetExtendedGraphemeCluster(const AExtendedGraphemeCluster: UnicodeString);
+ function GetAttribute: Byte;
+ procedure SetAttribute(Attr: Byte);
+ public
+ property ExtendedGraphemeCluster: UnicodeString read GetExtendedGraphemeCluster write SetExtendedGraphemeCluster;
+ property Attribute: Byte read GetAttribute write SetAttribute;
+
+ private
+ FAttributes: Word;
+ case integer of
+ 0: (EGC_SingleChar: WideChar);
+ 1: (EGC_WideStr: Pointer);
+ end;
+ PEnhancedVideoCell = ^TEnhancedVideoCell;
+
+ TEnhancedVideoBuf = array of TEnhancedVideoCell;
+
TVideoDriver = Record
- InitDriver : Procedure;
- DoneDriver : Procedure;
- UpdateScreen : Procedure(Force : Boolean);
- ClearScreen : Procedure;
- SetVideoMode : Function (Const Mode : TVideoMode) : Boolean;
- GetVideoModeCount : Function : Word;
- GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean;
- SetCursorPos : procedure (NewCursorX, NewCursorY: Word);
- GetCursorType : function : Word;
- SetCursorType : procedure (NewType: Word);
- GetCapabilities : Function : Word;
+ InitDriver : Procedure;
+ InitEnhancedDriver : Procedure;
+ DoneDriver : Procedure;
+ UpdateScreen : Procedure(Force : Boolean);
+ ClearScreen : Procedure;
+ SetVideoMode : Function (Const Mode : TVideoMode) : Boolean;
+ GetVideoModeCount : Function : Word;
+ GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean;
+ SetCursorPos : procedure (NewCursorX, NewCursorY: Word);
+ GetCursorType : function : Word;
+ SetCursorType : procedure (NewType: Word);
+ GetCapabilities : Function : Word;
+ GetActiveCodePage : function : TSystemCodePage;
+ ActivateCodePage : procedure(CodePage: TSystemCodePage);
+ GetSupportedCodePageCount: function : Integer;
+ GetSupportedCodePage : function(Index: Integer): TSystemCodePage;
end;
const
@@ -97,6 +129,8 @@ var
OldVideoBuf : PVideoBuf;
VideoBufSize : Longint;
CursorLines : Byte;
+ EnhancedVideoBuf,
+ OldEnhancedVideoBuf: TEnhancedVideoBuf;
const {The following constants were variables in the past.
- Lowascii was set to true if ASCII characters < 32 were available
@@ -112,6 +146,8 @@ const {The following constants were variables in the past.
FVMaxWidth = 240;
+operator = (const a,b : TEnhancedVideoCell) res: Boolean;
+
Procedure LockScreenUpdate;
{ Increments the screen update lock count with one.}
Procedure UnlockScreenUpdate;
@@ -127,6 +163,10 @@ procedure InitVideo;
{ Initializes the video subsystem }
procedure DoneVideo;
{ Deinitializes the video subsystem }
+procedure InitEnhancedVideo;
+{ Initializes the enhanced (Unicode) video subsystem }
+procedure DoneEnhancedVideo;
+{ Deinitializes the enhanced (Unicode) video subsystem }
function GetCapabilities: Word;
{ Return the capabilities of the current environment }
procedure ClearScreen;
@@ -140,6 +180,18 @@ function GetCursorType: Word;
{ Return the cursor type: Hidden, UnderLine or Block }
procedure SetCursorType(NewType: Word);
{ Set the cursor to the given type }
+function ExtendedGraphemeClusterDisplayWidth(const EGC: UnicodeString): Integer;
+{ Returns the number of display columns needed for the given extended grapheme cluster }
+function StringDisplayWidth(const S: UnicodeString): Integer;
+{ Returns the number of display columns needed for the given string }
+function GetActiveCodePage: TSystemCodePage;
+{ Returns the current active legacy code page }
+procedure ActivateCodePage(CodePage: TSystemCodePage);
+{ Activates a specified legacy code page (if supported) }
+function GetSupportedCodePageCount: Integer;
+{ Get the number of code pages supported by this driver }
+function GetSupportedCodePage(Index: Integer): TSystemCodePage;
+{ Get the supported code page with index Index. Index is zero based. }
procedure GetVideoMode(var Mode: TVideoMode);
{ Return dimensions of the current video mode }
diff --git a/packages/rtl-console/src/msdos/keyboard.pp b/packages/rtl-console/src/msdos/keyboard.pp
index 415f5a4a24..e132d47012 100644
--- a/packages/rtl-console/src/msdos/keyboard.pp
+++ b/packages/rtl-console/src/msdos/keyboard.pp
@@ -86,6 +86,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
begin
diff --git a/packages/rtl-console/src/msdos/video.pp b/packages/rtl-console/src/msdos/video.pp
index aa7eef1e60..4677c1ae5a 100644
--- a/packages/rtl-console/src/msdos/video.pp
+++ b/packages/rtl-console/src/msdos/video.pp
@@ -27,7 +27,8 @@ implementation
uses
mouse,
- dos;
+ dos,
+ graphemebreakproperty,eastasianwidth,charset;
{$i video.inc}
@@ -278,17 +279,22 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
- DoneDriver : @SysDoneVideo;
- UpdateScreen : @SysUpdateScreen;
- ClearScreen : Nil;
- SetVideoMode : @SysSetVideoMode;
- GetVideoModeCount : @SysGetVideoModeCount;
- GetVideoModeData : @SysGetVideoModedata;
- SetCursorPos : @SysSetCursorPos;
- GetCursorType : @SysGetCursorType;
- SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : Nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
initialization
diff --git a/packages/rtl-console/src/netware/keyboard.pp b/packages/rtl-console/src/netware/keyboard.pp
index 806e23f2d4..e15db9e82e 100644
--- a/packages/rtl-console/src/netware/keyboard.pp
+++ b/packages/rtl-console/src/netware/keyboard.pp
@@ -83,6 +83,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
begin
diff --git a/packages/rtl-console/src/netware/video.pp b/packages/rtl-console/src/netware/video.pp
index 8380d87bcf..4ca10d37fd 100644
--- a/packages/rtl-console/src/netware/video.pp
+++ b/packages/rtl-console/src/netware/video.pp
@@ -23,7 +23,7 @@ interface
implementation
uses
- dos;
+ dos,graphemebreakproperty,eastasianwidth,charset;
{$i video.inc}
{$i nwsys.inc}
@@ -173,17 +173,22 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
- DoneDriver : @SysDoneVideo;
- UpdateScreen : @SysUpdateScreen;
- ClearScreen : Nil;
- SetVideoMode : @SysSetVideoMode;
- GetVideoModeCount : @SysGetVideoModeCount;
- GetVideoModeData : @SysGetVideoModedata;
- SetCursorPos : @SysSetCursorPos;
- GetCursorType : @SysGetCursorType;
- SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : Nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
diff --git a/packages/rtl-console/src/netwlibc/keyboard.pp b/packages/rtl-console/src/netwlibc/keyboard.pp
index 1a546c193e..7149e2006c 100644
--- a/packages/rtl-console/src/netwlibc/keyboard.pp
+++ b/packages/rtl-console/src/netwlibc/keyboard.pp
@@ -125,6 +125,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : nil; //@SysTranslateKeyEvent;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
begin
diff --git a/packages/rtl-console/src/netwlibc/video.pp b/packages/rtl-console/src/netwlibc/video.pp
index 99ad45ff80..600177ccd6 100644
--- a/packages/rtl-console/src/netwlibc/video.pp
+++ b/packages/rtl-console/src/netwlibc/video.pp
@@ -22,7 +22,7 @@ interface
implementation
uses
- Libc;
+ Libc,graphemebreakproperty,eastasianwidth,charset;
{$i video.inc}
@@ -162,17 +162,22 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
- DoneDriver : @SysDoneVideo;
- UpdateScreen : @SysUpdateScreen;
- ClearScreen : Nil;
- SetVideoMode : @SysSetVideoMode;
- GetVideoModeCount : @SysGetVideoModeCount;
- GetVideoModeData : @SysGetVideoModedata;
- SetCursorPos : @SysSetCursorPos;
- GetCursorType : @SysGetCursorType;
- SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : Nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
diff --git a/packages/rtl-console/src/os2commn/keyboard.pp b/packages/rtl-console/src/os2commn/keyboard.pp
index 48fe7014ef..0b778c6488 100644
--- a/packages/rtl-console/src/os2commn/keyboard.pp
+++ b/packages/rtl-console/src/os2commn/keyboard.pp
@@ -120,6 +120,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
diff --git a/packages/rtl-console/src/os2commn/video.pp b/packages/rtl-console/src/os2commn/video.pp
index 188ca9ecb1..70aee4a7d1 100644
--- a/packages/rtl-console/src/os2commn/video.pp
+++ b/packages/rtl-console/src/os2commn/video.pp
@@ -22,7 +22,7 @@ interface
implementation
uses
- DosCalls, VioCalls, Mouse;
+ DosCalls, VioCalls, Mouse, graphemebreakproperty, eastasianwidth, charset;
{$i video.inc}
@@ -427,17 +427,22 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
- DoneDriver : @SysDoneVideo;
- UpdateScreen : @SysUpdateScreen;
- ClearScreen : @SysClearScreen;
- SetVideoMode : @SysSetVideoMode;
- GetVideoModeCount : @SysGetVideoModeCount;
- GetVideoModeData : @SysGetVideoModedata;
- SetCursorPos : @SysSetCursorPos;
- GetCursorType : @SysGetCursorType;
- SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : @SysClearScreen;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : nil;
+ ActivateCodePage : nil;
+ GetSupportedCodePageCount : nil;
+ GetSupportedCodePage : nil;
);
procedure TargetEntry;
diff --git a/packages/rtl-console/src/unix/convert.inc b/packages/rtl-console/src/unix/convert.inc
deleted file mode 100644
index 9307c9e58a..0000000000
--- a/packages/rtl-console/src/unix/convert.inc
+++ /dev/null
@@ -1,73 +0,0 @@
-const convert_linuxlowascii_to_vga:array[#0..#31] of word=(
- $0020,$0001,$0002,$0003,$0004,$0005,$0006,$0007,
- $00db,$0009,$00db,$000b,$006f,$0070,$006e,$002a,
- $0010,$0011,$0012,$0013,$0014,$0015,$0016,$0017,
- $0018,$0019,$001a,$0011,$001c,$001d,$001e,$001f
- );
- convert_lowascii_to_iso01:array[#0..#31] of word=(
- $0020,$006f,$006f,$006f,$006f,$006f,$006f,$0020, { $00..$07 }
- $f861,$006f,$f861,$0064,$006f,$0070,$006e,$002a, { $08..$0f }
- $003e,$003c,$007c,$0021,$00b6,$00a7,$005f,$007c, { $10..$18 }
- $0076,$005e,$003e,$003c,$f86d,$f86e,$005e,$0076 { $18..$1f }
- );
- convert_cp437_to_iso01:array[#128..#255] of word=(
- $00c7,$00fc,$00e9,$00e2,$00e4,$00e0,$00e5,$00e7, { $80..$87 }
- $00ea,$00eb,$00e8,$00ef,$00ee,$00ec,$00c4,$00c5, { $88..$8f }
- $00c9,$00e6,$00c6,$00f4,$00f6,$00f2,$00fb,$00f9, { $90..$97 }
- $00ff,$00d6,$00dc,$00a2,$00a3,$00a5,$0050,$0066, { $98..$9f }
- $00e1,$00ed,$00f3,$00fa,$00f1,$00d1,$00aa,$00ba, { $a0..$a7 }
- $00bf,$f86c,$00ac,$00bd,$00bc,$00a1,$00ab,$00bb, { $a8..$af }
- $f861,$f861,$f861,$f878,$f875,$f875,$f875,$f86b, { $b0..$b7 }
- $f86b,$f875,$f878,$f86b,$f86a,$f86a,$f86a,$f86b, { $b8..$bf }
- $f86d,$f876,$f877,$f874,$f871,$f86e,$f874,$f874, { $c0..$c7 }
- $f86d,$f86c,$f876,$f877,$f874,$f871,$f86e,$f876, { $c8..$cf }
- $f876,$f877,$f877,$f86d,$f86d,$f86c,$f86c,$f86e, { $d0..$d7 }
- $f86e,$f86a,$f86c,$f861,$f861,$f861,$f861,$f861, { $d8..$df }
- $0061,$00df,$f86c,$f87b,$0053,$0073,$00b5,$0054, { $e0..$e7 }
- $00d8,$0054,$004f,$0064,$0049,$00f8,$0065,$006e, { $e8..$ef }
- $003d,$00b1,$f879,$f87a,$f878,$f878,$00f7,$00b1, { $f0..$f7 }
- $00b0,$0078,$00b7,$0056,$006e,$00b2,$002a,$00a0 { $f8..$ff }
- );
- convert_cp850_to_iso01:array[#128..#255] of word=(
- $00c7,$00fc,$00e9,$00e2,$00e4,$00e0,$00e5,$00e7, { $80..$87 }
- $00ea,$00eb,$00e8,$00ef,$00ee,$00ec,$00c4,$00c5, { $88..$8f }
- $00c9,$00e6,$00c6,$00f4,$00f6,$00f2,$00fb,$00f9, { $90..$97 }
- $00ff,$00d6,$00dc,$00a2,$00a3,$00a5,$0050,$0066, { $98..$9f }
- $00e1,$00ed,$00f3,$00fa,$00f1,$00d1,$00aa,$00ba, { $a0..$a7 }
- $00bf,$f86c,$00ac,$00bd,$00bc,$00a1,$00ab,$00bb, { $a8..$af }
- $f861,$f861,$f861,$f878,$f875,$00c1,$00c2,$00c0, { $b0..$b7 }
- $00a9,$f875,$f878,$f86b,$f86a,$00a2,$00a5,$f86b, { $b8..$bf }
- $f86d,$f876,$f877,$f874,$f871,$f86e,$00e3,$00c3, { $c0..$c7 }
- $f86d,$f86c,$f876,$f877,$f874,$f871,$f86e,$00a4, { $c8..$cf }
- $00f0,$00d0,$00ca,$00cb,$00c8,$0069,$00cd,$00ce, { $d0..$d7 }
- $00cf,$f86a,$f86c,$f861,$f861,$00a6,$00cc,$f861, { $d8..$df }
- $00d3,$00df,$00d4,$00d2,$00f5,$00d5,$00b5,$00fe, { $e0..$e7 }
- $00de,$00da,$00db,$00d9,$00fd,$00dd,$00af,$00b4, { $e8..$ef }
- $00ad,$00b1,$f879,$00be,$00b6,$00a7,$00f7,$00b8, { $f0..$f7 }
- $00b0,$00a8,$00b7,$00b9,$00b3,$00b2,$002a,$00a0 { $f8..$ff }
- );
- convert_lowascii_to_UTF8:array[#0..#31] of WideChar=(
- #8199,#9786,#9787,#9829,#9830,#9827,#9824,#8226,
- #9688,#9675,#9689,#9794,#9792,#9834,#9835,#9788,
- #9658,#9668,#8597,#8252,#0182,#0167,#9644,#8616,
- #8593,#8595,#8594,#8592,#8735,#8596,#9650,#9660
- );
- convert_cp437_to_UTF8:array[#127..#255] of WideChar=(
- #8962, { $7f }
- #0199,#0252,#0233,#0226,#0228,#0224,#0229,#0231, { $80..$87 }
- #0234,#0235,#0232,#0239,#0238,#0236,#0196,#0197, { $88..$8f }
- #0201,#0230,#0198,#0244,#0246,#0242,#0251,#0249, { $90..$97 }
- #0255,#0214,#0220,#0162,#0163,#0165,#8359,#0402, { $98..$9f }
- #0225,#0237,#0243,#0250,#0241,#0209,#0170,#0186, { $a0..$a7 }
- #0191,#8976,#0172,#0189,#0188,#0161,#0171,#0187, { $a8..$af }
- #9617,#9618,#9619,#9474,#9508,#9569,#9570,#9558, { $b0..$b7 }
- #9557,#9571,#9553,#9559,#9565,#9564,#9563,#9488, { $b8..$bf }
- #9492,#9524,#9516,#9500,#9472,#9532,#9566,#9567, { $c0..$c7 }
- #9562,#9556,#9577,#9574,#9568,#9552,#9580,#9575, { $c8..$cf }
- #9576,#9572,#9573,#9561,#9560,#9554,#9555,#9579, { $d0..$d7 }
- #9578,#9496,#9484,#9608,#9604,#9612,#9616,#9600, { $d8..$df }
- #0945,#0223,#0915,#0960,#0931,#0963,#0181,#0964, { $e0..$e7 }
- #0934,#0920,#0937,#0948,#8734,#0966,#0949,#8745, { $e8..$ef }
- #8801,#0177,#8805,#8804,#8992,#8993,#0247,#8776, { $f0..$f7 }
- #0176,#8729,#0183,#8730,#8319,#0178,#9632,#0160 { $f8..$ff }
- );
diff --git a/packages/rtl-console/src/unix/keyboard.pp b/packages/rtl-console/src/unix/keyboard.pp
index af39f4c2d2..c2d235b41f 100644
--- a/packages/rtl-console/src/unix/keyboard.pp
+++ b/packages/rtl-console/src/unix/keyboard.pp
@@ -38,6 +38,7 @@ type
char : byte;
ScanValue : byte;
CharValue : byte;
+ ShiftValue : TEnhancedShiftState;
SpecialHandler : Tprocedure;
end;
@@ -56,13 +57,14 @@ function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement;
{*****************************************************************************}
uses
- Mouse, Strings,
+ Mouse, Strings,unixkvmbase,
termio,baseUnix
{$ifdef linux},linuxvcs{$endif};
{$i keyboard.inc}
var OldIO,StartTio : TermIos;
+ Utf8KeyboardInputEnabled: Boolean;
{$ifdef linux}
is_console:boolean;
vt_switched_away:boolean;
@@ -74,10 +76,12 @@ var OldIO,StartTio : TermIos;
const
KeyBufferSize = 20;
var
- KeyBuffer : Array[0..KeyBufferSize-1] of Char;
+ KeyBuffer : Array[0..KeyBufferSize-1] of TEnhancedKeyEvent;
KeyPut,
KeySend : longint;
+ PendingEnhancedKeyEvent: TEnhancedKeyEvent;
+
{ Buffered Input routines }
const
InSize=256;
@@ -177,9 +181,9 @@ type
end;
const
- kbdchange:array[0..23] of chgentry=(
+ kbdchange:array[0..35] of chgentry=(
{This prevents the alt+function keys from switching consoles.
- We code the F1..F12 sequences into ALT+F1..ALT+12, we check
+ We code the F1..F12 sequences into ALT+F1..ALT+F12, we check
the shiftstates separetely anyway.}
(tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
(tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
@@ -191,10 +195,10 @@ const
(tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
(tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
(tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0),
- (tab:8; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0),
- (tab:8; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0),
+ (tab:8; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0),
+ (tab:8; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0),
{This prevents the shift+function keys outputting strings, so
- the kernel will the codes for the non-shifted function
+ the kernel will send the codes for the non-shifted function
keys. This is desired because normally shift+f1/f2 will output the
same string as f11/12. We will get the shift state separately.}
(tab:1; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
@@ -207,8 +211,24 @@ const
(tab:1; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
(tab:1; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
(tab:1; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0),
- (tab:1; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0),
- (tab:1; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0)
+ (tab:1; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0),
+ (tab:1; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0),
+ {This maps ctrl+function keys outputting strings to the regular
+ F1..F12 keys also, because they no longer produce an ASCII
+ output at all in most modern linux keymaps. We obtain the
+ shift state separately.}
+ (tab:4; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
+ (tab:4; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
+ (tab:4; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
+ (tab:4; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
+ (tab:4; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
+ (tab:4; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
+ (tab:4; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
+ (tab:4; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
+ (tab:4; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
+ (tab:4; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0),
+ (tab:4; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0),
+ (tab:4; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0)
);
KDGKBENT=$4B46;
@@ -410,7 +430,17 @@ begin
InTail:=0;
end;
-procedure PushKey(Ch:char);
+{ returns an already read character back into InBuf }
+procedure PutBackIntoInBuf(ch: Char);
+begin
+ If InTail=0 then
+ InTail:=InSize-1
+ else
+ Dec(InTail);
+ InBuf[InTail]:=ch;
+end;
+
+procedure PushKey(const Ch:TEnhancedKeyEvent);
var
Tmp : Longint;
begin
@@ -425,7 +455,7 @@ begin
End;
-function PopKey:char;
+function PopKey:TEnhancedKeyEvent;
begin
If KeyPut<>KeySend Then
begin
@@ -435,30 +465,7 @@ begin
KeySend:=0;
End
Else
- PopKey:=#0;
-End;
-
-
-procedure PushExt(b:byte);
-begin
- PushKey(#0);
- PushKey(chr(b));
-end;
-
-
-const
- AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-=';
- AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+
- #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
-function FAltKey(ch:char):byte;
-var
- Idx : longint;
-begin
- Idx:=Pos(ch,AltKeyStr);
- if Idx>0 then
- FAltKey:=byte(AltCodeStr[Idx])
- else
- FAltKey:=0;
+ PopKey:=NilEnhancedKeyEvent;
End;
@@ -730,7 +737,7 @@ begin
Pa^.Child:=newPtree;
end;
-function DoAddSequence(const St : String; AChar,AScan :byte) : PTreeElement;
+function DoAddSequence(const St : String; AChar,AScan :byte; const AShift: TEnhancedShiftState) : PTreeElement;
var
CurPTree,NPT : PTreeElement;
c : byte;
@@ -794,6 +801,7 @@ begin
{$endif DEBUG}
ScanValue:=AScan;
CharValue:=AChar;
+ ShiftValue:=AShift;
end;
end
else with CurPTree^ do
@@ -801,6 +809,7 @@ begin
CanBeTerminal:=True;
ScanValue:=AScan;
CharValue:=AChar;
+ ShiftValue:=AShift;
end;
DoAddSequence:=CurPTree;
end;
@@ -808,7 +817,7 @@ end;
procedure AddSequence(const St : String; AChar,AScan :byte);inline;
begin
- DoAddSequence(St,AChar,AScan);
+ DoAddSequence(St,AChar,AScan,[]);
end;
{ Returns the Child that as c as char if it exists }
@@ -829,7 +838,7 @@ function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement;
var
NPT : PTreeElement;
begin
- NPT:=DoAddSequence(St,0,0);
+ NPT:=DoAddSequence(St,0,0,[]);
NPT^.SpecialHandler:=Proc;
AddSpecialSequence:=NPT;
end;
@@ -871,331 +880,355 @@ begin
end;
type key_sequence=packed record
- char,scan:byte;
+ char:0..127;
+ scan:byte;
+ shift:TEnhancedShiftState;
st:string[7];
end;
-const key_sequences:array[0..297] of key_sequence=(
- (char:0;scan:kbAltA;st:#27'A'),
- (char:0;scan:kbAltA;st:#27'a'),
- (char:0;scan:kbAltB;st:#27'B'),
- (char:0;scan:kbAltB;st:#27'b'),
- (char:0;scan:kbAltC;st:#27'C'),
- (char:0;scan:kbAltC;st:#27'c'),
- (char:0;scan:kbAltD;st:#27'D'),
- (char:0;scan:kbAltD;st:#27'd'),
- (char:0;scan:kbAltE;st:#27'E'),
- (char:0;scan:kbAltE;st:#27'e'),
- (char:0;scan:kbAltF;st:#27'F'),
- (char:0;scan:kbAltF;st:#27'f'),
- (char:0;scan:kbAltG;st:#27'G'),
- (char:0;scan:kbAltG;st:#27'g'),
- (char:0;scan:kbAltH;st:#27'H'),
- (char:0;scan:kbAltH;st:#27'h'),
- (char:0;scan:kbAltI;st:#27'I'),
- (char:0;scan:kbAltI;st:#27'i'),
- (char:0;scan:kbAltJ;st:#27'J'),
- (char:0;scan:kbAltJ;st:#27'j'),
- (char:0;scan:kbAltK;st:#27'K'),
- (char:0;scan:kbAltK;st:#27'k'),
- (char:0;scan:kbAltL;st:#27'L'),
- (char:0;scan:kbAltL;st:#27'l'),
- (char:0;scan:kbAltM;st:#27'M'),
- (char:0;scan:kbAltM;st:#27'm'),
- (char:0;scan:kbAltN;st:#27'N'),
- (char:0;scan:kbAltN;st:#27'n'),
- (char:0;scan:kbAltO;st:#27'O'),
- (char:0;scan:kbAltO;st:#27'o'),
- (char:0;scan:kbAltP;st:#27'P'),
- (char:0;scan:kbAltP;st:#27'p'),
- (char:0;scan:kbAltQ;st:#27'Q'),
- (char:0;scan:kbAltQ;st:#27'q'),
- (char:0;scan:kbAltR;st:#27'R'),
- (char:0;scan:kbAltR;st:#27'r'),
- (char:0;scan:kbAltS;st:#27'S'),
- (char:0;scan:kbAltS;st:#27's'),
- (char:0;scan:kbAltT;st:#27'T'),
- (char:0;scan:kbAltT;st:#27't'),
- (char:0;scan:kbAltU;st:#27'U'),
- (char:0;scan:kbAltU;st:#27'u'),
- (char:0;scan:kbAltV;st:#27'V'),
- (char:0;scan:kbAltV;st:#27'v'),
- (char:0;scan:kbAltW;st:#27'W'),
- (char:0;scan:kbAltW;st:#27'w'),
- (char:0;scan:kbAltX;st:#27'X'),
- (char:0;scan:kbAltX;st:#27'x'),
- (char:0;scan:kbAltY;st:#27'Y'),
- (char:0;scan:kbAltY;st:#27'y'),
- (char:0;scan:kbAltZ;st:#27'Z'),
- (char:0;scan:kbAltZ;st:#27'z'),
- (char:0;scan:kbAltMinus;st:#27'-'),
- (char:0;scan:kbAltEqual;st:#27'='),
- (char:0;scan:kbAlt0;st:#27'0'),
- (char:0;scan:kbAlt1;st:#27'1'),
- (char:0;scan:kbAlt2;st:#27'2'),
- (char:0;scan:kbAlt3;st:#27'3'),
- (char:0;scan:kbAlt4;st:#27'4'),
- (char:0;scan:kbAlt5;st:#27'5'),
- (char:0;scan:kbAlt6;st:#27'6'),
- (char:0;scan:kbAlt7;st:#27'7'),
- (char:0;scan:kbAlt8;st:#27'8'),
- (char:0;scan:kbAlt9;st:#27'9'),
-
- (char:0;scan:kbF1;st:#27'[[A'), {linux,konsole,xterm}
- (char:0;scan:kbF2;st:#27'[[B'), {linux,konsole,xterm}
- (char:0;scan:kbF3;st:#27'[[C'), {linux,konsole,xterm}
- (char:0;scan:kbF4;st:#27'[[D'), {linux,konsole,xterm}
- (char:0;scan:kbF5;st:#27'[[E'), {linux,konsole}
- (char:0;scan:kbF1;st:#27'[11~'), {Eterm,rxvt}
- (char:0;scan:kbF2;st:#27'[12~'), {Eterm,rxvt}
- (char:0;scan:kbF3;st:#27'[13~'), {Eterm,rxvt}
- (char:0;scan:kbF4;st:#27'[14~'), {Eterm,rxvt}
- (char:0;scan:kbF5;st:#27'[15~'), {xterm,Eterm,gnome,rxvt}
- (char:0;scan:kbF6;st:#27'[17~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF7;st:#27'[18~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF8;st:#27'[19~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF9;st:#27'[20~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF10;st:#27'[21~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF11;st:#27'[23~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF12;st:#27'[24~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
- (char:0;scan:kbF1;st:#27'[M'), {FreeBSD}
- (char:0;scan:kbF2;st:#27'[N'), {FreeBSD}
- (char:0;scan:kbF3;st:#27'[O'), {FreeBSD}
- (char:0;scan:kbF4;st:#27'[P'), {FreeBSD}
- (char:0;scan:kbF5;st:#27'[Q'), {FreeBSD}
- (char:0;scan:kbF6;st:#27'[R'), {FreeBSD}
- (char:0;scan:kbF7;st:#27'[S'), {FreeBSD}
- (char:0;scan:kbF8;st:#27'[T'), {FreeBSD}
- (char:0;scan:kbF9;st:#27'[U'), {FreeBSD}
- (char:0;scan:kbF10;st:#27'[V'), {FreeBSD}
- (char:0;scan:kbF11;st:#27'[W'), {FreeBSD}
- (char:0;scan:kbF12;st:#27'[X'), {FreeBSD}
- (char:0;scan:kbF1;st:#27'OP'), {vt100,gnome,konsole}
- (char:0;scan:kbF2;st:#27'OQ'), {vt100,gnome,konsole}
- (char:0;scan:kbF3;st:#27'OR'), {vt100,gnome,konsole}
- (char:0;scan:kbF4;st:#27'OS'), {vt100,gnome,konsole}
- (char:0;scan:kbF5;st:#27'Ot'), {vt100}
- (char:0;scan:kbF6;st:#27'Ou'), {vt100}
- (char:0;scan:kbF7;st:#27'Ov'), {vt100}
- (char:0;scan:kbF8;st:#27'Ol'), {vt100}
- (char:0;scan:kbF9;st:#27'Ow'), {vt100}
- (char:0;scan:kbF10;st:#27'Ox'), {vt100}
- (char:0;scan:kbF11;st:#27'Oy'), {vt100}
- (char:0;scan:kbF12;st:#27'Oz'), {vt100}
- (char:0;scan:kbEsc;st:#27'[0~'), {if linux keyboard patched, escape
- returns this}
- (char:0;scan:kbIns;st:#27'[2~'), {linux,Eterm,rxvt}
- (char:0;scan:kbDel;st:#27'[3~'), {linux,Eterm,rxvt}
- (char:0;scan:kbHome;st:#27'[1~'), {linux}
- (char:0;scan:kbHome;st:#27'[7~'), {Eterm,rxvt}
- (char:0;scan:kbHome;st:#27'[H'), {FreeBSD}
- (char:0;scan:kbHome;st:#27'OH'), {some xterm configurations}
- (char:0;scan:kbEnd;st:#27'[4~'), {linux,Eterm}
- (char:0;scan:kbEnd;st:#27'[8~'), {rxvt}
- (char:0;scan:kbEnd;st:#27'[F'), {FreeBSD}
- (char:0;scan:kbEnd;st:#27'OF'), {some xterm configurations}
- (char:0;scan:kbPgUp;st:#27'[5~'), {linux,Eterm,rxvt}
- (char:0;scan:kbPgUp;st:#27'[I'), {FreeBSD}
- (char:0;scan:kbPgDn;st:#27'[6~'), {linux,Eterm,rxvt}
- (char:0;scan:kbPgDn;st:#27'[G'), {FreeBSD}
- (char:0;scan:kbUp;st:#27'[A'), {linux,FreeBSD,rxvt}
- (char:0;scan:kbDown;st:#27'[B'), {linux,FreeBSD,rxvt}
- (char:0;scan:kbRight;st:#27'[C'), {linux,FreeBSD,rxvt}
- (char:0;scan:kbLeft;st:#27'[D'), {linux,FreeBSD,rxvt}
- (char:0;scan:kbUp;st:#27'OA'), {xterm}
- (char:0;scan:kbDown;st:#27'OB'), {xterm}
- (char:0;scan:kbRight;st:#27'OC'), {xterm}
- (char:0;scan:kbLeft;st:#27'OD'), {xterm}
+const key_sequences:array[0..298] of key_sequence=(
+ (char:0;scan:kbAltA;shift:[essAlt];st:#27'A'),
+ (char:0;scan:kbAltA;shift:[essAlt];st:#27'a'),
+ (char:0;scan:kbAltB;shift:[essAlt];st:#27'B'),
+ (char:0;scan:kbAltB;shift:[essAlt];st:#27'b'),
+ (char:0;scan:kbAltC;shift:[essAlt];st:#27'C'),
+ (char:0;scan:kbAltC;shift:[essAlt];st:#27'c'),
+ (char:0;scan:kbAltD;shift:[essAlt];st:#27'D'),
+ (char:0;scan:kbAltD;shift:[essAlt];st:#27'd'),
+ (char:0;scan:kbAltE;shift:[essAlt];st:#27'E'),
+ (char:0;scan:kbAltE;shift:[essAlt];st:#27'e'),
+ (char:0;scan:kbAltF;shift:[essAlt];st:#27'F'),
+ (char:0;scan:kbAltF;shift:[essAlt];st:#27'f'),
+ (char:0;scan:kbAltG;shift:[essAlt];st:#27'G'),
+ (char:0;scan:kbAltG;shift:[essAlt];st:#27'g'),
+ (char:0;scan:kbAltH;shift:[essAlt];st:#27'H'),
+ (char:0;scan:kbAltH;shift:[essAlt];st:#27'h'),
+ (char:0;scan:kbAltI;shift:[essAlt];st:#27'I'),
+ (char:0;scan:kbAltI;shift:[essAlt];st:#27'i'),
+ (char:0;scan:kbAltJ;shift:[essAlt];st:#27'J'),
+ (char:0;scan:kbAltJ;shift:[essAlt];st:#27'j'),
+ (char:0;scan:kbAltK;shift:[essAlt];st:#27'K'),
+ (char:0;scan:kbAltK;shift:[essAlt];st:#27'k'),
+ (char:0;scan:kbAltL;shift:[essAlt];st:#27'L'),
+ (char:0;scan:kbAltL;shift:[essAlt];st:#27'l'),
+ (char:0;scan:kbAltM;shift:[essAlt];st:#27'M'),
+ (char:0;scan:kbAltM;shift:[essAlt];st:#27'm'),
+ (char:0;scan:kbAltN;shift:[essAlt];st:#27'N'),
+ (char:0;scan:kbAltN;shift:[essAlt];st:#27'n'),
+ (char:0;scan:kbAltO;shift:[essAlt];st:#27'O'),
+ (char:0;scan:kbAltO;shift:[essAlt];st:#27'o'),
+ (char:0;scan:kbAltP;shift:[essAlt];st:#27'P'),
+ (char:0;scan:kbAltP;shift:[essAlt];st:#27'p'),
+ (char:0;scan:kbAltQ;shift:[essAlt];st:#27'Q'),
+ (char:0;scan:kbAltQ;shift:[essAlt];st:#27'q'),
+ (char:0;scan:kbAltR;shift:[essAlt];st:#27'R'),
+ (char:0;scan:kbAltR;shift:[essAlt];st:#27'r'),
+ (char:0;scan:kbAltS;shift:[essAlt];st:#27'S'),
+ (char:0;scan:kbAltS;shift:[essAlt];st:#27's'),
+ (char:0;scan:kbAltT;shift:[essAlt];st:#27'T'),
+ (char:0;scan:kbAltT;shift:[essAlt];st:#27't'),
+ (char:0;scan:kbAltU;shift:[essAlt];st:#27'U'),
+ (char:0;scan:kbAltU;shift:[essAlt];st:#27'u'),
+ (char:0;scan:kbAltV;shift:[essAlt];st:#27'V'),
+ (char:0;scan:kbAltV;shift:[essAlt];st:#27'v'),
+ (char:0;scan:kbAltW;shift:[essAlt];st:#27'W'),
+ (char:0;scan:kbAltW;shift:[essAlt];st:#27'w'),
+ (char:0;scan:kbAltX;shift:[essAlt];st:#27'X'),
+ (char:0;scan:kbAltX;shift:[essAlt];st:#27'x'),
+ (char:0;scan:kbAltY;shift:[essAlt];st:#27'Y'),
+ (char:0;scan:kbAltY;shift:[essAlt];st:#27'y'),
+ (char:0;scan:kbAltZ;shift:[essAlt];st:#27'Z'),
+ (char:0;scan:kbAltZ;shift:[essAlt];st:#27'z'),
+ (char:0;scan:kbAltMinus;shift:[essAlt];st:#27'-'),
+ (char:0;scan:kbAltEqual;shift:[essAlt];st:#27'='),
+ (char:0;scan:kbAlt0;shift:[essAlt];st:#27'0'),
+ (char:0;scan:kbAlt1;shift:[essAlt];st:#27'1'),
+ (char:0;scan:kbAlt2;shift:[essAlt];st:#27'2'),
+ (char:0;scan:kbAlt3;shift:[essAlt];st:#27'3'),
+ (char:0;scan:kbAlt4;shift:[essAlt];st:#27'4'),
+ (char:0;scan:kbAlt5;shift:[essAlt];st:#27'5'),
+ (char:0;scan:kbAlt6;shift:[essAlt];st:#27'6'),
+ (char:0;scan:kbAlt7;shift:[essAlt];st:#27'7'),
+ (char:0;scan:kbAlt8;shift:[essAlt];st:#27'8'),
+ (char:0;scan:kbAlt9;shift:[essAlt];st:#27'9'),
+
+ (char:0;scan:kbF1;shift:[];st:#27'[[A'), {linux,konsole,xterm}
+ (char:0;scan:kbF2;shift:[];st:#27'[[B'), {linux,konsole,xterm}
+ (char:0;scan:kbF3;shift:[];st:#27'[[C'), {linux,konsole,xterm}
+ (char:0;scan:kbF4;shift:[];st:#27'[[D'), {linux,konsole,xterm}
+ (char:0;scan:kbF5;shift:[];st:#27'[[E'), {linux,konsole}
+ (char:0;scan:kbF1;shift:[];st:#27'[11~'), {Eterm,rxvt}
+ (char:0;scan:kbF2;shift:[];st:#27'[12~'), {Eterm,rxvt}
+ (char:0;scan:kbF3;shift:[];st:#27'[13~'), {Eterm,rxvt}
+ (char:0;scan:kbF4;shift:[];st:#27'[14~'), {Eterm,rxvt}
+ (char:0;scan:kbF5;shift:[];st:#27'[15~'), {xterm,Eterm,gnome,rxvt}
+ (char:0;scan:kbF6;shift:[];st:#27'[17~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF7;shift:[];st:#27'[18~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF8;shift:[];st:#27'[19~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF9;shift:[];st:#27'[20~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF10;shift:[];st:#27'[21~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF11;shift:[];st:#27'[23~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF12;shift:[];st:#27'[24~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
+ (char:0;scan:kbF1;shift:[];st:#27'[M'), {FreeBSD}
+ (char:0;scan:kbF2;shift:[];st:#27'[N'), {FreeBSD}
+ (char:0;scan:kbF3;shift:[];st:#27'[O'), {FreeBSD}
+ (char:0;scan:kbF4;shift:[];st:#27'[P'), {FreeBSD}
+ (char:0;scan:kbF5;shift:[];st:#27'[Q'), {FreeBSD}
+ (char:0;scan:kbF6;shift:[];st:#27'[R'), {FreeBSD}
+ (char:0;scan:kbF7;shift:[];st:#27'[S'), {FreeBSD}
+ (char:0;scan:kbF8;shift:[];st:#27'[T'), {FreeBSD}
+ (char:0;scan:kbF9;shift:[];st:#27'[U'), {FreeBSD}
+ (char:0;scan:kbF10;shift:[];st:#27'[V'), {FreeBSD}
+ (char:0;scan:kbF11;shift:[];st:#27'[W'), {FreeBSD}
+ (char:0;scan:kbF12;shift:[];st:#27'[X'), {FreeBSD}
+ (char:0;scan:kbF1;shift:[];st:#27'OP'), {vt100,gnome,konsole}
+ (char:0;scan:kbF2;shift:[];st:#27'OQ'), {vt100,gnome,konsole}
+ (char:0;scan:kbF3;shift:[];st:#27'OR'), {vt100,gnome,konsole}
+ (char:0;scan:kbF4;shift:[];st:#27'OS'), {vt100,gnome,konsole}
+ (char:0;scan:kbF5;shift:[];st:#27'Ot'), {vt100}
+ (char:0;scan:kbF6;shift:[];st:#27'Ou'), {vt100}
+ (char:0;scan:kbF7;shift:[];st:#27'Ov'), {vt100}
+ (char:0;scan:kbF8;shift:[];st:#27'Ol'), {vt100}
+ (char:0;scan:kbF9;shift:[];st:#27'Ow'), {vt100}
+ (char:0;scan:kbF10;shift:[];st:#27'Ox'), {vt100}
+ (char:0;scan:kbF11;shift:[];st:#27'Oy'), {vt100}
+ (char:0;scan:kbF12;shift:[];st:#27'Oz'), {vt100}
+ (char:27;scan:kbEsc;shift:[];st:#27'[0~'), {if linux keyboard patched, escape
+ returns this}
+ (char:0;scan:kbIns;shift:[];st:#27'[2~'), {linux,Eterm,rxvt}
+ (char:0;scan:kbDel;shift:[];st:#27'[3~'), {linux,Eterm,rxvt}
+ (char:0;scan:kbHome;shift:[];st:#27'[1~'), {linux}
+ (char:0;scan:kbHome;shift:[];st:#27'[7~'), {Eterm,rxvt}
+ (char:0;scan:kbHome;shift:[];st:#27'[H'), {FreeBSD}
+ (char:0;scan:kbHome;shift:[];st:#27'OH'), {some xterm configurations}
+ (char:0;scan:kbEnd;shift:[];st:#27'[4~'), {linux,Eterm}
+ (char:0;scan:kbEnd;shift:[];st:#27'[8~'), {rxvt}
+ (char:0;scan:kbEnd;shift:[];st:#27'[F'), {FreeBSD}
+ (char:0;scan:kbEnd;shift:[];st:#27'OF'), {some xterm configurations}
+ (char:0;scan:kbPgUp;shift:[];st:#27'[5~'), {linux,Eterm,rxvt}
+ (char:0;scan:kbPgUp;shift:[];st:#27'[I'), {FreeBSD}
+ (char:0;scan:kbPgDn;shift:[];st:#27'[6~'), {linux,Eterm,rxvt}
+{$ifdef FREEBSD}
+ (char:0;scan:kbPgDn;shift:[];st:#27'[G'), {FreeBSD, conflicts with linux.
+ Note: new FreeBSD versions seem
+ to use xterm-like sequences, so
+ this one is not needed for them.
+ Todo: resolve conflicting sequences
+ according to the TERM variable,
+ instead of using IFDEFs, this way
+ it'll work over SSH across platforms
+ too.}
+{$else FREEBSD}
+ (char:0;scan:kbCenter;shift:[];st:#27'[G'), {linux}
+{$endif FREEBSD}
+ (char:0;scan:kbCenter;shift:[];st:#27'[E'), {xterm,gnome3}
+ (char:0;scan:kbUp;shift:[];st:#27'[A'), {linux,FreeBSD,rxvt}
+ (char:0;scan:kbDown;shift:[];st:#27'[B'), {linux,FreeBSD,rxvt}
+ (char:0;scan:kbRight;shift:[];st:#27'[C'), {linux,FreeBSD,rxvt}
+ (char:0;scan:kbLeft;shift:[];st:#27'[D'), {linux,FreeBSD,rxvt}
+ (char:0;scan:kbUp;shift:[];st:#27'OA'), {xterm}
+ (char:0;scan:kbDown;shift:[];st:#27'OB'), {xterm}
+ (char:0;scan:kbRight;shift:[];st:#27'OC'), {xterm}
+ (char:0;scan:kbLeft;shift:[];st:#27'OD'), {xterm}
(* Already recognized above as F11!
- (char:0;scan:kbShiftF1;st:#27'[23~'), {rxvt}
- (char:0;scan:kbShiftF2;st:#27'[24~'), {rxvt}
+ (char:0;scan:kbShiftF1;shift:[essShift];st:#27'[23~'), {rxvt}
+ (char:0;scan:kbShiftF2;shift:[essShift];st:#27'[24~'), {rxvt}
*)
- (char:0;scan:kbShiftF3;st:#27'[25~'), {linux,rxvt}
- (char:0;scan:kbShiftF4;st:#27'[26~'), {linux,rxvt}
- (char:0;scan:kbShiftF5;st:#27'[28~'), {linux,rxvt}
- (char:0;scan:kbShiftF6;st:#27'[29~'), {linux,rxvt}
- (char:0;scan:kbShiftF7;st:#27'[31~'), {linux,rxvt}
- (char:0;scan:kbShiftF8;st:#27'[32~'), {linux,rxvt}
- (char:0;scan:kbShiftF9;st:#27'[33~'), {linux,rxvt}
- (char:0;scan:kbShiftF10;st:#27'[34~'), {linux,rxvt}
- (char:0;scan:kbShiftF11;st:#27'[23$'), {rxvt}
- (char:0;scan:kbShiftF12;st:#27'[24$'), {rxvt}
- (char:0;scan:kbShiftF1;st:#27'[11;2~'), {konsole in vt420pc mode}
- (char:0;scan:kbShiftF2;st:#27'[12;2~'), {konsole in vt420pc mode}
- (char:0;scan:kbShiftF3;st:#27'[13;2~'), {konsole in vt420pc mode}
- (char:0;scan:kbShiftF4;st:#27'[14;2~'), {konsole in vt420pc mode}
- (char:0;scan:kbShiftF5;st:#27'[15;2~'), {xterm}
- (char:0;scan:kbShiftF6;st:#27'[17;2~'), {xterm}
- (char:0;scan:kbShiftF7;st:#27'[18;2~'), {xterm}
- (char:0;scan:kbShiftF8;st:#27'[19;2~'), {xterm}
- (char:0;scan:kbShiftF9;st:#27'[20;2~'), {xterm}
- (char:0;scan:kbShiftF10;st:#27'[21;2~'), {xterm}
- (char:0;scan:kbShiftF11;st:#27'[23;2~'), {xterm}
- (char:0;scan:kbShiftF12;st:#27'[24;2~'), {xterm}
- (char:0;scan:kbShiftF1;st:#27'O2P'), {konsole,xterm}
- (char:0;scan:kbShiftF2;st:#27'O2Q'), {konsole,xterm}
- (char:0;scan:kbShiftF3;st:#27'O2R'), {konsole,xterm}
- (char:0;scan:kbShiftF4;st:#27'O2S'), {konsole,xterm}
- (char:0;scan:kbShiftF1;st:#27'[1;2P'), {xterm,gnome3}
- (char:0;scan:kbShiftF2;st:#27'[1;2Q'), {xterm,gnome3}
- (char:0;scan:kbShiftF3;st:#27'[1;2R'), {xterm,gnome3}
- (char:0;scan:kbShiftF4;st:#27'[1;2S'), {xterm,gnome3}
- (char:0;scan:kbCtrlF1;st:#27'O5P'), {konsole,xterm}
- (char:0;scan:kbCtrlF2;st:#27'O5Q'), {konsole,xterm}
- (char:0;scan:kbCtrlF3;st:#27'O5R'), {konsole,xterm}
- (char:0;scan:kbCtrlF4;st:#27'O5S'), {konsole,xterm}
- (char:0;scan:kbCtrlF1;st:#27'[1;5P'), {xterm,gnome3}
- (char:0;scan:kbCtrlF2;st:#27'[1;5Q'), {xterm,gnome3}
- (char:0;scan:kbCtrlF3;st:#27'[1;5R'), {xterm,gnome3}
- (char:0;scan:kbCtrlF4;st:#27'[1;5S'), {xterm,gnome3}
- (char:0;scan:kbCtrlF1;st:#27'[11;5~'), {none, but expected}
- (char:0;scan:kbCtrlF2;st:#27'[12;5~'), {none, but expected}
- (char:0;scan:kbCtrlF3;st:#27'[13;5~'), {none, but expected}
- (char:0;scan:kbCtrlF4;st:#27'[14;5~'), {none, but expected}
- (char:0;scan:kbCtrlF5;st:#27'[15;5~'), {xterm}
- (char:0;scan:kbCtrlF6;st:#27'[17;5~'), {xterm}
- (char:0;scan:kbCtrlF7;st:#27'[18;5~'), {xterm}
- (char:0;scan:kbCtrlF8;st:#27'[19;5~'), {xterm}
- (char:0;scan:kbCtrlF9;st:#27'[20;5~'), {xterm}
- (char:0;scan:kbCtrlF10;st:#27'[21;5~'), {xterm}
- (char:0;scan:kbCtrlF11;st:#27'[23;5~'), {xterm}
- (char:0;scan:kbCtrlF12;st:#27'[24;5~'), {xterm}
- (char:0;scan:kbCtrlF1;st:#27'[11^'), {rxvt}
- (char:0;scan:kbCtrlF2;st:#27'[12^'), {rxvt}
- (char:0;scan:kbCtrlF3;st:#27'[13^'), {rxvt}
- (char:0;scan:kbCtrlF4;st:#27'[14^'), {rxvt}
- (char:0;scan:kbCtrlF5;st:#27'[15^'), {rxvt}
- (char:0;scan:kbCtrlF6;st:#27'[17^'), {rxvt}
- (char:0;scan:kbCtrlF7;st:#27'[18^'), {rxvt}
- (char:0;scan:kbCtrlF8;st:#27'[19^'), {rxvt}
- (char:0;scan:kbCtrlF9;st:#27'[20^'), {rxvt}
- (char:0;scan:kbCtrlF10;st:#27'[21^'), {rxvt}
- (char:0;scan:kbCtrlF11;st:#27'[23^'), {rxvt}
- (char:0;scan:kbCtrlF12;st:#27'[24^'), {rxvt}
- (char:0;scan:kbShiftIns;st:#27'[2;2~'), {should be the code, but shift+ins
- is paste X clipboard in many
- terminal emulators :(}
- (char:0;scan:kbShiftDel;st:#27'[3;2~'), {xterm,konsole}
- (char:0;scan:kbCtrlIns;st:#27'[2;5~'), {xterm}
- (char:0;scan:kbCtrlDel;st:#27'[3;5~'), {xterm}
- (char:0;scan:kbShiftDel;st:#27'[3$'), {rxvt}
- (char:0;scan:kbCtrlIns;st:#27'[2^'), {rxvt}
- (char:0;scan:kbCtrlDel;st:#27'[3^'), {rxvt}
- (char:0;scan:kbAltF1;st:#27#27'[[A'),
- (char:0;scan:kbAltF2;st:#27#27'[[B'),
- (char:0;scan:kbAltF3;st:#27#27'[[C'),
- (char:0;scan:kbAltF4;st:#27#27'[[D'),
- (char:0;scan:kbAltF5;st:#27#27'[[E'),
- (char:0;scan:kbAltF1;st:#27#27'[11~'), {rxvt}
- (char:0;scan:kbAltF2;st:#27#27'[12~'), {rxvt}
- (char:0;scan:kbAltF3;st:#27#27'[13~'), {rxvt}
- (char:0;scan:kbAltF4;st:#27#27'[14~'), {rxvt}
- (char:0;scan:kbAltF5;st:#27#27'[15~'), {rxvt}
- (char:0;scan:kbAltF6;st:#27#27'[17~'), {rxvt}
- (char:0;scan:kbAltF7;st:#27#27'[18~'), {rxvt}
- (char:0;scan:kbAltF8;st:#27#27'[19~'), {rxvt}
- (char:0;scan:kbAltF9;st:#27#27'[20~'), {rxvt}
- (char:0;scan:kbAltF10;st:#27#27'[21~'), {rxvt}
- (char:0;scan:kbAltF11;st:#27#27'[23~'), {rxvt}
- (char:0;scan:kbAltF12;st:#27#27'[24~'), {rxvt}
- (char:0;scan:kbAltF1;st:#27#27'OP'), {xterm}
- (char:0;scan:kbAltF2;st:#27#27'OQ'), {xterm}
- (char:0;scan:kbAltF3;st:#27#27'OR'), {xterm}
- (char:0;scan:kbAltF4;st:#27#27'OS'), {xterm}
- (char:0;scan:kbAltF5;st:#27#27'Ot'), {xterm}
- (char:0;scan:kbAltF6;st:#27#27'Ou'), {xterm}
- (char:0;scan:kbAltF7;st:#27#27'Ov'), {xterm}
- (char:0;scan:kbAltF8;st:#27#27'Ol'), {xterm}
- (char:0;scan:kbAltF9;st:#27#27'Ow'), {xterm}
- (char:0;scan:kbAltF10;st:#27#27'Ox'), {xterm}
- (char:0;scan:kbAltF11;st:#27#27'Oy'), {xterm}
- (char:0;scan:kbAltF12;st:#27#27'Oz'), {xterm}
- (char:0;scan:kbAltF1;st:#27'[1;3P'), {xterm,gnome3}
- (char:0;scan:kbAltF2;st:#27'[1;3Q'), {xterm,gnome3}
- (char:0;scan:kbAltF3;st:#27'[1;3R'), {xterm,gnome3}
- (char:0;scan:kbAltF4;st:#27'[1;3S'), {xterm,gnome3}
- (char:0;scan:kbAltF1;st:#27'O3P'), {xterm on FreeBSD}
- (char:0;scan:kbAltF2;st:#27'O3Q'), {xterm on FreeBSD}
- (char:0;scan:kbAltF3;st:#27'O3R'), {xterm on FreeBSD}
- (char:0;scan:kbAltF4;st:#27'O3S'), {xterm on FreeBSD}
- (char:0;scan:kbAltF5;st:#27'[15;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF6;st:#27'[17;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF7;st:#27'[18;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF8;st:#27'[19;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF9;st:#27'[20;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF10;st:#27'[21;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF11;st:#27'[23;3~'), {xterm on FreeBSD}
- (char:0;scan:kbAltF12;st:#27'[24;3~'), {xterm on FreeBSD}
-
- (char:0;scan:kbShiftTab;st:#27#9), {linux - 'Meta_Tab'}
- (char:0;scan:kbShiftTab;st:#27'[Z'),
- (char:0;scan:kbShiftUp;st:#27'[1;2A'), {xterm}
- (char:0;scan:kbShiftDown;st:#27'[1;2B'), {xterm}
- (char:0;scan:kbShiftRight;st:#27'[1;2C'), {xterm}
- (char:0;scan:kbShiftLeft;st:#27'[1;2D'), {xterm}
- (char:0;scan:kbShiftUp;st:#27'[a'), {rxvt}
- (char:0;scan:kbShiftDown;st:#27'[b'), {rxvt}
- (char:0;scan:kbShiftRight;st:#27'[c'), {rxvt}
- (char:0;scan:kbShiftLeft;st:#27'[d'), {rxvt}
- (char:0;scan:kbShiftEnd;st:#27'[1;2F'), {xterm}
- (char:0;scan:kbShiftEnd;st:#27'[8$'), {rxvt}
- (char:0;scan:kbShiftHome;st:#27'[1;2H'), {xterm}
- (char:0;scan:kbShiftHome;st:#27'[7$'), {rxvt}
-
- (char:0;scan:KbCtrlShiftUp;st:#27'[1;6A'), {xterm}
- (char:0;scan:KbCtrlShiftDown;st:#27'[1;6B'), {xterm}
- (char:0;scan:KbCtrlShiftRight;st:#27'[1;6C'), {xterm, xfce4}
- (char:0;scan:KbCtrlShiftLeft;st:#27'[1;6D'), {xterm, xfce4}
- (char:0;scan:KbCtrlShiftHome;st:#27'[1;6H'), {xterm}
- (char:0;scan:KbCtrlShiftEnd;st:#27'[1;6F'), {xterm}
-
- (char:0;scan:kbCtrlPgDn;st:#27'[6;5~'), {xterm}
- (char:0;scan:kbCtrlPgUp;st:#27'[5;5~'), {xterm}
- (char:0;scan:kbCtrlUp;st:#27'[1;5A'), {xterm}
- (char:0;scan:kbCtrlDown;st:#27'[1;5B'), {xterm}
- (char:0;scan:kbCtrlRight;st:#27'[1;5C'), {xterm}
- (char:0;scan:kbCtrlLeft;st:#27'[1;5D'), {xterm}
- (char:0;scan:kbCtrlUp;st:#27'[Oa'), {rxvt}
- (char:0;scan:kbCtrlDown;st:#27'[Ob'), {rxvt}
- (char:0;scan:kbCtrlRight;st:#27'[Oc'), {rxvt}
- (char:0;scan:kbCtrlLeft;st:#27'[Od'), {rxvt}
- (char:0;scan:kbCtrlEnd;st:#27'[1;5F'), {xterm}
- (char:0;scan:kbCtrlEnd;st:#27'[8^'), {rxvt}
- (char:0;scan:kbCtrlHome;st:#27'[1;5H'), {xterm}
- (char:0;scan:kbCtrlHome;st:#27'[7^'), {rxvt}
-
- (char:0;scan:kbAltUp;st:#27#27'[A'), {rxvt}
- (char:0;scan:kbAltDown;st:#27#27'[B'), {rxvt}
- (char:0;scan:kbAltLeft;st:#27#27'[D'), {rxvt}
- (char:0;scan:kbAltRight;st:#27#27'[C'), {rxvt}
+(* These seem to be shifted. Probably something changed with linux's default keymaps.
+ (char:0;scan:kbShiftF3;shift:[essShift];st:#27'[25~'), {linux,rxvt}
+ (char:0;scan:kbShiftF4;shift:[essShift];st:#27'[26~'), {linux,rxvt}
+ (char:0;scan:kbShiftF5;shift:[essShift];st:#27'[28~'), {linux,rxvt}
+ (char:0;scan:kbShiftF6;shift:[essShift];st:#27'[29~'), {linux,rxvt}
+ (char:0;scan:kbShiftF7;shift:[essShift];st:#27'[31~'), {linux,rxvt}
+ (char:0;scan:kbShiftF8;shift:[essShift];st:#27'[32~'), {linux,rxvt}
+ (char:0;scan:kbShiftF9;shift:[essShift];st:#27'[33~'), {linux,rxvt}
+ (char:0;scan:kbShiftF10;shift:[essShift];st:#27'[34~'), {linux,rxvt}*)
+ (char:0;scan:kbShiftF1;shift:[essShift];st:#27'[25~'), {linux}
+ (char:0;scan:kbShiftF2;shift:[essShift];st:#27'[26~'), {linux}
+ (char:0;scan:kbShiftF3;shift:[essShift];st:#27'[28~'), {linux}
+ (char:0;scan:kbShiftF4;shift:[essShift];st:#27'[29~'), {linux}
+ (char:0;scan:kbShiftF5;shift:[essShift];st:#27'[31~'), {linux}
+ (char:0;scan:kbShiftF6;shift:[essShift];st:#27'[32~'), {linux}
+ (char:0;scan:kbShiftF7;shift:[essShift];st:#27'[33~'), {linux}
+ (char:0;scan:kbShiftF8;shift:[essShift];st:#27'[34~'), {linux}
+ (char:0;scan:kbShiftF11;shift:[essShift];st:#27'[23$'), {rxvt}
+ (char:0;scan:kbShiftF12;shift:[essShift];st:#27'[24$'), {rxvt}
+ (char:0;scan:kbShiftF1;shift:[essShift];st:#27'[11;2~'), {konsole in vt420pc mode}
+ (char:0;scan:kbShiftF2;shift:[essShift];st:#27'[12;2~'), {konsole in vt420pc mode}
+ (char:0;scan:kbShiftF3;shift:[essShift];st:#27'[13;2~'), {konsole in vt420pc mode}
+ (char:0;scan:kbShiftF4;shift:[essShift];st:#27'[14;2~'), {konsole in vt420pc mode}
+ (char:0;scan:kbShiftF5;shift:[essShift];st:#27'[15;2~'), {xterm}
+ (char:0;scan:kbShiftF6;shift:[essShift];st:#27'[17;2~'), {xterm}
+ (char:0;scan:kbShiftF7;shift:[essShift];st:#27'[18;2~'), {xterm}
+ (char:0;scan:kbShiftF8;shift:[essShift];st:#27'[19;2~'), {xterm}
+ (char:0;scan:kbShiftF9;shift:[essShift];st:#27'[20;2~'), {xterm}
+ (char:0;scan:kbShiftF10;shift:[essShift];st:#27'[21;2~'), {xterm}
+ (char:0;scan:kbShiftF11;shift:[essShift];st:#27'[23;2~'), {xterm}
+ (char:0;scan:kbShiftF12;shift:[essShift];st:#27'[24;2~'), {xterm}
+ (char:0;scan:kbShiftF1;shift:[essShift];st:#27'O2P'), {konsole,xterm}
+ (char:0;scan:kbShiftF2;shift:[essShift];st:#27'O2Q'), {konsole,xterm}
+ (char:0;scan:kbShiftF3;shift:[essShift];st:#27'O2R'), {konsole,xterm}
+ (char:0;scan:kbShiftF4;shift:[essShift];st:#27'O2S'), {konsole,xterm}
+ (char:0;scan:kbShiftF1;shift:[essShift];st:#27'[1;2P'), {xterm,gnome3}
+ (char:0;scan:kbShiftF2;shift:[essShift];st:#27'[1;2Q'), {xterm,gnome3}
+ (char:0;scan:kbShiftF3;shift:[essShift];st:#27'[1;2R'), {xterm,gnome3}
+ (char:0;scan:kbShiftF4;shift:[essShift];st:#27'[1;2S'), {xterm,gnome3}
+ (char:0;scan:kbCtrlF1;shift:[essCtrl];st:#27'O5P'), {konsole,xterm}
+ (char:0;scan:kbCtrlF2;shift:[essCtrl];st:#27'O5Q'), {konsole,xterm}
+ (char:0;scan:kbCtrlF3;shift:[essCtrl];st:#27'O5R'), {konsole,xterm}
+ (char:0;scan:kbCtrlF4;shift:[essCtrl];st:#27'O5S'), {konsole,xterm}
+ (char:0;scan:kbCtrlF1;shift:[essCtrl];st:#27'[1;5P'), {xterm,gnome3}
+ (char:0;scan:kbCtrlF2;shift:[essCtrl];st:#27'[1;5Q'), {xterm,gnome3}
+ (char:0;scan:kbCtrlF3;shift:[essCtrl];st:#27'[1;5R'), {xterm,gnome3}
+ (char:0;scan:kbCtrlF4;shift:[essCtrl];st:#27'[1;5S'), {xterm,gnome3}
+ (char:0;scan:kbCtrlF1;shift:[essCtrl];st:#27'[11;5~'), {none, but expected}
+ (char:0;scan:kbCtrlF2;shift:[essCtrl];st:#27'[12;5~'), {none, but expected}
+ (char:0;scan:kbCtrlF3;shift:[essCtrl];st:#27'[13;5~'), {none, but expected}
+ (char:0;scan:kbCtrlF4;shift:[essCtrl];st:#27'[14;5~'), {none, but expected}
+ (char:0;scan:kbCtrlF5;shift:[essCtrl];st:#27'[15;5~'), {xterm}
+ (char:0;scan:kbCtrlF6;shift:[essCtrl];st:#27'[17;5~'), {xterm}
+ (char:0;scan:kbCtrlF7;shift:[essCtrl];st:#27'[18;5~'), {xterm}
+ (char:0;scan:kbCtrlF8;shift:[essCtrl];st:#27'[19;5~'), {xterm}
+ (char:0;scan:kbCtrlF9;shift:[essCtrl];st:#27'[20;5~'), {xterm}
+ (char:0;scan:kbCtrlF10;shift:[essCtrl];st:#27'[21;5~'), {xterm}
+ (char:0;scan:kbCtrlF11;shift:[essCtrl];st:#27'[23;5~'), {xterm}
+ (char:0;scan:kbCtrlF12;shift:[essCtrl];st:#27'[24;5~'), {xterm}
+ (char:0;scan:kbCtrlF1;shift:[essCtrl];st:#27'[11^'), {rxvt}
+ (char:0;scan:kbCtrlF2;shift:[essCtrl];st:#27'[12^'), {rxvt}
+ (char:0;scan:kbCtrlF3;shift:[essCtrl];st:#27'[13^'), {rxvt}
+ (char:0;scan:kbCtrlF4;shift:[essCtrl];st:#27'[14^'), {rxvt}
+ (char:0;scan:kbCtrlF5;shift:[essCtrl];st:#27'[15^'), {rxvt}
+ (char:0;scan:kbCtrlF6;shift:[essCtrl];st:#27'[17^'), {rxvt}
+ (char:0;scan:kbCtrlF7;shift:[essCtrl];st:#27'[18^'), {rxvt}
+ (char:0;scan:kbCtrlF8;shift:[essCtrl];st:#27'[19^'), {rxvt}
+ (char:0;scan:kbCtrlF9;shift:[essCtrl];st:#27'[20^'), {rxvt}
+ (char:0;scan:kbCtrlF10;shift:[essCtrl];st:#27'[21^'), {rxvt}
+ (char:0;scan:kbCtrlF11;shift:[essCtrl];st:#27'[23^'), {rxvt}
+ (char:0;scan:kbCtrlF12;shift:[essCtrl];st:#27'[24^'), {rxvt}
+ (char:0;scan:kbShiftIns;shift:[essShift];st:#27'[2;2~'), {should be the code, but shift+ins
+ is paste X clipboard in many
+ terminal emulators :(}
+ (char:0;scan:kbShiftDel;shift:[essShift];st:#27'[3;2~'), {xterm,konsole}
+ (char:0;scan:kbCtrlIns;shift:[essCtrl];st:#27'[2;5~'), {xterm}
+ (char:0;scan:kbCtrlDel;shift:[essCtrl];st:#27'[3;5~'), {xterm}
+ (char:0;scan:kbShiftDel;shift:[essShift];st:#27'[3$'), {rxvt}
+ (char:0;scan:kbCtrlIns;shift:[essCtrl];st:#27'[2^'), {rxvt}
+ (char:0;scan:kbCtrlDel;shift:[essCtrl];st:#27'[3^'), {rxvt}
+ (char:0;scan:kbAltF1;shift:[essAlt];st:#27#27'[[A'),
+ (char:0;scan:kbAltF2;shift:[essAlt];st:#27#27'[[B'),
+ (char:0;scan:kbAltF3;shift:[essAlt];st:#27#27'[[C'),
+ (char:0;scan:kbAltF4;shift:[essAlt];st:#27#27'[[D'),
+ (char:0;scan:kbAltF5;shift:[essAlt];st:#27#27'[[E'),
+ (char:0;scan:kbAltF1;shift:[essAlt];st:#27#27'[11~'), {rxvt}
+ (char:0;scan:kbAltF2;shift:[essAlt];st:#27#27'[12~'), {rxvt}
+ (char:0;scan:kbAltF3;shift:[essAlt];st:#27#27'[13~'), {rxvt}
+ (char:0;scan:kbAltF4;shift:[essAlt];st:#27#27'[14~'), {rxvt}
+ (char:0;scan:kbAltF5;shift:[essAlt];st:#27#27'[15~'), {rxvt}
+ (char:0;scan:kbAltF6;shift:[essAlt];st:#27#27'[17~'), {rxvt}
+ (char:0;scan:kbAltF7;shift:[essAlt];st:#27#27'[18~'), {rxvt}
+ (char:0;scan:kbAltF8;shift:[essAlt];st:#27#27'[19~'), {rxvt}
+ (char:0;scan:kbAltF9;shift:[essAlt];st:#27#27'[20~'), {rxvt}
+ (char:0;scan:kbAltF10;shift:[essAlt];st:#27#27'[21~'), {rxvt}
+ (char:0;scan:kbAltF11;shift:[essAlt];st:#27#27'[23~'), {rxvt}
+ (char:0;scan:kbAltF12;shift:[essAlt];st:#27#27'[24~'), {rxvt}
+ (char:0;scan:kbAltF1;shift:[essAlt];st:#27#27'OP'), {xterm}
+ (char:0;scan:kbAltF2;shift:[essAlt];st:#27#27'OQ'), {xterm}
+ (char:0;scan:kbAltF3;shift:[essAlt];st:#27#27'OR'), {xterm}
+ (char:0;scan:kbAltF4;shift:[essAlt];st:#27#27'OS'), {xterm}
+ (char:0;scan:kbAltF5;shift:[essAlt];st:#27#27'Ot'), {xterm}
+ (char:0;scan:kbAltF6;shift:[essAlt];st:#27#27'Ou'), {xterm}
+ (char:0;scan:kbAltF7;shift:[essAlt];st:#27#27'Ov'), {xterm}
+ (char:0;scan:kbAltF8;shift:[essAlt];st:#27#27'Ol'), {xterm}
+ (char:0;scan:kbAltF9;shift:[essAlt];st:#27#27'Ow'), {xterm}
+ (char:0;scan:kbAltF10;shift:[essAlt];st:#27#27'Ox'), {xterm}
+ (char:0;scan:kbAltF11;shift:[essAlt];st:#27#27'Oy'), {xterm}
+ (char:0;scan:kbAltF12;shift:[essAlt];st:#27#27'Oz'), {xterm}
+ (char:0;scan:kbAltF1;shift:[essAlt];st:#27'[1;3P'), {xterm,gnome3}
+ (char:0;scan:kbAltF2;shift:[essAlt];st:#27'[1;3Q'), {xterm,gnome3}
+ (char:0;scan:kbAltF3;shift:[essAlt];st:#27'[1;3R'), {xterm,gnome3}
+ (char:0;scan:kbAltF4;shift:[essAlt];st:#27'[1;3S'), {xterm,gnome3}
+ (char:0;scan:kbAltF1;shift:[essAlt];st:#27'O3P'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF2;shift:[essAlt];st:#27'O3Q'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF3;shift:[essAlt];st:#27'O3R'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF4;shift:[essAlt];st:#27'O3S'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF5;shift:[essAlt];st:#27'[15;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF6;shift:[essAlt];st:#27'[17;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF7;shift:[essAlt];st:#27'[18;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF8;shift:[essAlt];st:#27'[19;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF9;shift:[essAlt];st:#27'[20;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF10;shift:[essAlt];st:#27'[21;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF11;shift:[essAlt];st:#27'[23;3~'), {xterm on FreeBSD}
+ (char:0;scan:kbAltF12;shift:[essAlt];st:#27'[24;3~'), {xterm on FreeBSD}
+
+ (char:0;scan:kbShiftTab;shift:[essShift];st:#27#9), {linux - 'Meta_Tab'}
+ (char:0;scan:kbShiftTab;shift:[essShift];st:#27'[Z'),
+ (char:0;scan:kbShiftUp;shift:[essShift];st:#27'[1;2A'), {xterm}
+ (char:0;scan:kbShiftDown;shift:[essShift];st:#27'[1;2B'), {xterm}
+ (char:0;scan:kbShiftRight;shift:[essShift];st:#27'[1;2C'), {xterm}
+ (char:0;scan:kbShiftLeft;shift:[essShift];st:#27'[1;2D'), {xterm}
+ (char:0;scan:kbShiftUp;shift:[essShift];st:#27'[a'), {rxvt}
+ (char:0;scan:kbShiftDown;shift:[essShift];st:#27'[b'), {rxvt}
+ (char:0;scan:kbShiftRight;shift:[essShift];st:#27'[c'), {rxvt}
+ (char:0;scan:kbShiftLeft;shift:[essShift];st:#27'[d'), {rxvt}
+ (char:0;scan:kbShiftEnd;shift:[essShift];st:#27'[1;2F'), {xterm}
+ (char:0;scan:kbShiftEnd;shift:[essShift];st:#27'[8$'), {rxvt}
+ (char:0;scan:kbShiftHome;shift:[essShift];st:#27'[1;2H'), {xterm}
+ (char:0;scan:kbShiftHome;shift:[essShift];st:#27'[7$'), {rxvt}
+
+ (char:0;scan:KbCtrlShiftUp;shift:[essCtrl,essShift];st:#27'[1;6A'), {xterm}
+ (char:0;scan:KbCtrlShiftDown;shift:[essCtrl,essShift];st:#27'[1;6B'), {xterm}
+ (char:0;scan:KbCtrlShiftRight;shift:[essCtrl,essShift];st:#27'[1;6C'), {xterm, xfce4}
+ (char:0;scan:KbCtrlShiftLeft;shift:[essCtrl,essShift];st:#27'[1;6D'), {xterm, xfce4}
+ (char:0;scan:KbCtrlShiftHome;shift:[essCtrl,essShift];st:#27'[1;6H'), {xterm}
+ (char:0;scan:KbCtrlShiftEnd;shift:[essCtrl,essShift];st:#27'[1;6F'), {xterm}
+
+ (char:0;scan:kbCtrlPgDn;shift:[essCtrl];st:#27'[6;5~'), {xterm}
+ (char:0;scan:kbCtrlPgUp;shift:[essCtrl];st:#27'[5;5~'), {xterm}
+ (char:0;scan:kbCtrlUp;shift:[essCtrl];st:#27'[1;5A'), {xterm}
+ (char:0;scan:kbCtrlDown;shift:[essCtrl];st:#27'[1;5B'), {xterm}
+ (char:0;scan:kbCtrlRight;shift:[essCtrl];st:#27'[1;5C'), {xterm}
+ (char:0;scan:kbCtrlLeft;shift:[essCtrl];st:#27'[1;5D'), {xterm}
+ (char:0;scan:kbCtrlUp;shift:[essCtrl];st:#27'[Oa'), {rxvt}
+ (char:0;scan:kbCtrlDown;shift:[essCtrl];st:#27'[Ob'), {rxvt}
+ (char:0;scan:kbCtrlRight;shift:[essCtrl];st:#27'[Oc'), {rxvt}
+ (char:0;scan:kbCtrlLeft;shift:[essCtrl];st:#27'[Od'), {rxvt}
+ (char:0;scan:kbCtrlEnd;shift:[essCtrl];st:#27'[1;5F'), {xterm}
+ (char:0;scan:kbCtrlEnd;shift:[essCtrl];st:#27'[8^'), {rxvt}
+ (char:0;scan:kbCtrlHome;shift:[essCtrl];st:#27'[1;5H'), {xterm}
+ (char:0;scan:kbCtrlHome;shift:[essCtrl];st:#27'[7^'), {rxvt}
+
+ (char:0;scan:kbAltUp;shift:[essAlt];st:#27#27'[A'), {rxvt}
+ (char:0;scan:kbAltDown;shift:[essAlt];st:#27#27'[B'), {rxvt}
+ (char:0;scan:kbAltLeft;shift:[essAlt];st:#27#27'[D'), {rxvt}
+ (char:0;scan:kbAltRight;shift:[essAlt];st:#27#27'[C'), {rxvt}
{$ifdef HAIKU}
- (char:0;scan:kbAltUp;st:#27#27'OA'),
- (char:0;scan:kbAltDown;st:#27#27'OB'),
- (char:0;scan:kbAltRight;st:#27#27'OC'),
+ (char:0;scan:kbAltUp;shift:[essAlt];st:#27#27'OA'),
+ (char:0;scan:kbAltDown;shift:[essAlt];st:#27#27'OB'),
+ (char:0;scan:kbAltRight;shift:[essAlt];st:#27#27'OC'),
{$else}
- (char:0;scan:kbAltUp;st:#27'OA'),
- (char:0;scan:kbAltDown;st:#27'OB'),
- (char:0;scan:kbAltRight;st:#27'OC'),
+ (char:0;scan:kbAltUp;shift:[essAlt];st:#27'OA'),
+ (char:0;scan:kbAltDown;shift:[essAlt];st:#27'OB'),
+ (char:0;scan:kbAltRight;shift:[essAlt];st:#27'OC'),
{$endif}
- (char:0;scan:kbAltLeft;st:#27#27'OD'),
- (char:0;scan:kbAltPgUp;st:#27#27'[5~'), {rxvt}
- (char:0;scan:kbAltPgDn;st:#27#27'[6~'), {rxvt}
- (char:0;scan:kbAltEnd;st:#27#27'[4~'),
- (char:0;scan:kbAltEnd;st:#27#27'[8~'), {rxvt}
- (char:0;scan:kbAltHome;st:#27#27'[1~'),
- (char:0;scan:kbAltHome;st:#27#27'[7~'), {rxvt}
- (char:0;scan:kbAltIns;st:#27#27'[2~'), {rxvt}
- (char:0;scan:kbAltDel;st:#27#27'[3~'), {rxvt}
+ (char:0;scan:kbAltLeft;shift:[essAlt];st:#27#27'OD'),
+ (char:0;scan:kbAltPgUp;shift:[essAlt];st:#27#27'[5~'), {rxvt}
+ (char:0;scan:kbAltPgDn;shift:[essAlt];st:#27#27'[6~'), {rxvt}
+ (char:0;scan:kbAltEnd;shift:[essAlt];st:#27#27'[4~'),
+ (char:0;scan:kbAltEnd;shift:[essAlt];st:#27#27'[8~'), {rxvt}
+ (char:0;scan:kbAltHome;shift:[essAlt];st:#27#27'[1~'),
+ (char:0;scan:kbAltHome;shift:[essAlt];st:#27#27'[7~'), {rxvt}
+ (char:0;scan:kbAltIns;shift:[essAlt];st:#27#27'[2~'), {rxvt}
+ (char:0;scan:kbAltDel;shift:[essAlt];st:#27#27'[3~'), {rxvt}
{ xterm default values }
{ xterm alternate default values }
{ ignored sequences }
- (char:0;scan:0;st:#27'[?1;0c'),
- (char:0;scan:0;st:#27'[?1l'),
- (char:0;scan:0;st:#27'[?1h'),
- (char:0;scan:0;st:#27'[?1;2c'),
- (char:0;scan:0;st:#27'[?7l'),
- (char:0;scan:0;st:#27'[?7h')
+ (char:0;scan:0;shift:[];st:#27'[?1;0c'),
+ (char:0;scan:0;shift:[];st:#27'[?1l'),
+ (char:0;scan:0;shift:[];st:#27'[?1h'),
+ (char:0;scan:0;shift:[];st:#27'[?1;2c'),
+ (char:0;scan:0;shift:[];st:#27'[?7l'),
+ (char:0;scan:0;shift:[];st:#27'[?7h')
);
procedure LoadDefaultSequences;
@@ -1209,18 +1242,18 @@ begin
if copy(fpgetenv('TERM'),1,4)='cons' then
begin
{FreeBSD is until now only terminal that uses it for delete.}
- DoAddSequence(#127,0,kbDel); {Delete}
- DoAddSequence(#27#127,0,kbAltDel); {Alt+delete}
+ DoAddSequence(#127,0,kbDel,[]); {Delete}
+ DoAddSequence(#27#127,0,kbAltDel,[essAlt]); {Alt+delete}
end
else
begin
- DoAddSequence(#127,8,0); {Backspace}
- DoAddSequence(#27#127,0,kbAltBack); {Alt+backspace}
+ DoAddSequence(#127,8,0,[]); {Backspace}
+ DoAddSequence(#27#127,0,kbAltBack,[essAlt]); {Alt+backspace}
end;
{ all Esc letter }
for i:=low(key_sequences) to high(key_sequences) do
with key_sequences[i] do
- DoAddSequence(st,char,scan);
+ DoAddSequence(st,char,scan,shift);
end;
function RawReadKey:char;
@@ -1228,11 +1261,11 @@ var
fdsin : tfdSet;
begin
{Check Buffer first}
- if KeySend<>KeyPut then
+{ if KeySend<>KeyPut then
begin
RawReadKey:=PopKey;
exit;
- end;
+ end;}
{Wait for Key}
if not sysKeyPressed then
begin
@@ -1267,25 +1300,207 @@ begin
end;
-function ReadKey(var IsAlt : boolean):char;
+{$ifdef linux}
+function ShiftState:byte;
+
+var arg:longint;
+
+begin
+ shiftstate:=0;
+ arg:=6;
+ if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
+ begin
+ if (arg and 8)<>0 then
+ shiftstate:=kbAlt;
+ if (arg and 4)<>0 then
+ inc(shiftstate,kbCtrl);
+ { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
+ if (arg and 2)<>0 then
+ shiftstate:=shiftstate or (kbAlt or kbCtrl);
+ if (arg and 1)<>0 then
+ inc(shiftstate,kbShift);
+ end;
+end;
+
+function EnhShiftState:TEnhancedShiftState;
+const
+ KG_SHIFT = 0;
+ KG_CTRL = 2;
+ KG_ALT = 3;
+ KG_ALTGR = 1;
+ KG_SHIFTL = 4;
+ KG_KANASHIFT = 4;
+ KG_SHIFTR = 5;
+ KG_CTRLL = 6;
+ KG_CTRLR = 7;
+ KG_CAPSSHIFT = 8;
+var
+ arg: longint;
+begin
+ EnhShiftState:=[];
+ arg:=6;
+ if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
+ begin
+ if (arg and (1 shl KG_ALT))<>0 then
+ Include(EnhShiftState,essAlt);
+ if (arg and (1 shl KG_CTRL))<>0 then
+ Include(EnhShiftState,essCtrl);
+ if (arg and (1 shl KG_CTRLL))<>0 then
+ Include(EnhShiftState,essLeftCtrl);
+ if (arg and (1 shl KG_CTRLR))<>0 then
+ Include(EnhShiftState,essRightCtrl);
+ if (arg and (1 shl KG_ALTGR))<>0 then
+ Include(EnhShiftState,essAltGr);
+ if (arg and (1 shl KG_SHIFT))<>0 then
+ Include(EnhShiftState,essShift);
+ if (arg and (1 shl KG_SHIFTL))<>0 then
+ Include(EnhShiftState,essLeftShift);
+ if (arg and (1 shl KG_SHIFTR))<>0 then
+ Include(EnhShiftState,essRightShift);
+ end;
+end;
+
+procedure force_linuxtty;
+
+var s:string[15];
+ handle:sizeint;
+ thistty:string;
+
+begin
+ is_console:=false;
+ if vcs_device<>-1 then
+ begin
+ { running on a tty, find out whether locally or remotely }
+ thistty:=ttyname(stdinputhandle);
+ if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then
+ begin
+ {Running from Midnight Commander or something... Bypass it.}
+ str(vcs_device,s);
+ handle:=fpopen('/dev/tty'+s,O_RDWR);
+ fpioctl(stdinputhandle,TIOCNOTTY,nil);
+ {This will currently only work when the user is root :(}
+ fpioctl(handle,TIOCSCTTY,nil);
+ if errno<>0 then
+ exit;
+ fpclose(stdinputhandle);
+ fpclose(stdoutputhandle);
+ fpclose(stderrorhandle);
+ fpdup2(handle,stdinputhandle);
+ fpdup2(handle,stdoutputhandle);
+ fpdup2(handle,stderrorhandle);
+ fpclose(handle);
+ end;
+ is_console:=true;
+ end;
+end;
+{$endif linux}
+
+
+function DetectUtf8ByteSequenceStart(ch: Char): LongInt;
+begin
+ if Ord(ch)<128 then
+ DetectUtf8ByteSequenceStart:=1
+ else if (Ord(ch) and %11100000)=%11000000 then
+ DetectUtf8ByteSequenceStart:=2
+ else if (Ord(ch) and %11110000)=%11100000 then
+ DetectUtf8ByteSequenceStart:=3
+ else if (Ord(ch) and %11111000)=%11110000 then
+ DetectUtf8ByteSequenceStart:=4
+ else
+ DetectUtf8ByteSequenceStart:=0;
+end;
+
+
+function IsValidUtf8ContinuationByte(ch: Char): Boolean;
+begin
+ IsValidUtf8ContinuationByte:=(Ord(ch) and %11000000)=%10000000;
+end;
+
+
+function ReadKey:TEnhancedKeyEvent;
+const
+ ReplacementAsciiChar='?';
var
- ch : char;
- fdsin : tfdSet;
store : array [0..8] of char;
arrayind : byte;
- NPT,NNPT : PTreeElement;
+ SState: TEnhancedShiftState;
procedure RestoreArray;
var
i : byte;
+ k : TEnhancedKeyEvent;
begin
for i:=0 to arrayind-1 do
- PushKey(store[i]);
+ begin
+ k := NilEnhancedKeyEvent;
+ k.AsciiChar := store[i];
+ k.VirtualScanCode := Ord(k.AsciiChar);
+ k.ShiftState := SState;
+ { todo: how to set the other fields? }
+ PushKey(k);
+ end;
end;
+ function ReadUtf8(ch: Char): LongInt;
+ const
+ ErrorCharacter = $FFFD; { U+FFFD = REPLACEMENT CHARACTER }
+ var
+ CodePoint: LongInt;
+ begin
+ ReadUtf8:=ErrorCharacter;
+ case DetectUtf8ByteSequenceStart(ch) of
+ 1: ReadUtf8:=Ord(ch);
+ 2:begin
+ CodePoint:=(Ord(ch) and %00011111) shl 6;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=(Ord(ch) and %00111111) or CodePoint;
+ if (CodePoint>=$80) and (CodePoint<=$7FF) then
+ ReadUtf8:=CodePoint;
+ end;
+ 3:begin
+ CodePoint:=(Ord(ch) and %00001111) shl 12;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=((Ord(ch) and %00111111) shl 6) or CodePoint;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=(Ord(ch) and %00111111) or CodePoint;
+ if ((CodePoint>=$800) and (CodePoint<=$D7FF)) or
+ ((CodePoint>=$E000) and (CodePoint<=$FFFF)) then
+ ReadUtf8:=CodePoint;
+ end;
+ 4:begin
+ CodePoint:=(Ord(ch) and %00000111) shl 18;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=((Ord(ch) and %00111111) shl 12) or CodePoint;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=((Ord(ch) and %00111111) shl 6) or CodePoint;
+ ch:=ttyRecvChar;
+ if not IsValidUtf8ContinuationByte(ch) then
+ exit;
+ CodePoint:=(Ord(ch) and %00111111) or CodePoint;
+ if (CodePoint>=$10000) and (CodePoint<=$10FFFF) then
+ ReadUtf8:=CodePoint;
+ end;
+ end;
+ end;
+
+var
+ ch : char;
+ fdsin : tfdSet;
+ NPT,NNPT : PTreeElement;
+ k: TEnhancedKeyEvent;
+ UnicodeCodePoint: LongInt;
begin
- IsAlt:=false;
{Check Buffer first}
if KeySend<>KeyPut then
begin
@@ -1299,10 +1514,47 @@ begin
fpFD_SET (StdInputHandle,fdsin);
fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
end;
+ k:=NilEnhancedKeyEvent;
+{$ifdef linux}
+ if is_console then
+ SState:=EnhShiftState
+ else
+{$endif}
+ SState:=[];
+ k.ShiftState:=SState;
ch:=ttyRecvChar;
+ k.AsciiChar:=ch;
NPT:=RootTree[ch];
if not assigned(NPT) then
- PushKey(ch)
+ begin
+ if Utf8KeyboardInputEnabled then
+ begin
+ UnicodeCodePoint:=ReadUtf8(ch);
+ if UnicodeCodePoint<=$FFFF then
+ begin
+ { Code point is in the Basic Multilingual Plane (BMP)
+ -> encode as single WideChar }
+ k.UnicodeChar:=WideChar(UnicodeCodePoint);
+ if UnicodeCodePoint<=127 then
+ k.AsciiChar:=Chr(UnicodeCodePoint)
+ else
+ k.AsciiChar:=ReplacementAsciiChar;
+ PushKey(k);
+ end
+ else if UnicodeCodePoint<=$10FFFF then
+ begin
+ { Code point from the Supplementary Planes (U+010000..U+10FFFF)
+ -> encode as a surrogate pair of WideChars (as in UTF-16) }
+ k.UnicodeChar:=WideChar(((UnicodeCodePoint-$10000) shr 10)+$D800);
+ k.AsciiChar:=ReplacementAsciiChar;
+ PushKey(k);
+ k.UnicodeChar:=WideChar(((UnicodeCodePoint-$10000) and %1111111111)+$DC00);
+ PushKey(k);
+ end;
+ end
+ else
+ PushKey(k);
+ end
else
begin
fpFD_ZERO(fdsin);
@@ -1322,11 +1574,7 @@ begin
{Alt+O cannot be used in this situation, it can be a function key.}
if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then
begin
- if intail=0 then
- intail:=insize
- else
- dec(intail);
- inbuf[intail]:=ch;
+ PutBackIntoInBuf(ch);
ch:=#27;
end
else
@@ -1342,37 +1590,37 @@ begin
if NPT^.CanBeTerminal and
assigned(NPT^.SpecialHandler) then
break;
- End;
+ End
+ else
+ begin
+ { Put that unused char back into InBuf? }
+ if ch<>#0 then
+ PutBackIntoInBuf(ch);
+ break;
+ end;
if ch<>#0 then
begin
store[arrayind]:=ch;
inc(arrayind);
end;
- if not assigned(NNPT) then
- begin
- if ch<>#0 then
- begin
- { Put that unused char back into InBuf }
- If InTail=0 then
- InTail:=InSize-1
- else
- Dec(InTail);
- InBuf[InTail]:=ch;
- end;
- break;
- end;
end;
if assigned(NPT) and NPT^.CanBeTerminal then
begin
if assigned(NPT^.SpecialHandler) then
begin
NPT^.SpecialHandler;
- PushExt(0);
+ k.AsciiChar := #0;
+ k.UnicodeChar := WideChar(#0);
+ k.VirtualScanCode := 0;
+ PushKey(k);
end
- else if NPT^.CharValue<>0 then
- PushKey(chr(NPT^.CharValue))
- else if NPT^.ScanValue<>0 then
- PushExt(NPT^.ScanValue);
+ else if (NPT^.CharValue<>0) or (NPT^.ScanValue<>0) then
+ begin
+ k.AsciiChar := chr(NPT^.CharValue);
+ k.UnicodeChar := WideChar(NPT^.CharValue);
+ k.VirtualScanCode := (NPT^.ScanValue shl 8) or Ord(k.AsciiChar);
+ PushKey(k);
+ end;
end
else
RestoreArray;
@@ -1384,67 +1632,13 @@ begin
ReadKey:=PopKey;
End;
-{$ifdef linux}
-function ShiftState:byte;
-
-var arg:longint;
-
-begin
- shiftstate:=0;
- arg:=6;
- if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
- begin
- if (arg and 8)<>0 then
- shiftstate:=kbAlt;
- if (arg and 4)<>0 then
- inc(shiftstate,kbCtrl);
- { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
- if (arg and 2)<>0 then
- shiftstate:=shiftstate or (kbAlt or kbCtrl);
- if (arg and 1)<>0 then
- inc(shiftstate,kbShift);
- end;
-end;
-
-procedure force_linuxtty;
-
-var s:string[15];
- handle:sizeint;
- thistty:string;
-
-begin
- is_console:=false;
- if vcs_device<>-1 then
- begin
- { running on a tty, find out whether locally or remotely }
- thistty:=ttyname(stdinputhandle);
- if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then
- begin
- {Running from Midnight Commander or something... Bypass it.}
- str(vcs_device,s);
- handle:=fpopen('/dev/tty'+s,O_RDWR);
- fpioctl(stdinputhandle,TIOCNOTTY,nil);
- {This will currently only work when the user is root :(}
- fpioctl(handle,TIOCSCTTY,nil);
- if errno<>0 then
- exit;
- fpclose(stdinputhandle);
- fpclose(stdoutputhandle);
- fpclose(stderrorhandle);
- fpdup2(handle,stdinputhandle);
- fpdup2(handle,stdoutputhandle);
- fpdup2(handle,stderrorhandle);
- fpclose(handle);
- end;
- is_console:=true;
- end;
-end;
-{$endif linux}
{ Exported functions }
procedure SysInitKeyboard;
begin
+ PendingEnhancedKeyEvent:=NilEnhancedKeyEvent;
+ Utf8KeyboardInputEnabled:=UnixKVMBase.UTF8Enabled;
SetRawMode(true);
{$ifdef logging}
assign(f,'keyboard.log');
@@ -1503,7 +1697,7 @@ begin
end;
-function SysGetKeyEvent: TKeyEvent;
+function SysGetEnhancedKeyEvent: TEnhancedKeyEvent;
function EvalScan(b:byte):byte;
const
@@ -1562,33 +1756,34 @@ const
var
MyScan:byte;
MyChar : char;
- EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
- SState:byte;
+ MyUniChar: WideChar;
+ MyKey: TEnhancedKeyEvent;
+ EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,Again : boolean;
+ SState: TEnhancedShiftState;
begin {main}
- MyChar:=Readkey(IsAlt);
- MyScan:=ord(MyChar);
-{$ifdef linux}
- if is_console then
- SState:=ShiftState
- else
-{$endif}
- Sstate:=0;
+ if PendingEnhancedKeyEvent<>NilEnhancedKeyEvent then
+ begin
+ SysGetEnhancedKeyEvent:=PendingEnhancedKeyEvent;
+ PendingEnhancedKeyEvent:=NilEnhancedKeyEvent;
+ exit;
+ end;
+ SysGetEnhancedKeyEvent:=NilEnhancedKeyEvent;
+ MyKey:=ReadKey;
+ MyChar:=MyKey.AsciiChar;
+ MyUniChar:=MyKey.UnicodeChar;
+ MyScan:=MyKey.VirtualScanCode shr 8;
+ Sstate:=MyKey.ShiftState;
CtrlPrefixUsed:=false;
AltPrefixUsed:=false;
ShiftPrefixUsed:=false;
EscUsed:=false;
- if IsAlt then
- SState:=SState or kbAlt;
repeat
again:=false;
if Mychar=#0 then
begin
- MyScan:=ord(ReadKey(IsAlt));
- if myscan=$01 then
- mychar:=#27;
{ Handle Ctrl-<x>, but not AltGr-<x> }
- if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
+ if (essCtrl in SState) and (not (essAlt in SState)) then
case MyScan of
kbShiftTab: MyScan := kbCtrlTab;
kbHome..kbDel : { cArrow }
@@ -1599,7 +1794,7 @@ begin {main}
MyScan:=MyScan+kbCtrlF11-kbF11;
end
{ Handle Alt-<x>, but not AltGr }
- else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
+ else if (essAlt in SState) and (not (essCtrl in SState)) then
case MyScan of
kbShiftTab: MyScan := kbAltTab;
kbHome..kbDel : { AltArrow }
@@ -1609,7 +1804,7 @@ begin {main}
kbF11..KbF12 : { aF11-aF12 }
MyScan:=MyScan+kbAltF11-kbF11;
end
- else if (SState and kbShift)<>0 then
+ else if essShift in SState then
case MyScan of
kbIns: MyScan:=kbShiftIns;
kbDel: MyScan:=kbShiftDel;
@@ -1623,28 +1818,31 @@ begin {main}
if myscan <= kbShiftEnd then
begin
myscan:=ShiftArrow[myscan];
- sstate:=sstate or kbshift;
+ Include(sstate, essShift);
end else
begin
myscan:=CtrlShiftArrow[myscan];
- sstate:=sstate or kbshift or kbCtrl;
+ sstate:=sstate + [essShift, essCtrl];
end;
end;
if myscan=kbAltBack then
- sstate:=sstate or kbalt;
- if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
- SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
- else
- SysGetKeyEvent:=0;
+ Include(sstate, essAlt);
+ if (MyChar<>#0) or (MyUniChar<>WideChar(0)) or (MyScan<>0) or (SState<>[]) then
+ begin
+ SysGetEnhancedKeyEvent.AsciiChar:=MyChar;
+ SysGetEnhancedKeyEvent.UnicodeChar:=MyUniChar;
+ SysGetEnhancedKeyEvent.ShiftState:=SState;
+ SysGetEnhancedKeyEvent.VirtualScanCode:=(MyScan shl 8) or Ord(MyChar);
+ end;
exit;
end
else if MyChar=#27 then
begin
if EscUsed then
- SState:=SState and not kbAlt
+ SState:=SState-[essAlt,essLeftAlt,essRightAlt]
else
begin
- SState:=SState or kbAlt;
+ Include(SState,essAlt);
Again:=true;
EscUsed:=true;
end;
@@ -1652,97 +1850,101 @@ begin {main}
else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
begin { ^Z - replace Alt for Linux OS }
if AltPrefixUsed then
- begin
- SState:=SState and not kbAlt;
- end
+ SState:=SState-[essAlt,essLeftAlt,essRightAlt]
else
begin
AltPrefixUsed:=true;
- SState:=SState or kbAlt;
+ Include(SState,essAlt);
Again:=true;
end;
end
else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
begin
if CtrlPrefixUsed then
- SState:=SState and not kbCtrl
+ SState:=SState-[essCtrl,essLeftCtrl,essRightCtrl]
else
begin
CtrlPrefixUsed:=true;
- SState:=SState or kbCtrl;
+ Include(SState,essCtrl);
Again:=true;
end;
end
else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
begin
if ShiftPrefixUsed then
- SState:=SState and not kbShift
+ SState:=SState-[essShift,essLeftShift,essRightShift]
else
begin
ShiftPrefixUsed:=true;
- SState:=SState or kbShift;
+ Include(SState,essShift);
Again:=true;
end;
end;
- if not again then
+ if again then
begin
- MyScan:=EvalScan(ord(MyChar));
- if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
- begin
- if MyChar=#9 then
- begin
- MyChar:=#0;
- MyScan:=kbCtrlTab;
- end;
- end
- else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
- begin
- if MyChar=#9 then
- begin
- MyChar:=#0;
- MyScan:=kbAltTab;
- end
- else
- begin
- if MyScan in [$02..$0D] then
- inc(MyScan,$76);
- MyChar:=chr(0);
- end;
- end
- else if (SState and kbShift)<>0 then
- if MyChar=#9 then
- begin
- MyChar:=#0;
- MyScan:=kbShiftTab;
- end;
- end
- else
+ MyKey:=ReadKey;
+ MyChar:=MyKey.AsciiChar;
+ MyUniChar:=MyKey.UnicodeChar;
+ MyScan:=MyKey.VirtualScanCode shr 8;
+ end;
+ until not Again;
+ MyScan:=EvalScan(ord(MyChar));
+ if (essCtrl in SState) and (not (essAlt in SState)) then
+ begin
+ if MyChar=#9 then
+ begin
+ MyChar:=#0;
+ MyUniChar:=WideChar(0);
+ MyScan:=kbCtrlTab;
+ end;
+ end
+ else if (essAlt in SState) and (not (essCtrl in SState)) then
+ begin
+ if MyChar=#9 then
+ begin
+ MyChar:=#0;
+ MyUniChar:=WideChar(0);
+ MyScan:=kbAltTab;
+ end
+ else
+ begin
+ if MyScan in [$02..$0D] then
+ inc(MyScan,$76);
+ MyChar:=chr(0);
+ MyUniChar:=WideChar(0);
+ end;
+ end
+ else if essShift in SState then
+ if MyChar=#9 then
begin
- MyChar:=Readkey(IsAlt);
- MyScan:=ord(MyChar);
- if IsAlt then
- SState:=SState or kbAlt;
+ MyChar:=#0;
+ MyUniChar:=WideChar(0);
+ MyScan:=kbShiftTab;
end;
- until not Again;
- if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
- SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
- else
- SysGetKeyEvent:=0;
+ if (MyChar<>#0) or (MyUniChar<>WideChar(0)) or (MyScan<>0) or (SState<>[]) then
+ begin
+ SysGetEnhancedKeyEvent.AsciiChar:=MyChar;
+ SysGetEnhancedKeyEvent.UnicodeChar:=MyUniChar;
+ SysGetEnhancedKeyEvent.ShiftState:=SState;
+ SysGetEnhancedKeyEvent.VirtualScanCode:=(MyScan shl 8) or Ord(MyChar);
+ end;
end;
-function SysPollKeyEvent: TKeyEvent;
+function SysPollEnhancedKeyEvent: TEnhancedKeyEvent;
var
- KeyEvent : TKeyEvent;
+ KeyEvent : TEnhancedKeyEvent;
begin
- if keypressed then
+ if PendingEnhancedKeyEvent<>NilEnhancedKeyEvent then
+ SysPollEnhancedKeyEvent:=PendingEnhancedKeyEvent
+ else if keypressed then
begin
- KeyEvent:=SysGetKeyEvent;
- PutKeyEvent(KeyEvent);
- SysPollKeyEvent:=KeyEvent
+ KeyEvent:=SysGetEnhancedKeyEvent;
+ PendingEnhancedKeyEvent:=KeyEvent;
+ SysPollEnhancedKeyEvent:=KeyEvent;
end
else
- SysPollKeyEvent:=0;
+ SysPollEnhancedKeyEvent:=NilEnhancedKeyEvent;
end;
@@ -1767,11 +1969,13 @@ const
SysKeyboardDriver : TKeyboardDriver = (
InitDriver : @SysInitKeyBoard;
DoneDriver : @SysDoneKeyBoard;
- GetKeyevent : @SysGetKeyEvent;
- PollKeyEvent : @SysPollKeyEvent;
+ GetKeyevent : Nil;
+ PollKeyEvent : Nil;
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : @SysGetEnhancedKeyEvent;
+ PollEnhancedKeyEvent : @SysPollEnhancedKeyEvent;
);
begin
diff --git a/packages/rtl-console/src/unix/unixkvmbase.pp b/packages/rtl-console/src/unix/unixkvmbase.pp
new file mode 100644
index 0000000000..51d1be316a
--- /dev/null
+++ b/packages/rtl-console/src/unix/unixkvmbase.pp
@@ -0,0 +1,51 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Miscellaneous routines used by the Keyboard, Mouse and
+ Video units on Unix-like operating systems.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit UnixKvmBase;
+
+{*****************************************************************************}
+ interface
+{*****************************************************************************}
+
+function UTF8Enabled: Boolean;
+
+{*****************************************************************************}
+ implementation
+{*****************************************************************************}
+
+uses
+ baseunix;
+
+{$ifdef BEOS}
+function UTF8Enabled: Boolean;
+begin
+ UTF8Enabled := true;
+end;
+{$else}
+function UTF8Enabled: Boolean;
+var
+ lang:string;
+begin
+{$ifdef OpenBSD}
+ lang:=upcase(fpgetenv('LC_CTYPE'));
+{$else OpenBSD}
+ lang:=upcase(fpgetenv('LANG'));
+{$endif OpenBSD}
+ UTF8Enabled := (Pos('.UTF-8', lang) > 0) or (Pos('.UTF8', lang) > 0);
+end;
+{$endif}
+
+end.
diff --git a/packages/rtl-console/src/unix/video.pp b/packages/rtl-console/src/unix/video.pp
index 54d3cb3b3b..7629608d21 100644
--- a/packages/rtl-console/src/unix/video.pp
+++ b/packages/rtl-console/src/unix/video.pp
@@ -24,57 +24,28 @@ unit video;
{$i videoh.inc}
-type Tencoding=(cp437, {Codepage 437}
- cp850, {Codepage 850}
- cp852, {Codepage 852}
- cp866, {Codepage 866}
- koi8r, {KOI8-R codepage}
- iso01, {ISO 8859-1}
- iso02, {ISO 8859-2}
- iso03, {ISO 8859-3}
- iso04, {ISO 8859-4}
- iso05, {ISO 8859-5}
- iso06, {ISO 8859-6}
- iso07, {ISO 8859-7}
- iso08, {ISO 8859-8}
- iso09, {ISO 8859-9}
- iso10, {ISO 8859-10}
- iso13, {ISO 8859-13}
- iso14, {ISO 8859-14}
- iso15, {ISO 8859-15}
- utf8); {UTF-8}
-
-const {Contains all code pages that can be considered a normal vga font.
- Note: KOI8-R has line drawing characters in wrong place. Support
- can perhaps be added, for now we'll let it rest.}
- vga_codepages=[cp437,cp850,cp852,cp866];
- iso_codepages=[iso01,iso02,iso03,iso04,iso05,iso06,iso07,iso08,
- iso09,iso10,iso13,iso14,iso15];
-
-var internal_codepage,external_codepage:Tencoding;
-
-
{*****************************************************************************}
implementation
{*****************************************************************************}
-uses baseunix,termio,strings
+uses baseunix,termio,strings,unixkvmbase,graphemebreakproperty,eastasianwidth
+ ,charset
{$ifdef linux},linuxvcs{$endif};
+const
+ CP_ISO01 = 28591; {ISO 8859-1}
+ CP_ISO02 = 28592; {ISO 8859-2}
+ CP_ISO05 = 28595; {ISO 8859-5}
+
+var external_codepage:TSystemCodePage;
+
{$i video.inc}
-{$i convert.inc}
type Tconsole_type=(ttyNetwork
{$ifdef linux},ttyLinux{$endif}
,ttyFreeBSD
,ttyNetBSD);
- Tconversion=(cv_none,
- cv_cp437_to_iso01,
- cv_cp850_to_iso01,
- cv_linuxlowascii_to_vga,
- cv_cp437_to_UTF8);
-
Ttermcode=(
enter_alt_charset_mode,
exit_alt_charset_mode,
@@ -179,8 +150,8 @@ const term_codes_ansi:Ttermcodes=
term_codes_beos:Ttermcodes=
(nil,//#$0E, {enter_alt_charset_mode}
nil,//#$0F, {exit_alt_charset_mode}
- #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
- #$1B#$5B#$48, {cursor_home}
+ #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
+ #$1B#$5B#$48, {cursor_home}
#$1B'[?25h',// nil,//#$1B#$5B#$3F#$31#$32#$6C#$1B#$5B#$3F#$32#$35#$68, {cursor_normal}
nil,//#$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor visible, underline}
nil,//#$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor visible, block}
@@ -217,8 +188,6 @@ const terminal_names:array[0..11] of string[7]=(
@term_codes_xterm,
@term_codes_beos);
-const convert:Tconversion=cv_none;
-
var
LastCursorType : byte;
{$ifdef linux}
@@ -249,6 +218,19 @@ const
TerminalSupportsHighIntensityColors: boolean = false;
TerminalSupportsBold: boolean = true;
+{Contains all code pages that can be considered a normal vga font.
+ Note: KOI8-R has line drawing characters in wrong place. Support
+ can perhaps be added, for now we'll let it rest.}
+function is_vga_code_page(CP: TSystemCodePage): Boolean;
+begin
+ case CP of
+ 437,850,852,866:
+ result:=true;
+ else
+ result:=false;
+ end;
+end;
+
function convert_vga_to_acs(ch:char):word;
{Ch contains a character in the VGA character set (i.e. codepage 437).
@@ -262,43 +244,43 @@ begin
case ch of
#18:
convert_vga_to_acs:=word('|');
- #24, #30: {}
+ #24, #30: {↑▲}
convert_vga_to_acs:=word('^');
- #25, #31: {}
+ #25, #31: {↓▼}
convert_vga_to_acs:=word('v');
- #26, #16: {Never introduce a ctrl-Z ... }
+ #26, #16: {Never introduce a ctrl-Z ... →►}
convert_vga_to_acs:=word('>');
- {#27,} #17: {}
+ {#27,} #17: {â†â—„}
convert_vga_to_acs:=word('<');
- #176, #177, #178: {°±²}
+ #176, #177, #178: {â–‘â–’â–“}
convert_vga_to_acs:=$f800+word('a');
- #180, #181, #182, #185: {´µ¶¹}
+ #180, #181, #182, #185: {┤╡╢╣}
convert_vga_to_acs:=$f800+word('u');
- #183, #184, #187, #191: {·¸»¿}
+ #183, #184, #187, #191: {â•–â••â•—â”}
convert_vga_to_acs:=$f800+word('k');
- #188, #189, #190, #217: {¼½¾Ù}
+ #188, #189, #190, #217: {â•â•œâ•›â”˜}
convert_vga_to_acs:=$f800+word('j');
- #192, #200, #211, #212: {ÀÈÓÔ}
+ #192, #200, #211, #212: {└╚╙╘}
convert_vga_to_acs:=$f800+word('m');
- #193, #202, #207, #208: {ÁÊÏÐ}
+ #193, #202, #207, #208: {┴╩╧╨}
convert_vga_to_acs:=$f800+word('v');
- #194, #203, #209, #210: {ÂËÑÒ}
+ #194, #203, #209, #210: {┬╦╤╥}
convert_vga_to_acs:=$f800+word('w');
- #195, #198, #199, #204: {ÃÆÇÌ}
+ #195, #198, #199, #204: {├╞╟╠}
convert_vga_to_acs:=$f800+word('t');
- #196, #205: {ÄÍ}
+ #196, #205: {─â•}
convert_vga_to_acs:=$f800+word('q');
- #179, #186: {³º}
+ #179, #186: {│║}
convert_vga_to_acs:=$f800+word('x');
- #197, #206, #215, #216: {ÅÎ×Ø}
+ #197, #206, #215, #216: {┼╬╫╪}
convert_vga_to_acs:=$f800+word('n');
- #201, #213, #214, #218: {ÉÕÖÚ}
+ #201, #213, #214, #218: {╔╒╓┌}
convert_vga_to_acs:=$f800+word('l');
- #254: { þ }
+ #254: { â–  }
convert_vga_to_acs:=word('*');
{ Shadows for Buttons }
- #220 { Ü },
- #223: { ß }
+ #220 { â–„ },
+ #223: { â–€ }
convert_vga_to_acs:=$f800+word('a');
else
convert_vga_to_acs:=word(ch);
@@ -503,19 +485,9 @@ end;
procedure UpdateTTY(Force:boolean);
-type
- tchattr=packed record
-{$ifdef ENDIAN_LITTLE}
- ch : char;
- attr : byte;
-{$else}
- attr : byte;
- ch : char;
-{$endif}
- end;
var
outbuf : array[0..1023+255] of char;
- chattr : tchattr;
+ chattr : tenhancedvideocell;
skipped : boolean;
outptr,
spaces,
@@ -524,160 +496,28 @@ var
LastX,LastY,
SpaceAttr,
LastAttr : longint;
- p,pold : pvideocell;
LastLineWidth : Longint;
+ p,pold : penhancedvideocell;
+ LastCharWasDoubleWidth: Boolean;
+ CurCharWidth: Integer;
- function transform_cp437_to_iso01(const st:string):string;
-
- var i:byte;
- c:char;
- converted:word;
-
- begin
- transform_cp437_to_iso01:='';
- for i:=1 to length(st) do
- begin
- c:=st[i];
- case c of
- #0..#31:
- converted:=convert_lowascii_to_iso01[c];
- #128..#255:
- converted:=convert_cp437_to_iso01[c];
- else
- converted:=byte(c);
- end;
- if converted and $ff00=$f800 then
- begin
- if not in_ACS then
- begin
- transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSIn;
- in_ACS:=true;
- end;
- c:=char(converted and $ff);
- end
- else
- if in_ACS then
- begin
- transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSOut+
- Attr2Ansi(LastAttr,0);
- in_ACS:=false;
- end;
- transform_cp437_to_iso01:=transform_cp437_to_iso01+c;
- end;
- end;
-
- function transform_cp850_to_iso01(const st:string):string;
-
- var i:byte;
- c:char;
- converted:word;
-
+ function transform(const hstr:UnicodeString):RawByteString;
begin
- transform_cp850_to_iso01:='';
- for i:=1 to length(st) do
- begin
- c:=st[i];
- case c of
- #0..#31:
- converted:=convert_lowascii_to_iso01[c];
- #128..#255:
- converted:=convert_cp850_to_iso01[c];
- else
- converted:=byte(c);
- end;
- if converted and $ff00=$f800 then
- begin
- if not in_ACS then
- begin
- transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSIn;
- in_ACS:=true;
- end;
- end
- else
- if in_ACS then
- begin
- transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSOut+
- Attr2Ansi(LastAttr,0);
- in_ACS:=false;
- end;
- c:=char(converted and $ff);
- transform_cp850_to_iso01:=transform_cp850_to_iso01+c;
- end;
+ result:=Utf8Encode(hstr);
+ if external_codepage<>CP_UTF8 then
+ SetCodePage(result,external_codepage,True);
end;
- function transform_linuxlowascii_to_vga(const st:string):string;
-
- var i:byte;
- c:char;
- converted:word;
-
- begin
- transform_linuxlowascii_to_vga:='';
- for i:=1 to length(st) do
- begin
- c:=st[i];
- case c of
- #0..#31:
- converted:=convert_linuxlowascii_to_vga[c];
- else
- converted:=byte(c);
- end;
- c:=char(converted and $ff);
- transform_linuxlowascii_to_vga:=transform_linuxlowascii_to_vga+c;
- end;
- end;
-
- function transform_cp437_to_UTF8(const st:string): string;
- var i:byte;
- c : char;
- converted : WideChar;
- s : WideString;
- begin
- s := '';
- for i:=1 to length(st) do
- begin
- c:=st[i];
- case c of
- #0..#31:
- converted:=convert_lowascii_to_UTF8[c];
- #127..#255:
- converted:=convert_cp437_to_UTF8[c];
- else
- begin
- converted := #0;
- converted := c;
- end;
- end;
- s := s + converted;
- end;
- transform_cp437_to_UTF8 := Utf8Encode(s);
- end;
-
- function transform(const hstr:string):string;
-
- begin
- case convert of
- cv_linuxlowascii_to_vga:
- transform:=transform_linuxlowascii_to_vga(hstr);
- cv_cp437_to_iso01:
- transform:=transform_cp437_to_iso01(hstr);
- cv_cp850_to_iso01:
- transform:=transform_cp850_to_iso01(hstr);
- cv_cp437_to_UTF8:
- transform:=transform_cp437_to_UTF8(hstr);
- else
- transform:=hstr;
- end;
- end;
-
- procedure outdata(hstr:string);
+ procedure outdata(hstr:rawbytestring);
begin
If Length(HStr)>0 Then
Begin
while (eol>0) do
begin
- hstr:=#13#10+hstr;
+ outbuf[outptr]:=#13;
+ outbuf[outptr+1]:=#10;
+ inc(outptr,2);
dec(eol);
end;
{ if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then
@@ -744,8 +584,8 @@ begin
OutPtr:=0;
Eol:=0;
skipped:=true;
- p:=PVideoCell(VideoBuf);
- pold:=PVideoCell(OldVideoBuf);
+ p:=PEnhancedVideoCell(@EnhancedVideoBuf[0]);
+ pold:=PEnhancedVideoCell(@OldEnhancedVideoBuf[0]);
{ init Attr, X,Y and set autowrap off }
SendEscapeSeq(#27'[0;40;37m'#27'[?7l'{#27'[H'} );
// 1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
@@ -759,56 +599,75 @@ begin
LastLineWidth:=ScreenWidth;
If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then
LastLineWidth:=ScreenWidth-2;
+ LastCharWasDoubleWidth:=False;
for x:=1 to LastLineWidth do
begin
- if (not force) and (p^=pold^) then
- begin
- if (Spaces>0) then
- OutSpaces;
- skipped:=true;
- end
+ if LastCharWasDoubleWidth then
+ LastCharWasDoubleWidth:=false
else
- begin
- if skipped then
- begin
- OutData(XY2Ansi(x,y,LastX,LastY));
- LastX:=x;
- LastY:=y;
- skipped:=false;
- end;
- chattr:=tchattr(p^);
-{ if chattr.ch in [#0,#255] then
- chattr.ch:=' ';}
- if chattr.ch=' ' then
- begin
- if Spaces=0 then
- SpaceAttr:=chattr.Attr;
- if (chattr.attr and $f0)=(spaceattr and $f0) then
- chattr.Attr:=SpaceAttr
- else
- begin
- OutSpaces;
- SpaceAttr:=chattr.Attr;
- end;
- inc(Spaces);
- end
- else
- begin
- if (Spaces>0) then
- OutSpaces;
-{ if ord(chattr.ch)<32 then
+ begin
+ CurCharWidth := ExtendedGraphemeClusterDisplayWidth(p^.ExtendedGraphemeCluster);
+ if (not force) and (p^=pold^) and
+ ((CurCharWidth <= 1) or (x=LastLineWidth) or (p[1]=pold[1])) then
+ begin
+ if (Spaces>0) then
+ OutSpaces;
+ skipped:=true;
+ if CurCharWidth = 2 then
+ LastCharWasDoubleWidth:=true;
+ end
+ else
+ begin
+ if skipped then
begin
- Chattr.Attr:= $ff xor Chattr.Attr;
- ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
- end;}
- if LastAttr<>chattr.Attr then
- OutClr(chattr.Attr);
- OutData(transform(chattr.ch));
- LastX:=x+1;
- LastY:=y;
- end;
- p^:=tvideocell(chattr);
- end;
+ OutData(XY2Ansi(x,y,LastX,LastY));
+ LastX:=x;
+ LastY:=y;
+ skipped:=false;
+ end;
+ chattr:=p^;
+ { if chattr.ch in [#0,#255] then
+ chattr.ch:=' ';}
+ if chattr.ExtendedGraphemeCluster=' ' then
+ begin
+ if Spaces=0 then
+ SpaceAttr:=chattr.Attribute;
+ if (chattr.Attribute and $f0)=(spaceattr and $f0) then
+ chattr.Attribute:=SpaceAttr
+ else
+ begin
+ OutSpaces;
+ SpaceAttr:=chattr.Attribute;
+ end;
+ inc(Spaces);
+ end
+ else
+ begin
+ if (Spaces>0) then
+ OutSpaces;
+ { if ord(chattr.ch)<32 then
+ begin
+ Chattr.Attr:= $ff xor Chattr.Attr;
+ ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
+ end;}
+ if LastAttr<>chattr.Attribute then
+ OutClr(chattr.Attribute);
+ OutData(transform(chattr.ExtendedGraphemeCluster));
+ if CurCharWidth=2 then
+ begin
+ LastX:=x+2;
+ LastCharWasDoubleWidth:=True;
+ end
+ else
+ begin
+ LastX:=x+1;
+ LastCharWasDoubleWidth:=False;
+ end;
+ LastY:=y;
+ end;
+ //p^:=chattr;
+ end;
+ end;
inc(p);
inc(pold);
end;
@@ -821,24 +680,24 @@ begin
end;
eol:=0;
{if am in capabilities? Then}
- if (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
+ if (Console=ttyFreeBSD) and (p^<>pold^) Then
begin
OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY));
OutData(#8);
{Output last char}
- chattr:=tchattr(p[1]);
- if LastAttr<>chattr.Attr then
- OutClr(chattr.Attr);
- OutData(transform(chattr.ch));
+ chattr:=p[1];
+ if LastAttr<>chattr.Attribute then
+ OutClr(chattr.Attribute);
+ OutData(transform(chattr.ExtendedGraphemeCluster));
inc(LastX);
// OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
// OutData(GetTermString(Insert_character));
OutData(#8+#27+'[1@');
- chattr:=tchattr(p^);
- if LastAttr<>chattr.Attr then
- OutClr(chattr.Attr);
- OutData(transform(chattr.ch));
+ chattr:=p^;
+ if LastAttr<>chattr.Attribute then
+ OutClr(chattr.Attribute);
+ OutData(transform(chattr.ExtendedGraphemeCluster));
inc(LastX);
end;
OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY));
@@ -958,58 +817,37 @@ begin
TCSetAttr(1,TCSANOW,tio);
end;
-function UTF8Enabled: Boolean;
-var
- lang:string;
-begin
- {$ifdef BEOS}
- UTF8Enabled := true;
- exit;
- {$endif}
- lang:=upcase(fpgetenv('LANG'));
- UTF8Enabled := (Pos('.UTF-8', lang) > 0) or (Pos('.UTF8', lang) > 0);
-end;
-
procedure decide_codepages;
var s:string;
begin
- if external_codepage in vga_codepages then
+ if is_vga_code_page(external_codepage) then
begin
{Possible override...}
s:=upcase(fpgetenv('CONSOLEFONT_CP'));
if s='CP437' then
- external_codepage:=cp437
+ external_codepage:=437
else if s='CP850' then
- external_codepage:=cp850;
+ external_codepage:=850;
end;
{A non-vcsa Linux console can display most control characters, but not all.}
- if {$ifdef linux}(console<>ttyLinux) and{$endif}
- (cur_term_strings=@term_codes_linux) then
- convert:=cv_linuxlowascii_to_vga;
case external_codepage of
- iso01: {West Europe}
- begin
- internal_codepage:=cp850;
- convert:=cv_cp850_to_iso01;
- end;
- iso02: {East Europe}
- internal_codepage:=cp852;
- iso05: {Cyrillic}
- internal_codepage:=cp866;
- utf8:
- begin
- internal_codepage:=cp437;
- convert:=cv_cp437_to_UTF8;
- end;
+ CP_ISO01: {West Europe}
+ CurrentLegacy2EnhancedTranslationCodePage:=850;
+ CP_ISO02: {East Europe}
+ CurrentLegacy2EnhancedTranslationCodePage:=852;
+ CP_ISO05: {Cyrillic}
+ CurrentLegacy2EnhancedTranslationCodePage:=866;
+ CP_UTF8:
+ CurrentLegacy2EnhancedTranslationCodePage:=437;
else
- if internal_codepage in vga_codepages then
- internal_codepage:=external_codepage
+ if is_vga_code_page(external_codepage) then
+ CurrentLegacy2EnhancedTranslationCodePage:=external_codepage
else
{We don't know how to convert to the external codepage. Use codepage
437 in the hope that the actual font has similarity to codepage 437.}
- internal_codepage:=cp437;
+ CurrentLegacy2EnhancedTranslationCodePage:=437;
end;
end;
@@ -1074,11 +912,11 @@ begin
{$endif linux}
Console:=TTyNetwork; {Default: Network or other vtxxx tty}
cur_term_strings:=@term_codes_vt100; {Default: vt100}
- external_codepage:=iso01; {Default: ISO-8859-1}
+ external_codepage:=CP_ISO01; {Default: ISO-8859-1}
if UTF8Enabled then
- external_codepage:=utf8;
+ external_codepage:=CP_UTF8;
{$ifdef linux}
- if (vcs_device>=0) and (external_codepage<>utf8) then
+ if (vcs_device>=0) and (external_codepage<>CP_UTF8) then
begin
str(vcs_device,s);
fname:='/dev/vcsa'+s;
@@ -1087,7 +925,7 @@ begin
if ttyfd<>-1 then
begin
console:=ttylinux;
- external_codepage:=cp437; {VCSA defaults to codepage 437.}
+ external_codepage:=437; {VCSA defaults to codepage 437.}
end
else
if try_grab_vcsa then
@@ -1096,7 +934,7 @@ begin
if ttyfd<>-1 then
begin
console:=ttylinux;
- external_codepage:=cp437; {VCSA defaults to codepage 437.}
+ external_codepage:=437; {VCSA defaults to codepage 437.}
end;
end;
end;
@@ -1142,16 +980,16 @@ begin
{$endif}
if cur_term_strings=@term_codes_linux then
begin
- if external_codepage<>utf8 then
+ if external_codepage<>CP_UTF8 then
begin
{Enable the VGA character set (codepage 437,850,....)}
fpwrite(stdoutputhandle,font_vga,sizeof(font_vga));
- external_codepage:=cp437; {Now default to codepage 437.}
+ external_codepage:=437; {Now default to codepage 437.}
end;
end
else
begin
- if external_codepage<>utf8 then
+ if external_codepage<>CP_UTF8 then
begin
{No VGA font :( }
fpwrite(stdoutputhandle,font_lat1,sizeof(font_lat1));
@@ -1244,7 +1082,7 @@ begin
{ if we're in utf8 mode, we didn't change the font, so
no need to restore anything }
- if external_codepage<>utf8 then
+ if external_codepage<>CP_UTF8 then
begin
{Enable the character set set through setfont}
fpwrite(stdoutputhandle,font_custom,3);
@@ -1279,6 +1117,8 @@ end;
procedure SysUpdateScreen(Force: Boolean);
+var
+ I: Integer;
begin
{$ifdef linux}
if console=ttylinux then
@@ -1286,7 +1126,8 @@ begin
else
{$endif}
updateTTY(force);
- move(VideoBuf^,OldVideoBuf^,VideoBufSize);
+ for I := Low(EnhancedVideoBuf) to High(EnhancedVideoBuf) do
+ OldEnhancedVideoBuf[I] := EnhancedVideoBuf[I];
end;
@@ -1364,7 +1205,8 @@ end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
+ InitDriver : nil;
+ InitEnhancedDriver: @SysInitVideo;
DoneDriver : @SysDoneVideo;
UpdateScreen : @SysUpdateScreen;
ClearScreen : @SysClearScreen;
@@ -1375,6 +1217,10 @@ Const
GetCursorType : @SysGetCursorType;
SetCursorType : @SysSetCursorType;
GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
initialization
diff --git a/packages/rtl-console/src/win/keyboard.pp b/packages/rtl-console/src/win/keyboard.pp
index 03f1cc7115..403dbebea2 100644
--- a/packages/rtl-console/src/win/keyboard.pp
+++ b/packages/rtl-console/src/win/keyboard.pp
@@ -47,8 +47,13 @@ uses
const MaxQueueSize = 120;
FrenchKeyboard = $040C040C;
+type
+ TFPKeyEventRecord = record
+ ev: TKeyEventRecord;
+ ShiftState: TEnhancedShiftState;
+ end;
var
- keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
+ keyboardeventqueue : array[0..maxqueuesize] of TFPKeyEventRecord;
nextkeyevent,nextfreekeyevent : longint;
newKeyEvent : THandle; {sinaled if key is available}
lockVar : TCriticalSection; {for queue access}
@@ -90,7 +95,7 @@ end;
{ gets or peeks the next key from the queue, does not wait for new keys }
-function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
+function getKeyEventFromQueue (VAR t : TFPKeyEventRecord; Peek : boolean) : boolean;
begin
if not Inited then
begin
@@ -114,7 +119,7 @@ end;
{ gets the next key from the queue, does wait for new keys }
-function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
+function getKeyEventFromQueueWait (VAR t : TFPKeyEventRecord) : boolean;
begin
if not Inited then
begin
@@ -144,16 +149,122 @@ begin
transShiftState := b;
end;
+procedure UpdateKeyboardLayoutInfo(Force: Boolean);
+var
+ NewKeyboardLayout: HKL;
+
+ procedure CheckAltGr;
+ var i: integer;
+ begin
+ HasAltGr:=false;
+
+ i:=$20;
+ while i<$100 do
+ begin
+ // <MSDN>
+ // For keyboard layouts that use the right-hand ALT key as a shift key
+ // (for example, the French keyboard layout), the shift state is
+ // represented by the value 6, because the right-hand ALT key is
+ // converted internally into CTRL+ALT.
+ // </MSDN>
+ if (HIBYTE(VkKeyScanEx(chr(i),KeyBoardLayout))=6) then
+ begin
+ HasAltGr:=true;
+ break;
+ end;
+ inc(i);
+ end;
+ end;
+
+begin
+ NewKeyBoardLayout:=GetKeyboardLayout(0);
+ if force or (NewKeyboardLayout <> KeyBoardLayout) then
+ begin
+ KeyBoardLayout:=NewKeyboardLayout;
+ CheckAltGr;
+ end;
+end;
+
{ The event-Handler thread from the unit event will call us if a key-event
is available }
procedure HandleKeyboard(var ir:INPUT_RECORD);
+
+ { translate win32 shift-state to keyboard shift state }
+ function transEnhShiftState (ControlKeyState : dword) : TEnhancedShiftState;
+ var b : TEnhancedShiftState;
+ begin
+ b := [];
+ { Ctrl + Right Alt = AltGr }
+ if HasAltGr and (ControlKeyState and RIGHT_ALT_PRESSED <> 0) and
+ ((ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
+ (ControlKeyState and RIGHT_CTRL_PRESSED <> 0)) then
+ begin
+ Include(b, essAltGr);
+ { if it's the right ctrl key, then we know it's RightCtrl+AltGr }
+ if ControlKeyState and RIGHT_CTRL_PRESSED <> 0 then
+ b:=b+[essCtrl,essRightCtrl];
+ { if it's the left ctrl key, unfortunately, we can't distinguish between
+ LeftCtrl+AltGr and AltGr alone, so we assume AltGr only }
+ end
+ else
+ begin
+ if ControlKeyState and LEFT_CTRL_PRESSED <> 0 then
+ b:=b+[essCtrl,essLeftCtrl];
+ if ControlKeyState and RIGHT_ALT_PRESSED <> 0 then
+ b:=b+[essAlt,essRightAlt];
+ if ControlKeyState and RIGHT_CTRL_PRESSED <> 0 then
+ b:=b+[essCtrl,essRightCtrl];
+ end;
+ if ControlKeyState and LEFT_ALT_PRESSED <> 0 then
+ b:=b+[essAlt,essLeftAlt];
+ if ControlKeyState and SHIFT_PRESSED <> 0 then { win32 makes no difference between left and right shift }
+ Include(b,essShift);
+ if ControlKeyState and NUMLOCK_ON <> 0 then
+ Include(b,essNumLockOn);
+ if ControlKeyState and CAPSLOCK_ON <> 0 then
+ Include(b,essCapsLockOn);
+ if ControlKeyState and SCROLLLOCK_ON <> 0 then
+ Include(b,essScrollLockOn);
+ if (GetKeyState(VK_LSHIFT) and $8000) <> 0 then
+ b:=b+[essShift,essLeftShift];
+ if (GetKeyState(VK_RSHIFT) and $8000) <> 0 then
+ b:=b+[essShift,essRightShift];
+ if (GetKeyState(VK_NUMLOCK) and $8000) <> 0 then
+ Include(b,essNumLockPressed);
+ if (GetKeyState(VK_CAPITAL) and $8000) <> 0 then
+ Include(b,essCapsLockPressed);
+ if (GetKeyState(VK_SCROLL) and $8000) <> 0 then
+ Include(b,essScrollLockPressed);
+ transEnhShiftState := b;
+ end;
+
var
i : longint;
c : word;
altc : char;
addThis: boolean;
begin
+ { Since Windows supports switching between different input locales, the
+ current input locale might change, while the app is still running. In
+ fact, this is the default configuration for languages, that use a Non
+ Latin script (e.g. Cyrillic, Greek, etc.) - they use this feature to
+ switch between Latin and the Non Latin layout. But Windows in general
+ can be configured to switch between any number of different keyboard
+ layouts, so it's not a feature, limited only to Non Latin scripts.
+
+ GUI apps get an WM_INPUTLANGCHANGE message in the case the keyboard layout
+ changes, but unfortunately, console apps get no such notification. Therefore
+ we must check and update our idea of the current keyboard layout on every
+ key event we receive. :(
+
+ Note: This doesn't actually work, due to this Windows bug:
+ https://github.com/Microsoft/console/issues/83
+ Since Microsoft considers this an open bug, and since there's no known
+ workaround, we still poll the keyboard layout, in hope that some day
+ Microsoft might fix this and issue a Windows Update. }
+ UpdateKeyboardLayoutInfo(False);
+
with ir.Event.KeyEvent do
begin
{ key up events are ignored (except alt) }
@@ -203,8 +314,10 @@ begin
end;
if addThis then
begin
- keyboardeventqueue[nextfreekeyevent]:=
+ keyboardeventqueue[nextfreekeyevent].ev:=
ir.Event.KeyEvent;
+ keyboardeventqueue[nextfreekeyevent].ShiftState:=
+ transEnhShiftState(dwControlKeyState);
incqueueindex(nextfreekeyevent);
end;
end;
@@ -228,10 +341,11 @@ begin
begin {add to queue}
fillchar (ir, sizeof (ir), 0);
bKeyDown := true;
- AsciiChar := char (c);
+ UnicodeChar := WideChar (c);
{and add to queue}
EnterCriticalSection (lockVar);
- keyboardeventqueue[nextfreekeyevent]:=ir.Event.KeyEvent;
+ keyboardeventqueue[nextfreekeyevent].ev:=ir.Event.KeyEvent;
+ keyboardeventqueue[nextfreekeyevent].ShiftState:=transEnhShiftState(dwControlKeyState);
incqueueindex(nextfreekeyevent);
SetEvent (newKeyEvent); {event that a new key is available}
LeaveCriticalSection (lockVar);
@@ -245,39 +359,12 @@ begin
end;
end;
-procedure CheckAltGr;
-
-var ahkl : HKL;
- i : integer;
-
- begin
- HasAltGr:=false;
-
- ahkl:=GetKeyboardLayout(0);
- i:=$20;
- while i<$100 do
- begin
- // <MSDN>
- // For keyboard layouts that use the right-hand ALT key as ashift key
- // (for example, the French keyboard layout), the shift state is
- // represented by the value 6, because the right-hand ALT key is
- // converted internally into CTRL+ALT.
- // </MSDN>
- if (HIBYTE(VkKeyScanEx(chr(i),ahkl))=6) then
- begin
- HasAltGr:=true;
- break;
- end;
- inc(i);
- end;
-end;
-
procedure SysInitKeyboard;
begin
- KeyBoardLayout:=GetKeyboardLayout(0);
+ UpdateKeyboardLayoutInfo(True);
lastShiftState := 0;
FlushConsoleInputBuffer(StdInputHandle);
newKeyEvent := CreateEvent (nil, // address of security attributes
@@ -295,7 +382,6 @@ begin
nextkeyevent:=0;
nextfreekeyevent:=0;
- checkaltgr;
SetKeyboardEventHandler (@HandleKeyboard);
Inited:=true;
end;
@@ -641,52 +727,119 @@ CONST
(n : $00; s : $0F; c : $94; a: $00)); {0F Tab }
-function TranslateKey (t : TKeyEventRecord) : TKeyEvent;
-var key : TKeyEvent;
- ss : byte;
+function WideCharToOemCpChar(WC: WideChar): Char;
+var
+ Res: Char;
+begin
+ if WideCharToMultiByte(CP_OEMCP,0,@WC,1,@Res,1,nil,nil)=0 then
+ Res:=#0;
+ WideCharToOemCpChar:=Res;
+end;
+
+
+function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+begin
+ if KeyEvent and $03000000 = $03000000 then
+ begin
+ if KeyEvent and $000000FF <> 0 then
+ begin
+ SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
+ exit;
+ end;
+ {translate function-keys and other specials, ascii-codes are already ok}
+ case (KeyEvent AND $0000FF00) shr 8 of
+ {F1..F10}
+ $3B..$44 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
+ {F11,F12}
+ $85..$86 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
+ {Shift F1..F10}
+ $54..$5D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
+ {Shift F11,F12}
+ $87..$88 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
+ {Alt F1..F10}
+ $68..$71 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
+ {Alt F11,F12}
+ $8B..$8C : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
+ {Ctrl F1..F10}
+ $5E..$67 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
+ {Ctrl F11,F12}
+ $89..$8A : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
+
+ {normal,ctrl,alt}
+ $47,$77,$97 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
+ $48,$8D,$98 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
+ $49,$84,$99 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
+ $4b,$73,$9B : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
+ $4d,$74,$9D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
+ $4f,$75,$9F : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
+ $50,$91,$A0 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
+ $51,$76,$A1 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
+ $52,$92,$A2 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
+ $53,$93,$A3 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
+ else
+ SysTranslateKeyEvent := KeyEvent;
+ end;
+ end else
+ SysTranslateKeyEvent := KeyEvent;
+end;
+
+
+function SysGetShiftState: Byte;
+
+begin
+ {may be better to save the last state and return that if no key is in buffer???}
+ SysGetShiftState:= lastShiftState;
+end;
+
+
+function TranslateEnhancedKeyEvent (t : TFPKeyEventRecord) : TEnhancedKeyEvent;
+var key : TEnhancedKeyEvent;
{$ifdef USEKEYCODES}
ScanCode : byte;
{$endif USEKEYCODES}
b : byte;
begin
- Key := 0;
- if t.bKeyDown then
+ Key := NilEnhancedKeyEvent;
+ if t.ev.bKeyDown then
begin
- { ascii-char is <> 0 if not a specal key }
+ { unicode-char is <> 0 if not a specal key }
{ we return it here otherwise we have to translate more later }
- if t.AsciiChar <> #0 then
+ if t.ev.UnicodeChar <> WideChar(0) then
begin
- if (t.dwControlKeyState and ENHANCED_KEY <> 0) and
- (t.wVirtualKeyCode = $DF) then
+ if (t.ev.dwControlKeyState and ENHANCED_KEY <> 0) and
+ (t.ev.wVirtualKeyCode = $DF) then
begin
- t.dwControlKeyState:=t.dwControlKeyState and not ENHANCED_KEY;
- t.wVirtualKeyCode:=VK_DIVIDE;
- t.AsciiChar:='/';
+ t.ev.dwControlKeyState:=t.ev.dwControlKeyState and not ENHANCED_KEY;
+ t.ev.wVirtualKeyCode:=VK_DIVIDE;
+ t.ev.UnicodeChar:='/';
end;
{drivers needs scancode, we return it here as under dos and linux
with $03000000 = the lowest two bytes is the physical representation}
{$ifdef USEKEYCODES}
- Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+ Scancode:=KeyToQwertyScan[t.ev.wVirtualKeyCode AND $00FF];
If ScanCode>0 then
- t.wVirtualScanCode:=ScanCode;
- Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
- ss := transShiftState (t.dwControlKeyState);
- key := key or (ss shl 16);
- if (ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState) then
- key := key and $FFFFFF00;
+ t.ev.wVirtualScanCode:=ScanCode;
+ Key.UnicodeChar := t.ev.UnicodeChar;
+ Key.AsciiChar := WideCharToOemCpChar(t.ev.UnicodeChar);
+ Key.VirtualScanCode := byte (Key.AsciiChar) + (t.ev.wVirtualScanCode shl 8);
+ Key.ShiftState := t.ShiftState;
+ if essAlt in t.ShiftState then
+ Key.VirtualScanCode := Key.VirtualScanCode and $FF00;
{$else not USEKEYCODES}
- Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
+ Key.UnicodeChar := t.ev.UnicodeChar;
+ Key.AsciiChar := WideCharToOemCpChar(t.ev.UnicodeChar);
+ Key.VirtualScanCode := byte (Key.AsciiChar) + ((t.ev.wVirtualScanCode AND $00FF) shl 8);
{$endif not USEKEYCODES}
end else
begin
{$ifdef USEKEYCODES}
- Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+ Scancode:=KeyToQwertyScan[t.ev.wVirtualKeyCode AND $00FF];
If ScanCode>0 then
- t.wVirtualScanCode:=ScanCode;
+ t.ev.wVirtualScanCode:=ScanCode;
{$endif not USEKEYCODES}
- translateKey := 0;
+ TranslateEnhancedKeyEvent := NilEnhancedKeyEvent;
{ ignore shift,ctrl,alt,numlock,capslock alone }
- case t.wVirtualKeyCode of
+ case t.ev.wVirtualKeyCode of
$0010, {shift}
$0011, {ctrl}
$0012, {alt}
@@ -701,181 +854,124 @@ begin
$00DD: exit; {´ and ` : next key i.e. e is modified }
end;
- key := $03000000 + (t.wVirtualScanCode shl 8); { make lower 8 bit=0 like under dos }
+ Key.VirtualScanCode := t.ev.wVirtualScanCode shl 8; { make lower 8 bit=0 like under dos }
end;
{ Handling of ~ key as AltGr 2 }
{ This is also French keyboard specific !! }
{ but without this I can not get a ~ !! PM }
{ MvdV: not rightruealtised, since it already has frenchkbd guard}
- if (t.wVirtualKeyCode=$32) and
+ if (t.ev.wVirtualKeyCode=$32) and
(KeyBoardLayout = FrenchKeyboard) and
- (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
- key:=(key and $ffffff00) or ord('~');
+ (t.ev.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
+ begin
+ Key.UnicodeChar := '~';
+ Key.AsciiChar := '~';
+ Key.VirtualScanCode := (Key.VirtualScanCode and $ff00) or ord('~');
+ end;
{ ok, now add Shift-State }
- ss := transShiftState (t.dwControlKeyState);
- key := key or (ss shl 16);
+ Key.ShiftState := t.ShiftState;
{ Reset Ascii-Char if Alt+Key, fv needs that, may be we
need it for other special keys too
18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
- if ((ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState)) or
+ if (essAlt in t.ShiftState) or
(*
{ yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
{aggg, this will not work because esc is also virtualKeyCode 27!!}
- {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
+ {if (t.ev.wVirtualKeyCode >= 25) and (t.ev.wVirtualKeyCode <= 28) then}
no VK_ESCAPE is $1B !!
there was a mistake :
VK_LEFT is $25 not 25 !! *)
{ not $2E VK_DELETE because its only the Keypad point !! PM }
- (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
- { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
- key := key and $FFFFFF00;
+ (t.ev.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
+ { if t.ev.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
+ Key.VirtualScanCode := Key.VirtualScanCode and $FF00;
{and translate to dos-scancodes to make fv happy, we will convert this
back in translateKeyEvent}
- if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
- if (t.wVirtualScanCode >= low (DosTT)) and
- (t.wVirtualScanCode <= high (dosTT)) then
- begin
- b := 0;
- if (ss and kbAlt) <> 0 then
- b := DosTT[t.wVirtualScanCode].a
- else
- if (ss and kbCtrl) <> 0 then
- b := DosTT[t.wVirtualScanCode].c
- else
- if (ss and kbShift) <> 0 then
- b := DosTT[t.wVirtualScanCode].s
- else
- b := DosTT[t.wVirtualScanCode].n;
- if b <> 0 then
- key := (key and $FFFF00FF) or (cardinal (b) shl 8);
- end;
+ if (t.ev.wVirtualScanCode >= low (DosTT)) and
+ (t.ev.wVirtualScanCode <= high (dosTT)) then
+ begin
+ b := 0;
+ if essAlt in t.ShiftState then
+ b := DosTT[t.ev.wVirtualScanCode].a
+ else
+ if essCtrl in t.ShiftState then
+ b := DosTT[t.ev.wVirtualScanCode].c
+ else
+ if essShift in t.ShiftState then
+ b := DosTT[t.ev.wVirtualScanCode].s
+ else
+ b := DosTT[t.ev.wVirtualScanCode].n;
+ if b <> 0 then
+ Key.VirtualScanCode := (Key.VirtualScanCode and $00FF) or (cardinal (b) shl 8);
+ end;
- {Alt-0 to Alt-9}
- if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
- if (t.wVirtualScanCode >= low (DosTT09)) and
- (t.wVirtualScanCode <= high (dosTT09)) then
- begin
- b := 0;
- if (ss and kbAlt) <> 0 then
- b := DosTT09[t.wVirtualScanCode].a
- else
- if (ss and kbCtrl) <> 0 then
- b := DosTT09[t.wVirtualScanCode].c
- else
- if (ss and kbShift) <> 0 then
- b := DosTT09[t.wVirtualScanCode].s
- else
- b := DosTT09[t.wVirtualScanCode].n;
- if b <> 0 then
- key := (key and $FFFF0000) or (cardinal (b) shl 8);
- end;
-
- TranslateKey := key;
+ {Alt-0 to Alt-9}
+ if (t.ev.wVirtualScanCode >= low (DosTT09)) and
+ (t.ev.wVirtualScanCode <= high (dosTT09)) then
+ begin
+ b := 0;
+ if essAlt in t.ShiftState then
+ b := DosTT09[t.ev.wVirtualScanCode].a
+ else
+ if essCtrl in t.ShiftState then
+ b := DosTT09[t.ev.wVirtualScanCode].c
+ else
+ if essShift in t.ShiftState then
+ b := DosTT09[t.ev.wVirtualScanCode].s
+ else
+ b := DosTT09[t.ev.wVirtualScanCode].n;
+ if b <> 0 then
+ Key.VirtualScanCode := cardinal (b) shl 8;
+ end;
end;
- translateKey := Key;
+ TranslateEnhancedKeyEvent := Key;
end;
-function SysGetKeyEvent: TKeyEvent;
-var t : TKeyEventRecord;
- key : TKeyEvent;
+function SysGetEnhancedKeyEvent: TEnhancedKeyEvent;
+var t : TFPKeyEventRecord;
+ key : TEnhancedKeyEvent;
begin
- key := 0;
+ key := NilEnhancedKeyEvent;
repeat
if getKeyEventFromQueueWait (t) then
- key := translateKey (t);
- until key <> 0;
-{$ifdef DEBUG}
- last_ir.Event.KeyEvent:=t;
-{$endif DEBUG}
- SysGetKeyEvent := key;
+ key := TranslateEnhancedKeyEvent (t);
+ until key <> NilEnhancedKeyEvent;
+ SysGetEnhancedKeyEvent := key;
end;
-function SysPollKeyEvent: TKeyEvent;
-var t : TKeyEventRecord;
- k : TKeyEvent;
+function SysPollEnhancedKeyEvent: TEnhancedKeyEvent;
+var t : TFPKeyEventRecord;
+ k : TEnhancedKeyEvent;
begin
- SysPollKeyEvent := 0;
+ SysPollEnhancedKeyEvent := NilEnhancedKeyEvent;
if getKeyEventFromQueue (t, true) then
begin
{ we get an enty for shift, ctrl, alt... }
- k := translateKey (t);
- while (k = 0) do
+ k := TranslateEnhancedKeyEvent (t);
+ while (k = NilEnhancedKeyEvent) do
begin
getKeyEventFromQueue (t, false); {remove it}
if not getKeyEventFromQueue (t, true) then exit;
- k := translateKey (t)
+ k := TranslateEnhancedKeyEvent (t)
end;
- SysPollKeyEvent := k;
+ SysPollEnhancedKeyEvent := k;
end;
end;
-
-function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
-begin
- if KeyEvent and $03000000 = $03000000 then
- begin
- if KeyEvent and $000000FF <> 0 then
- begin
- SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
- exit;
- end;
- {translate function-keys and other specials, ascii-codes are already ok}
- case (KeyEvent AND $0000FF00) shr 8 of
- {F1..F10}
- $3B..$44 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
- {F11,F12}
- $85..$86 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
- {Shift F1..F10}
- $54..$5D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
- {Shift F11,F12}
- $87..$88 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
- {Alt F1..F10}
- $68..$71 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
- {Alt F11,F12}
- $8B..$8C : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
- {Ctrl F1..F10}
- $5E..$67 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
- {Ctrl F11,F12}
- $89..$8A : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
-
- {normal,ctrl,alt}
- $47,$77,$97 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
- $48,$8D,$98 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
- $49,$84,$99 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
- $4b,$73,$9B : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
- $4d,$74,$9D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
- $4f,$75,$9F : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
- $50,$91,$A0 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
- $51,$76,$A1 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
- $52,$92,$A2 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
- $53,$93,$A3 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
- else
- SysTranslateKeyEvent := KeyEvent;
- end;
- end else
- SysTranslateKeyEvent := KeyEvent;
-end;
-
-
-function SysGetShiftState: Byte;
-
-begin
- {may be better to save the last state and return that if no key is in buffer???}
- SysGetShiftState:= lastShiftState;
-end;
-
Const
SysKeyboardDriver : TKeyboardDriver = (
InitDriver : @SysInitKeyBoard;
DoneDriver : @SysDoneKeyBoard;
- GetKeyevent : @SysGetKeyEvent;
- PollKeyEvent : @SysPollKeyEvent;
+ GetKeyevent : Nil;
+ PollKeyEvent : Nil;
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : @SysTranslateKeyEvent;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : @SysGetEnhancedKeyEvent;
+ PollEnhancedKeyEvent : @SysPollEnhancedKeyEvent;
);
diff --git a/packages/rtl-console/src/win/video.pp b/packages/rtl-console/src/win/video.pp
index 7a60ffbb12..577219f5a0 100644
--- a/packages/rtl-console/src/win/video.pp
+++ b/packages/rtl-console/src/win/video.pp
@@ -17,291 +17,16 @@ unit Video;
interface
{$i videoh.inc}
-const
- useunicodefunctions : boolean = false;
-
procedure VideoSetConsoleOutHandle (NewHandle: THandle);
implementation
uses
- windows,dos;
+ windows,dos,graphemebreakproperty,eastasianwidth,charset;
{$i video.inc}
- type
- tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
- umf_unused);
-
- punicodecharmapping = ^tunicodecharmapping;
- tunicodecharmapping = record
- unicode : word;
- flag : tunicodecharmappingflag;
- reserved : byte;
- end;
-
- const
- mapcp850 : array[0..255] of tunicodecharmapping = (
- (unicode : 0; flag : umf_noinfo; reserved : 0),
- (unicode : 1; flag : umf_noinfo; reserved : 0),
- (unicode : 2; flag : umf_noinfo; reserved : 0),
- (unicode : 3; flag : umf_noinfo; reserved : 0),
- (unicode : 4; flag : umf_noinfo; reserved : 0),
- (unicode : 5; flag : umf_noinfo; reserved : 0),
- (unicode : 6; flag : umf_noinfo; reserved : 0),
- (unicode : 7; flag : umf_noinfo; reserved : 0),
- (unicode : 8; flag : umf_noinfo; reserved : 0),
- (unicode : 9; flag : umf_noinfo; reserved : 0),
- (unicode : 10; flag : umf_noinfo; reserved : 0),
- (unicode : 11; flag : umf_noinfo; reserved : 0),
- (unicode : 12; flag : umf_noinfo; reserved : 0),
- (unicode : 13; flag : umf_noinfo; reserved : 0),
- (unicode : 14; flag : umf_noinfo; reserved : 0),
- (unicode : 15; flag : umf_noinfo; reserved : 0),
- (unicode : 16; flag : umf_noinfo; reserved : 0),
- (unicode : 17; flag : umf_noinfo; reserved : 0),
- (unicode : 18; flag : umf_noinfo; reserved : 0),
- (unicode : 19; flag : umf_noinfo; reserved : 0),
- (unicode : 20; flag : umf_noinfo; reserved : 0),
- (unicode : 21; flag : umf_noinfo; reserved : 0),
- (unicode : 22; flag : umf_noinfo; reserved : 0),
- (unicode : 23; flag : umf_noinfo; reserved : 0),
- (unicode : 24; flag : umf_noinfo; reserved : 0),
- (unicode : 25; flag : umf_noinfo; reserved : 0),
- (unicode : 26; flag : umf_noinfo; reserved : 0),
- (unicode : 27; flag : umf_noinfo; reserved : 0),
- (unicode : 28; flag : umf_noinfo; reserved : 0),
- (unicode : 29; flag : umf_noinfo; reserved : 0),
- (unicode : 30; flag : umf_noinfo; reserved : 0),
- (unicode : 31; flag : umf_noinfo; reserved : 0),
- (unicode : 32; flag : umf_noinfo; reserved : 0),
- (unicode : 33; flag : umf_noinfo; reserved : 0),
- (unicode : 34; flag : umf_noinfo; reserved : 0),
- (unicode : 35; flag : umf_noinfo; reserved : 0),
- (unicode : 36; flag : umf_noinfo; reserved : 0),
- (unicode : 37; flag : umf_noinfo; reserved : 0),
- (unicode : 38; flag : umf_noinfo; reserved : 0),
- (unicode : 39; flag : umf_noinfo; reserved : 0),
- (unicode : 40; flag : umf_noinfo; reserved : 0),
- (unicode : 41; flag : umf_noinfo; reserved : 0),
- (unicode : 42; flag : umf_noinfo; reserved : 0),
- (unicode : 43; flag : umf_noinfo; reserved : 0),
- (unicode : 44; flag : umf_noinfo; reserved : 0),
- (unicode : 45; flag : umf_noinfo; reserved : 0),
- (unicode : 46; flag : umf_noinfo; reserved : 0),
- (unicode : 47; flag : umf_noinfo; reserved : 0),
- (unicode : 48; flag : umf_noinfo; reserved : 0),
- (unicode : 49; flag : umf_noinfo; reserved : 0),
- (unicode : 50; flag : umf_noinfo; reserved : 0),
- (unicode : 51; flag : umf_noinfo; reserved : 0),
- (unicode : 52; flag : umf_noinfo; reserved : 0),
- (unicode : 53; flag : umf_noinfo; reserved : 0),
- (unicode : 54; flag : umf_noinfo; reserved : 0),
- (unicode : 55; flag : umf_noinfo; reserved : 0),
- (unicode : 56; flag : umf_noinfo; reserved : 0),
- (unicode : 57; flag : umf_noinfo; reserved : 0),
- (unicode : 58; flag : umf_noinfo; reserved : 0),
- (unicode : 59; flag : umf_noinfo; reserved : 0),
- (unicode : 60; flag : umf_noinfo; reserved : 0),
- (unicode : 61; flag : umf_noinfo; reserved : 0),
- (unicode : 62; flag : umf_noinfo; reserved : 0),
- (unicode : 63; flag : umf_noinfo; reserved : 0),
- (unicode : 64; flag : umf_noinfo; reserved : 0),
- (unicode : 65; flag : umf_noinfo; reserved : 0),
- (unicode : 66; flag : umf_noinfo; reserved : 0),
- (unicode : 67; flag : umf_noinfo; reserved : 0),
- (unicode : 68; flag : umf_noinfo; reserved : 0),
- (unicode : 69; flag : umf_noinfo; reserved : 0),
- (unicode : 70; flag : umf_noinfo; reserved : 0),
- (unicode : 71; flag : umf_noinfo; reserved : 0),
- (unicode : 72; flag : umf_noinfo; reserved : 0),
- (unicode : 73; flag : umf_noinfo; reserved : 0),
- (unicode : 74; flag : umf_noinfo; reserved : 0),
- (unicode : 75; flag : umf_noinfo; reserved : 0),
- (unicode : 76; flag : umf_noinfo; reserved : 0),
- (unicode : 77; flag : umf_noinfo; reserved : 0),
- (unicode : 78; flag : umf_noinfo; reserved : 0),
- (unicode : 79; flag : umf_noinfo; reserved : 0),
- (unicode : 80; flag : umf_noinfo; reserved : 0),
- (unicode : 81; flag : umf_noinfo; reserved : 0),
- (unicode : 82; flag : umf_noinfo; reserved : 0),
- (unicode : 83; flag : umf_noinfo; reserved : 0),
- (unicode : 84; flag : umf_noinfo; reserved : 0),
- (unicode : 85; flag : umf_noinfo; reserved : 0),
- (unicode : 86; flag : umf_noinfo; reserved : 0),
- (unicode : 87; flag : umf_noinfo; reserved : 0),
- (unicode : 88; flag : umf_noinfo; reserved : 0),
- (unicode : 89; flag : umf_noinfo; reserved : 0),
- (unicode : 90; flag : umf_noinfo; reserved : 0),
- (unicode : 91; flag : umf_noinfo; reserved : 0),
- (unicode : 92; flag : umf_noinfo; reserved : 0),
- (unicode : 93; flag : umf_noinfo; reserved : 0),
- (unicode : 94; flag : umf_noinfo; reserved : 0),
- (unicode : 95; flag : umf_noinfo; reserved : 0),
- (unicode : 96; flag : umf_noinfo; reserved : 0),
- (unicode : 97; flag : umf_noinfo; reserved : 0),
- (unicode : 98; flag : umf_noinfo; reserved : 0),
- (unicode : 99; flag : umf_noinfo; reserved : 0),
- (unicode : 100; flag : umf_noinfo; reserved : 0),
- (unicode : 101; flag : umf_noinfo; reserved : 0),
- (unicode : 102; flag : umf_noinfo; reserved : 0),
- (unicode : 103; flag : umf_noinfo; reserved : 0),
- (unicode : 104; flag : umf_noinfo; reserved : 0),
- (unicode : 105; flag : umf_noinfo; reserved : 0),
- (unicode : 106; flag : umf_noinfo; reserved : 0),
- (unicode : 107; flag : umf_noinfo; reserved : 0),
- (unicode : 108; flag : umf_noinfo; reserved : 0),
- (unicode : 109; flag : umf_noinfo; reserved : 0),
- (unicode : 110; flag : umf_noinfo; reserved : 0),
- (unicode : 111; flag : umf_noinfo; reserved : 0),
- (unicode : 112; flag : umf_noinfo; reserved : 0),
- (unicode : 113; flag : umf_noinfo; reserved : 0),
- (unicode : 114; flag : umf_noinfo; reserved : 0),
- (unicode : 115; flag : umf_noinfo; reserved : 0),
- (unicode : 116; flag : umf_noinfo; reserved : 0),
- (unicode : 117; flag : umf_noinfo; reserved : 0),
- (unicode : 118; flag : umf_noinfo; reserved : 0),
- (unicode : 119; flag : umf_noinfo; reserved : 0),
- (unicode : 120; flag : umf_noinfo; reserved : 0),
- (unicode : 121; flag : umf_noinfo; reserved : 0),
- (unicode : 122; flag : umf_noinfo; reserved : 0),
- (unicode : 123; flag : umf_noinfo; reserved : 0),
- (unicode : 124; flag : umf_noinfo; reserved : 0),
- (unicode : 125; flag : umf_noinfo; reserved : 0),
- (unicode : 126; flag : umf_noinfo; reserved : 0),
- (unicode : 127; flag : umf_noinfo; reserved : 0),
- (unicode : 199; flag : umf_noinfo; reserved : 0),
- (unicode : 252; flag : umf_noinfo; reserved : 0),
- (unicode : 233; flag : umf_noinfo; reserved : 0),
- (unicode : 226; flag : umf_noinfo; reserved : 0),
- (unicode : 228; flag : umf_noinfo; reserved : 0),
- (unicode : 224; flag : umf_noinfo; reserved : 0),
- (unicode : 229; flag : umf_noinfo; reserved : 0),
- (unicode : 231; flag : umf_noinfo; reserved : 0),
- (unicode : 234; flag : umf_noinfo; reserved : 0),
- (unicode : 235; flag : umf_noinfo; reserved : 0),
- (unicode : 232; flag : umf_noinfo; reserved : 0),
- (unicode : 239; flag : umf_noinfo; reserved : 0),
- (unicode : 238; flag : umf_noinfo; reserved : 0),
- (unicode : 236; flag : umf_noinfo; reserved : 0),
- (unicode : 196; flag : umf_noinfo; reserved : 0),
- (unicode : 197; flag : umf_noinfo; reserved : 0),
- (unicode : 201; flag : umf_noinfo; reserved : 0),
- (unicode : 230; flag : umf_noinfo; reserved : 0),
- (unicode : 198; flag : umf_noinfo; reserved : 0),
- (unicode : 244; flag : umf_noinfo; reserved : 0),
- (unicode : 246; flag : umf_noinfo; reserved : 0),
- (unicode : 242; flag : umf_noinfo; reserved : 0),
- (unicode : 251; flag : umf_noinfo; reserved : 0),
- (unicode : 249; flag : umf_noinfo; reserved : 0),
- (unicode : 255; flag : umf_noinfo; reserved : 0),
- (unicode : 214; flag : umf_noinfo; reserved : 0),
- (unicode : 220; flag : umf_noinfo; reserved : 0),
- (unicode : 248; flag : umf_noinfo; reserved : 0),
- (unicode : 163; flag : umf_noinfo; reserved : 0),
- (unicode : 216; flag : umf_noinfo; reserved : 0),
- (unicode : 215; flag : umf_noinfo; reserved : 0),
- (unicode : 402; flag : umf_noinfo; reserved : 0),
- (unicode : 225; flag : umf_noinfo; reserved : 0),
- (unicode : 237; flag : umf_noinfo; reserved : 0),
- (unicode : 243; flag : umf_noinfo; reserved : 0),
- (unicode : 250; flag : umf_noinfo; reserved : 0),
- (unicode : 241; flag : umf_noinfo; reserved : 0),
- (unicode : 209; flag : umf_noinfo; reserved : 0),
- (unicode : 170; flag : umf_noinfo; reserved : 0),
- (unicode : 186; flag : umf_noinfo; reserved : 0),
- (unicode : 191; flag : umf_noinfo; reserved : 0),
- (unicode : 174; flag : umf_noinfo; reserved : 0),
- (unicode : 172; flag : umf_noinfo; reserved : 0),
- (unicode : 189; flag : umf_noinfo; reserved : 0),
- (unicode : 188; flag : umf_noinfo; reserved : 0),
- (unicode : 161; flag : umf_noinfo; reserved : 0),
- (unicode : 171; flag : umf_noinfo; reserved : 0),
- (unicode : 187; flag : umf_noinfo; reserved : 0),
- (unicode : 9617; flag : umf_noinfo; reserved : 0),
- (unicode : 9618; flag : umf_noinfo; reserved : 0),
- (unicode : 9619; flag : umf_noinfo; reserved : 0),
- (unicode : 9474; flag : umf_noinfo; reserved : 0),
- (unicode : 9508; flag : umf_noinfo; reserved : 0),
- (unicode : 193; flag : umf_noinfo; reserved : 0),
- (unicode : 194; flag : umf_noinfo; reserved : 0),
- (unicode : 192; flag : umf_noinfo; reserved : 0),
- (unicode : 169; flag : umf_noinfo; reserved : 0),
- (unicode : 9571; flag : umf_noinfo; reserved : 0),
- (unicode : 9553; flag : umf_noinfo; reserved : 0),
- (unicode : 9559; flag : umf_noinfo; reserved : 0),
- (unicode : 9565; flag : umf_noinfo; reserved : 0),
- (unicode : 162; flag : umf_noinfo; reserved : 0),
- (unicode : 165; flag : umf_noinfo; reserved : 0),
- (unicode : 9488; flag : umf_noinfo; reserved : 0),
- (unicode : 9492; flag : umf_noinfo; reserved : 0),
- (unicode : 9524; flag : umf_noinfo; reserved : 0),
- (unicode : 9516; flag : umf_noinfo; reserved : 0),
- (unicode : 9500; flag : umf_noinfo; reserved : 0),
- (unicode : 9472; flag : umf_noinfo; reserved : 0),
- (unicode : 9532; flag : umf_noinfo; reserved : 0),
- (unicode : 227; flag : umf_noinfo; reserved : 0),
- (unicode : 195; flag : umf_noinfo; reserved : 0),
- (unicode : 9562; flag : umf_noinfo; reserved : 0),
- (unicode : 9556; flag : umf_noinfo; reserved : 0),
- (unicode : 9577; flag : umf_noinfo; reserved : 0),
- (unicode : 9574; flag : umf_noinfo; reserved : 0),
- (unicode : 9568; flag : umf_noinfo; reserved : 0),
- (unicode : 9552; flag : umf_noinfo; reserved : 0),
- (unicode : 9580; flag : umf_noinfo; reserved : 0),
- (unicode : 164; flag : umf_noinfo; reserved : 0),
- (unicode : 240; flag : umf_noinfo; reserved : 0),
- (unicode : 208; flag : umf_noinfo; reserved : 0),
- (unicode : 202; flag : umf_noinfo; reserved : 0),
- (unicode : 203; flag : umf_noinfo; reserved : 0),
- (unicode : 200; flag : umf_noinfo; reserved : 0),
- (unicode : 305; flag : umf_noinfo; reserved : 0),
- (unicode : 205; flag : umf_noinfo; reserved : 0),
- (unicode : 206; flag : umf_noinfo; reserved : 0),
- (unicode : 207; flag : umf_noinfo; reserved : 0),
- (unicode : 9496; flag : umf_noinfo; reserved : 0),
- (unicode : 9484; flag : umf_noinfo; reserved : 0),
- (unicode : 9608; flag : umf_noinfo; reserved : 0),
- (unicode : 9604; flag : umf_noinfo; reserved : 0),
- (unicode : 166; flag : umf_noinfo; reserved : 0),
- (unicode : 204; flag : umf_noinfo; reserved : 0),
- (unicode : 9600; flag : umf_noinfo; reserved : 0),
- (unicode : 211; flag : umf_noinfo; reserved : 0),
- (unicode : 223; flag : umf_noinfo; reserved : 0),
- (unicode : 212; flag : umf_noinfo; reserved : 0),
- (unicode : 210; flag : umf_noinfo; reserved : 0),
- (unicode : 245; flag : umf_noinfo; reserved : 0),
- (unicode : 213; flag : umf_noinfo; reserved : 0),
- (unicode : 181; flag : umf_noinfo; reserved : 0),
- (unicode : 254; flag : umf_noinfo; reserved : 0),
- (unicode : 222; flag : umf_noinfo; reserved : 0),
- (unicode : 218; flag : umf_noinfo; reserved : 0),
- (unicode : 219; flag : umf_noinfo; reserved : 0),
- (unicode : 217; flag : umf_noinfo; reserved : 0),
- (unicode : 253; flag : umf_noinfo; reserved : 0),
- (unicode : 221; flag : umf_noinfo; reserved : 0),
- (unicode : 175; flag : umf_noinfo; reserved : 0),
- (unicode : 180; flag : umf_noinfo; reserved : 0),
- (unicode : 173; flag : umf_noinfo; reserved : 0),
- (unicode : 177; flag : umf_noinfo; reserved : 0),
- (unicode : 8215; flag : umf_noinfo; reserved : 0),
- (unicode : 190; flag : umf_noinfo; reserved : 0),
- (unicode : 182; flag : umf_noinfo; reserved : 0),
- (unicode : 167; flag : umf_noinfo; reserved : 0),
- (unicode : 247; flag : umf_noinfo; reserved : 0),
- (unicode : 184; flag : umf_noinfo; reserved : 0),
- (unicode : 176; flag : umf_noinfo; reserved : 0),
- (unicode : 168; flag : umf_noinfo; reserved : 0),
- (unicode : 183; flag : umf_noinfo; reserved : 0),
- (unicode : 185; flag : umf_noinfo; reserved : 0),
- (unicode : 179; flag : umf_noinfo; reserved : 0),
- (unicode : 178; flag : umf_noinfo; reserved : 0),
- (unicode : 9632; flag : umf_noinfo; reserved : 0),
- (unicode : 160; flag : umf_noinfo; reserved : 0)
- );
-
-
const
LastCursorType: word = crUnderline;
OrigScreen: PVideoBuf = nil;
@@ -318,6 +43,8 @@ var ConsoleInfo : TConsoleScreenBufferInfo;
NewConsoleHandleAllocated: boolean;
ConsoleOutHandle: THandle;
+ LineBuf: array of TCharInfo;
+
procedure SysInitVideo;
var
SecAttr: TSecurityAttributes;
@@ -417,6 +144,7 @@ begin
SetConsoleCursorInfo(ConsoleOutHandle, OrigConsoleCursorInfo);
SetConsoleCP(OrigCP);
end;
+ SetLength(LineBuf,0);
end;
@@ -598,73 +326,20 @@ begin
end;
procedure SysUpdateScreen(Force: Boolean);
-
-type WordRec = record
- One, Two: Byte;
- end; { wordrec }
-
var
BufSize,
BufCoord : COORD;
WriteRegion : SMALL_RECT;
- LineBuf : Array[0..(1024*32) - 1] of TCharInfo;
BufCounter : Longint;
LineCounter,
ColCounter : Longint;
smallforce : boolean;
x1,y1,x2,y2 : longint;
- p1,p2,p3 : PCardinal;
- j : integer;
begin
if force then
smallforce:=true
else
- begin
- {$ifdef cpui386}
- asm
- pushl %esi
- pushl %edi
- movl VideoBuf,%esi
- movl OldVideoBuf,%edi
- movl VideoBufSize,%ecx
- shrl $2,%ecx
- repe
- cmpsl
- setne smallforce
- popl %edi
- popl %esi
- end;
- {$else}
- {$ifdef cpux86_64}
- asm
- pushq %rsi
- pushq %rdi
- xorq %rcx,%rcx
- movq VideoBuf(%rip),%rsi
- movq OldVideoBuf(%rip),%rdi
- movl VideoBufSize(%rip),%ecx
- shrq $2,%rcx
- repe
- cmpsl
- setne smallforce
- popq %rdi
- popq %rsi
- end;
- {$else}
- {$INFO No optimized version for this CPU, reverting to a pascal version}
- j:=Videobufsize shr 2;
- smallforce:=false;
- p1:=pcardinal(VideoBuf);
- p2:=pcardinal(OldVideoBuf);
- p3:=@pcardinal(videobuf)[j];
- while (p1<p3) and (p1^=p2^) do
- begin
- inc(p1); inc(p2);
- end;
- smallforce:=p1<>p3;
- {$ENDIF}
- {$endif}
- end;
+ SmallForce:=CompareByte(EnhancedVideoBuf[0],OldEnhancedVideoBuf[0],Length(EnhancedVideoBuf)*SizeOf(TEnhancedVideoCell))<>0;
if SmallForce then
begin
BufSize.X := ScreenWidth;
@@ -684,30 +359,31 @@ begin
x2:=-1;
y1:=ScreenHeight+1;
y2:=-1;
+ SetLength(LineBuf,ScreenHeight*ScreenWidth);
for LineCounter := 1 to ScreenHeight do
begin
for ColCounter := 1 to ScreenWidth do
begin
- if (WordRec(VideoBuf^[BufCounter]).One<>WordRec(OldVideoBuf^[BufCounter]).One) or
- (WordRec(VideoBuf^[BufCounter]).Two<>WordRec(OldVideoBuf^[BufCounter]).Two) then
+ if EnhancedVideoBuf[BufCounter]<>OldEnhancedVideoBuf[BufCounter] then
begin
- if ColCounter<x1 then
- x1:=ColCounter;
- if ColCounter>x2 then
- x2:=ColCounter;
- if LineCounter<y1 then
- y1:=LineCounter;
- if LineCounter>y2 then
- y2:=LineCounter;
+ OldEnhancedVideoBuf[BufCounter]:=EnhancedVideoBuf[BufCounter];
+ if ColCounter<x1 then
+ x1:=ColCounter;
+ if ColCounter>x2 then
+ x2:=ColCounter;
+ if LineCounter<y1 then
+ y1:=LineCounter;
+ if LineCounter>y2 then
+ y2:=LineCounter;
end;
- if useunicodefunctions then
- LineBuf[BufCounter].UniCodeChar := Widechar(mapcp850[WordRec(VideoBuf^[BufCounter]).One].unicode)
+ if Length(EnhancedVideoBuf[BufCounter].ExtendedGraphemeCluster) = 1 then
+ LineBuf[BufCounter].UniCodeChar := EnhancedVideoBuf[BufCounter].ExtendedGraphemeCluster[1]
else
- LineBuf[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
+ LineBuf[BufCounter].UniCodeChar := ' ';
{ If (WordRec(VideoBuf^[BufCounter]).Two and $80)<>0 then
LineBuf^[BufCounter].Attributes := $100+WordRec(VideoBuf^[BufCounter]).Two
else }
- LineBuf[BufCounter].Attributes := WordRec(VideoBuf^[BufCounter]).Two;
+ LineBuf[BufCounter].Attributes := EnhancedVideoBuf[BufCounter].Attribute;
Inc(BufCounter);
end; { for }
@@ -742,18 +418,14 @@ begin
writeln('X2: ',x2);
writeln('Y2: ',y2);
}
- if useunicodefunctions then
- WriteConsoleOutputW(ConsoleOutHandle, @LineBuf, BufSize, BufCoord, WriteRegion)
- else
- WriteConsoleOutput(ConsoleOutHandle, @LineBuf, BufSize, BufCoord, WriteRegion);
-
- move(VideoBuf^,OldVideoBuf^,VideoBufSize);
+ WriteConsoleOutputW(ConsoleOutHandle, @LineBuf[0], BufSize, BufCoord, WriteRegion)
end;
end;
Const
SysVideoDriver : TVideoDriver = (
- InitDriver : @SysInitVideo;
+ InitDriver : nil;
+ InitEnhancedDriver: @SysInitVideo;
DoneDriver : @SysDoneVideo;
UpdateScreen : @SysUpdateScreen;
ClearScreen : @SysClearScreen;
@@ -763,8 +435,11 @@ Const
SetCursorPos : @SysSetCursorPos;
GetCursorType : @SysGetCursorType;
SetCursorType : @SysSetCursorType;
- GetCapabilities : @SysGetCapabilities
-
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : Nil;
+ ActivateCodePage : Nil;
+ GetSupportedCodePageCount : Nil;
+ GetSupportedCodePage : Nil;
);
procedure TargetEntry;
diff --git a/packages/rtl-console/src/win/winevent.pp b/packages/rtl-console/src/win/winevent.pp
index 09b7f049c7..c307c9734e 100644
--- a/packages/rtl-console/src/win/winevent.pp
+++ b/packages/rtl-console/src/win/winevent.pp
@@ -122,7 +122,7 @@ interface
}
if not(ExitEventHandleThread) then
begin
- if ReadConsoleInput(StdInputHandle,ir[0],irsize,dwRead) then
+ if ReadConsoleInputW(StdInputHandle,ir[0],irsize,dwRead) then
begin
i:=0;
EnterCriticalSection(HandlerChanging);
diff --git a/packages/rtl-console/src/win16/keyboard.pp b/packages/rtl-console/src/win16/keyboard.pp
index f8f18ad3e5..b0f9e2177c 100644
--- a/packages/rtl-console/src/win16/keyboard.pp
+++ b/packages/rtl-console/src/win16/keyboard.pp
@@ -392,6 +392,8 @@ Const
GetShiftState : @SysGetShiftState;
TranslateKeyEvent : Nil;
TranslateKeyEventUnicode : Nil;
+ GetEnhancedKeyEvent : Nil;
+ PollEnhancedKeyEvent : Nil;
);
begin
diff --git a/packages/rtl-console/src/win16/video.pp b/packages/rtl-console/src/win16/video.pp
index 22d656fc8a..fde5347938 100644
--- a/packages/rtl-console/src/win16/video.pp
+++ b/packages/rtl-console/src/win16/video.pp
@@ -31,7 +31,7 @@ var
implementation
uses
- WinProcs;
+ WinProcs, graphemebreakproperty, eastasianwidth, charset;
{$I video.inc}
@@ -255,17 +255,22 @@ end;
const
SysVideoDriver: TVideoDriver = (
- InitDriver: @SysInitVideo;
- DoneDriver: @SysDoneVideo;
- UpdateScreen: @SysUpdateScreen;
- ClearScreen: nil;
- SetVideoMode: @SysSetVideoMode;
- GetVideoModeCount: nil;
- GetVideoModeData: nil;
- SetCursorPos: @SysSetCursorPos;
- GetCursorType: @SysGetCursorType;
- SetCursorType: @SysSetCursorType;
- GetCapabilities: @SysGetCapabilities;
+ InitDriver : @SysInitVideo;
+ InitEnhancedDriver : nil;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : nil;
+ GetVideoModeData : nil;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ GetActiveCodePage : nil;
+ ActivateCodePage : nil;
+ GetSupportedCodePageCount : nil;
+ GetSupportedCodePage : nil;
);
begin