src/lib/navigator.slate

   1 prototypes define: #NavigationHistory
   2 &slots: {
   3 #here -> here.
   4 #pastVisits -> ExtensibleSequence new.
   5 "Remembered visits in sequential, historical order."
   6 #futureVisits -> ExtensibleSequence new.
   7 "Remembered visits when navigation proceeds backwards."
   8 #allVisits -> Set new.
   9 "All visits this NavigationHistory has ever touched."
  10 #rememberTest -> [| :_ | True].
  11 "Answers whether a particular object, when visited, should be remembered."
  12 }.
  13
  14 nh@(NavigationHistory traits) new
  15 [
  16   resend `>> [clear. rememberTest := [| :_ | True]. ]
  17 ].
  18
  19 nh@(NavigationHistory traits) clear
  20 [
  21   nh here := Nil.
  22   nh allVisits := nh allVisits new.
  23   nh clearFuture.
  24   nh clearPast.
  25 ].
  26
  27 nh@(NavigationHistory traits) clearFuture
  28 [
  29   nh futureVisits := nh futureVisits new.
  30 ].
  31
  32 nh@(NavigationHistory traits) clearPast
  33 [
  34   nh pastVisits := nh pastVisits new.
  35 ].
  36
  37 nh@(NavigationHistory traits) hasFuture
  38 [
  39   nh futureVisits isNotEmpty
  40 ].
  41
  42 nh@(NavigationHistory traits) hasPast
  43 [
  44   nh pastVisits isNotEmpty
  45 ].
  46
  47 nh@(NavigationHistory traits) shouldRemember: obj
  48 [
  49   (nh rememberTest applyWith: obj) not
  50 ].
  51
  52 nh@(NavigationHistory traits) remember: obj
  53 [
  54   nh allVisits remove: obj ifAbsent: [].
  55   nh allVisits add: obj.
  56 ].
  57
  58 nh@(NavigationHistory traits) next
  59 "Answer the closest visit from the future. Fail if the future is empty."
  60 [
  61   nh futureVisits first
  62 ].
  63
  64 nh@(NavigationHistory traits) previous
  65 "Answer the closest visit from the past. Fail if the past is empty."
  66 [
  67   nh pastVisits last
  68 ].
  69
  70 nh@(NavigationHistory traits) do: block
  71 [
  72   (nh shouldRemember: nh here) ifFalse: [block applyWith: nh here].
  73   nh allVisits do: block
  74 ].
  75
  76 nh@(NavigationHistory traits) goBack
  77 [
  78   nh hasPast ifTrue:
  79     [(nh shouldRemember: nh here) ifTrue:
  80       [nh futureVisits addFirst: nh here].
  81      nh here := nh pastVisits removeLast].
  82 ].
  83
  84 nh@(NavigationHistory traits) goBackTo: obj
  85 [
  86   [nh here = obj \/ [nh hasPast not]] whileFalse: [nh goBack]
  87 ].
  88
  89 nh@(NavigationHistory traits) goForward
  90 [
  91   nh hasFuture ifTrue:
  92     [(nh shouldRemember: nh here) ifTrue:
  93       [nh pastVisits addLast: nh here].
  94      nh here := nh futureVisits removeFirst].
  95 ].
  96
  97 nh@(NavigationHistory traits) goForwardTo: obj
  98 [
  99   [nh here = obj \/ [nh hasFuture not]] whileFalse: [nh goForward]
 100 ].
 101
 102 nh@(NavigationHistory traits) visit: obj
 103 "Make the argument the current object of the history.
 104 The prior current object becomes the last object of the 'past' queue.
 105 The 'future' queue is erased, unless the visit is the first future element."
 106 [
 107   nh here = obj ifFalse:
 108     [nh here isNotNil /\ [nh shouldRemember: nh here] ifTrue:
 109       [nh pastVisits addLast: here].
 110      nh here := obj.
 111      (nh shouldRemember: obj) ifTrue: [nh remember: obj].
 112      nh hasFuture ifTrue:
 113        [nh futureVisits first = nh here
 114           ifTrue: [nh futureVisits removeFirst]
 115           ifFalse: [nh clearFuture]].
 116      ].
 117 ].
 118
 119 nh@(NavigationHistory traits) hasVisited: obj
 120 [
 121   nh allVisits includes: obj
 122 ].
 123
 124 prototypes define: #Navigator
 125 "This is a very basic object navigator, for playing around and ease of use
 126 at the command line."
 127 &slots: {
 128 #history -> (NavigationHistory new `>> [remember: here. ]).
 129 "The previous objects inspected into; the series of contexts followed."
 130 #namespace -> (Namespace clone `>> [addDelegate: lobby. ])
 131 "The namespace in which expressions are evaluated."}.
 132
 133 i@(Navigator traits) newOn: obj
 134 [i clone `setting: #{#history} to: {i history new `>> [remember: obj. ]}].
 135
 136 _@(Namespace traits) inspect: obj
 137 [| i |
 138   i := (Navigator newOn: obj).
 139   here inform: 'You are in a twisty little maze of objects, all alike.'.
 140   obj
 141 ].
 142
 143 i@(Navigator traits) help &target: r
 144 [
 145   (r ifNil: [Console]) writer
 146     ; 'The Navigator is an extension to the evaluator which allows "travelling" and keeps a navigable travel-history.\n'
 147     ; 'here - Answers the current location.\n'
 148     ; 'go: address - Visits the object at the slot-name or index of \'here\'.\n'
 149     ; 'slots - Shows the current slots here.\n'
 150     ; 'indexedSlots - Shows the current array slots here, if any.\n'
 151     ; 'parents - Shows the current parent slots here.\n'
 152     ; 'visit: obj - Visits the mentioned object.\n'
 153     ; 'history - Shows the history of visited objects.'
 154     ; 'back - Goes back one step in the history.\n'
 155     ; 'back: N - Goes back N steps along the history.\n'
 156     ; 'backToStart - Goes back to the start of the history.\n'
 157     ; 'navigator - Answers the navigator itself.\n'
 158     ; 'close - Exits the Navigator.\n'
 159     ; 'help - Prints this helpful message.\n'.
 160 ].
 161
 162 i@(Navigator traits) last
 163 [i history top].
 164
 165 i@(Navigator traits) here
 166 [i history here].
 167
 168 i@(Navigator traits) slots
 169 [i here slotNames].
 170
 171 i@(Navigator traits) indexedSlots
 172 [| s |
 173   s := Console writer.
 174   (i here is: Sequence)
 175     ifFalse: [^ Nil].
 176   s nextPut: ${.
 177   i here doWithIndex:
 178     [| :each :index | s ; index printString ; ': ' ; each printString ; '.\n'].
 179   s nextPut: $}.
 180   s newLine.
 181 ].
 182
 183 i@(Navigator traits) parents
 184 [i here _map delegates].
 185
 186 i@(Navigator traits) visit: obj
 187 [
 188   i history visit: obj.
 189   i here
 190 ].
 191
 192 i@(Navigator traits) visit: _@Nil
 193 ['Nil: nothing done.'].
 194
 195 i@(Navigator traits) go: slotName@(Symbol traits)
 196 [i visit: (i here atSlotNamed: slotName)].
 197
 198 i@(Navigator traits) go: slotName
 199 [i go: slotName intern].
 200
 201 i@(Navigator traits) go: index@(Integer traits)
 202 [i visit: (i here at: index)].
 203
 204 i@(Navigator traits) back
 205 "Moves the last context off the history Stack and makes it it."
 206 [
 207   i history goBack
 208 ].
 209
 210 i@(Navigator traits) back: n
 211 "Moves the last n contexts off the history Stack and makes the last one here."
 212 [
 213   n timesRepeat: [i history goBack]
 214 ].
 215
 216 i@(Navigator traits) backToStart
 217 "Clears the history stack and returns the navigator to the original object
 218 inspected."
 219 [
 220   i history goBackTo: i history pastVisits first.
 221 ].
 222
 223 i@(Navigator traits) close
 224 "Sever all the connections that make the Navigator work, for memory safety,
 225 and return the Navigator."
 226 [
 227   i history := Nil.
 228   i
 229 ].