src/lib/text.slate

   1 prototypes ensureNamespace: #text &delegate: True.
   2
   3 text define: #BufferPointer &parents: {Comparable}.
   4 text define: #TextBuffer &parents: {Cloneable} &slots: {#lines. #view}. "call view update when changed"
   5
   6 TextBuffer traits define: #Pointer &parents: {BufferPointer}
   7  &slots: {#lineNo. #columnNo. #partner}.
   8
   9 p@(TextBuffer Pointer traits) newAtLine: lineNo column: columnNo &partner: partner
  10 [p clone `setting: #{#lineNo. #columnNo. #partner} to: {lineNo. columnNo. partner}].
  11
  12 p1@(TextBuffer Pointer traits) < p2@(BufferPointer traits)
  13 [
  14   p1 lineNo < p2 lineNo \/
  15     [p1 lineNo = p2 lineNo /\ [p1 columnNo < p2 columnNo]]
  16 ].
  17
  18 "the following doesn't work.. doesn't specialize on traits:
  19
  20 ( #= findOn: {TextBuffer Pointer traits. TextBuffer Pointer traits}) disassemble.
  21
  22 (identity comparison)
  23
  24 ( #= findOn: {TextBuffer Pointer. TextBuffer Pointer}) disassemble.
  25
  26 (slot per slot comparison)
  27 "
  28
  29 TextBuffer Pointer compareAndHashUsingSlots: #{#lineNo. #columnNo}.
  30
  31 "so I did this:"
  32
  33 p1@(TextBuffer Pointer traits) = p2@(TextBuffer Pointer traits)
  34 [
  35   p1 lineNo = p2 lineNo /\ [p1 columnNo = p2 columnNo]
  36 ].
  37
  38 " -- some primitive commands I'm making to help with fundamental mode -- "
  39
  40 text define: #TextBufferCommand &parents: {Command} &slots: {#buffer -> Nil.}.
  41
  42 text define: #TextBufferBlockCommand &parents: {BlockCommand. TextBufferCommand} &slots: {}.
  43 text define: #TextBufferCommandGroup &parents: {CommandGroup. TextBufferCommand} &slots: {}.
  44
  45 "define slots for undo information, other stuff is passed in the #arguments"
  46 text define: #TextBufferPointManipulationCommand &parents: {TextBufferCommand} &slots: {#oldPoint -> Nil.}.
  47
  48 text define: #MovePointCommand &parents: {TextBufferPointManipulationCommand}.
  49 text define: #MovePointBeginningOfLineCommand &parents: {MovePointCommand}.
  50 text define: #MovePointEndOfLineCommand &parents: {MovePointCommand}.
  51 text define: #DropMarkCommand &parents: {TextBufferPointManipulationCommand}.
  52
  53 text define: #InsertTextCommand &parents: {TextBufferCommand} &slots: {#numCharacters -> 0}.
  54
  55 text define: #CopyRegionCommand &parents: {TextBufferCommand} &slots: {#oldPasteRing -> Nil.}.
  56 text define: #DeleteRegionCommand &parents: {TextBufferPointManipulationCommand} &slots:
  57 {
  58   #deletedText -> ''.
  59   #oldMark -> Nil
  60 }.
  61
  62 "The following deletes (sucks) from the right like the delete key, the
  63 first argument is the point, the second is the number of times the
  64 user would hit delete to accomplish the action. This behaves just like
  65 InsertText and of course the user defined actions would include
  66 actions later to move the point after the text is inserted."
  67
  68 text define: #DeleteFromPointCommand &parents: {TextBufferPointManipulationCommand} &slots: {#oldText -> ''.}.
  69
  70 tbc@(TextBufferCommand traits) name: name arguments: arguments buffer: buffer
  71 [
  72   tbc clone `setting: #{#name. #arguments. #buffer} to: {name. arguments. buffer}
  73 ].
  74
  75 " -- required functions by every buffer implementation -- "
  76
  77 "negative distance is towards the origin -- this should wrap also and is DESTRUCTIVE to p"
  78 p@(TextBuffer Pointer traits) moveOn: tb@(TextBuffer traits) distance: i@(Integer traits)
  79 [overrideThis].
  80
  81 p1@(TextBuffer Pointer traits) isConnectedTo: p2@(TextBuffer Pointer traits)
  82 [p1 partner == p2 /\ [p2 partner == p1]].
  83
  84 p1@(TextBuffer Pointer traits) connectTo: p2@(TextBuffer Pointer traits)
  85 [
  86   p1 partner := p2.
  87   p2 partner := p1.
  88   p1
  89 ].
  90
  91 p1@(TextBuffer Pointer traits) setTo: p2@(TextBuffer Pointer traits)
  92 [
  93   p1 partner := p2 partner.
  94   p1 lineNo := p2 lineNo.
  95   p1 columnNo := p2 columnNo.
  96   p1
  97 ].
  98
  99 p1@(TextBuffer Pointer traits) disconnect
 100 [
 101   p1 partner ifNotNil: [p1 partner partner := Nil.].
 102   p1 partner := Nil.
 103   p1
 104 ].
 105
 106 tb@(TextBuffer traits) makePointActive: p1@(TextBuffer Pointer traits)
 107 [tb view update. p1].
 108
 109 tb@(TextBuffer traits) ensurePointActive: p1@(TextBuffer Pointer traits)
 110 "delete the current point if it's not it"
 111 [tb view update. p1].
 112
 113 tb@(TextBuffer traits) addPoint: p1@(TextBuffer Pointer traits)
 114 [tb view update. p1].
 115
 116 tb@(TextBuffer traits) deletePoint: p1@(TextBuffer Pointer traits)
 117 [tb view update. p1].
 118
 119 tb@(TextBuffer traits) allPoints
 120 [overrideThis].
 121
 122 tb@(TextBuffer traits) activePoint
 123 [overrideThis].
 124
 125 tb@(TextBuffer traits) at: p1@(TextBuffer Pointer traits) insert: text
 126 [tb view update. tb].
 127
 128 tb@(TextBuffer traits) at: p1@(TextBuffer Pointer traits) delete: characters@(Integer traits)
 129 [tb view update. tb].
 130
 131 tb@(TextBuffer traits) getContentsFrom: p1@(TextBuffer Pointer traits) to: p2@(TextBuffer Pointer traits)
 132 [overrideThis].
 133
 134 tb@(TextBuffer traits) at: p1@(TextBuffer Pointer traits)
 135 [overrideThis].
 136
 137 tb@(TextBuffer traits) at: p1@(TextBuffer Pointer traits) ifAbsent: block
 138 [overrideThis].
 139
 140 tb@(TextBuffer traits) beginningOfBuffer
 141 " return a point "
 142 [overrideThis].
 143
 144 tb@(TextBuffer traits) endOfBuffer
 145 " return a point "
 146 [overrideThis].
 147
 148 tb@(TextBuffer traits) endOfLine: lineNo
 149 " return a point "
 150 [overrideThis].
 151
 152 " -- some given command interface commands using base functionality
 153 that need to be overridden per-buffer impl. --"
 154
 155 "FIXME unoverride this and make it install the command into a undo/recording place"
 156
 157 action@(TextBufferCommand traits) execute
 158 [overrideThis].
 159
 160 action@(TextBufferCommand traits) undo
 161 "do the opposite"
 162 [overrideThis].
 163
 164 action@(TextBufferCommand traits) pointArgument
 165 [
 166   ((action arguments at: 0) ifNil: [action buffer activePoint])
 167 ].
 168
 169 action@(MovePointCommand traits) execute
 170 [| point distance |
 171   action buffer view update.
 172   lobby inform: ('execute: ' ; action printString ; ' args: ' ; action arguments printString).
 173   point := action pointArgument.
 174   distance := (action arguments at: 1).
 175
 176   action oldPoint := point copy.
 177
 178   " the second argument can be an integer or another point's location "
 179
 180   (distance is: TextBuffer Pointer)
 181           ifTrue: [point setTo: distance]
 182           ifFalse: [point moveOn: action buffer distance: distance].
 183   action
 184 ].
 185
 186 action@(MovePointCommand traits) undo
 187 [
 188   action buffer view update.
 189   action pointArgument setTo: (action oldPoint).
 190 ].
 191
 192 action@(MovePointBeginningOfLineCommand traits) execute
 193 [| point |
 194   action buffer view update.
 195   point := action pointArgument.
 196
 197   action oldPoint := point copy.
 198
 199   " the second argument can be an integer or another point's location "
 200
 201   point columnNo := 0.
 202   action
 203 ].
 204
 205 action@(MovePointEndOfLineCommand traits) execute
 206 [| point |
 207   action buffer view update.
 208
 209   point := action pointArgument.
 210
 211   action oldPoint := point copy.
 212
 213   " the second argument can be an integer or another point's location "
 214
 215   point columnNo := (action buffer lines at: point lineNo) size.
 216   action
 217 ].
 218
 219 action@(DropMarkCommand traits) execute
 220 [| newPartner |
 221  action oldPoint := action buffer activePoint partner.
 222  action buffer activePoint partner := Nil.
 223
 224  newPartner := action buffer activePoint copy.
 225  action buffer addPoint: newPartner.
 226
 227  action buffer activePoint connectTo: newPartner.
 228
 229  lobby inform: action buffer activePoint printString.
 230
 231  action
 232 ].
 233
 234 action@(DropMarkCommand traits) undo
 235 [
 236  action buffer deletePoint: action buffer activePoint partner.
 237  action buffer activePoint partner := action oldPoint.
 238
 239  lobby inform: action buffer activePoint printString.
 240 ].
 241
 242
 243 action@(InsertTextCommand traits) execute
 244 [| point |
 245
 246   point := action pointArgument.
 247   action buffer at: point insert: (action arguments at: 1).
 248   action numCharacters := (action arguments at: 1) size.
 249   action
 250 ].
 251
 252 action@(InsertTextCommand traits) undo
 253 [
 254   action buffer at: action pointArgument delete: action numCharacters.
 255 ].
 256
 257 action@(CopyRegionCommand traits) execute
 258 [
 259   "FIXME figure out the pastering thingy #oldPasteRing"
 260   action oldPasteRing := action buffer getContentsFrom: action buffer activePoint
 261                              to: (action buffer activePoint partner ifNil: [action buffer activePoint]).
 262   action
 263 ].
 264
 265 action@(CopyRegionCommand traits) undo
 266 [
 267   action "FIXME"
 268 ].
 269
 270 action@(DeleteRegionCommand traits) execute
 271 [
 272   (action buffer activePoint partner)
 273    ifNil: [action deletedText := ''.
 274            action oldPoint := action buffer activePoint.
 275            action oldMark := Nil]
 276    ifNotNil: [action oldPoint := action buffer activePoint copy.
 277               action oldMark := action buffer activePoint partner copy.
 278               action deletedText := (action buffer getContentsFrom: action buffer activePoint
 279                               to: action buffer activePoint partner).
 280               action buffer at: (action buffer activePoint min: action buffer activePoint partner)
 281                             delete: action deletedText size.
 282               action buffer activePoint setTo: (action buffer activePoint min: action buffer activePoint partner).
 283               action buffer deletePoint: action oldPoint.
 284               action buffer activePoint disconnect]
 285 ].
 286
 287 action@(DeleteRegionCommand traits) undo
 288 [
 289   action oldMark ifNotNilDo:
 290     [| :oldPoint |
 291      action buffer activePoint setTo: oldPoint.
 292      action buffer activePoint partner setTo: action oldMark.
 293      action buffer at: (action buffer activePoint min: action buffer activePoint partner)
 294                insert: action deletedText]
 295 ].
 296
 297 action@(DeleteFromPointCommand traits) execute
 298 [| point distance |
 299   point := action pointArgument.
 300   distance := (action arguments at: 1).
 301   action oldText := (action buffer getContentsFrom: point to: (point copy moveOn: action buffer distance: distance)).
 302   action buffer at: point delete: distance.
 303 ].
 304
 305 action@(DeleteFromPointCommand traits) undo
 306 [
 307   action buffer at: action pointArgument insert: action oldText.
 308 ].
 309
 310 " -- simple buffer and support functions, override the functions that need overriding  -- "
 311
 312 text define: #ArrayTextBuffer &parents: {TextBuffer}.
 313
 314 tb@(ArrayTextBuffer traits) pointerToLine: lineNo column: columnNo
 315 [tb Pointer newAtLine: lineNo column: columnNo].
 316
 317 tb@(ArrayTextBuffer traits) beginningOfBuffer
 318 [tb pointerToLine: 0 column: 0].
 319
 320 tb@(ArrayTextBuffer traits) endOfLine: lineNo
 321 " return a point "
 322 [(tb lines at: lineNo) length].
 323
 324 tb@(ArrayTextBuffer traits) endOfBuffer
 325 [| lastLineNo |
 326   lastLineNo := tb lines indexLast.
 327   tb pointerToLine: lastLineNo column: (tb endOfLine: lastLineNo)
 328 ].
 329
 330 ArrayTextBuffer addSlot: #cursors valued:
 331   (ExtensibleArray new*, ArrayTextBuffer beginningOfBuffer).
 332
 333 atb@(ArrayTextBuffer traits) new
 334 [
 335   resend `>> [lines := ExtensibleArray new*, (ExtensibleArray new). ]
 336 ].
 337
 338 "negative distance is towards the origin -- this should wrap also and is DESTRUCTIVE to p"
 339 p@(TextBuffer Pointer traits) moveOn: tb@(TextBuffer traits) distance: i@(Integer traits)
 340 [
 341   tb view update.
 342   p assureOn: tb.
 343
 344   lobby inform: '--'.
 345   lobby inform: ('move from: ' ; (p printString) ; ' dist: ' ; i printString).
 346
 347   i isNegative
 348     ifTrue: "move back"
 349       [[tb beginningOfBuffer = p \/ [i = 0]] whileFalse:
 350          [p columnNo isZero
 351             ifTrue: [p lineNo := p lineNo - 1. p columnNo := (tb endOfLine: p lineNo)]
 352             ifFalse: [p columnNo := p columnNo - 1].
 353           i += 1]]
 354     ifFalse: "move forward"
 355       [[p = tb endOfBuffer \/ [i isZero]] whileFalse:
 356          [(p columnNo = (tb endOfLine: p lineNo))
 357             ifTrue: [p lineNo := p lineNo + 1. p columnNo := 0]
 358             ifFalse: [p columnNo := p columnNo + 1].
 359           i -= 1]].
 360
 361   lobby inform: 'move to: ' ; p printString ; ' dist: ' ; i printString.
 362   p
 363 ].
 364
 365 tb@(ArrayTextBuffer traits) makePointActive: p1@(TextBuffer Pointer traits)
 366 [
 367   resend.
 368   tb cursors remove: p1 ifAbsent: [].
 369   tb cursors addFirst: p1.
 370   p1
 371 ].
 372
 373 tb@(ArrayTextBuffer traits) ensurePointActive: p1@(TextBuffer Pointer traits)
 374 [
 375   resend.
 376   tb activePoint == p1 ifFalse:
 377     [tb cursors remove: tb activePoint.
 378      tb cursors remove: p1 ifAbsent: [].
 379      tb cursors addFirst: p1].
 380   p1
 381 ].
 382
 383 tb@(ArrayTextBuffer traits) addPoint: p1@(TextBuffer Pointer traits)
 384 [
 385   resend.
 386   tb cursors addLast: p1.
 387 ].
 388
 389 tb@(ArrayTextBuffer traits) deletePoint: p1@(TextBuffer Pointer traits)
 390 [
 391   resend.
 392   tb cursors remove: p1.
 393 ].
 394
 395 tb@(ArrayTextBuffer traits) allPoints
 396 [
 397   tb cursors
 398 ].
 399
 400 tb@(ArrayTextBuffer traits) activePoint
 401 [
 402   tb cursors at: 0
 403 ].
 404
 405 p1@(TextBuffer Pointer traits) assureOn: tb@(ArrayTextBuffer traits)
 406 [
 407  "if it's off the end of the line, put it on the last character"
 408  p1 columnNo <= (tb lines at: p1 lineNo) size ifFalse:
 409    [p1 columnNo := (tb lines at: p1 lineNo) size].
 410 ].
 411
 412 tb@(ArrayTextBuffer traits) at: p1@(TextBuffer Pointer traits) insert: text
 413 [
 414   resend.
 415
 416  " if you want to insert text but the cursor is off the end of the
 417  line (from a previous-line, etc instr), then move the cursor back
 418  first."
 419
 420   p1 assureOn: tb.
 421
 422   (text is: String)
 423     ifTrue: [text reverse do: [| :char | tb at: p1 insert: char]]
 424     ifFalse: " insert the character "
 425       [text = $\n \/ [text = $\r]
 426          ifTrue:
 427            [| chars |
 428             chars := (tb lines at: p1 lineNo) removeLast:
 429               (tb lines at: p1 lineNo) size - p1 columnNo.
 430             tb lines at: p1 lineNo + 1 insert: (chars as: tb lines first)]
 431          ifFalse: [(tb lines at: p1 lineNo) at: p1 columnNo insert: text]]
 432 ].
 433
 434 tb@(ArrayTextBuffer traits) at: p1@(TextBuffer Pointer traits) delete: characters@(Integer traits)
 435 [
 436   p1 assureOn: tb.
 437   resend.
 438   lobby inform: ('delete at: ' ; (p1 printString)).
 439   characters timesRepeat:
 440     [(p1 = tb endOfBuffer) ifFalse:
 441       [p1 columnNo = (tb endOfLine: p1 lineNo)
 442          ifTrue:
 443            ["cursor at end of line, suck up the next one"
 444             (tb lines at: p1 lineNo) addAll: (tb lines at: p1 lineNo + 1).
 445             tb lines removeAt: p1 lineNo + 1]
 446          ifFalse:
 447            ["delete a character"
 448             (tb lines at: p1 lineNo) removeAt: p1 columnNo]]]
 449 ].
 450
 451 tb@(ArrayTextBuffer traits) getContentsFrom: p1@(TextBuffer Pointer traits) to: p2@(TextBuffer Pointer traits)
 452 [| min max |
 453   p1 < p2
 454     ifTrue: [min := p1 copy. max := p2 copy]
 455     ifFalse: [min := p2 copy. max := p1 copy].
 456   [| :result |
 457    "FIXME: handle newlines"
 458    [min < max] whileTrue:
 459      [result ; ((tb at: min ifAbsent: ['\n']) as: String).
 460       min moveOn: tb distance: 1].
 461    result ; ((tb at: min ifAbsent: ['\n']) as: String) "capture last character"
 462    ] writingAs: ''
 463 ].
 464
 465 tb@(ArrayTextBuffer traits) at: p1@(TextBuffer Pointer traits)
 466 [
 467   tb at: p1 ifAbsent: [break]
 468 ].
 469
 470 tb@(ArrayTextBuffer traits) at: p1@(TextBuffer Pointer traits) ifAbsent: block
 471 [
 472  p1 assureOn: tb.
 473  p1 lineNo >= tb lines size
 474    /\ [p1 columnNo >= (tb lines at: p1 lineNo) size]
 475    ifTrue: [block do]
 476    ifFalse: [(tb lines at: p1 lineNo) at: p1 columnNo ifAbsent: [block do]]
 477 ].