fix file protocol and anchors, close #80 (not for changelog)

This commit is contained in:
Basile Burg 2016-07-04 05:44:08 +02:00
parent d9c8fcce06
commit c35cc3c92c
2 changed files with 62 additions and 4 deletions

View File

@ -8,14 +8,14 @@ uses
Classes, SysUtils, Classes, SysUtils,
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
Windows, JwaTlHelp32, Windows, JwaTlHelp32, registry,
{$ELSE} {$ELSE}
ExtCtrls, FileUtil, LazFileUtils, ExtCtrls, FileUtil, LazFileUtils,
{$ENDIF} {$ENDIF}
{$IFNDEF CEBUILD} {$IFNDEF CEBUILD}
forms, forms,
{$ENDIF} {$ENDIF}
process, asyncprocess, ghashmap, ghashset; process, asyncprocess, ghashmap, ghashset, LCLIntf;
const const
exeExt = {$IFDEF WINDOWS} '.exe' {$ELSE} '' {$ENDIF}; exeExt = {$IFDEF WINDOWS} '.exe' {$ELSE} '' {$ENDIF};
@ -280,11 +280,17 @@ type
*) *)
function indentationMode(strings: TStrings): TIndentationMode; function indentationMode(strings: TStrings): TIndentationMode;
(** (**
* Detects the main indetation mode used in a file * Detects the main indetation mode used in a file
*) *)
function indentationMode(const fname: string): TIndentationMode; function indentationMode(const fname: string): TIndentationMode;
(**
* like LCLIntf eponymous function but includes a woraround that's gonna
* be in Lazarus from version 1.8 (anchor + file:/// protocol under win).
*)
function openUrl(const value: string): boolean;
var var
// supplementatl directories to find background tools // supplementatl directories to find background tools
additionalPath: string; additionalPath: string;
@ -1243,6 +1249,58 @@ begin
end; end;
end; end;
function openUrl(const value: string): boolean;
{$IFDEF WINDOWS}
function GetDefaultBrowserForCurrentUser: String;
begin
result := '';
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKeyReadOnly('Software\Classes\http\shell\open\command') then
begin
result := ReadString('');
CloseKey;
end;
finally
Free;
end;
end;
var
browser: string;
i: integer = 2;
{$ENDIF}
begin
{$IFNDEF WINDOWS}
result := LCLIntf.OpenURL(value);
{$ELSE}
if pos('file://', value) = 0 then
result := LCLIntf.OpenURL(value)
else
begin
browser := GetDefaultBrowserForCurrentUser;
if browser.isEmpty then
result := LCLIntf.OpenURL(value)
else
begin
if browser[1] = '"' then
begin
while browser[i] <> '"' do
begin
if i > browser.length then
break;
i += 1;
end;
if i <= browser.length then
browser := browser[1..i];
end;
result := ShellExecuteW(0, 'open', PWideChar(WideString(browser)),
PWideChar(WideString(value)), nil, SW_SHOWNORMAL) > 32;
end;
end;
{$ENDIF}
end;
initialization initialization
registerClasses([TCEPersistentShortcut]); registerClasses([TCEPersistentShortcut]);
end. end.

View File

@ -9,7 +9,7 @@ uses
SynEdit, SynPluginSyncroEdit, SynCompletion, SynEditKeyCmds, LazSynEditText, SynEdit, SynPluginSyncroEdit, SynCompletion, SynEditKeyCmds, LazSynEditText,
SynHighlighterLFM, SynEditHighlighter, SynEditMouseCmds, SynEditFoldedView, SynHighlighterLFM, SynEditHighlighter, SynEditMouseCmds, SynEditFoldedView,
SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs, SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs,
fpjson, jsonparser, LCLIntf, fpjson, jsonparser,
ce_common, ce_observer, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs, ce_common, ce_observer, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs,
ce_sharedres, ce_dlang, ce_stringrange; ce_sharedres, ce_dlang, ce_stringrange;