diff options
-rw-r--r-- | prototypes/fpgui2/tests/edittest.lpi | 5 | ||||
-rw-r--r-- | src/corelib/fpgfx.pas | 49 | ||||
-rw-r--r-- | src/corelib/gfxbase.pas | 22 | ||||
-rw-r--r-- | src/corelib/x11/fpgfx_package.lpk | 28 | ||||
-rw-r--r-- | src/corelib/x11/fpgfx_package.pas | 4 | ||||
-rw-r--r-- | src/corelib/x11/gfx_x11.pas | 126 | ||||
-rw-r--r-- | src/gui/gui_edit.pas | 3 |
7 files changed, 197 insertions, 40 deletions
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi index ae200625..2879bbde 100644 --- a/prototypes/fpgui2/tests/edittest.lpi +++ b/prototypes/fpgui2/tests/edittest.lpi @@ -50,6 +50,11 @@ <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> + <Linking> + <Debugging> + <UseLineInfoUnit Value="False"/> + </Debugging> + </Linking> <Other> <CustomOptions Value="-FUunits "/> diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 5138caf3..7160f1c4 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -42,7 +42,7 @@ const // version and name constants fpGUIVersion = '0.5.1'; - fpGUIName = 'fpGUI Library'; + fpGUIName = 'fpGUI Toolkit'; type @@ -242,14 +242,20 @@ type property Width: integer read FWidth; property Height: integer read FHeight; end; + + + TfpgClipboard = class(TfpgClipboardImpl) + end; + var fpgStyle: TfpgStyle; { TODO -ograemeg : move this into fpgApplication } fpgCaret: TfpgCaret; { TODO -ograemeg : move this into fpgApplication } fpgImages: TfpgImages; { TODO -ograemeg : move this into fpgApplication } -// Application singleton +// Application & Clipboard singletons function fpgApplication: TfpgApplication; +function fpgClipboard: TfpgClipboard; // Fonts (easy access function) function fpgGetFont(const afontdesc: string): TfpgFont; @@ -304,10 +310,11 @@ uses gfx_extinterpolation; // only so that it get auto compiled var - fpgTimers: TList; + fpgTimers: TList; fpgNamedColors: array[0..255] of TfpgColor; - fpgNamedFonts: TList; - uApplication: TfpgApplication; + fpgNamedFonts: TList; + uApplication: TfpgApplication; + uClipboard: TfpgClipboard; uMsgQueueList: TList; const @@ -592,13 +599,20 @@ begin end; end; -function fpgApplication: TfpgApplication; +function fpgApplication: TfpgApplication; begin if not Assigned(uApplication) then uApplication := TfpgApplication.Create; result := uApplication; end; +function fpgClipboard: TfpgClipboard; +begin + if not Assigned(uClipboard) then + uClipboard := TfpgClipboard.Create; + Result := uClipboard; +end; + function fpgColorToRGB(col: TfpgColor): TfpgColor; begin if (col and cl_BaseNamedColor) <> 0 then @@ -671,15 +685,20 @@ begin FScreenHeight := -1; FModalFormStack := TList.Create; - inherited Create(aparams); + try + inherited Create(aparams); - if IsInitialized then - begin - FScreenWidth := GetScreenWidth; - FScreenHeight := GetScreenHeight; - end; + if IsInitialized then + begin + FScreenWidth := GetScreenWidth; + FScreenHeight := GetScreenHeight; + end; - FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC); + FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC); + except + on E: Exception do + writeln(E.Message); + end; end; destructor TfpgApplication.Destroy; @@ -759,7 +778,7 @@ end; procedure TfpgApplication.Initialize; begin - {$Note Remember to process parameters!! } + { TODO : Remember to process parameters!! } if IsInitialized then InternalInit else @@ -1413,6 +1432,7 @@ end; initialization uApplication := nil; + uClipboard := nil; uMsgQueueList := nil; fpgTimers := nil; fpgCaret := nil; @@ -1421,6 +1441,7 @@ initialization fpgInitMsgQueue; finalization; + uClipboard.Free; uApplication.Free; end. diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index 499b98f9..ed8aeb43 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -6,7 +6,8 @@ interface uses Classes, - SysUtils; + SysUtils, + gfx_impl; type TfpgCoord = integer; // we might use floating point coordinates in the future... @@ -403,6 +404,18 @@ type // property FormCount... // property Forms[]... end; + + + TfpgClipboardBase = class(TObject) + protected + FClipboardWndHandle: TfpgWinHandle; + function DoGetText: string; virtual; abstract; + procedure DoSetText(const AValue: string); virtual; abstract; + procedure InitClipboard; virtual; abstract; + public + constructor Create; + property Text: string read DoGetText write DoSetText; + end; { ******** Helper functions ******** } @@ -1665,5 +1678,12 @@ begin end; end; +{ TfpgClipboardBase } + +constructor TfpgClipboardBase.Create; +begin + InitClipboard; +end; + end. diff --git a/src/corelib/x11/fpgfx_package.lpk b/src/corelib/x11/fpgfx_package.lpk index e6790455..91b61140 100644 --- a/src/corelib/x11/fpgfx_package.lpk +++ b/src/corelib/x11/fpgfx_package.lpk @@ -24,7 +24,7 @@ <License Value="Modified LGPL "/> <Version Minor="5" Release="1"/> - <Files Count="18"> + <Files Count="17"> <Item1> <Filename Value="x11_xft.pas"/> <UnitName Value="x11_xft"/> @@ -70,33 +70,29 @@ <UnitName Value="gfx_cmdlineparams"/> </Item11> <Item12> - <Filename Value="../gfx_clipboard.pas"/> - <UnitName Value="gfx_clipboard"/> - </Item12> - <Item13> <Filename Value="gfx_utils.pas"/> <UnitName Value="gfx_utils"/> - </Item13> - <Item14> + </Item12> + <Item13> <Filename Value="../gfx_popupwindow.pas"/> <UnitName Value="gfx_popupwindow"/> - </Item14> - <Item15> + </Item13> + <Item14> <Filename Value="gfx_impl.pas"/> <UnitName Value="gfx_impl"/> - </Item15> - <Item16> + </Item14> + <Item15> <Filename Value="../gfx_command_intf.pas"/> <UnitName Value="gfx_command_intf"/> - </Item16> - <Item17> + </Item15> + <Item16> <Filename Value="../gfx_wuline.pas"/> <UnitName Value="gfx_wuline"/> - </Item17> - <Item18> + </Item16> + <Item17> <Filename Value="../gfx_imagelist.pas"/> <UnitName Value="gfx_imagelist"/> - </Item18> + </Item17> </Files> <LazDoc Paths="../../../docs/xml/corelib/;../../../docs/xml/corelib/x11/;../../../docs/xml/corelib/gdi/"/> <RequiredPkgs Count="1"> diff --git a/src/corelib/x11/fpgfx_package.pas b/src/corelib/x11/fpgfx_package.pas index b1b3678a..ee7e9a84 100644 --- a/src/corelib/x11/fpgfx_package.pas +++ b/src/corelib/x11/fpgfx_package.pas @@ -9,8 +9,8 @@ interface uses x11_xft, x11_keyconv, gfxbase, gfx_x11, fpgfx, gfx_stdimages, gfx_imgfmt_bmp, gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, - gfx_clipboard, gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, - gfx_wuline, gfx_imagelist; + gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, + gfx_imagelist; implementation diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index c6ccf16a..de987f0b 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -165,7 +165,7 @@ type DefaultScreen: integer; DefaultVisual: PVisual; DefaultColorMap: TColorMap; - RootWindow: TfpgWinHandle; + FRootWindow: TfpgWinHandle; xia_clipboard: TAtom; xia_motif_wm_hints: TAtom; xia_wm_protocols: TAtom; @@ -186,9 +186,21 @@ type function GetScreenWidth: TfpgCoord; function GetScreenHeight: TfpgCoord; property Display: PXDisplay read FDisplay; + property RootWindow: TfpgWinHandle read FRootWindow; end; + TfpgClipboardImpl = class(TfpgClipboardBase) + private + FWaitingForSelection: Boolean; + protected + FClipboardText: string; + function DoGetText: string; override; + procedure DoSetText(const AValue: string); override; + procedure InitClipboard; override; + end; + + implementation uses @@ -395,6 +407,65 @@ begin Result := '#' + IntToStr(Event); end; +// clipboard event +procedure ProcessSelection(var ev: TXEvent); +var + s: string; + actual: TAtom; + format: integer; + count, remaining: longword; + data: PChar; +begin + if ev.xselection._property > 0 then + begin + XGetWindowProperty(xapplication.Display, ev.xselection.requestor, + ev.xselection._property, 0, 16000, + false, // delete + 0, // type + @actual, @format, @count, @remaining, + @data); + s := data; + + fpgClipboard.FClipboardText := s; + XFree(data); + end + else + begin + fpgClipboard.FClipboardText := ''; + end; + + fpgClipboard.FWaitingForSelection := false; +end; + +// clipboard event +procedure ProcessSelectionRequest(var ev: TXEvent); +var + e: TXSelectionEvent; + a: TAtom; +begin + e._type := SelectionNotify; + e.requestor := ev.xselectionrequest.requestor; + e.selection := ev.xselectionrequest.selection; + e.selection := xapplication.xia_clipboard; + e.target := ev.xselectionrequest.target; + e.time := ev.xselectionrequest.time; + e._property := ev.xselectionrequest._property; + + if e.target = xapplication.xia_targets then + begin + a := XA_STRING; + XChangeProperty(xapplication.Display, e.requestor, e._property, + XA_ATOM, sizeof(TAtom)*8, 0, PByte(@a), sizeof(TAtom)); + end + else + begin + XChangeProperty(xapplication.Display, e.requestor, e._property, e.target, + 8, 0, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText)); + end; + + XSendEvent(xapplication.Display, e.requestor, false, 0, @e ); +end; + { TfpgApplicationImpl } function TfpgApplicationImpl.ConvertShiftState(AState: Cardinal): TShiftState; @@ -537,11 +608,14 @@ begin FDisplay := XOpenDisplay(PChar(aparams)); if FDisplay = nil then - Exit; //==> +// begin + raise Exception.Create('fpGUI-X11: Could not open the display. Is your X11 server running?'); +// halt(1); +// end; Terminated := False; DefaultScreen := XDefaultScreen(Display); - RootWindow := XRootWindow(FDisplay, DefaultScreen); + FRootWindow := XRootWindow(FDisplay, DefaultScreen); DefaultBackground := XBlackPixel(FDisplay, DefaultScreen); DefaultForeground := XWhitePixel(FDisplay, DefaultScreen); @@ -989,7 +1063,6 @@ begin end; end; -{ X.SelectionNotify: begin ProcessSelection(ev); @@ -999,7 +1072,16 @@ begin begin ProcessSelectionRequest(ev); end; -} + + X.SelectionClear: + begin + { TODO : Not sure if I am handling this correctly? } + if ev.xselectionclear.selection = xia_clipboard then + begin + fpgClipboard.FClipboardText := ''; + Exit; + end; + end; X.FocusIn: fpgPostMessage(nil, FindWindowByHandle(ev.xfocus.window), FPGM_ACTIVATE); @@ -1908,6 +1990,40 @@ begin Result := @FXimgMask; end; +{ TfpgClipboardImpl } + +function TfpgClipboardImpl.DoGetText: string; +begin + XConvertSelection(xapplication.Display, xapplication.xia_clipboard, + XA_STRING, xapplication.xia_clipboard, FClipboardWndHandle, 0); + + FWaitingForSelection := True; + fpgDeliverMessages; // delivering the remaining messages + + repeat + fpgWaitWindowMessage; + fpgDeliverMessages; + until not FWaitingForSelection; + + Result := FClipboardText; +end; + +procedure TfpgClipboardImpl.DoSetText(const AValue: string); +begin + FClipboardText := AValue; + XSetSelectionOwner(xapplication.Display, xapplication.xia_clipboard, + FClipboardWndHandle, 0); +end; + +procedure TfpgClipboardImpl.InitClipboard; +begin + FWaitingForSelection := False; + FClipboardWndHandle := XCreateSimpleWindow(xapplication.Display, + xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0); +end; + + + initialization xapplication := nil; diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas index 8f6358c5..3a1b5aa2 100644 --- a/src/gui/gui_edit.pas +++ b/src/gui/gui_edit.pas @@ -140,8 +140,7 @@ function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; implementation uses - gfx_UTF8utils, - gfx_clipboard; + gfx_UTF8utils; const // internal popupmenu item names |