浏览代码

DEL: Obsolete units

Alexander Koblov 2 年之前
父节点
当前提交
a26bb27431
共有 3 个文件被更改,包括 0 次插入368 次删除
  1. 0 3
      src/doublecmd.lpr
  2. 0 135
      src/platform/unix/uappindicator.pas
  3. 0 230
      src/platform/win/uexceptionhandlerfix.pas

+ 0 - 3
src/doublecmd.lpr

@@ -10,9 +10,6 @@ uses
   uDarkStyle,
   {$ENDIF}
   {$ENDIF}
-  {$IF DEFINED(WIN64) AND (FPC_FULLVERSION < 30000)}
-  uExceptionHandlerFix,
-  {$ENDIF}
   {$IFDEF UNIX}
   cthreads,
   {$IFNDEF HEAPTRC}

+ 0 - 135
src/platform/unix/uappindicator.pas

@@ -1,135 +0,0 @@
-{
-    Double Commander
-    -------------------------------------------------------------------------
-    Application indicator support.
-
-    Copyright (C) 2015 Alexander Koblov ([email protected])
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    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.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
-
-unit uAppIndicator;
-
-{$mode delphi}
-
-interface
-
-uses
-  ExtCtrls;
-
-procedure RegisterAppIndicator(const ATrayIcon: TCustomTrayIcon);
-
-implementation
-
-uses
-  DynLibs, WSLCLClasses, Glib2, Gtk2, Gtk2WSExtCtrls, DCOSUtils, uMyUnix;
-
-type
-  TAppIndicatorCategory = (
-	APP_INDICATOR_CATEGORY_APPLICATION_STATUS,
-	APP_INDICATOR_CATEGORY_COMMUNICATIONS,
-	APP_INDICATOR_CATEGORY_SYSTEM_SERVICES,
-	APP_INDICATOR_CATEGORY_HARDWARE,
-	APP_INDICATOR_CATEGORY_OTHER
-  );
-
-  TAppIndicatorStatus = (
-	APP_INDICATOR_STATUS_PASSIVE,
-	APP_INDICATOR_STATUS_ACTIVE,
-	APP_INDICATOR_STATUS_ATTENTION
-  );
-
-  PAppIndicator = ^TAppIndicator;
-  TAppIndicator = record end;
-
-type
-
-  { TGtk2WSCustomTrayIconEx }
-
-  TGtk2WSCustomTrayIconEx = class(TGtk2WSCustomTrayIcon)
-  published
-    class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
-    class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
-  end;
-
-var
-  PopupMenu: PGtkWidget;
-  AppInd: PAppIndicator = nil;
-
-var
-  app_indicator_new: function(const id, icon_name: Pgchar; category: TAppIndicatorCategory): PAppIndicator; cdecl;
-  app_indicator_set_status: procedure(self: PAppIndicator; status: TAppIndicatorStatus); cdecl;
-  app_indicator_set_menu: procedure(self: PAppIndicator; menu: PGtkWidget); cdecl;
-
-{ TGtk2WSCustomTrayIconEx }
-
-class function TGtk2WSCustomTrayIconEx.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
-begin
-  Result:= inherited Hide(ATrayIcon);
-  if Assigned(AppInd) then app_indicator_set_status(AppInd, APP_INDICATOR_STATUS_PASSIVE);
-end;
-
-class function TGtk2WSCustomTrayIconEx.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
-begin
-  Result:= inherited Show(ATrayIcon);
-  if Assigned(AppInd) then app_indicator_set_status(AppInd, APP_INDICATOR_STATUS_ACTIVE);
-end;
-
-function Load: Boolean;
-var
-  libapp: TLibHandle;
-begin
-  libapp:= LoadLibrary('libappindicator.so.1');
-  Result:= libapp <> NilHandle;
-  if Result then
-  try
-    @app_indicator_new:= SafeGetProcAddress(libapp, 'app_indicator_new');
-    @app_indicator_set_menu:= SafeGetProcAddress(libapp, 'app_indicator_set_menu');
-    @app_indicator_set_status:= SafeGetProcAddress(libapp, 'app_indicator_set_status');
-  except
-    Result:= False;
-    FreeLibrary(libapp);
-  end;
-end;
-
-procedure RegisterAppIndicator(const ATrayIcon: TCustomTrayIcon);
-var
-  Index: Integer;
-  MenuItem: PGtkWidget;
-  WidgetSetClass: ^TWSLCLComponentClass;
-begin
-  if fpSystemStatus('pgrep unity > /dev/null 2>&1') = 0 then
-  begin
-    if not Load then Exit;
-
-    // Replace tray icon widgetset class
-    WidgetSetClass:= @ATrayIcon.WidgetSetClass;
-    WidgetSetClass^:= TGtk2WSCustomTrayIconEx;
-
-    // Create and fill popup menu
-    PopupMenu:= gtk_menu_new();
-    for Index:= 0 to ATrayIcon.PopupMenu.Items.Count - 1 do
-    begin
-      MenuItem:= PGtkWidget(ATrayIcon.PopupMenu.Items[Index].Handle);
-      gtk_menu_shell_append(GTK_MENU_SHELL(PopupMenu), MenuItem);
-    end;
-
-    // Create application indicator
-    AppInd:= app_indicator_new('doublecmd', 'doublecmd', APP_INDICATOR_CATEGORY_APPLICATION_STATUS);
-    if Assigned(AppInd) then app_indicator_set_menu(AppInd, PopupMenu);
-  end;
-end;
-
-end.

+ 0 - 230
src/platform/win/uexceptionhandlerfix.pas

@@ -1,230 +0,0 @@
-{
-   Replaces Free Pascal exception handler
-
-   Fixes bug:
-        http://doublecmd.sourceforge.net/mantisbt/view.php?id=50
-
-   Uses workaround from:
-        http://bugs.freepascal.org/view.php?id=17280
-        http://bugs.freepascal.org/view.php?id=12974
-}
-
-unit uExceptionHandlerFix;
-
-{$mode delphi}
-
-interface
-
-implementation
-
-uses
-  Windows, SysUtils;
-
-
-type
-  M128A = record
-    Low : QWord;
-    High : Int64;
-  end;
-
-  PContext = ^TContext;
-  TContext = record
-    P1Home : QWord;
-    P2Home : QWord;
-    P3Home : QWord;
-    P4Home : QWord;
-    P5Home : QWord;
-    P6Home : QWord;
-    ContextFlags : DWord;
-    MxCsr : DWord;
-    SegCs : word;
-    SegDs : word;
-    SegEs : word;
-    SegFs : word;
-    SegGs : word;
-    SegSs : word;
-    EFlags : DWord;
-    Dr0 : QWord;
-    Dr1 : QWord;
-    Dr2 : QWord;
-    Dr3 : QWord;
-    Dr6 : QWord;
-    Dr7 : QWord;
-    Rax : QWord;
-    Rcx : QWord;
-    Rdx : QWord;
-    Rbx : QWord;
-    Rsp : QWord;
-    Rbp : QWord;
-    Rsi : QWord;
-    Rdi : QWord;
-    R8 : QWord;
-    R9 : QWord;
-    R10 : QWord;
-    R11 : QWord;
-    R12 : QWord;
-    R13 : QWord;
-    R14 : QWord;
-    R15 : QWord;
-    Rip : QWord;
-    Header : array[0..1] of M128A;
-    Legacy : array[0..7] of M128A;
-    Xmm0 : M128A;
-    Xmm1 : M128A;
-    Xmm2 : M128A;
-    Xmm3 : M128A;
-    Xmm4 : M128A;
-    Xmm5 : M128A;
-    Xmm6 : M128A;
-    Xmm7 : M128A;
-    Xmm8 : M128A;
-    Xmm9 : M128A;
-    Xmm10 : M128A;
-    Xmm11 : M128A;
-    Xmm12 : M128A;
-    Xmm13 : M128A;
-    Xmm14 : M128A;
-    Xmm15 : M128A;
-    VectorRegister : array[0..25] of M128A;
-    VectorControl : QWord;
-    DebugControl : QWord;
-    LastBranchToRip : QWord;
-    LastBranchFromRip : QWord;
-    LastExceptionToRip : QWord;
-    LastExceptionFromRip : QWord;
-  end;
-
-type
-  PExceptionRecord = ^TExceptionRecord;
-  TExceptionRecord = record
-    ExceptionCode   : DWord;
-    ExceptionFlags  : DWord;
-    ExceptionRecord : PExceptionRecord;
-    ExceptionAddress : Pointer;
-    NumberParameters : DWord;
-    ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
-  end;
-
-  PExceptionPointers = ^TExceptionPointers;
-  TExceptionPointers = packed record
-    ExceptionRecord   : PExceptionRecord;
-    ContextRecord     : PContext;
-  end;
-
-type
-  PVectoredExceptionNode = ^TVectoredExceptionNode;
-  TVectoredExceptionNode = record
-    m_pNextNode: PVectoredExceptionNode;
-    m_pPreviousNode: PVectoredExceptionNode;
-    m_Unknown: Pointer;
-    m_pfnVectoredHandler: Pointer;
-  end;
-
-function AddVectoredExceptionHandler(FirstHandler: ULONG; VectoredHandler: Pointer): Pointer; stdcall;
-  external 'kernel32.dll' name 'AddVectoredExceptionHandler';
-function RemoveVectoredExceptionHandler(VectoredHandlerHandle: Pointer): ULONG; stdcall;
-  external 'kernel32.dll' name 'RemoveVectoredExceptionHandler';  
-function GetModuleHandleEx(dwFlags: DWORD; lpModuleName: Pointer; var hModule: THandle): BOOL; stdcall;
-  external 'kernel32.dll' name 'GetModuleHandleExA';
-function RtlEncodePointer(pfnVectoredHandler: Pointer): Pointer; stdcall;
-  external 'ntdll' name 'RtlEncodePointer';
-
-const
-  GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT = 2;
-  GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS       = 4;
-
-// These entries are linked from FPC's RTL.
-// If the RTL changes, the entries should be changed accordingly.
-function syswin64_x86_64_exception_handler(excep : pointer) : Longint; external name 'SYSTEM_SYSWIN64_X86_64_EXCEPTION_HANDLER$PEXCEPTIONPOINTERS$$LONGINT';
-var _fltused: int64 external name '_fltused';
-
-// Test if the exception address resides in our program.
-function CheckOurModule(p: Pointer): boolean;
-var
-  ModuleWithException: THandle;
-  OurModule: THandle;
-  Flags: DWORD;
-begin
-  Result := False;
-
-  { It's necessary to keep refcount intact. }
-  Flags := GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS or GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT;
-
-  with PExceptionPointers(p)^.ExceptionRecord^ do
-    Result := GetModuleHandleEx(Flags, ExceptionAddress, ModuleWithException) and
-      GetModuleHandleEx(Flags, @CheckOurModule, OurModule) and (ModuleWithException = OurModule);
-end;
-
-function ProcessException(p: Pointer): longint; stdcall;
-var
-  _SS: PCardinal;
-  Saved: TExceptionRecord;
-begin
-  Result := EXCEPTION_CONTINUE_SEARCH;
-
-  if CheckOurModule(p) then
-  begin
-    Saved := PExceptionPointers(p)^.ExceptionRecord^;
-
-    with PExceptionPointers(p)^.ExceptionRecord^ do
-    begin
-      // Dirty hack - in system.pp, private variable _SS is just after public _fltused. This might change in the future.
-      _SS := @_fltused;
-      inc(PBYTE(_SS), sizeof(int64));
-      _SS^ := PExceptionPointers(p)^.ContextRecord^.SegSs;
-
-      // Trying to unwind the stack in FPC's way - by walking the linked list of exception handers.
-      Result := syswin64_x86_64_exception_handler(p);
-    end;
-
-    if Result <> 0 then
-    begin
-      // The FPC's unwind failed for some reason.
-      // Restoring the Exception record, so the program's exception handlers can try to recover from the exception.
-      PExceptionPointers(p)^.ExceptionRecord^ := Saved;
-
-      // You can insert some kind of logging etc here.
-      // ...
-    end;
-  end;
-end;
-
-var
-  VectoredExceptionHandler: PVectoredExceptionNode = nil;
-
-procedure InstallExceptionHandler;
-var
-  HandlerAddress: Pointer;
-  Node: PVectoredExceptionNode;
-begin
-  // Get Free Pascal exception handler encoded address
-  HandlerAddress := RtlEncodePointer(@syswin64_x86_64_exception_handler);
-  VectoredExceptionHandler := AddVectoredExceptionHandler(1, @ProcessException);
-  // Find Free Pascal exception handler and remove it
-  Node:= VectoredExceptionHandler^.m_pNextNode;
-  repeat
-    if (Node^.m_pfnVectoredHandler = HandlerAddress) then
-    begin
-      RemoveVectoredExceptionHandler(Node);
-      Break;
-    end;
-    Node := Node^.m_pNextNode;
-  until (Node = nil);
-end;
-
-procedure UninstallExceptionHandler;
-begin
-  if Assigned(VectoredExceptionHandler) then
-  begin
-    RemoveVectoredExceptionHandler(VectoredExceptionHandler);
-    VectoredExceptionHandler := nil;
-  end;
-end;
-
-initialization
-  InstallExceptionHandler;
-
-finalization
-  UninstallExceptionHandler;
-
-end.