Skip to content

Commit

Permalink
stop assuming the prettified code just adds a space
Browse files Browse the repository at this point in the history
  • Loading branch information
retailcoder committed Jun 23, 2018
1 parent 5d9bff5 commit f321177
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 14 deletions.
56 changes: 46 additions & 10 deletions Rubberduck.Core/AutoComplete/AutoCompleteBase.cs
@@ -1,7 +1,11 @@
using Rubberduck.Settings;
using Rubberduck.Parsing.VBA;
using Rubberduck.Settings;
using Rubberduck.VBEditor;
using Rubberduck.VBEditor.Events;
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text.RegularExpressions;

namespace Rubberduck.AutoComplete
{
Expand Down Expand Up @@ -29,37 +33,69 @@ public virtual bool Execute(AutoCompleteEventArgs e, AutoCompleteSettings settin
var module = e.CodeModule;
using (var pane = module.CodePane)
{
var selection = pane.Selection;
var original = module.GetLines(selection);
var nextChar = selection.StartColumn - 1 == original.Length ? string.Empty : original.Substring(selection.StartColumn - 1, 1);
var pSelection = pane.Selection;
var zSelection = pSelection.ToZeroBased();

var original = module.GetLines(pSelection);
var nextChar = zSelection.StartColumn == original.Length ? string.Empty : original.Substring(zSelection.StartColumn, 1);
if (input == InputToken && (input != OutputToken || nextChar != OutputToken))
{
var code = original.Insert(Math.Max(0, selection.StartColumn - 1), InputToken + OutputToken);
module.ReplaceLine(selection.StartLine, code);
var newCode = module.GetLines(selection);
var code = original.Insert(Math.Max(0, zSelection.StartColumn), InputToken + OutputToken);
module.ReplaceLine(pSelection.StartLine, code);

var newCode = module.GetLines(pSelection);
if (newCode == code)
{
pane.Selection = new Selection(selection.StartLine, selection.StartColumn + 1);
pane.Selection = new Selection(pSelection.StartLine, pSelection.StartColumn + 1);
}
else
{
// VBE added a space; need to compensate:
pane.Selection = new Selection(selection.StartLine, selection.StartColumn + 2);
pane.Selection = new Selection(pSelection.StartLine, GetPrettifiedCaretPosition(pSelection, code, newCode));
}
e.Handled = true;
return true;
}
else if (input == OutputToken && nextChar == OutputToken)
{
// just move caret one character to the right & suppress the keypress
pane.Selection = new Selection(selection.StartLine, selection.StartColumn + 2);
pane.Selection = new Selection(pSelection.StartLine, pSelection.StartColumn + 2);
e.Handled = true;
return true;
}
return false;
}
}

private int GetPrettifiedCaretPosition(Selection pSelection, string insertedCode, string prettifiedCode)
{
var zSelection = pSelection.ToZeroBased();

var outputTokenIndices = new List<int>();
for (int i = 0; i < insertedCode.Length; i++)
{
var character = insertedCode[i].ToString();
if (character == OutputToken)
{
outputTokenIndices.Add(i);
}
}

var firstAfterCaret = outputTokenIndices.Where(i => i > zSelection.StartColumn).Min();

var prettifiedTokenIndices = new List<int>();
for (int i = 0; i < prettifiedCode.Length; i++)
{
var character = prettifiedCode[i].ToString();
if (character == OutputToken)
{
prettifiedTokenIndices.Add(i);
}
}

return prettifiedTokenIndices[outputTokenIndices.IndexOf(firstAfterCaret)] + 1;
}

public virtual bool IsMatch(string input) =>
(IsInlineCharCompletion && !string.IsNullOrEmpty(input) && (input == InputToken || input == OutputToken));
}
Expand Down
2 changes: 1 addition & 1 deletion Rubberduck.Core/AutoComplete/AutoCompleteBlockBase.cs
Expand Up @@ -98,7 +98,7 @@ private bool IsBlockCompleted(ICodeModule module, Selection selection)
var proc = module.GetProcOfLine(selection.StartLine);
if (proc == null)
{
content = module.GetLines(1, module.CountOfDeclarationLines);
content = module.GetLines(1, module.CountOfDeclarationLines).StripStringLiterals();
}
else
{
Expand Down
5 changes: 2 additions & 3 deletions Rubberduck.Core/AutoComplete/AutoCompletePropertyBlock.cs
Expand Up @@ -20,9 +20,8 @@ public override bool Execute(AutoCompleteEventArgs e, AutoCompleteSettings setti
using (var pane = module.CodePane)
{
var original = module.GetLines(e.CurrentSelection);
var hasAsToken = Regex.IsMatch(original, $"\\)\\s+{Tokens.As}", RegexOptions.IgnoreCase) ||
Regex.IsMatch(original, $"{Tokens.Property} {Tokens.Get}\\s+\\(.*\\)\\s+{Tokens.As} ", RegexOptions.IgnoreCase);
var hasAsType = Regex.IsMatch(original, $"{Tokens.Property} {Tokens.Get}\\s+\\w+\\(.*\\)\\s+{Tokens.As}\\s+\\w+", RegexOptions.IgnoreCase);
var hasAsToken = Regex.IsMatch(original, $@"{Tokens.Property} {Tokens.Get}\s+\(.*\)\s+{Tokens.As}\s?", RegexOptions.IgnoreCase);
var hasAsType = Regex.IsMatch(original, $@"{Tokens.Property} {Tokens.Get}\s+\w+\(.*\)\s+{Tokens.As}\s+(?<Identifier>\w+)", RegexOptions.IgnoreCase);
var asTypeClause = hasAsToken && hasAsType
? string.Empty
: hasAsToken
Expand Down
3 changes: 3 additions & 0 deletions Rubberduck.VBEEditor/SafeComWrappers/VB/Abstract/ICodePane.cs
Expand Up @@ -11,6 +11,9 @@ public interface ICodePane : ISafeComWrapper, IEquatable<ICodePane>
int CountOfVisibleLines { get; }
ICodeModule CodeModule { get; }
CodePaneView CodePaneView { get; }
/// <summary>
/// Gets or sets a 1-based <see cref="Selection"/> representing the current selection in the code pane.
/// </summary>
Selection Selection { get; set; }
QualifiedSelection? GetQualifiedSelection();
QualifiedModuleName QualifiedModuleName { get; }
Expand Down
6 changes: 6 additions & 0 deletions Rubberduck.VBEEditor/Selection.cs
Expand Up @@ -4,6 +4,7 @@ namespace Rubberduck.VBEditor
{
public struct Selection : IEquatable<Selection>, IComparable<Selection>
{

public Selection(int line, int column) : this(line, column, line, column) { }

public Selection(int startLine, int startColumn, int endLine, int endColumn)
Expand All @@ -21,6 +22,11 @@ public Selection(int startLine, int startColumn, int endLine, int endColumn)

public static Selection Empty => new Selection();

public Selection ToZeroBased() =>
new Selection(StartLine - 1, StartColumn - 1, EndLine - 1, EndColumn - 1);
public Selection ToOneBased() =>
new Selection(StartLine + 1, StartColumn + 1, EndLine + 1, EndColumn + 1);

public bool IsEmpty()
{
return Equals(Empty);
Expand Down

0 comments on commit f321177

Please sign in to comment.