diff --git a/heidisql.lpi b/heidisql.lpi index be251195..88bf47a4 100644 --- a/heidisql.lpi +++ b/heidisql.lpi @@ -287,6 +287,13 @@ + + + + + + + diff --git a/heidisql.lpr b/heidisql.lpr index a0b29cea..138cfd6a 100644 --- a/heidisql.lpr +++ b/heidisql.lpr @@ -20,7 +20,7 @@ uses column_selection, loaddata, csv_detector, createdatabase, editvar, copytable, exportgrid, usermanager, selectdbobject, reformatter, searchreplace, connections, jsonregistry, sqlhelp, updatecheck, insertfiles, texteditor, - customize_highlighter, preferences, table_editor, view; + customize_highlighter, preferences, table_editor, view, routine_editor; {$R *.res} {.$R resources.rc} diff --git a/source/main.pas b/source/main.pas index fc420379..8c8cc58a 100644 --- a/source/main.pas +++ b/source/main.pas @@ -1421,7 +1421,7 @@ implementation uses FileInfo, winpeimagereader, elfreader, machoreader, About, data_sorting, column_selection, loaddata, editvar, copytable, csv_detector, exportgrid, usermanager, selectdbobject, reformatter, connections, sqlhelp, updatecheck, - insertfiles, texteditor, preferences, table_editor, view; + insertfiles, texteditor, preferences, table_editor, view, routine_editor; {$R *.lfm} @@ -6811,7 +6811,7 @@ var Queries: TSQLBatch; Query: TSQLSentence; Conn: TDBConnection; - //RoutineEditor: TfrmRoutineEditor; + RoutineEditor: TfrmRoutineEditor; Param: TRoutineParam; DisplayText: String; SQLFunc: TSQLFunction; @@ -6838,7 +6838,7 @@ var end; DisplayText := SynCompletionProposalPrettyText(Obj.ImageIndex, _(LowerCase(Obj.ObjType)), Obj.Name, FunctionDeclaration); - Proposal.ItemList.Add(DisplayText); + Proposal.ItemList.Add(Obj.Name+FunctionDeclaration); end; procedure AddColumns(const LeftToken: String); @@ -6879,10 +6879,9 @@ var // Put formatted text and icon into proposal DisplayText := SynCompletionProposalPrettyText(ColumnIcon, LowerCase(Col.DataType.Name), Col.Name, Col.Comment, DatatypeCategories[Col.DataType.Category].NullColor); //if CurrentInput.StartsWith(Conn.QuoteChar) then - // Proposal.AddItem(DisplayText, Conn.QuoteChar + Col.Name) + // Proposal.ItemList.Add(Conn.QuoteChar + Col.Name) //else - // Proposal.AddItem(DisplayText, Col.Name); - Proposal.ItemList.Add(DisplayText); + Proposal.ItemList.Add(Col.Name); Inc(ColumnsInList); end; Columns.Free; @@ -6930,7 +6929,7 @@ begin Results := Conn.GetResults('SHOW '+UpperCase(rx.Match[1])+' VARIABLES'); while not Results.Eof do begin DisplayText := SynCompletionProposalPrettyText(ICONINDEX_PRIMARYKEY, _('Variable'), Results.Col(0), StringReplace(Results.Col(1), '\', '\\', [rfReplaceAll])); - Proposal.ItemList.Add(DisplayText); + Proposal.ItemList.Add(Results.Col(1)); Results.Next; end; except @@ -7055,7 +7054,7 @@ begin end; // Procedure params - {if GetParentFormOrFrame(Editor) is TfrmRoutineEditor then begin + if GetParentFormOrFrame(Editor) is TfrmRoutineEditor then begin RoutineEditor := GetParentFormOrFrame(Editor) as TfrmRoutineEditor; for Param in RoutineEditor.Parameters do begin if Param.Context = 'IN' then ImageIndex := 120 @@ -7063,9 +7062,9 @@ begin else if Param.Context = 'INOUT' then ImageIndex := 122 else ImageIndex := -1; DisplayText := SynCompletionProposalPrettyText(ImageIndex, Param.Datatype, Param.Name, ''); - Proposal.AddItem(DisplayText, Param.Name); + Proposal.ItemList.Add(Param.Name); end; - end;} + end; end; @@ -12191,7 +12190,7 @@ begin case Obj.NodeType of lntTable: EditorClass := TfrmTableEditor; lntView: EditorClass := TfrmView; - //lntProcedure, lntFunction: EditorClass := TfrmRoutineEditor; + lntProcedure, lntFunction: EditorClass := TfrmRoutineEditor; //lntTrigger: EditorClass := TfrmTriggerEditor; //lntEvent: EditorClass := TfrmEventEditor; else Exit; @@ -14203,8 +14202,8 @@ begin if SelectedTableColumns.Count > Integer(Node.Index) then CellText := SelectedTableColumns[Node.Index].Name; lntFunction, lntProcedure: - //if Assigned(ActiveObjectEditor) then - // CellText := TfrmRoutineEditor(ActiveObjectEditor).Parameters[Node.Index].Name; + if Assigned(ActiveObjectEditor) then + CellText := TfrmRoutineEditor(ActiveObjectEditor).Parameters[Node.Index].Name; end; end; TQueryTab.HelperNodeFunctions: begin @@ -14348,7 +14347,7 @@ begin ChildCount := SelectedTableColumns.Count; lntFunction, lntProcedure: if Assigned(ActiveObjectEditor) then - ChildCount := 0; //TfrmRoutineEditor(ActiveObjectEditor).Parameters.Count + ChildCount := TfrmRoutineEditor(ActiveObjectEditor).Parameters.Count else ChildCount := 0; end; diff --git a/source/routine_editor.lfm b/source/routine_editor.lfm new file mode 100644 index 00000000..14d6a93d --- /dev/null +++ b/source/routine_editor.lfm @@ -0,0 +1,621 @@ +object frmRoutineEditor: TfrmRoutineEditor + Left = 0 + Height = 625 + Top = 0 + Width = 875 + ClientHeight = 625 + ClientWidth = 875 + DesignTimePPI = 120 + ParentFont = False + TabOrder = 0 + object lblSQLcode: TLabel + Left = 6 + Height = 20 + Top = 236 + Width = 863 + Align = alTop + BorderSpacing.Around = 6 + Caption = 'Routine body:' + FocusControl = SynMemoBody + end + object lblDisabledWhy: TLabel + AnchorSideLeft.Control = btnSave + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 306 + Height = 20 + Top = 599 + Width = 241 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 6 + Caption = 'You have no privilege to this routine.' + Visible = False + end + object spltTop: TSplitter + Cursor = crVSplit + Left = 0 + Height = 10 + Top = 220 + Width = 875 + Align = alTop + ResizeAnchor = akTop + end + object btnSave: TButton + AnchorSideLeft.Control = btnDiscard + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 206 + Height = 31 + Top = 588 + Width = 94 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 6 + Caption = 'Save' + Default = True + TabOrder = 4 + OnClick = btnSaveClick + end + object btnDiscard: TButton + AnchorSideLeft.Control = btnHelp + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 106 + Height = 31 + Top = 588 + Width = 94 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 6 + Caption = 'Discard' + ModalResult = 2 + TabOrder = 3 + OnClick = btnDiscardClick + end + object btnHelp: TButton + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 6 + Height = 31 + Top = 588 + Width = 94 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 6 + Caption = 'Help' + TabOrder = 2 + OnClick = btnHelpClick + end + inline SynMemoBody: TSynEdit + AnchorSideBottom.Control = btnSave + Left = 6 + Height = 320 + Top = 262 + Width = 863 + Align = alTop + BorderSpacing.Around = 6 + Anchors = [akTop, akLeft, akRight, akBottom] + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqNonAntialiased + ParentColor = False + ParentFont = False + TabOrder = 1 + OnDragDrop = SynMemoBodyDragDrop + OnDragOver = SynMemoBodyDragOver + Gutter.LeftOffset = 2 + Gutter.Width = 70 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Highlighter = MainForm.SynSQLSynUsed + Keystrokes = <> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Lines.Strings = ( + 'SynMemoBody' + ) + VisibleSpecialChars = [vscSpace, vscTabAtLast] + RightEdge = 0 + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + TabWidth = 3 + OnChange = Modification + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 30 + MouseActions = <> + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 17 + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterChanges1: TSynGutterChanges + Width = 5 + MouseActions = <> + ModifiedColor = 59900 + SavedColor = clGreen + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 3 + MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + Width = 13 + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + object PageControlMain: TPageControl + Left = 6 + Height = 208 + Top = 6 + Width = 863 + ActivePage = tabOptions + Align = alTop + BorderSpacing.Around = 6 + Constraints.MinHeight = 125 + Images = MainForm.ImageListIcons8 + TabIndex = 0 + TabOrder = 0 + OnChange = PageControlMainChange + object tabOptions: TTabSheet + Caption = 'Options' + ClientHeight = 175 + ClientWidth = 855 + ImageIndex = 39 + object lblName: TLabel + AnchorSideLeft.Control = tabOptions + AnchorSideTop.Control = editName + AnchorSideTop.Side = asrCenter + Left = 6 + Height = 20 + Top = 10 + Width = 43 + BorderSpacing.Around = 6 + Caption = '&Name:' + FocusControl = editName + end + object lblType: TLabel + AnchorSideLeft.Control = tabOptions + AnchorSideTop.Control = comboType + AnchorSideTop.Side = asrCenter + Left = 6 + Height = 20 + Top = 78 + Width = 34 + BorderSpacing.Around = 6 + Caption = '&Type:' + FocusControl = comboType + end + object lblReturns: TLabel + AnchorSideLeft.Control = tabOptions + AnchorSideTop.Control = comboReturns + AnchorSideTop.Side = asrCenter + Left = 6 + Height = 20 + Top = 112 + Width = 52 + BorderSpacing.Around = 6 + Caption = '&Returns:' + FocusControl = comboReturns + end + object lblSQL: TLabel + AnchorSideLeft.Control = comboType + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = comboDataAccess + AnchorSideTop.Side = asrCenter + Left = 499 + Height = 20 + Top = 78 + Width = 81 + BorderSpacing.Around = 6 + Caption = '&Data access:' + FocusControl = comboDataAccess + end + object lblSecurity: TLabel + AnchorSideLeft.Control = comboReturns + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = comboSecurity + AnchorSideTop.Side = asrCenter + Left = 499 + Height = 20 + Top = 112 + Width = 85 + BorderSpacing.Around = 6 + Caption = 'SQL Se&curity:' + FocusControl = comboSecurity + end + object lblComment: TLabel + AnchorSideLeft.Control = tabOptions + AnchorSideTop.Control = editComment + AnchorSideTop.Side = asrCenter + Left = 6 + Height = 20 + Top = 44 + Width = 68 + BorderSpacing.Around = 6 + Caption = '&Comment:' + FocusControl = editComment + end + object lblDefiner: TLabel + AnchorSideLeft.Control = editName + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = comboDefiner + AnchorSideTop.Side = asrCenter + Left = 499 + Height = 20 + Top = 10 + Width = 52 + BorderSpacing.Around = 6 + Caption = 'De&finer:' + end + object chkDeterministic: TCheckBox + AnchorSideLeft.Control = comboReturns + AnchorSideTop.Control = comboSecurity + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = tabOptions + AnchorSideRight.Side = asrBottom + Left = 111 + Height = 24 + Top = 142 + Width = 738 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + Caption = '&Deterministic' + TabOrder = 7 + OnClick = Modification + end + object editComment: TEdit + AnchorSideTop.Control = editName + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = tabOptions + AnchorSideRight.Side = asrBottom + Left = 105 + Height = 28 + Top = 40 + Width = 744 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + TabOrder = 2 + Text = 'editComment' + OnChange = Modification + end + object comboSecurity: TComboBox + AnchorSideTop.Control = comboDataAccess + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = tabOptions + AnchorSideRight.Side = asrBottom + Left = 611 + Height = 28 + Top = 108 + Width = 238 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + ItemHeight = 20 + Style = csDropDownList + TabOrder = 6 + OnChange = Modification + end + object comboDataAccess: TComboBox + AnchorSideTop.Control = editComment + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = tabOptions + AnchorSideRight.Side = asrBottom + Left = 611 + Height = 28 + Top = 74 + Width = 238 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + ItemHeight = 20 + Style = csDropDownList + TabOrder = 5 + OnChange = Modification + end + object comboReturns: TComboBox + AnchorSideTop.Control = comboType + AnchorSideTop.Side = asrBottom + Left = 105 + Height = 28 + Top = 108 + Width = 388 + BorderSpacing.Around = 6 + ItemHeight = 20 + TabOrder = 4 + Text = 'comboReturns' + OnChange = Modification + end + object comboType: TComboBox + AnchorSideTop.Control = editComment + AnchorSideTop.Side = asrBottom + Left = 105 + Height = 28 + Top = 74 + Width = 388 + BorderSpacing.Around = 6 + ItemHeight = 20 + Style = csDropDownList + TabOrder = 3 + OnSelect = comboTypeSelect + end + object editName: TEdit + AnchorSideTop.Control = tabOptions + Left = 105 + Height = 28 + Top = 6 + Width = 388 + BorderSpacing.Around = 6 + TabOrder = 0 + Text = 'editName' + TextHint = 'Enter routine name' + OnChange = Modification + end + object comboDefiner: TComboBox + AnchorSideTop.Control = tabOptions + AnchorSideRight.Control = tabOptions + AnchorSideRight.Side = asrBottom + Left = 611 + Height = 28 + Top = 6 + Width = 238 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 6 + ItemHeight = 20 + TabOrder = 1 + Text = 'comboDefiner' + OnChange = Modification + OnDropDown = comboDefinerDropDown + end + end + object tabParameters: TTabSheet + Caption = 'Parameters' + ClientHeight = 175 + ClientWidth = 855 + ImageIndex = 122 + object listParameters: TLazVirtualStringTree + Left = 103 + Height = 175 + Top = 0 + Width = 752 + Align = alClient + DragImageKind = diMainColumnOnly + DragMode = dmAutomatic + DragType = dtVCL + EditDelay = 0 + Header.AutoSizeIndex = 1 + Header.Columns = < + item + Position = 0 + Text = '#' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 1 + Text = 'Name' + Width = 485 + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 2 + Text = 'Datatype' + Width = 112 + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 3 + Text = 'Context' + Width = 88 + end> + Header.MainColumn = 1 + Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoVisible, hoDisableAnimatedResize] + Header.PopupMenu = MainForm.popupListHeader + Images = MainForm.ImageListIcons8 + NodeDataSize = 0 + TabOrder = 0 + TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toHotTrack, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines, toUseExplorerTheme] + TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect] + OnBeforePaint = listParametersBeforePaint + OnCreateEditor = listParametersCreateEditor + OnEditing = listParametersEditing + OnFocusChanged = listParametersFocusChanged + OnGetText = listParametersGetText + OnPaintText = listParametersPaintText + OnGetImageIndex = listParametersGetImageIndex + OnNewText = listParametersNewText + end + object tlbParameters: TToolBar + Left = 0 + Height = 175 + Top = 0 + Width = 103 + Align = alLeft + AutoSize = True + ButtonHeight = 35 + ButtonWidth = 102 + Caption = 'tlbParameters' + Images = MainForm.ImageListIcons8 + List = True + ShowCaptions = True + TabOrder = 1 + object btnAddParam: TToolButton + Left = 1 + Top = 2 + Caption = 'Add' + ImageIndex = 45 + OnClick = btnAddParamClick + Wrap = True + end + object btnRemoveParam: TToolButton + Left = 1 + Top = 37 + Caption = 'Remove' + Enabled = False + ImageIndex = 46 + OnClick = btnRemoveParamClick + Wrap = True + end + object btnClearParams: TToolButton + Left = 1 + Top = 72 + Caption = 'Clear' + ImageIndex = 26 + OnClick = btnClearParamsClick + Wrap = True + end + object btnMoveUpParam: TToolButton + Left = 1 + Top = 107 + Caption = 'Move up' + Enabled = False + ImageIndex = 74 + OnClick = btnMoveParamClick + Wrap = True + end + object btnMoveDownParam: TToolButton + Left = 103 + Top = 2 + Caption = 'Move down' + Enabled = False + ImageIndex = 75 + OnClick = btnMoveParamClick + end + end + end + object tabCreateCode: TTabSheet + Caption = 'CREATE code' + ClientHeight = 175 + ClientWidth = 855 + ImageIndex = 119 + inline SynMemoCREATEcode: TSynEdit + Left = 0 + Height = 175 + Top = 0 + Width = 855 + Align = alClient + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqNonAntialiased + ParentColor = False + ParentFont = False + TabOrder = 0 + Gutter.Width = 68 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Highlighter = MainForm.SynSQLSynUsed + Keystrokes = <> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Lines.Strings = ( + 'SynMemoCREATEcode' + ) + VisibleSpecialChars = [vscSpace, vscTabAtLast] + ReadOnly = True + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 30 + MouseActions = <> + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 17 + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterChanges1: TSynGutterChanges + Width = 5 + MouseActions = <> + ModifiedColor = 59900 + SavedColor = clGreen + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 3 + MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + Width = 13 + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + end + end + object btnRunProc: TSpeedButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 664 + Height = 31 + Top = 588 + Width = 205 + Action = MainForm.actRunRoutines + Anchors = [akRight, akBottom] + BorderSpacing.Around = 6 + Images = MainForm.ImageListIcons8 + ImageIndex = 35 + end +end diff --git a/source/routine_editor.pas b/source/routine_editor.pas new file mode 100644 index 00000000..1f671847 --- /dev/null +++ b/source/routine_editor.pas @@ -0,0 +1,591 @@ +unit routine_editor; + +{$mode delphi}{$H+} + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SynEdit, StdCtrls, + ComCtrls, ToolWin, laz.VirtualTrees, RegExpr, extra_controls, + dbconnection, apphelpers, Menus, ExtCtrls, Buttons, LCLProc; + +type + TFrame = TDBObjectEditor; + TfrmRoutineEditor = class(TFrame) + btnSave: TButton; + btnDiscard: TButton; + btnHelp: TButton; + lblSQLcode: TLabel; + SynMemoBody: TSynEdit; + PageControlMain: TPageControl; + tabOptions: TTabSheet; + tabParameters: TTabSheet; + tabCreateCode: TTabSheet; + chkDeterministic: TCheckBox; + editComment: TEdit; + comboSecurity: TComboBox; + comboDataAccess: TComboBox; + comboReturns: TComboBox; + comboType: TComboBox; + editName: TEdit; + lblName: TLabel; + lblType: TLabel; + lblReturns: TLabel; + lblSQL: TLabel; + lblSecurity: TLabel; + lblComment: TLabel; + listParameters: TLazVirtualStringTree; + tlbParameters: TToolBar; + btnAddParam: TToolButton; + btnRemoveParam: TToolButton; + btnClearParams: TToolButton; + SynMemoCREATEcode: TSynEdit; + btnRunProc: TSpeedButton; + lblDefiner: TLabel; + comboDefiner: TComboBox; + btnMoveUpParam: TToolButton; + btnMoveDownParam: TToolButton; + lblDisabledWhy: TLabel; + spltTop: TSplitter; + procedure comboTypeSelect(Sender: TObject); + procedure btnSaveClick(Sender: TObject); + procedure btnHelpClick(Sender: TObject); + procedure btnAddParamClick(Sender: TObject); + procedure listParametersGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); + procedure listParametersGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: TImageIndex); + procedure btnClearParamsClick(Sender: TObject); + procedure btnRemoveParamClick(Sender: TObject); + procedure listParametersBeforePaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas); + procedure listParametersFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); + procedure listParametersCreateEditor(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); + procedure listParametersNewText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; NewText: String); + procedure listParametersEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + procedure Modification(Sender: TObject); + procedure SynMemoBodyDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + procedure SynMemoBodyDragDrop(Sender, Source: TObject; X, Y: Integer); + procedure listParametersPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); + procedure btnDiscardClick(Sender: TObject); + procedure comboDefinerDropDown(Sender: TObject); + procedure btnMoveParamClick(Sender: TObject); + procedure PageControlMainChange(Sender: TObject); + private + { Private declarations } + FAlterRoutineType: String; + function ComposeCreateStatement(NameOfObject: String): String; + public + { Public declarations } + Parameters: TRoutineParamList; + constructor Create(AOwner: TComponent); override; + procedure Init(Obj: TDBObject); override; + function DeInit: TModalResult; override; + function ApplyModifications: TModalResult; override; + end; + + +implementation + +uses main, dbstructures, dbstructures.mysql; + +{$R *.lfm} + + +constructor TfrmRoutineEditor.Create(AOwner: TComponent); +begin + inherited; + // Combo items in a .dfm are sporadically lost after an IDE restart, + // so we set them here to avoid developer annoyance + comboType.Items.Add(_('Procedure (doesn''t return a result)')); + comboType.Items.Add(_('Function (returns a result)')); + comboDataAccess.Items.Add('Contains SQL'); + comboDataAccess.Items.Add('No SQL'); + comboDataAccess.Items.Add('Reads SQL data'); + comboDataAccess.Items.Add('Modifies SQL data'); + comboSecurity.Items.Add('Definer'); + comboSecurity.Items.Add('Invoker'); + Mainform.SynCompletionProposal.AddEditor(SynMemoBody); + Parameters := TRoutineParamList.Create; + editName.MaxLength := NAME_LEN; + FMainSynMemo := SynMemoBody; + btnSave.Hint := ShortCutToText(MainForm.actSaveSQL.ShortCut); +end; + + +procedure TfrmRoutineEditor.Init(Obj: TDBObject); +var + i: Integer; +begin + inherited; + FixVT(listParameters); + TExtForm.RestoreListSetup(listParameters); + if Obj.NodeType = lntProcedure then FAlterRoutineType := 'PROCEDURE' + else FAlterRoutineType := 'FUNCTION'; + editName.Text := DBObject.Name; + comboType.ItemIndex := 0; + comboReturns.Text := ''; + comboReturns.Clear; + for i:=0 to High(Obj.Connection.Datatypes) do + comboReturns.Items.Add(Obj.Connection.Datatypes[i].Name); + chkDeterministic.Checked := False; + SelectNode(listParameters, nil); + listParameters.Clear; + Parameters.Clear; + comboDataAccess.ItemIndex := 0; + comboSecurity.ItemIndex := 0; + editComment.Clear; + case Obj.NodeType of + lntProcedure: comboType.ItemIndex := 0; + lntFunction: comboType.ItemIndex := 1; + end; + comboDefiner.Text := ''; + comboDefiner.TextHint := f_('Current user (%s)', [Obj.Connection.CurrentUserHostCombination]); + comboDefiner.Hint := f_('Leave empty for current user (%s)', [Obj.Connection.CurrentUserHostCombination]); + SynMemoBody.Text := 'BEGIN'+CRLF+CRLF+'END'; + if ObjectExists then begin + // Editing existing routine + DBObject.Connection.ParseRoutineStructure(Obj, Parameters); + comboReturns.Text := Obj.Returns; + chkDeterministic.Checked := Obj.Deterministic; + if Obj.DataAccess <> '' then + comboDataAccess.ItemIndex := comboDataAccess.Items.IndexOf(Obj.DataAccess); + if Obj.Security <> '' then + comboSecurity.ItemIndex := comboSecurity.Items.IndexOf(Obj.Security); + editComment.Text := Obj.Comment; + comboDefiner.Text := Obj.Definer; + // The whole CREATE CODE may be empty if the user is not allowed to view code in SHOW CREATE FUNCTION + // => Disable the whole editor in this case. + SynMemoBody.Text := Obj.Body; + lblDisabledWhy.Visible := Obj.Body = ''; + PageControlMain.Enabled := not lblDisabledWhy.Visible; + SynMemoBody.Enabled := PageControlMain.Enabled; + SynMemoBody.TopLine := FMainSynMemoPreviousTopLine; + end else begin + editName.Text := ''; + end; + comboTypeSelect(comboType); + Modified := False; + btnSave.Enabled := Modified; + btnDiscard.Enabled := Modified; + {// Buttons are randomly moved, since VirtualTree update, see #440 - not required with anchors set + btnSave.Top := Height - btnSave.Height - 3; + btnHelp.Top := btnSave.Top; + btnDiscard.Top := btnSave.Top; + btnRunProc.Top := btnSave.Top; + btnRunProc.Left := Width - btnRunProc.Width - 3;} + Mainform.actRunRoutines.Enabled := ObjectExists; + Mainform.ShowStatusMsg; + TExtForm.PageControlTabHighlight(PageControlMain); + Screen.Cursor := crDefault; +end; + + +function TfrmRoutineEditor.DeInit: TModalResult; +begin + // Store GUI setup + TExtForm.SaveListSetup(listParameters); + Result := inherited; +end; + + +procedure TfrmRoutineEditor.Modification(Sender: TObject); +begin + Modified := True; + btnSave.Enabled := Modified and (editName.Text <> ''); + btnDiscard.Enabled := Modified; + SynMemoCreateCode.Text := ComposeCreateStatement(editName.Text); +end; + + +procedure TfrmRoutineEditor.PageControlMainChange(Sender: TObject); +begin + TExtForm.PageControlTabHighlight(PageControlMain); +end; + +procedure TfrmRoutineEditor.comboTypeSelect(Sender: TObject); +var + isfunc: Boolean; +begin + isfunc := (Sender as TComboBox).ItemIndex = 1; + lblReturns.Enabled := isfunc; + comboReturns.Enabled := isfunc; + Modification(Sender); + listParameters.Repaint; +end; + + +procedure TfrmRoutineEditor.comboDefinerDropDown(Sender: TObject); +begin + // Populate definers from mysql.user + (Sender as TComboBox).Items.Assign(DBObject.Connection.AllUserHostCombinations); +end; + + +procedure TfrmRoutineEditor.btnAddParamClick(Sender: TObject); +var + Param: TRoutineParam; + Position: Integer; +begin + Param := TRoutineParam.Create; + Param.Name := 'Param'+IntToStr(Parameters.Count+1); + Param.Datatype := 'INT'; + Param.Context := 'IN'; + if Assigned(listParameters.FocusedNode) then + Position := listParameters.FocusedNode.Index+1 + else + Position := Parameters.Count; + Parameters.Insert(Position, Param); + // See List.OnPaint: + listParameters.Repaint; + SelectNode(listParameters, Position); + Modification(Sender); +end; + + +procedure TfrmRoutineEditor.btnRemoveParamClick(Sender: TObject); +begin + Parameters.Delete(ListParameters.FocusedNode.Index); + listParameters.Repaint; + Modification(Sender); +end; + + +procedure TfrmRoutineEditor.btnClearParamsClick(Sender: TObject); +begin + Parameters.Clear; + listParameters.Repaint; + Modification(Sender); +end; + + +procedure TfrmRoutineEditor.btnMoveParamClick(Sender: TObject); +var + Source, Target: Integer; +begin + // Move param up or down + Source := ListParameters.FocusedNode.Index; + if Sender = btnMoveUpParam then + Target := Source -1 + else + Target := Source +1; + Parameters.Exchange(Source, Target); + SelectNode(listParameters, Target); + listParameters.Repaint; + Modification(Sender); +end; + + +procedure TfrmRoutineEditor.listParametersBeforePaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas); +begin + (Sender as TLazVirtualStringTree).RootNodeCount := Parameters.Count; +end; + + +procedure TfrmRoutineEditor.listParametersGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + List: TLazVirtualStringTree; + Context: String; +begin + // Draw arrow icon to indicate in/out context + if not (Kind in [ikNormal, ikSelected]) then Exit; + List := Sender as TLazVirtualStringTree; + if Column <> 3 then + ImageIndex := -1 + else begin + Context := List.Text[Node, 3]; + if Context = 'IN' then ImageIndex := 120 + else if Context = 'OUT' then ImageIndex := 121 + else if Context = 'INOUT' then ImageIndex := 122; + end; +end; + + +procedure TfrmRoutineEditor.listParametersGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + Param: TRoutineParam; +begin + Param := Parameters[Node.Index]; + case Column of + 0: CellText := IntToStr(Node.Index+1); + 1: CellText := Param.Name; + 2: CellText := Param.Datatype; + 3: begin + if comboType.ItemIndex = 1 then + CellText := 'IN' // A function can only have IN parameters + else + CellText := Param.Context; + end; + end; +end; + + +procedure TfrmRoutineEditor.listParametersPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + if (Column = 3) and (comboType.ItemIndex = 1) then + TargetCanvas.Font.Color := GetThemeColor(clBtnShadow); +end; + + +procedure TfrmRoutineEditor.listParametersFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); +var + HasNode: Boolean; +begin + // Enable/disable buttons + HasNode := Assigned(Node); + btnRemoveParam.Enabled := HasNode; + btnMoveUpParam.Enabled := HasNode and (Node <> Sender.GetFirst); + btnMoveDownParam.Enabled := HasNode and (Node <> Sender.GetLast); + + if HasNode and (not ((comboType.ItemIndex = 1) and (Column=3))) then + Sender.EditNode(Node, Column); +end; + + +procedure TfrmRoutineEditor.listParametersNewText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; NewText: String); +var + Param: TRoutineParam; + rx: TRegExpr; +begin + Param := Parameters[Node.Index]; + case Column of + 1: Param.Name := NewText; + 2: begin + rx := TRegExpr.Create; + rx.ModifierG := True; + rx.Expression := '^(\w+)(.*)$'; + if rx.Exec(NewText) then + NewText := UpperCase(rx.Match[1]) + rx.Match[2] + else + NewText := UpperCase(NewText); + rx.Free; + Param.Datatype := NewText; + end; + 3: Param.Context := NewText; + end; + Modification(Sender); +end; + + +procedure TfrmRoutineEditor.listParametersCreateEditor(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); +var + VT: TLazVirtualStringTree; + //EnumEditor: TEnumEditorLink; + Datatype: String; + DBDatatype: TDBDatatype; +begin + VT := Sender as TLazVirtualStringTree; + if Column = 1 then + EditLink := TStringEditLink.Create + {else if Column = 2 then begin + EnumEditor := TEnumEditorLink.Create(VT, True, nil); + EnumEditor.AllowCustomText := True; + EnumEditor.ValueList := TStringList.Create; + for DBDatatype in DBObject.Connection.Datatypes do begin + Datatype := DBDatatype.Name; + if DBDatatype.RequiresLength then + Datatype := Datatype + '(' + DBDatatype.DefLengthSet + ')'; + EnumEditor.ValueList.Add(Datatype); + end; + EditLink := EnumEditor; + end else if Column = 3 then begin + EnumEditor := TEnumEditorLink.Create(VT, True, nil); + EnumEditor.ValueList := TStringList.Create; + EnumEditor.ValueList.Add('IN'); + EnumEditor.ValueList.Add('OUT'); + EnumEditor.ValueList.Add('INOUT'); + EditLink := EnumEditor; + end;} +end; + + +procedure TfrmRoutineEditor.listParametersEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + // Do not allow the number cells to be edited + Allowed := Column > 0; + if (Column = 3) and (comboType.ItemIndex = 1) then begin + Allowed := False; + MessageDialog(_('A stored function can only have IN parameters so context editing is blocked.'), mtInformation, [mbOK]); + end; +end; + + +procedure TfrmRoutineEditor.SynMemoBodyDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +begin + // Allow dragging parameters here + Accept := Source = listParameters; + // set cursor position + SynMemoBody.CaretX := (x - SynMemoBody.Gutter.Width) div SynMemoBody.CharWidth - 1 + SynMemoBody.LeftChar; + SynMemoBody.CaretY := y div SynMemoBody.LineHeight + SynMemoBody.TopLine; + if not SynMemoBody.Focused then + SynMemoBody.SetFocus; +end; + + +procedure TfrmRoutineEditor.SynMemoBodyDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + list: TLazVirtualStringTree; + memo: TSynEdit; +begin + list := Source as TLazVirtualStringTree; + memo := Sender as TSynEdit; + memo.SelText := list.Text[list.FocusedNode, 1]; +end; + + +procedure TfrmRoutineEditor.btnSaveClick(Sender: TObject); +begin + // Apply or OK button clicked + ApplyModifications; +end; + + +function TfrmRoutineEditor.ApplyModifications: TModalResult; +var + TempName: String; + i: Integer; + allRoutineNames: TStringList; + ProcOrFunc: String; + TargetExists: Boolean; +begin + // Save changes + btnSave.Enabled := False; + btnDiscard.Enabled := False; + Result := mrOk; + case comboType.ItemIndex of + 0: ProcOrFunc := 'PROCEDURE'; + else ProcOrFunc := 'FUNCTION'; + end; + + // There is no way to ALTER parameters or the name of it. + // Create a temp routine, check for syntax errors, then drop the old routine and create it. + // See also: http://dev.mysql.com/doc/refman/5.0/en/alter-procedure.html + try + if ObjectExists then begin + // Create temp name + i := 0; + allRoutineNames := DBObject.Connection.GetCol('SELECT ROUTINE_NAME FROM '+DBObject.Connection.QuoteIdent(DBObject.Connection.InfSch)+'.'+DBObject.Connection.QuoteIdent('ROUTINES')+ + ' WHERE ROUTINE_SCHEMA = '+DBObject.Connection.EscapeString(DBObject.Connection.Database)+ + ' AND ROUTINE_TYPE = '+DBObject.Connection.EscapeString(ProcOrFunc) + ); + TargetExists := ((editName.Text <> DBObject.Name) or (ProcOrFunc <> FAlterRoutineType)) and + (allRoutineNames.IndexOf(editName.Text) > -1); + if TargetExists then begin + Result := MessageDialog(f_('Overwrite "%s"?', [editName.Text]), f_('Routine "%s" already exists.', [editName.Text]), + mtConfirmation, [mbYes, mbNo, mbCancel]); + if Result = mrNo then + Exit; + end; + while True do begin + inc(i); + TempName := APPNAME + '_temproutine_' + IntToStr(i); + if allRoutineNames.IndexOf(TempName) = -1 then + break; + end; + DBObject.Connection.Query(ComposeCreateStatement(tempName)); + // Drop temporary routine, used for syntax checking + DBObject.Connection.Query('DROP '+ProcOrFunc+' IF EXISTS '+DBObject.Connection.QuoteIdent(TempName)); + // Drop edited routine + DBObject.Connection.Query('DROP '+FAlterRoutineType+' IF EXISTS '+DBObject.Connection.QuoteIdent(DBObject.Name)); + if TargetExists then begin + // Drop target routine - overwriting has been confirmed, see above + DBObject.Connection.Query('DROP '+ProcOrFunc+' IF EXISTS '+DBObject.Connection.QuoteIdent(editName.Text)); + end; + end; + DBObject.Connection.Query(ComposeCreateStatement(editName.Text)); + // Set editing name if create/alter query was successful + DBObject.Name := editName.Text; + DBObject.UnloadDetails; + FAlterRoutineType := ProcOrFunc; + if FAlterRoutineType = 'PROCEDURE' then DBObject.NodeType := lntProcedure + else DBObject.NodeType := lntFunction; + Mainform.UpdateEditorTab; + Mainform.RefreshTree(DBObject); + Modified := False; + Mainform.actRunRoutines.Enabled := True; + except + on E:EDbError do begin + ErrorDialog(E.Message); + Result := mrAbort; + end; + end; + btnSave.Enabled := Modified; + btnDiscard.Enabled := Modified; +end; + + +function TfrmRoutineEditor.ComposeCreateStatement(NameOfObject: String): String; +var + ProcOrFunc, tmp: String; + i: Integer; + Params: TStringList; +begin + case comboType.ItemIndex of + 0: ProcOrFunc := 'PROCEDURE'; + else ProcOrFunc := 'FUNCTION'; + end; + Result := 'CREATE '; + if comboDefiner.Text <> '' then + Result := Result + 'DEFINER='+DBObject.Connection.QuoteIdent(comboDefiner.Text, True, '@')+' '; + Result := Result + ProcOrFunc+' '+DBObject.Connection.QuoteIdent(NameOfObject)+'('; + Params := TStringList.Create; + for i:=0 to Parameters.Count-1 do begin + tmp := ''; + if ProcOrFunc = 'PROCEDURE' then + tmp := tmp + Parameters[i].Context + ' '; + tmp := tmp + DBObject.Connection.QuoteIdent(Parameters[i].Name) + ' ' + Parameters[i].Datatype; + Params.Add(tmp); + end; + if Params.Count > 0 then + Result := Result + sLineBreak + CodeIndent + Implode(',' + sLineBreak + CodeIndent, Params) + sLineBreak; + Result := Result + ')'+CRLF; + if comboReturns.Enabled then + Result := Result + 'RETURNS '+comboReturns.Text+CRLF; + Result := Result + 'LANGUAGE SQL'+CRLF; + if not chkDeterministic.Checked then + Result := Result + 'NOT '; + Result := Result + 'DETERMINISTIC'+CRLF + + UpperCase(comboDataAccess.Text)+CRLF + + 'SQL SECURITY ' + UpperCase(comboSecurity.Text)+CRLF + + 'COMMENT ' + DBObject.Connection.EscapeString(editComment.Text)+CRLF + + SynMemoBody.Text; +end; + + +procedure TfrmRoutineEditor.btnDiscardClick(Sender: TObject); +begin + Modified := False; + Init(DBObject); +end; + + +procedure TfrmRoutineEditor.btnHelpClick(Sender: TObject); +begin + // Help button + Help(Self, 'createroutine'); +end; + + +end.