├── README.md ├── complete-input.red ├── info.red ├── syntax-highlighting.red ├── syntax3.app └── Contents │ ├── Info.plist │ └── MacOS │ └── syntax3 └── syntax3.exe /README.md: -------------------------------------------------------------------------------- 1 | (Not updated for a long time. May be broken) 2 | 3 | # syntax-highlighter 4 | Red syntax/expressions highlighting 5 | 6 | ## Usage and limitations 7 | 1. Expressions highlighting works by default for predefined functions only. If UDF is evaluated in step mode, highlighting will work on these too (They are evaluated in default context; in-object evaluation TBD) 8 | 2. `op!` scope is correctly found when treated as argument. Arguments highlighting for `op!` itself (in "Expr" mode) is partly done 17.01 (Left nested parens TBD) 9 | 3. Highlighting does not adapt to dialects (e.g. parse, VID, RTD). TBD 10 | 4. Editing: 11 | - First version 24.01 12 | - Font size and type changeable 13 | - Selection with keys, double-click, shift-click 14 | - Selection by dragging TBD 15 | - Automatic tabbing, line numbering added 2.02 16 | - Auto-completion with F1 12.02 17 | 5. Resizing: 18 | - First version done 18.01 19 | 6. No error-handling. TBD 20 | 7. No comments :). TBD 21 | 8. Code evaluation: 22 | - First draft done 18.01: In "Step" mode use "Eval" button to evaluate highlighted expression 23 | - Refining 7.02: Click "Construct". Then in step mode select expression and ctrl-click it to open refining panel... Works only for programs not in anonymous or path-named contexts. 24 | 9. Navigation: 25 | - By scroller (from start) 26 | - Simple wheeling done 18.01 27 | - Back-stepping added 19.01 28 | - Step-selection by mouse click 19.01 29 | - Simple search added 20.01. Pointing on element, choose "Show" from contextual menu. For navigation between highlighted elements, select "Next" or "Prev", use contextual menu or arrow-keys. 30 | - "Find" added to contextual menu 21.01. Next/prev find with buttons, contextual menu or arrow-keys. 31 | - Move "Step"-highlighted elements: buttons, menu and keys (down-arrow-key = "into" while stepping, enter = evaluate) 32 | 10. Layout is done according to W10. It may show with defects on other platforms/versions. 33 | 11. Hovering worked initially for ~1.5 page only. 34 | - Now works throughout longer files too 25.01 35 | 12. Using `bold` in syntax highlighting style definitions has no effect on `caret-to-offset` calculations, which causes misplacement of hover-reactive boxes on layer above rich-text. Red bug? 36 | -------------------------------------------------------------------------------- /complete-input.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Description: {Adjusted to work with multilne text} 3 | ] 4 | red-complete-ctx/complete-input: func [ 5 | str [string!] 6 | console? [logic!] 7 | /local 8 | word ptr result sys-word delim? len insert? 9 | start end delimiters d w change? 10 | ] bind [ 11 | has-common-part?: no 12 | result: make block! 4 13 | delimiters: charset [#"^/" #"^-" #" " #"[" #"(" #":" #"'" #"{"] 14 | delim?: no 15 | insert?: not tail? str 16 | len: (index? str) - 1 17 | end: str 18 | ptr: head str ;str: 19 | word: find/reverse/tail/part str delimiters len 20 | if all [word (index? ptr) < (index? word)] [ptr: word] 21 | either head? ptr [start: head str] [start: ptr delim?: yes] 22 | word: copy/part start end 23 | unless empty? word [ 24 | case [ 25 | all [ 26 | #"%" = word/1 27 | 1 < length? word 28 | ] [ 29 | append result 'file 30 | append result red-complete-file word console? 31 | ] 32 | all [ 33 | #"/" <> word/1 34 | ptr: find word #"/" 35 | #" " <> pick ptr -1 36 | ] [ 37 | append result 'path 38 | append result red-complete-path word console? 39 | ] 40 | true [ 41 | append result 'word 42 | foreach w words-of system/words [ 43 | if value? w [ 44 | sys-word: mold w 45 | if find/match sys-word word [ 46 | append result sys-word 47 | ] 48 | ] 49 | ] 50 | if ptr: find result word [swap next result ptr] 51 | if console? [common-substr next result] 52 | ] 53 | ] 54 | ] 55 | if console? [result: next result] 56 | if all [console? any [has-common-part? 1 = length? result]] [ 57 | if word = result/1 [ 58 | unless has-common-part? [clear result] 59 | ] 60 | ] 61 | result 62 | ] red-complete-ctx 63 | -------------------------------------------------------------------------------- /info.red: -------------------------------------------------------------------------------- 1 | Red [] 2 | info-ctx: context [ 3 | get-function: function [path][ 4 | path: copy path while [ 5 | not any [ 6 | tail? path 7 | any-function? attempt [get/any either 1 = length? path [path/1][path]] 8 | ] 9 | ][ 10 | clear back tail path 11 | ] 12 | either empty? path [none][path] 13 | ] 14 | 15 | set 'info func ['fn /local intr ars refs locs ret arg ref typ irefs][ 16 | intr: copy "" ars: make map! copy [] refs: make map! copy [] locs: copy [] ret: copy [] irefs: copy [] typ: ref-arg: ref-arg-type: none 17 | ;if path? fn [irefs: copy next to-block fn fn: first fn] 18 | if path? fn [irefs: copy skip to-block fn length? fn: get-function fn if 1 = length? fn [fn: fn/1]] 19 | if lit-word? fn [fn: to-word fn] 20 | unless any-function? get fn [ 21 | cause-error 'user 'message ["Only function types accepted!"] 22 | ] 23 | out: make map! copy [] 24 | specs: spec-of get fn 25 | parse specs [ 26 | opt [set intr string!] 27 | any [set arg [word! | lit-word! | get-word!] opt [set typ block!] opt string! (put ars arg either typ [typ][[any-type!]])] 28 | any [set ref refinement! [ 29 | if (ref <> /local) (put refs to-lit-word ref make map! copy []) 30 | opt string! 31 | any [set ref-arg word! opt [set ref-arg-type block!] 32 | (put refs/(to-word ref) to-lit-word ref-arg either ref-arg-type [ref-arg-type][[any-type!]]) 33 | ] 34 | opt string! 35 | | any [set loc word! (append locs loc) opt string!] 36 | opt [set-word! set ret block!] 37 | ]] 38 | ] 39 | 40 | make object! [ 41 | name: either path? fn [last fn][to-word fn];to-word fn 42 | intro: intr 43 | args: ars 44 | refinements: refs 45 | locals: locs 46 | return: ret 47 | spec: specs 48 | type: type? get fn 49 | arg-num: length? args 50 | arg-names: copy keys-of args 51 | arg-types: copy values-of args 52 | ref-names: copy keys-of refinements 53 | ref-types: copy values-of refinements 54 | ref-num: length? refinements 55 | ] 56 | ] 57 | ] 58 | -------------------------------------------------------------------------------- /syntax-highlighting.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Needs: 'View 3 | Author: "Toomas Vooglaid" 4 | Date: 2019-01-14 5 | Last: 2019-02-15 6 | Purpose: {Study of syntax highlighting} 7 | Licence: "Public domain" 8 | ] 9 | starting-pos: length? words-of system/words 10 | if all [value? 'syntax-ctx attempt [object? syntax-ctx]][ 11 | syntax-ctx/new-words-in-default-context: clear [] 12 | syntax-ctx/overloaded-predefined-words: clear [] 13 | ;syntax-ctx/overloaded-undefined-words: clear [] 14 | ] 15 | #include %info.red 16 | #include %../../red-latest/red-master/environment/console/help.red 17 | #include %complete-input.red 18 | syntax-ctx: context [ 19 | sys-words: clear [] 20 | collect/into [ 21 | foreach word words-of system/words [ 22 | if not unset? get/any word [keep word] 23 | ] 24 | ] sys-words 25 | word-idx: 0 26 | sp: charset " ^-" 27 | ws: charset " ^/^-" 28 | opn: charset "[(" 29 | cls: charset ")]" 30 | cls2: union ws cls 31 | brc: union opn cls 32 | brc2: union brc charset "{}" 33 | skp: union ws brc 34 | skp2: union skp charset "/" 35 | skp3: union skp2 charset ":" 36 | skp4: union skp3 charset "'" 37 | com-check: charset {^/;} 38 | skip-chars: charset "#$&" 39 | opn-brc: charset "{[(^"" ;" 40 | opp: "[][()({}{^"^"" 41 | delim: charset [#"^/" #"^-" #" " #"[" #"(" #":" #"'" #"{"] 42 | rt: layer: bs: refine: lns: r-expr: r-def: r-val: none 43 | br: scr: s: s1: s2: i: i1: i2: in-brc: pos: bx-pos: str1: str2: blk: res: wheel-pos: len: line-num: needle: none 44 | _i1: _i2: _str1: _str2: el: caret: found: found-del: dont-move: ctrl?: deleted: none 45 | text-start: text-end: address: fnt: opts: edit: step: btns: tip: tips: args: ret: none 46 | 47 | new-words: none 48 | new-words-in-default-context: clear [] 49 | overloaded-predefined-words: clear [] 50 | ;overloaded-undefined-words: clear [] 51 | 52 | save-bd: clear [] 53 | curpos: anchor: 1 54 | crt-start: crt-end: 1 55 | crt-diff: 0 56 | dbl: no 57 | cnt: 0 58 | steps: clear [] 59 | last-find: []; act str1 i1 len 60 | coef: 1 61 | 62 | open-new: does [ 63 | if not lay/extra/saved [ask-save] 64 | lay/extra/file: none 65 | rt/text: copy "Red []^/" 66 | lay/text: "New file" 67 | set-caret length? rt/text 68 | renew-view 69 | ] 70 | open: func [/local file [file!]][ 71 | if all [lay/extra/file not lay/extra/saved][ask-save] 72 | file: request-file/title/filter "Open file" ["Red" "*.red" "All" "*"] 73 | if file [ 74 | file: second lay/extra/file: split-path file 75 | rt/text: read file 76 | lay/text: mold file 77 | renew-view 78 | lay/extra/saved: yes 79 | ] 80 | ] 81 | save: func [/as /copy /local file [file! none!] curdir [file! none!]][ 82 | case [ 83 | copy [ 84 | curdir: none 85 | if lay/extra/file [curdir: lay/extra/file/1] 86 | if attempt [file: request-file/save/title "Save copy as"][ 87 | write file rt/text 88 | if all [curdir what-dir <> curdir] [set-current-dir curdir] 89 | ] 90 | ] 91 | any [as not lay/extra/file] [ 92 | if attempt [file: request-file/save/title "Save file as"][ 93 | lay/text: mold second lay/extra/file: split-path file 94 | show lay 95 | write file rt/text 96 | lay/extra/saved: yes 97 | ] 98 | ] 99 | true [ 100 | write lay/extra/file/2 rt/text 101 | lay/extra/saved: yes 102 | ] 103 | ] 104 | ] 105 | ask-save: does [ 106 | view/flags [ 107 | text "Save file?" return 108 | button "Yes" [save unview] 109 | button "No" [unview] 110 | ] [modal popup] 111 | ] 112 | quit: does [ 113 | if not lay/extra/saved [ask-save] 114 | unview lay 115 | ] 116 | copy-selection: does [ 117 | if rt/data/1/y > 0 [write-clipboard copy/part at rt/text rt/data/1/x rt/data/1/y dont-move: true] 118 | ] 119 | cut-selection: does [ 120 | if rt/data/1/y > 0 [ 121 | write-clipboard copy/part pos1: at rt/text rt/data/1/x len: rt/data/1/y 122 | remove/part pos1 len 123 | lay/extra/saved: no 124 | recolor 125 | renumber 126 | set-caret rt/data/1/x 127 | adjust-scroller 128 | ] 129 | ] 130 | paste-selection: does [ 131 | parse txt: read-clipboard [any [change crlf lf | skip]] 132 | len: (length? txt) - rt/data/1/y 133 | either rt/data/1/y > 0 [ 134 | change/part at rt/text curpos: rt/data/1/x txt rt/data/1/y 135 | ][ 136 | insert at rt/text curpos txt 137 | ] 138 | lay/extra/saved: no 139 | adjust-markers/length pos1 len 140 | ;show-rt 141 | ;recolor 142 | renumber 143 | set-caret curpos + length? txt 144 | adjust-scroller 145 | ] 146 | del: func [key][ 147 | case [ 148 | rt/data/1/y > 0 [ 149 | remove/part pos1: at rt/text curpos: rt/data/1/x rt/data/1/y 150 | recolor set-caret curpos 151 | ] 152 | not empty? last-find [ 153 | remove/part pos1: at rt/text curpos: last-find/3 last-find/4 154 | found-del: find rt/data reduce [as-pair last-find/3 last-find/4 'backdrop] 155 | found-del: remove/part found-del 3 156 | adjust-markers/length/only at rt/text curpos + 1 negate last-find/4 157 | if last-find/1 = 'show [deleted: yes] 158 | ] 159 | 'else [ 160 | case [ 161 | all [key = 'delete curpos <= length? rt/text] [ 162 | remove pos1: at rt/text curpos 163 | recolor 164 | ] 165 | all [key = #"^H" curpos > 1] [ 166 | remove pos1: at rt/text curpos: curpos - 1 167 | recolor set-caret curpos 168 | ] 169 | ] 170 | adjust-markers/length pos1 -1 171 | ] 172 | ] 173 | lay/extra/saved: no 174 | renumber 175 | ] 176 | set-coef: has [sz][ 177 | sz: (rich-text/line-count? rt) * (rich-text/line-height? rt 1) 178 | coef: rt/size/y * 1.0 / sz 179 | ] 180 | renew-view: does [ 181 | lns/offset: 0x0 182 | rt/offset: 60x0 183 | rt/data/4/2: 1 + length? rt/text 184 | show rt 185 | lns/size/y: rt/size/y: second size-text rt 186 | set-coef 187 | scr/max-size: rich-text/line-count? rt 188 | scr/position: 1 189 | scr/page: 1 190 | scr/page-size: (bs/size/y / rich-text/line-height? rt 1) + 1 191 | 192 | clear steps 193 | recolor 194 | renumber 195 | lns/data/1/2: 1 + length? lns/text 196 | show lns 197 | anchor: curpos: 1 198 | rt/draw: compose [ 199 | pen black caret: line 200 | (as-pair 0 y: second caret-to-offset rt 1) 201 | (as-pair 0 y + rich-text/line-height? rt 1) 202 | ] 203 | rt/rate: 3 204 | if step/data [step/actors/on-change step none] 205 | set-focus bs 206 | show lay 207 | ] 208 | highlight: function [s1 [string!] s2 [string!] style [tuple! block!]] bind [ 209 | keep as-pair i: index? s1 (index? s2) - i 210 | keep style 211 | ] :collect 212 | skip-some: func [str [string!] chars [bitset!]][ 213 | while [find/match str chars][str: next str] 214 | str 215 | ] 216 | count-lines: function [cnt-pos [string!]][ 217 | i: 1 218 | parse head cnt-pos [any [s: if (s = cnt-pos) thru end | newline (i: i + 1) | skip]] 219 | i 220 | ] 221 | prev-step: does [ 222 | unless empty? steps [ 223 | set [_str1 _str2] take/last/part steps 2 224 | curpos: _i1: index? _str1 225 | _i2: index? _str2 226 | clear pos 227 | repend rt/data [as-pair _i1 _i2 - _i1 'backdrop sky] 228 | reposition count-lines _str1 229 | ] 230 | ] 231 | next-step: does [ 232 | unless tail? _str2 [ 233 | repend steps [_str1 _str2] 234 | _str2: skip-some _str2 cls2 235 | ] 236 | unless tail? _str2 [ 237 | while [_str2/1 = #";"][ 238 | _str2: arg-scope _str2 none 239 | _str2: skip-some _str2 cls2 240 | ] 241 | _i1: index? _str1: _str2 242 | move-backdrop _str2 243 | ] 244 | ] 245 | into-step: does [ 246 | repend steps [_str1 _str2] 247 | _i1: index? _str1: either find/match opn _str1/1 [ 248 | skip-some next _str1 ws 249 | ][ 250 | find/tail _str1 skp 251 | ] 252 | move-backdrop _str1 253 | ] 254 | do-step: does [ 255 | do copy/part either s1: find/match/tail _str1 "#include " [s1][_str1] _str2 256 | next-step 257 | set-focus bs 258 | show lay 259 | ] 260 | ;construct-step: does [ 261 | ; if find [object context] el: load/next _str1 '_str2 [ 262 | ; tmp-obj: construct load/next _tmp '_str2 263 | ; loop 2 [into-step] 264 | ; ] 265 | ;] 266 | move-backdrop: func [str [string!]][ 267 | _i2: index? _str2: arg-scope str none 268 | clear pos 269 | repend rt/data [as-pair curpos: _i1 _i2 - _i1 'backdrop sky] 270 | if (count-lines _str2) > (scr/position + scr/page-size - 1) [ 271 | reposition/start/force count-lines str 272 | ] 273 | ] 274 | get-function: function [path [path!]][ 275 | path: copy path 276 | while [ 277 | not any [ 278 | tail? path 279 | any-function? attempt [get/any either 1 = length? path [path/1][path]] 280 | ] 281 | ][ 282 | clear back tail path 283 | ] 284 | either empty? path [none][path] 285 | ] 286 | br-scope: function [br [string!]][ 287 | stack: append clear [] br/1 288 | mstack: clear [] 289 | either find opn br/1 [ 290 | i1: index? br 291 | parse next br [some [s: 292 | newline (comm: no) 293 | | [ 294 | if (not any [comm instr inmstr]) [ 295 | if (s/1 = select opp stack/1) (remove stack) 296 | [if (empty? stack) (i2: index? next s) thru end | skip] 297 | | if (find brc s/1) (insert stack s/1) skip 298 | | {"} (instr: yes) 299 | | #"{" (inmstr: yes insert mstack s/1) 300 | | #";" (comm: yes) 301 | ] 302 | | if (not comm) [ 303 | if (not instr) [ 304 | #"{" (insert mstack s/1) 305 | | #"}" [if (mstack/1 = #"{")(remove mstack if empty? mstack [inmstr: no]) | ] 306 | ] 307 | | if (not inmstr) {"} [if (instr)(instr: no) | ] 308 | ] 309 | ] 310 | | skip 311 | ]] 312 | color: either empty? stack [gray + 100][i2: index? s 255.220.220] 313 | repend rt/data [as-pair i1 i2 - i1 'backdrop color] 314 | ][ 315 | i2: 1 + index? br 316 | found: br 317 | until [any [ 318 | all [ 319 | found: find/reverse found select opp stack/1 320 | not find/part find/reverse/tail found lf #";" found 321 | load/next found 's 322 | s = next br 323 | ] 324 | not found 325 | ]] 326 | color: either found [gray + 100][255.220.220] 327 | i1: either found [index? found][1] 328 | repend rt/data [as-pair i1 i2 - i1 'backdrop color] 329 | ] 330 | ] 331 | left-scope: func [str [string!] /local i [integer!]][i: 0 332 | until [str: back str not find/match str ws] 333 | either #")" = str/1 [find/reverse str "("][find/reverse/tail str skp] 334 | ] 335 | arg-scope: func [str [string!] type [none! block! datatype! typeset!] /left /right /local el el2 s0 s1 s2 i2 _][ 336 | either left [ 337 | s1: left-scope str 338 | s0: left-scope s1 339 | el: load/next s0 '_ 340 | if op? attempt [get/any el][s1: arg-scope/left s0 none] 341 | ][ 342 | el: load/next str 's1 343 | el2: either right [none][load/next s1 's2] 344 | either all [word? el2 op? attempt/safer [get/any el2]][ 345 | s1: arg-scope s2 none 346 | ][ 347 | either find/match str "#include " [ 348 | s1: arg-scope s1 none 349 | ][ 350 | switch type?/word el [ 351 | set-word! set-path! [s1: arg-scope s1 none] 352 | word! [if any-function? get/any el [s1: scope str]] 353 | path! [ 354 | case [ 355 | any-function? get/any first el [s1: scope str] 356 | get-function el [s1: scope str] 357 | ] 358 | ] 359 | ] 360 | ] 361 | ] 362 | ] 363 | s1 364 | ] 365 | scope: func [str [string!] /color col /local fn fnc inf clr arg i1 i2 s1 s2][ 366 | fn: load/next str 's1 367 | case [ 368 | all [word? fn any-function? get/any :fn] [fnc: fn] 369 | all [path? fn fn1: get-function fn 1 = length? fn1] [fnc: fn/1] 370 | all [path? fn fn1] [fnc: fn1] 371 | 'else [fnc: none] 372 | ] 373 | if fnc [ 374 | inf: info :fnc 375 | clr: any [col yello] 376 | either op! = inf/type [ 377 | s0: arg-scope/left str none 378 | i1: index? s0 379 | i2: -1 + index? str 380 | repend rt/data [as-pair i1 i2 - i1 'backdrop clr: clr - 30] 381 | i2: index? s2: arg-scope/right s1 none 382 | while [find ws s1/1][s1: next s1] 383 | i1: index? s1 384 | repend rt/data [as-pair i1 i2 - i1 'backdrop clr: clr - 30] 385 | ][ 386 | foreach arg inf/arg-names [ 387 | i2: index? s2: arg-scope s1 inf/args/:arg 388 | while [find ws s1/1][s1: next s1] 389 | i1: index? s1 390 | repend rt/data [as-pair i1 i2 - i1 'backdrop clr: clr - 30] 391 | s1: :s2 392 | ] 393 | ] 394 | if all [path? fn any [word? fnc (length? fn) > (length? fnc)]][ 395 | foreach ref either word? fnc [next fn][skip fn length? fnc] [ 396 | if 0 < length? refs: inf/refinements/:ref [ 397 | foreach type values-of refs [ 398 | i2: index? s2: arg-scope s1 type 399 | while [find ws s1/1][s1: next s1] 400 | i1: index? s1 401 | repend rt/data [as-pair i1 i2 - i1 'backdrop clr: clr - 30] 402 | s1: :s2 403 | ] 404 | ] 405 | ] 406 | ] 407 | show rt 408 | s1 409 | ] 410 | ] 411 | rule: [any [s: [if ((index? text-end) <= index? s) (return true) |] 412 | ws 413 | | brc (s2: next s highlight s s2 rebolor) 414 | | #";" [if (s2: find s newline) | (s2: tail s)] (highlight s s2 reduce ['italic beige - 50]) :s2 415 | | [if (all [attempt [el: load/next s 's2] s <> s2])( 416 | case [ 417 | string? el [highlight s s2 gray] 418 | any-string? el [highlight s s2 orange] 419 | refinement? el [highlight s s2 papaya] 420 | word? el [ 421 | case [ 422 | function? get/any el [highlight s s2 brick]; reduce ['bold blue]] 423 | op? get/any el [highlight s s2 brick] 424 | any-function? get/any el [highlight s s2 crimson] 425 | ;immediate? get/any el [highlight s s2 leaf] 426 | 'else [highlight s s2 violet] 427 | ] 428 | ] 429 | path? el [ 430 | case [ 431 | function? get/any el/1 [highlight s s2: find s #"/" brick] 432 | op? get/any el/1 [highlight s s2: find s #"/" brick] 433 | any-function? get/any el/1 [highlight s s2: find s #"/" crimson] 434 | fn: get-function :el [ 435 | highlight s s2: find/tail s form fn brick 436 | highlight s find s #"/" violet 437 | ] 438 | 'else [highlight s s2: find s #"/" violet] 439 | ] 440 | ] 441 | set-word? el [ 442 | either all [ 443 | (index? to-word :el) < index? 'starting-pos 444 | find sys-words to-word :el 445 | ][ 446 | append overloaded-predefined-words to-word :el 447 | highlight s s2 red 448 | ][ 449 | if unset? to-word :el [ 450 | append new-words-in-default-context to-word :el 451 | ] 452 | highlight s s2 navy 453 | ] 454 | ] 455 | any-word? el [highlight s s2 navy] 456 | any-path? el [highlight s s2 water] 457 | number? el [highlight s s2 mint] 458 | scalar? el [highlight s s2 teal] 459 | immediate? el [highlight s s2 leaf] 460 | ] 461 | ) | [if (s2: find s ws) | (s2: tail s)] (highlight s s2 red)] :s2 462 | ]] 463 | ; brc func op any-func word 464 | boxes: reduce [rebolor '| brick '| crimson '| violet] 465 | box-rule: bind [ 466 | any [p: 467 | boxes ( 468 | address: back p 469 | keep reduce [ 470 | 'box (caret-to-offset rt address/1/1) + rt/offset + -60x2 471 | (caret-to-offset rt bx-pos: address/1/1 + address/1/2) + 472 | (as-pair 0 rich-text/line-height? rt bx-pos) + rt/offset - 60x2 473 | ] 474 | ) 475 | | skip 476 | ] 477 | ] :collect 478 | scroll: func [sc-pos [integer!]][ 479 | lns/offset/y: rt/offset/y: to-integer negate (sc-pos - 1) * (rich-text/line-height? rt 1) * coef 480 | recolor 481 | show bs 482 | ] 483 | adjust-scroller: does [ 484 | lns/size/y: rt/size/y: second size-text rt 485 | set-coef 486 | scr/max-size: rich-text/line-count? rt 487 | scr/page-size: (bs/size/y / rich-text/line-height? rt 1) + 1 488 | ] 489 | reposition: func [line-num [integer!] /start /force][ 490 | if any [ 491 | force 492 | line-num < scr/position 493 | line-num > (scr/position + scr/page-size - 1) 494 | ][ 495 | scr/position: max 1 line-num - either start [0][scr/page-size / 3] 496 | scr/page: scr/position - 1 / scr/page-size + 1 497 | scroll scr/position 498 | ] 499 | set-focus bs 500 | show lay 501 | ] 502 | ask-find: has [needle [string!]][ 503 | view/flags [ 504 | text "Find what" fnd: field 100 focus on-enter [needle: face/text unview] 505 | button "OK" [needle: fnd/text unview] 506 | ][modal popup] 507 | needle 508 | ] 509 | find-again: func [prev [logic!]][ 510 | switch last-find/1 [ 511 | show [ 512 | either deleted [ 513 | pos1: skip found-del pick [-1 2] prev 514 | deleted: no 515 | ][ 516 | pos1: find pos [backdrop 0.200.0] 517 | pos1/2: 100.255.100 518 | pos1: skip pos1 pick [-2 4] prev 519 | ] 520 | either prev [ 521 | unless pos1/1 = 100.255.100 [pos1: next find/last pos 'backdrop] 522 | ][ 523 | if empty? pos1 [pos1: next find pos 'backdrop] 524 | ] 525 | pos1/1: 0.200.0 526 | reposition count-lines at rt/text last-find/3: curpos: pos1/-2/1 527 | ] 528 | find [ 529 | clear pos 530 | if str1: either prev [ 531 | any [ 532 | either head? last-find/2 [ 533 | find/reverse tail rt/text needle 534 | ][ 535 | find/reverse back last-find/2 needle 536 | ] 537 | find/reverse tail rt/text needle 538 | ] 539 | ][ 540 | any [find next last-find/2 needle find rt/text needle] 541 | ][ 542 | curpos: last-find/3: index? last-find/2: str1 543 | repend rt/data [as-pair last-find/3 last-find/4 'backdrop cyan] 544 | reposition count-lines str1 545 | ] 546 | ] 547 | ] 548 | ] 549 | find-menu: ["Find" find "Show" show "Prev" prev "Next" next]; "Inspect" insp] 550 | find-word: func [event [event!]][ 551 | switch event/picked [ 552 | find [ 553 | clear pos 554 | if needle: ask-find [ 555 | either str1: find rt/text needle [ 556 | curpos: i1: index? str1 557 | len: length? needle 558 | repend rt/data [as-pair i1 len 'backdrop cyan] 559 | reposition count-lines str1 560 | repend clear last-find ['find str1 i1 len] 561 | ][];TBD "Not found" message 562 | ] 563 | ] 564 | show [ 565 | clear pos 566 | i0: index? str: find/reverse/tail at rt/text offset-to-caret rt offset event skp4 567 | str2: find str skp3 568 | elem: copy/part str str2 569 | str1: rt/text 570 | len: length? elem 571 | while [ 572 | str1: find/tail str1 elem 573 | ][ 574 | if all [ 575 | any [attempt [find skp4 first skip str1 -1 - len] head? skip str1 0 - len] 576 | any [attempt [find skp3 first str1] tail? str1] 577 | ][ 578 | i1: index? str1 579 | repend rt/data [as-pair i: i1 - len len 'backdrop either i = i0 [0.200.0][100.255.100]] 580 | ] 581 | ] 582 | curpos: i0 583 | repend clear last-find ['show str i0 len] 584 | show rt 585 | ] 586 | prev next [find-again event/picked = 'prev] 587 | insp [ 588 | 589 | ] 590 | ] 591 | ] 592 | renumber: has [n][ 593 | append clear lns/text #"1" 594 | n: 1 found: rt/text 595 | while [found: find/tail found lf] [append lns/text rejoin [lf n: n + 1]] 596 | lns/data/1/2: 1 + length? lns/text 597 | ] 598 | recolor: has [ofs][ 599 | text-start: at rt/text offset-to-caret rt ofs: negate rt/offset - layer/offset ;as-pair 60 0 - rt/offset/y 600 | text-end: at rt/text offset-to-caret rt ofs + bs/size 601 | if pos [move/part pos save-bd length? pos] 602 | clear at rt/data 7 603 | collect/into [parse text-start rule] rt/data 604 | clear at layer/draw 5 605 | collect/into [parse rt/data box-rule] layer/draw 606 | pos: tail rt/data 607 | if not empty? save-bd [move/part save-bd pos length? save-bd] 608 | system/view/platform/redraw layer ; ?? 609 | ] 610 | change-font: func [what [integer! string!] /type /local n][ 611 | n: pick [6 5] type 612 | rt/data/:n: what 613 | lns/data/(n - 3): what 614 | lns/size/y: rt/size/y: second size-text rt 615 | recolor 616 | show [lns rt] 617 | adjust-scroller 618 | set-caret curpos 619 | ] 620 | adjust-markers: func [pos1 [string!] /length len /only /local i1 pos3][ 621 | len: any [len 1] 622 | i1: either found: find/reverse/tail pos1 skp2 [index? found][1] 623 | pos3: rt/data 624 | rt/data/4/2: 1 + length? rt/text 625 | lns/data/1/2: 1 + length? lns/text 626 | forall pos3 [ 627 | if pair? pos3/1 [ 628 | case [ 629 | all [negative? len curpos < pos3/1/1] [pos3/1/1: pos3/1/1 + len] 630 | all [negative? len curpos > pos3/1/1 curpos < (pos3/1/1 + pos3/1/2 + len)][pos3/1/2: pos3/1/2 + len] 631 | all [positive? len curpos <= pos3/1/1] [pos3/1/1: pos3/1/1 + len] 632 | all [positive? len curpos > pos3/1/1 curpos <= (pos3/1/1 + pos3/1/2 + len)][pos3/1/2: pos3/1/2 + len] 633 | ] 634 | ] 635 | ] 636 | show rt 637 | unless only [recolor] 638 | ] 639 | complete: func [e /local found word new-word][ 640 | unless found: find/reverse/tail at rt/text curpos delim [found: head rt/text] 641 | word: copy/part found at rt/text curpos 642 | if #"%" = word/1 [word: next word] 643 | new-word: pick e/face/data e/face/selected 644 | unview 645 | found: find/tail new-word word 646 | len: length? new-word 647 | if found [len: len - (length? word)] 648 | insert at rt/text curpos either found [found][new-word] 649 | ] 650 | set-caret: func [e [event! none! integer!] /dont-move /only /local found posM pos1M pos2M tmppos line-start brc_][ 651 | case [ 652 | event? e [ 653 | switch e/type [ 654 | down [ 655 | either e/shift? [ 656 | curpos: offset-to-caret rt offset e 657 | rt/data/1: as-pair min anchor curpos absolute anchor - curpos 658 | ][ 659 | anchor: curpos: offset-to-caret rt offset e 660 | rt/data/1/2: 0 661 | ] 662 | ] 663 | key [ 664 | switch/default e/key [ 665 | right [ 666 | curpos: either e/ctrl? [ 667 | index? find at rt/text curpos + 1 skp2 668 | ][ 669 | either all [0 < rt/data/1/2 not e/shift?] [ 670 | rt/data/1/1 + rt/data/1/2 671 | ][ 672 | min 1 + length? rt/text curpos + 1 673 | ] 674 | ] 675 | ] 676 | left [ 677 | curpos: either e/ctrl? [ 678 | either found: find/reverse/tail at rt/text curpos - 1 skp2 [index? found][1] 679 | ][ 680 | either all [0 < rt/data/1/2 not e/shift?] [ 681 | rt/data/1/1 682 | ][ 683 | max 1 curpos - 1 684 | ] 685 | ] 686 | ] 687 | down [ 688 | curpos: min 1 + length? rt/text offset-to-caret rt 689 | ((caret-to-offset rt curpos) + as-pair 0 rich-text/line-height? rt 1) 690 | ] 691 | up [curpos: max 1 offset-to-caret rt (caret-to-offset rt curpos) - 0x3] 692 | page-down [ 693 | curpos: min 1 + length? rt/text offset-to-caret rt ( 694 | (caret-to-offset rt curpos) + as-pair 0 scr/page-size + 1 * rich-text/line-height? rt 1 695 | ) 696 | ] 697 | page-up [ 698 | curpos: max 1 offset-to-caret rt ( 699 | (caret-to-offset rt curpos) - as-pair 0 scr/page-size + 1 * rich-text/line-height? rt 1 700 | ) 701 | ] 702 | end [ 703 | curpos: either e/ctrl? [ 704 | 1 + length? rt/text 705 | ][ 706 | either found: find at rt/text curpos lf [index? found][1 + length? rt/text] 707 | ] 708 | ] 709 | home [ 710 | curpos: either e/ctrl? [1][ 711 | either found: find/reverse/tail at rt/text curpos lf [index? found][1] 712 | ] 713 | ] 714 | #"^A" [anchor: 1 curpos: 1 + length? rt/text] ;Select all 715 | #"^C" [copy-selection] 716 | #"^X" [cut-selection] 717 | #"^V" [paste-selection] 718 | delete #"^H" [del e/key] ;Delete and backspace 719 | #"^[" [clear pos clear last-find] ;Escape 720 | #"^M" [ 721 | pos1M: any [find/reverse/tail at rt/text curpos newline head rt/text] 722 | pos2M: skip-some pos1M sp 723 | tmppos: index? pos1: insert at rt/text curpos reduce [newline line-start: copy/part pos1M pos2M] 724 | either brc_: find/match back at rt/text curpos opn [ 725 | brc_: back brc_ 726 | skip-some brc_ sp 727 | tmppos: index? pos1: insert pos1 tab 728 | either pos1/1 = opp/(brc_/1) [ 729 | posM: insert at rt/text tmppos reduce [newline line-start] 730 | len: 2 * (length? line-start) + 4 731 | ][ 732 | posM: pos1 733 | len: 2 + length? line-start 734 | ] 735 | ][ 736 | posM: pos1 737 | len: 1 + length? line-start 738 | ] 739 | curpos: tmppos 740 | show rt 741 | replace/all rt/text crlf lf ; Needed? 742 | lay/extra/saved: no 743 | adjust-markers/length posM len 744 | renumber 745 | ] 746 | #"^S" [save] 747 | #"^O" [open] 748 | #"^N" [open-new] 749 | #"^Q" [quit] 750 | ][ 751 | curpos: index? pos1: either rt/data/1/y > 0 [ 752 | len: negate rt/data/1/y - 1 753 | change/part at rt/text rt/data/1/x e/key rt/data/1/y 754 | ] [ 755 | either all [e/key = 'F1][ 756 | suggestions: red-complete-ctx/complete-input at rt/text curpos yes 757 | view/flags/options/tight compose/only [ 758 | text-list data (suggestions) focus select 1 759 | on-key-down [case [ 760 | find [#"^M" #"^-"] event/key [ret: complete event] 761 | event/key = #"^[" [unview len: 0 ret: at rt/text curpos] 762 | ]] 763 | on-dbl-click [ret: complete event] 764 | ][modal no-border][offset: (caret-to-offset rt curpos) + rt/offset + lay/offset + bs/offset + 0x20] 765 | ret 766 | ][ 767 | len: 1 768 | insert at rt/text curpos e/key 769 | ] 770 | ] 771 | if attempt [find opn-brc e/key] [insert pos1 opp/(e/key) len: 2] 772 | lay/extra/saved: no 773 | adjust-markers/length pos1 len 774 | ] 775 | adjust-scroller 776 | ] 777 | ] 778 | either any [find [#"^A" #"^C"] e/key all [e/shift? any [e/type = 'down find [left right down up end home] e/key]]] [ 779 | rt/data/1: as-pair min anchor curpos absolute anchor - curpos 780 | ][ 781 | anchor: curpos rt/data/1/2: 0 782 | ] 783 | ] 784 | integer? e [curpos: e rt/data/1/2: 0 unless only [anchor: curpos]] 785 | ] 786 | caret/2: caret-to-offset rt curpos 787 | caret/3: as-pair caret/2/1 caret/2/2 + rich-text/line-height? rt 1 788 | unless dont-move [reposition count-lines at rt/text curpos] 789 | ] 790 | offset: func [e [event!]][either e/face = rt [e/offset][e/offset - rt/offset + layer/offset]] 791 | tip-text: rtd-layout reduce [white ""] tip-text/size: 580x30 792 | make-ctx-path: func [face [object!] addr [pair!] /local s s2 e b][ 793 | face/extra/addr: addr 794 | clear at face/extra/path 2 795 | append face/extra/path parse at rt/text addr/1 [ 796 | collect any [s: 797 | ["make object!" | "object" | "context"] b: 798 | any ws b: #"[" 799 | (load/next b 'e) 800 | if (addr/1 < index? e) ( 801 | s: find/reverse/tail e: find/reverse s ws ws 802 | ) keep (to-word copy/part s e) 803 | (s: back s) :s 804 | | if (head? s) break 805 | | (s: back s) :s 806 | ] 807 | ] 808 | ] 809 | save-code-back: func [face [object!]][ 810 | if step/data [ 811 | change/part at rt/text face/extra/addr/1 face/text face/extra/addr/2 812 | lay/extra/saved: no 813 | set-caret curpos: _i1: face/extra/addr/1 814 | move-backdrop at rt/text _i1 815 | recolor 816 | renumber 817 | set-focus bs show bs 818 | face/extra/addr/2: length? face/text 819 | adjust-scroller 820 | reposition curpos 821 | ] 822 | ] 823 | show-refine: has [sz1 sz2 diff s b e _path_] [ 824 | ctrl?: no 825 | refine/offset: as-pair lay/size/x / 3 * 2 + 5 bs/offset/y 826 | refine/size: as-pair lay/size/x / 3 - 15 bs/size/y 827 | bs/size/x: refine/offset/x - 5 828 | rt/size/x: layer/size/x: bs/size/x - 78 829 | r-expr/size/x: r-def/size/x: r-val/size/x: refine/size/x - 20 830 | step-expr: first back find pos [backdrop 164.200.255] 831 | make-ctx-path r-expr step-expr 832 | r-expr/text: copy/part at rt/text step-expr/1 step-expr/2 833 | sz1: r-expr/size/y 834 | r-expr/size/y: min 400 max 50 second size-text r-expr 835 | r-expr/selected: 1x0 ; ? Doesn't work? 836 | show r-expr 837 | sz2: r-expr/size/y 838 | diff: sz2 - sz1 839 | foreach-face/with refine [face/offset/y: face/offset/y + diff] [face/offset/y > r-expr/offset/y] 840 | refine/visible?: yes 841 | show [bs refine] 842 | ] 843 | do-refine-code: func [face [object!] /local res code ctx][ 844 | code: bind load/all face/text get to-path face/extra/path 845 | r-val/text: either string? res: do code [res][mold :res] 846 | r-val/size/y: second size-text r-val 847 | show r-val 848 | ] 849 | __explore-ctx__: none 850 | construct-code: has [loaded s e rule __current-ctx__ stack][ 851 | __explore-ctx__: construct skip loaded: load rt/text 2 852 | __current-ctx__: __explore-ctx__ 853 | stack: clear [] 854 | parse loaded rule: [ 855 | some [ 856 | 'Red block! 857 | | set-word! s: [ 858 | change ['object | 'context | 'make 'object!] construct 859 | ( 860 | ;if set-path? s/-1 [s/-1: load replace/all form s/-1 #"/" #"_"] ; what if there is context with path, eg system/view/VID | or anonymous? 861 | __current-ctx__/(to-word s/-1): do/next s 'e 862 | repend stack [__current-ctx__ e] 863 | __current-ctx__: __current-ctx__/(to-word s/-1) 864 | ) 865 | s: (bind s/1 __current-ctx__) into rule 866 | (set [__current-ctx__ e] take/last/part stack 2) :e 867 | | if (__current-ctx__/(to-word s/-1): attempt/safer [do/next s 'e]) :e ; attempt - to avoid routines 868 | ] 869 | | skip 870 | ] 871 | ] 872 | ] 873 | 874 | system/view/auto-sync?: off 875 | view/flags/no-wait lay: layout/options/tight [ 876 | title "New file" 877 | backdrop white 878 | panel 800x50 [ 879 | origin 0x0 880 | options: panel 800x50 [ 881 | panel 210x30 [ 882 | origin 0x0 883 | edit: radio 45 "Edit" data yes [clear pos set-focus bs attempt [show lay]] 884 | tips: radio 45 "Tips" [set-focus bs cnt: 0 attempt [show lay]] 885 | args: radio 45 "Args" [set-focus bs cnt: 0 attempt [show lay]] 886 | step: radio 45 "Step" [ 887 | if 1 = cnt: cnt + 1 [ 888 | clear pos 889 | clear last-find 890 | either face/data [ 891 | cnt: 0 892 | either empty? steps [ 893 | _str1: head rt/text 894 | _i2: index? _str2: arg-scope _str1 none 895 | repend rt/data [as-pair 1 _i2 - 1 'backdrop sky] 896 | ][ 897 | prev-step 898 | ] 899 | ][ 900 | repend steps [_str1 _str2] 901 | ] 902 | set-focus bs 903 | show lay 904 | 'stop 905 | ] 906 | ] 907 | ] 908 | btns: panel [ 909 | origin 0x0 910 | button "Prev" [either all [step/data empty? last-find] [prev-step][find-again true]] 911 | button "Into" [either all [step/data empty? last-find] [into-step][find-again false]] 912 | button "Next" [either all [step/data empty? last-find] [next-step][find-again false]] 913 | button "Eval" [if all [step/data empty? last-find] [do-step]] 914 | button "Exec" [do rt/text] 915 | ;button "Construct" [if all [step/data empty? last-find] [construct-step]] 916 | button "Construct" [construct-code] 917 | button "Recolor" [recolor set-focus bs attempt [show lay]] 918 | font-size: drop-list 40 data ["9" "10" "11" "12" "13" "14"] select 4 on-change [ 919 | change-font to-integer pick face/data face/selected 920 | ] 921 | drop-list with [ 922 | data: collect [foreach fnt exclude words-of fonts: system/view/fonts [size] [keep fonts/:fnt]] 923 | selected: index? find data system/view/fonts/system 924 | ] on-change [ 925 | change-font/type pick face/data face/selected 926 | ] 927 | ] 928 | ] 929 | ] 930 | space 0x0 931 | return pad 10x10 932 | bs: base white with [ 933 | size: system/view/screens/1/size - 12x150 934 | pane: layout/only [ 935 | origin 0x0 across 936 | lns: rich-text top right "" white with [ 937 | size: as-pair 50 system/view/screens/1/size/y 938 | data: reduce [1x0 to-integer pick font-size/data font-size/selected system/view/fonts/system silver] 939 | ] 940 | rt: rich-text "Red []^/" with [ 941 | size: system/view/screens/1/size - 90x0 942 | data: reduce [1x0 'backdrop silver 1x0 to-integer pick font-size/data font-size/selected system/view/fonts/system] 943 | menu: find-menu 944 | ] 945 | cursor I-beam 946 | on-time [face/draw/2: pick [glass black] face/draw/2 = 'black show face] 947 | on-menu [find-word event] 948 | ;all-over on-over [ ; NB! Works on first page only 949 | ; if event/down? [ 950 | ; curpos: i2: offset-to-caret rt event/offset 951 | ; set-caret/dont-move/only curpos 952 | ; rt/data/1: as-pair min anchor curpos absolute anchor - curpos 953 | ; show rt 954 | ; ] 955 | ;] 956 | 957 | at 60x0 layer: box with [ 958 | size: system/view/screens/1/size - 30x160 959 | menu: find-menu 960 | ] 961 | draw [pen off fill-pen 0.0.0.254] 962 | on-menu [find-word event] 963 | on-over [ 964 | either event/away? [ 965 | case [ 966 | in-brc [ 967 | clear skip tail rt/data -3 968 | in-brc: no 969 | show bs 970 | ] 971 | tips/data [ 972 | tip/visible?: no 973 | show tip 974 | ] 975 | any [args/data all [edit/data ctrl?]] [ 976 | clear pos 977 | show rt 978 | ] 979 | ] 980 | ][ 981 | str: find/reverse/tail br: at rt/text offset-to-caret rt event/offset - rt/offset + layer/offset skp 982 | case [ 983 | any [find brc br/1 all [any [find ws br/1 not find [word! path!] type? load/next br '_] find brc br/-1 br: back br]][ 984 | in-brc: yes 985 | br-scope br 986 | show bs 987 | ] 988 | tips/data [ 989 | parse layer/draw [ 990 | some [ 991 | 'box bx: pair! 992 | if (within? event/offset bx/1 - 1x1 bx/2 - bx/1 + 2x2) (in-box: bx) 993 | | skip 994 | ] 995 | ] 996 | wrd: load copy/part 997 | at rt/text offset-to-caret rt in-box/1 + 0x3 - rt/offset + layer/offset 998 | at rt/text offset-to-caret rt in-box/2 - 0x3 - rt/offset + layer/offset 999 | either event/ctrl? [ 1000 | tip-text/text: rejoin [type? fn: get :wrd "!^/"] 1001 | append tip-text/text either any-function? :fn [mold spec-of :fn][help-string :wrd] ; or :fn for non-func? (with scrollers) 1002 | case [ 1003 | any [function? :fn op? :fn] [append tip-text/text mold body-of :fn] 1004 | bitset? :fn [ 1005 | append tip-text/text "Chars: " 1006 | append tip-text/text mold rejoin collect [repeat i length? :fn [if pick :fn i [keep to-char i]]] 1007 | ] 1008 | ] 1009 | 1010 | ][ 1011 | tip-text/text: help-string :wrd 1012 | ] 1013 | tip-text/data/1/2: 1 + length? tip-text/text 1014 | tip/size/y: 20 + tip-text/size/y: second size-text tip-text 1015 | tip/draw/5/y: tip/size/y - 1 1016 | case [ 1017 | (event/offset/y - face/offset/y) > (tip/size/y + 20) [ 1018 | tip/offset: min bs/size - tip/size 1019 | max 0x40 event/offset + face/offset - as-pair 30 tip/size/y 1020 | ] 1021 | (event/offset/x - face/offset/x) > tip/size/x [ 1022 | tip/offset: min 1023 | max 0x40 event/offset + face/offset + as-pair 0 - tip/size/x - 30 0 - (tip/size/y / 2) 1024 | bs/size - tip/size 1025 | ] 1026 | (face/size/y - event/offset/y) > (tip/size/y + 40) [ 1027 | tip/offset: min bs/size - tip/size 1028 | max 0x40 event/offset + face/offset + -30x80 1029 | ] 1030 | true [ 1031 | tip/offset: min 1032 | max 0x40 event/offset + face/offset + as-pair 30 0 - (tip/size/y / 2) 1033 | bs/size - tip/size 1034 | ] 1035 | ] 1036 | tip/visible?: yes 1037 | show tip 1038 | 'stop 1039 | ] 1040 | any [args/data all [edit/data ctrl?]] [if all [str not empty? str] [scope str]] 1041 | ] 1042 | ] 1043 | ] 1044 | ;at 60x0 layer2: box 0.0.0.254 with [size: system/view/screens/1/size - 30x160] 1045 | ;all-over on-over [ 1046 | ; if event/down? [ 1047 | ; curpos: i2: offset-to-caret rt offset event 1048 | ; set-caret/dont-move/only curpos 1049 | ; rt/data/1: as-pair min anchor curpos absolute anchor - curpos 1050 | ; show rt 1051 | ; ] 1052 | ;] 1053 | ] 1054 | flags: 'scrollable 1055 | ] 1056 | on-created [ 1057 | put get-scroller face 'horizontal 'visible? no 1058 | scr: get-scroller face 'vertical 1059 | ] 1060 | on-scroll [ 1061 | unless event/key = 'end [ 1062 | scroll scr/position: min scr/max-size max 1 switch event/key [ 1063 | track [event/picked] 1064 | up [scr/position - 1] 1065 | page-up [scr/position - scr/page-size] 1066 | down [scr/position + 1] 1067 | page-down [scr/position + scr/page-size] 1068 | ] 1069 | clear at layer/draw 5 1070 | collect/into [parse rt/data box-rule] layer/draw 1071 | pos: tail rt/data 1072 | show bs 1073 | ] 1074 | ] 1075 | on-wheel [if bs/size/y < second size-text rt [scroll scr/position: min max 1 scr/position - (3 * event/picked) scr/max-size - scr/page-size]] 1076 | on-key [ 1077 | switch/default event/key [ 1078 | left up [case [ 1079 | all [event/key = 'up ctrl?] [scroll scr/position: min max 1 scr/position - 1 scr/max-size] 1080 | all [step/data empty? last-find] [prev-step] 1081 | all [find [show find] last-find/1][find-again true] 1082 | edit/data [set-caret event] 1083 | ]] 1084 | right [case [ 1085 | all [step/data empty? last-find] [next-step] 1086 | all [find [show find] last-find/1] [find-again false] 1087 | edit/data [set-caret event] 1088 | ]] 1089 | down [case [ 1090 | ctrl? [scroll scr/position: min max 1 scr/position + 1 scr/max-size] 1091 | all [step/data empty? last-find] [into-step] 1092 | all [find [show find] last-find/1] [find-again false] 1093 | edit/data [set-caret event] 1094 | ]] 1095 | #"^M" [either all [step/data empty? last-find] [do-step][set-caret event]] 1096 | ][ 1097 | set-caret event 1098 | ] 1099 | ] 1100 | on-key-down [ 1101 | switch event/key [ 1102 | left-control right-control [ctrl?: yes] 1103 | ] 1104 | ] 1105 | on-key-up [ 1106 | switch event/key [ 1107 | left-control right-control [ 1108 | ctrl?: no 1109 | if all [edit/data empty? last-find] [clear pos show rt] 1110 | ] 1111 | ] 1112 | ] 1113 | on-down [ 1114 | unless lay/selected = bs [set-focus bs show bs] 1115 | either step/data [ 1116 | either any [ctrl? event/ctrl?] [ 1117 | show-refine 1118 | ][ 1119 | clear pos 1120 | repend steps [_str1 _str2] 1121 | _i1: index? _str1: find/reverse/tail at rt/text offset-to-caret rt offset event skp 1122 | _i2: index? _str2: arg-scope _str1 none 1123 | repend rt/data [as-pair _i1 _i2 - _i1 'backdrop sky] ;sky - selected expr in step mode 1124 | if (count-lines _str2) > (scr/position + scr/page-size - 1) [ 1125 | reposition/start/force count-lines _str1 1126 | ] 1127 | show bs 1128 | ] 1129 | ][set-caret event] 1130 | ;'stop 1131 | ] 1132 | on-dbl-click [ 1133 | i1: index? str1: find/reverse/tail at rt/text offset-to-caret rt offset event skp2 1134 | i2: index? str2: find str1 skp2 1135 | set-caret/dont-move curpos: i2 1136 | anchor: i1 1137 | rt/data/1: as-pair min anchor curpos absolute anchor - curpos 1138 | show rt 1139 | ] 1140 | at 0x0 refine: panel hidden [ 1141 | r-expr: area wrap extra [addr 0x0 path [__explore-ctx__]] 1142 | with [menu: ["Show def" show-def]] 1143 | on-menu [ 1144 | switch event/picked [ 1145 | show-def [ 1146 | str: find rt/text append copy/part at r-expr/text 1147 | r-expr/selected/1 - (count-lines at r-expr/text r-expr/selected/1) + 1 1148 | r-expr/selected/2 - r-expr/selected/1 + 1 #":" 1149 | sz1: r-def/size/y 1150 | r-def/text: copy/part str arg-scope str none 1151 | make-ctx-path r-def as-pair i1: index? str length? r-def/text 1152 | r-def/size/y: second min 400 max 50 size-text r-def 1153 | show r-def 1154 | sz2: r-def/size/y 1155 | diff: sz2 - sz1 1156 | foreach-face/with refine [face/offset/y: face/offset/y + diff] [face/offset/y > r-def/offset/y] 1157 | show refine 1158 | ] 1159 | ] 1160 | ] 1161 | return 1162 | button "Do" [do-refine-code r-expr] 1163 | button "Save" [save-code-back r-expr] return 1164 | r-def: area wrap extra [addr 0x0 path [__explore-ctx__]] return 1165 | button "Do" [do-refine-code r-def] 1166 | button "Save" [save-code-back r-def] 1167 | return 1168 | r-val: text wrap white 1169 | ] 1170 | at 0x0 tip: rich-text 600x50 hidden with [ 1171 | draw: compose [ 1172 | fill-pen 0.0.128 1173 | box 0x0 (size - 1) 1174 | ;fill-pen 254.254.254.1 1175 | text 10x10 (tip-text) 1176 | ] 1177 | ] 1178 | 1179 | do [lns/parent: bs rt/parent: bs layer/parent: bs] 1180 | ] [ 1181 | offset: -7x0 1182 | extra: reduce ['file none 'saved false] 1183 | menu: [ 1184 | "File" [ 1185 | "New (^^N)" new 1186 | "Open... (^^O)" open 1187 | "Save (^^S)" save 1188 | "Save as..." save-as 1189 | "Save copy..." save-copy 1190 | "Quit (^^Q)" quit 1191 | ] 1192 | "Edit" [ 1193 | "Copy (^^C)" copy 1194 | "Cut (^^X)" cut 1195 | "Paste (^^V)" paste 1196 | "Delete (del)" del 1197 | ] 1198 | ] 1199 | actors: object [ 1200 | max-x: max-y: 0 1201 | cur-y: 10 1202 | lim: func [:z face][face/offset/:z + face/size/:z] 1203 | opts: options/pane 1204 | on-menu: func [face [object!] event [event!]][ 1205 | switch event/picked [ 1206 | ;---File--- 1207 | new [open-new] 1208 | open [open] 1209 | save [save] 1210 | save-as [save/as] 1211 | save-copy [save/copy] 1212 | quit [quit] 1213 | ;---Edit--- 1214 | copy [copy-selection] 1215 | cut [cut-selection] 1216 | paste [paste-selection] 1217 | del [del 'delete] 1218 | ] 1219 | ] 1220 | resize: func [face [object!] event [event!] /local _last diff][ 1221 | if any [ 1222 | 0 > diff: face/size/x - options/size/x 1223 | all [diff > 0 options/size/x < 900] 1224 | ][ 1225 | max-y: 0 1226 | max-x: 0 1227 | cur-y: 10 1228 | options/size/x: face/size/x 1229 | forall opts [ 1230 | if 1 < length? opts [ 1231 | max-x: max max-x lim x opts/1 1232 | max-y: max max-y lim y opts/1 1233 | opts/2/offset: either options/size/x - opts/2/size/x - 20 < lim x opts/1 [ 1234 | max-x: 0 1235 | as-pair 10 cur-y: max-y + 10 1236 | ][ 1237 | as-pair max-x + 10 cur-y 1238 | ] 1239 | ] 1240 | ] 1241 | options/parent/size/y: options/size/y: 10 + lim y last opts 1242 | ] 1243 | options/parent/size/x: face/size/x 1244 | bs/offset/y: options/offset/y + options/size/y + 10 1245 | bs/size/x: face/size/x - 12 1246 | bs/size/y: face/size/y - bs/offset/y - 10 1247 | rt/size/x: layer/size/x: bs/size/x - 78 1248 | show bs 1249 | adjust-scroller 1250 | reposition count-lines at rt/text curpos 1251 | ] 1252 | on-resizing: func [face event][resize face event] 1253 | on-resize: func [face event][resize face event] 1254 | ] 1255 | ] 'resize 1256 | renew-view 1257 | ending-pos: length? words-of system/words 1258 | do-events 1259 | ] 1260 | -------------------------------------------------------------------------------- /syntax3.app/Contents/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDevelopmentRegion 6 | en 7 | CFBundleExecutable 8 | syntax3 9 | CFBundleIconFile 10 | AppIcon 11 | CFBundlePackageType 12 | APPL 13 | CFBundleInfoDictionaryVersion 14 | 6.0 15 | CFBundleShortVersionString 16 | 1.0 17 | CFBundleVersion 18 | 1.0.0 19 | CFBundleIdentifier 20 | org.redlang.syntax3 21 | LSMinimumSystemVersion 22 | 10.8.0 23 | NSHighResolutionCapable 24 | YES 25 | 26 | 27 | -------------------------------------------------------------------------------- /syntax3.app/Contents/MacOS/syntax3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/toomasv/syntax-highlighter/646778b1ac23f32f42ecec2e30aa72b9465e2dfe/syntax3.app/Contents/MacOS/syntax3 -------------------------------------------------------------------------------- /syntax3.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/toomasv/syntax-highlighter/646778b1ac23f32f42ecec2e30aa72b9465e2dfe/syntax3.exe --------------------------------------------------------------------------------