1 #Region "Microsoft.VisualBasic::17805255bceab15b494eb0d3c45d8349, Microsoft.VisualBasic.Core\ApplicationServices\Terminal\InteractiveIODevice\InteractiveDevice.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Class InteractiveDevice
35     
36     '         Properties: PromptText
37     
38     '         Constructor: (+1 OverloadsSub New
39     
40     '         Function: ReadKey, ReadLine, (+2 Overloads) Save
41     
42     '         Sub: (+2 Overloads) Dispose, InternalClearLine, PrintPrompted
43     
44     
45     ' /********************************************************************************/
46
47 #End Region
48
49 Imports System.Text
50 Imports Microsoft.VisualBasic.ComponentModel
51 Imports Microsoft.VisualBasic.Text
52
53 Namespace Terminal
54
55     Public Class InteractiveDevice : Inherits Terminal
56         Implements System.IDisposable
57         Implements ISaveHandle
58
59         Dim _innerBuffer As StringBuilder = New StringBuilder(2048)
60         Dim _cmdsHistory As HistoryStacks
61         Dim Blanks As String
62
63         ''' <summary>
64         ''' 
65         ''' </summary>
66         ''' <param name="s"></param>
67         ''' <remarks></remarks>
68         Public Event NewOutputMessage(s As String)
69
70         Public Property PromptText As String
71
72         ''' <summary>
73         ''' 
74         ''' </summary>
75         ''' <param name="HistoryFile">历史数据文件的存放位置,假若为空,则使用默认文件路径</param>
76         ''' <remarks></remarks>
77         Sub New(Optional HistoryFile As String = "")
78             If String.IsNullOrEmpty(HistoryFile) Then
79                 HistoryFile = $"{Application.ExecutablePath}.commandline_histories.dat"
80             End If
81
82             Try
83                 _cmdsHistory = HistoryFile.LoadXml(Of HistoryStacks)()
84             Catch ex As Exception
85                 _cmdsHistory = New HistoryStacks()
86                 Call _cmdsHistory.Save(HistoryFile)
87             End Try
88
89             If _cmdsHistory Is Nothing Then
90                 _cmdsHistory = New HistoryStacks(HistoryFile)
91             End If
92
93             Call _cmdsHistory.StartInitialize()
94
95             PromptText = "#"
96             Blanks = New String(" "c, Console.BufferWidth)
97         End Sub
98
99         Dim _cacheReadLine As String
100         Dim _EmptyHistory As Boolean, _historyControl As Boolean = True
101
102         Public Overrides Function ReadKey() As ConsoleKeyInfo
103             Dim n = Console.ReadKey
104
105             _historyControl = True
106
107             Select Case n.Key
108                 Case ConsoleKey.UpArrow
109                     _cacheReadLine = _cmdsHistory.MovePrevious
110                 Case ConsoleKey.DownArrow
111                     _cacheReadLine = _cmdsHistory.MoveNext
112                 Case ConsoleKey.Home
113                     _cacheReadLine = _cmdsHistory.MoveFirst
114                 Case ConsoleKey.End
115                     _cacheReadLine = _cmdsHistory.MoveLast
116                 Case Else
117                     _historyControl = False
118             End Select
119
120             If _historyControl Then
121                 Call Console.SetCursorPosition(Console.CursorLeft - 1, CursorTop)       '回移一格,因为控制符也会被输出的
122             End If
123
124             If Not String.IsNullOrEmpty(_cacheReadLine) Then
125                 Call InternalClearLine(Console.CursorTop)
126                 Call Console.Write(_cacheReadLine)
127                 _EmptyHistory = False
128             ElseIf Not String.IsNullOrEmpty(HistoryCallerStack) Then
129                 _cacheReadLine = HistoryCallerStack
130                 HistoryCallerStack = ""
131                 _EmptyHistory = False
132             Else
133                 _cacheReadLine = ""
134                 _EmptyHistory = True   '空的历史
135             End If
136
137             Return n
138         End Function
139
140         ''' <summary>
141         ''' ReadLine函数的递归返回值
142         ''' </summary>
143         ''' <remarks></remarks>
144         Dim HistoryCallerStack As String
145
146         Public Overrides Function ReadLine() As String
147             Dim strCommand As String = "", n = Me.ReadKey()
148
149             If _historyControl Then '用户浏览了历史记录
150                 HistoryCallerStack = _cacheReadLine
151                 Return Me.ReadLine
152             Else
153                 If n.Key = ConsoleKey.Enter Then '用户输入了数据
154                     strCommand = _cacheReadLine
155                 Else '用户还没有完成输入
156 EXIT_INPUT:         strCommand = HistoryCallerStack & n.KeyChar & MyBase.ReadLine
157                 End If
158             End If
159
160             HistoryCallerStack = ""
161             _cacheReadLine = ""
162
163             '            If Not String.IsNullOrEmpty(_InternalCacheReadLine) Then
164             '                strCommand = n.KeyChar & _InternalCacheReadLine
165             '                _InternalCacheReadLine = ""
166             '                If Not n.Key = ConsoleKey.Enter Then
167             '                    If _historyControl Then
168             '                        '用户调出了历史,但是没有按下回车,可能还会继续浏览历史
169             '                        HistoryCallerStack = strCommand
170             '                        Return Me.ReadLine()   '上一个按键是方向键
171             '                    Else
172             '                        GoTo EXIT_INPUT       '不是方向键则输出
173             '                    End If
174             '                Else
175             '                    If _EmptyHistory Then
176             '                        Call Me.PrintPrompted(Lf:=True)
177             '                        Return Me.ReadLine()
178             '                    Else
179             '                        Call Console.WriteLine()
180             '                    End If
181             '                End If
182             '            Else
183             '                If _historyControl Then '历史记录是空的,但是任然算是浏览了历史记录
184             '                    Return Me.ReadLine
185             '                End If
186
187             '                If n.Key = ConsoleKey.Enter Then
188             '                    Return Me.ReadLine           '没有输入,则换行并要求重新输入
189             '                Else
190             'EXIT_INPUT:         strCommand = strCommand & MyBase.ReadLine
191             '                End If
192             '            End If
193
194             Call _cmdsHistory.PushStack(strCommand)
195
196             Return strCommand
197         End Function
198
199         Public Sub PrintPrompted(Optional Lf As Boolean = False)
200             If Lf Then Call Console.WriteLine()
201             Call Console.Write(PromptText & "  ")
202         End Sub
203
204         Private Sub InternalClearLine(top As Integer)
205             Dim current As Integer = Console.CursorTop
206
207             Call Console.SetCursorPosition(Len(PromptText) + 2, top)
208             Call Console.Write(Blanks)
209             Call Console.SetCursorPosition(Len(PromptText) + 2, current)
210         End Sub
211
212 #Region "IDisposable Support"
213         Private disposedValue As Boolean To detect redundant calls
214
215         ' IDisposable
216         Protected Overridable Sub Dispose(disposing As Boolean)
217             If Not Me.disposedValue Then
218                 If disposing Then
219                     Call Me.Save(encoding:=Encodings.UTF8)
220                     ' TODO: dispose managed state (managed objects).
221                 End If
222
223                 ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
224                 ' TODO: set large fields to null.
225             End If
226             Me.disposedValue = True
227         End Sub
228
229         ' TODO: override Finalize() only if Dispose(      disposing As Boolean) above has code to free unmanaged resources.
230         'Protected Overrides Sub Finalize()
231         '    ' Do not change this code.  Put cleanup code in Dispose(      disposing As Boolean) above.
232         '    Dispose(False)
233         '    MyBase.Finalize()
234         'End Sub
235
236         ' This code added by Visual Basic to correctly implement the disposable pattern.
237         Public Sub Dispose() Implements IDisposable.Dispose
238             Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
239             Dispose(True)
240             GC.SuppressFinalize(Me)
241         End Sub
242 #End Region
243
244         ''' <summary>
245         ''' 保存历史数据
246         ''' </summary>
247         ''' <param name="Path"></param>
248         ''' <param name="encoding"></param>
249         ''' <returns></returns>
250         ''' <remarks></remarks>
251         Public Function Save(Optional Path As String = ""Optional encoding As Encoding = NothingAs Boolean Implements ISaveHandle.Save
252             Return _cmdsHistory.Save(Path, encoding)
253         End Function
254
255         Public Function Save(Optional Path As String = ""Optional encoding As Encodings = Encodings.UTF8) As Boolean Implements ISaveHandle.Save
256             Return Save(Path, encoding.CodePage)
257         End Function
258     End Class
259 End Namespace