Продолжаю баловаться.
Теперь правила раскраски в отдельном файле, имена, определенные в просматриватриваемом файле автоматически расцвечиваются, правда есть побочные эффекты в случае повторного определения слов.
Вообще, так как файл по сути интерпретируестя правила расцветки ограничиваются фантазией.
p.s. не делал многострочные строковые литералы и коментарии.
для того, чтобы текст выглядел контрастно нужно в свойствах окна поправить значение серого цвета со 128 128 128 на 80 80 80
source file: view.fts
\ 02.07.2013 ~mOleg
\ Copyright [C] 2013 mOleg mOlegg@ya.ru
\ просмотрщик текстовых файлов с раскраской исходников
vocs/ unit.fts
vocs/ struct.fts
os/ heap.fts
os/ console.fts
os/ ccon.fts
branch/ for-next.fts
memory/ buff.fts
memory/ pocket.fts
\ rel/ keys.fts
ALSO HIDDEN
ALIAS EKEY SYSKEY
ALIAS EKEY? key?
PREVIOUS
Unit: key'
F: esc 0x101001B ;F
F: up 0x1480000 ;F
F: dn 0x1500000 ;F
F: left 0x14B0000 ;F
F: right 0x14D0000 ;F
F: home 0x1470000 ;F
F: end 0x14F0000 ;F
F: pgup 0x1490000 ;F
F: pgdn 0x1510000 ;F
EndUnit
Unit: View{
USER 1stLine \ первая линия текста
USER LastLine \ последняя линия текста
USER TopLine \ первая отображаемая линия текста
70 VALUE Width \ ширина рабочей области экрана
0 VALUE Displ \ смещение первого отображаемого символа от начала строки
2 VALUE Up \ положение первого символа окна просмотра слева
2 VALUE Top \ и сверху
25 VALUE Height \ высота рабочей области экрана
255 VALUE MaxWidth \ максимальная длина строки
\ каждая линия хранится отдельно
0 Struct: line
Addr[] off_prev \ ссылка на предыдущую линию текста
Addr[] off_next \ ссылка на следующую линию текста
Cell[] off_size \ длина строки
Zero[] off_body \ начало текста
EndStruct
\ получить указатель на следующую линию текста
: next ( str --> str | nil ) line off_next A@ ;
\ задать ссылку str2 на следующую строку str1
: !next ( str1 str2 --> ) line off_next A! ;
\ получить указатель на предыдущую линию текста
: prev ( str --> str | nil ) line off_prev A@ ;
\ задать ссылку str2 на предыдущую строку str1
: !prev ( str1 str2 --> ) line off_prev A! ;
\ вернуть начало a2 и a1 конец строки ?
: str> ( str --> asc # )
DUP line off_size @
SWAP line off_body SWAP ;
USER-VALUE cbuff \ временный буфер
\ инициализация буфера
: cinit ( --> buff )
cbuff *IF DUP Clean ;THEN
DROP MaxWidth Buffer DUP TO cbuff ;
\ Выделить лидирующие пробельные символы
: skipsp ( a1 a2 --> a1 a2 str # ) DDUP
BEGIN DDUP > WHILE
DUP C@ ?separator WHILE C+
REPEAT
THEN -ROT DROP DDUP - ;
\ Выделить лидирующие непробельные символы
: nextlx ( a1 a2 --> a1 a2 asc # ) DDUP
BEGIN DDUP > WHILE
DUP C@ ?separator WHILENOT C+
REPEAT
THEN -ROT DROP DDUP - ;
\ выделить из строки подстроку, содержащую пару лексем,
\ вернуть ключевое слово
: _pair> ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # )
DROP >L skipsp DDROP
nextlx D>R
DUP L@ - L> SWAP
DR> ;
\ выделить из строки подстроку, содержащую тройку лексем,
\ вернуть последнюю лексему в виде строки asc3 #
: _thre> ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # )
DROP >L
skipsp DDROP nextlx DDROP
skipsp DDROP nextlx D>R
DUP L@ - L> SWAP DR> ;
\ выделить из строки подстроку, завершенную указанным символом ch
: _toch ( a1 a2 asc1 # ch --> a1 a2 asc1 #1 asc2 # )
>L DROP >R
BEGIN DDUP > WHILE
DUP C@ L@ <> WHILE
C+
REPEAT C+
THEN
DUP R@ - R> SWAP LDROP ;
\ выделить из строки подстроку, завершенную переводом строки
: _eol ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )
DROP >L
BEGIN DDUP > WHILE
DUP ?NewLine WHILENOT
C+
REPEAT
THEN DUP L@ - L> SWAP ;
\ преобразовать цвет в строку
: c>s" ( color --> x asc # ) 8 LSHIFT SP@ 2 ;
USER-VALUE prevcol \ предыдущий цвет
\ переменная для хранения vId временного словаря для хранения правил расцветки
USER-VALUE cvid
\ вернуть id временного словаря
: cVid ( --> vID )
cvid *IF ;THEN DROP
ALSO HEAP DEFINITIONS
s" RULES" SVOCAB DUP TO cvid DUP MOUNT
RECENT ;
\ удалить содержимое временного словаря
: Remove ( vId --> )
DUP DUP [ ALSO HIDDEN ] off_umount PERFORM [ PREVIOUS ]
ALSO MOUNT PREVIOUS ;
\ создание правила расцветки
: rule: ( color / name --> ) DUP >L c>s" ALSO cVid WITH THIS [COMPILE] : ;
\ создание правила расцветки имя задается строкой со счетчиком
: ruleS: ( asc # color --> ) >L D>R L@ c>s" ALSO cVid WITH THIS DR> S: NOOP ;
\ завершение правила расцветки
: ;r ( x asc # --> ) SLIT, DROP [COMPILE] ; DEFINITIONS L> TO prevcol ; IMMEDIATE
\ правило для расцветки одиночных имен
: ones: ( color / name --> ) rule: [COMPILE] ;r ;
\ правило для расцветки пары имен
: pair: ( color / name --> ) rule: COMPILE _pair> COMPILE DDROP [COMPILE] ;r ;
\ выполнить над всеми словами до конца строки действие name c параметром color
: All ( color / name lex1 lex2 .. lexN --> )
>L ' >L
<: BEGIN SeeForw NIP WHILE DL@ EXECUTE REPEAT LDROP LDROP ;>
Cr_ PARSE ROT EVALUATE-WITH ;
0 VALUE ?State
Color{
Gray CONSTANT StdBG \ стандартный цвет фона
\ получить цвет из комбинации цвета текста и цвета фона
: FONE ( color fone --> ) Fone + ;
\ добавить к цвету стандартный фон
: OnBG ( color --> color )
StdBG DDUP =
IF 0xF XOR THEN \ если цвета совпадают, инвертировать фон
Fone + ;
\ выбор цветов для различных групп слов
White OnBG CONSTANT control's
Magenta Light OnBG CONSTANT vocab's
Yellow Black FONE CONSTANT vocdef's
Gray Light OnBG CONSTANT simple's
Brown OnBG CONSTANT local's
Brown OnBG CONSTANT filed's
Yellow OnBG CONSTANT def's
Red Light OnBG CONSTANT danger's
Red Light OnBG CONSTANT errmes's
Green Light OnBG CONSTANT literal's
Blue Light Black FONE CONSTANT format's
Cyan Light OnBG CONSTANT confer's
Cyan OnBG CONSTANT comment's
Blue OnBG CONSTANT diagram's
Gray Light Black FONE CONSTANT newdef's
Blue Light Gray Light FONE CONSTANT hilight's
\ автоматическое добавление правил при разборе текста
: dodef _pair> newdef's ruleS: [COMPILE] ;r ;
: dovoc _pair> vocab's ruleS: [COMPILE] ;r ;
: dofld _pair> filed's ruleS: [COMPILE] ;r ;
: donew _pair> newdef's ruleS: [COMPILE] ;r ;
: doals _thre> newdef's ruleS: [COMPILE] ;r ;
( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )
\ цвет имен, правила расцветки для которых не определены
Gray OnBG : undefcode [ c>s" SLIT, DROP ] ;
\ цвет пробельных символов
StdBG 1 + OnBG : spaces [ c>s" SLIT, DROP ] ;
\ цвет литералов (чисел, строк, адресов, символов, т.п.)
literal's : litcode [ c>s" SLIT, DROP ] ;
RECENT
\ вернуть тег расцветки
: ?color ( a1 a2 asc1 #1 -->
a1 a2 asc1 #1 asc2 #2 )
DDUP cVid ( WHO CVID) SEARCH-NAME
*IF LINK>C EXECUTE ;THEN DROP
DDUP [ ALSO HIDDEN ] snNumber [ PREVIOUS ] \ если число
*IF NIP 2 = IF DROP THEN litcode ;THEN DROP
OVER s" off_" TUCK COMPARE IFNOT litcode ;THEN \ если строка начинаестя с "off_"
OVER s" to_" TUCK COMPARE IFNOT litcode ;THEN \ если строка начинаестя с "to_"
OVER C@ [CHAR] / = IF litcode ;THEN \ если строка начинается со "\"
undefcode ;
\ преобразовать
: colorify ( asc # --> asc # )
BOUNDS cinit >L
BEGIN DDUP > WHILE
skipsp *IF spaces L@ >Buffer DROP THEN
L@ >Buffer DROP
nextlx ?color L@ >Buffer DROP
L@ >Buffer DROP
REPEAT DDROP
L> Buffer> ;
\ создать новую запись в хипе, скопировать туда содержимое строки ?
: new ( asc # --> str )
colorify
DUP line /size + BLOCK >L
TUCK L@ line off_body SWAP CMOVE
L@ line off_size !
nil L@ !prev
nil L@ !next
L> ;
\ добавить строку в конец текста
: push ( str --> )
LastLine A@ OVER !prev
DUP LastLine A@ !next
LastLine A! ;
\ задать начальное состояние
: set ( str --> ) DUP 1stLine A! DUP LastLine A! TopLine A! ;
\ добавить строку в конец списка строк
: add ( str --> ) 1stLine @ IF push ;THEN set ;
\ вернуть адрес конца подстроки
: part ( a1 a2 --> a3 )
BEGIN DDUP > WHILE
DUP B@ WHILE
1 +
REPEAT
THEN NIP ;
\ вернуть цвет из начала указанной строки, пропустить цветовую информацию
: @col ( a1 --> a2 c ) 1 + DUP B@ 0:1 D+ ;
\ выделить из начала строки, ограниченной адресами a1 a2 раскрашенную в цвет C подстроку asc #
\ исключить из начала исходной строки выделенную подстроку
: lex ( a1 a2 --> a1 a4 asc # c ) @col >L DDUP part TUCK OVER - L> ;
\ длинная строка пробелов
CREATE spaceS MaxWidth <| FOR Bl_ KEEP TILL |> S, ;CREATE
\ отобразить с текущей позиции курсора указанное количество
\ пробельных символов фонового цвета
: cSpaces ( # --> )
*IF spaceS SWAP spaces DROP 1 + B@ CTYPE ;THEN DROP ;
\ вывести строку asc # в консоль максимально допустимая длина строки s символов
: cType] ( asc # s --> )
>L BEGIN DDUP > WHILE
lex L@ THRID -
-IF DROP NIP L> SWAP CTYPE DDROP ;THEN
LDROP >L CTYPE
REPEAT DDROP
L> cSpaces ;
\ вывести строку asc # в консоль длина отображаемой строки u символов
\ если строка длиннее - обрезать, если короче - дополнить пробелами
: >cType] ( asc # s u --> )
>L -ROT BOUNDS THRID >R
BEGIN DDUP > WHILE
lex L@ THRID -
-IF DROP -ROT L> SKIPn DUP >L R> MIN ROT CTYPE
ROT L> - 0 MAX cType]
;THEN
LDROP >L TDROP
REPEAT RDROP LDROP ROT cType] ;
\ отобразить текст в окне начиная с позиции up top размером width height
\ текст сместить от начала строк на x позиций
: show ( width disp TopLine up top height --> )
FOR DDUP setxy D>L
THRID THRID THRID
IF THRID str> DSWAP >cType] next
ELSE spaces DSWAP >cType]
THEN
DL> 1 +
TILL 5 nDROP ;
\ освободить занимаемую память
: free ( 1stLine --> )
A@ BEGIN *WHILE DUP next SWAP FREE DROP REPEAT DROP
nil set ;
\ загрузка строк из файла
: load ( asc # --> )
FILE>HEAP IFNOT ERROR" Invalid file name!" THEN
OVER >L
<: BOUNDS SWAP
BEGIN DDUP < WHILE
DDUP EOL> -ROT THRID ROT TUCK - -EOL
['] new CATCH IF 1stLine free ERROR" Not enought memory!" THEN
add
REPEAT DDROP
;> CATCH
L> FREE DROP
THROW ;
\ сместить окно на одну линию вверх
: TopUp ( --> ) TopLine A@ prev *IF TopLine A! ELSE DROP THEN ;
\ сместить окно на одну линию вниз
: TopDn ( --> ) TopLine A@ next *IF TopLine A! ELSE DROP THEN ;
\ на одну страницу вверх
: PgUp ( --> ) Height FOR TopUp TILL ;
\ на одну страницу вниз
: PgDn ( --> ) Height FOR TopDn TILL ;
\ отслеживание изменение размеров экрана (отображаемой области)
: scr# ( --> )
width Up - 2 - TO Width
height Top - 2 - TO Height ;
\ обработка событий нажатий клавиш
: reflex ( key --> flag )
CASE key' esc OF ERROR" Ok." ENDOF
key' dn OF TopDn TRUE ENDOF
key' up OF TopUp TRUE ENDOF
key' right OF Displ 1 + MaxWidth Width - MIN TO Displ TRUE ENDOF
key' left OF Displ 1 - 0 MAX TO Displ TRUE ENDOF
key' pgup OF PgUp TRUE ENDOF
key' pgdn OF PgDn TRUE ENDOF
key' home OF 1stLine A@ TopLine A! TRUE ENDOF
key' end OF LastLine A@ TopLine A! TRUE ENDOF
scr#
DROP FALSE
ENDCASE ;
\ отобразить страницу текста в окне
: ~Page ( --> ) Width Displ TopLine A@ Up Top Height show ;
\ главный рабочий цикл
:> Viewer ( --> )
~Page
BEGIN key? IF SYSKEY reflex
IF ~Page THEN \ отрисовка только в случае изменений
THEN
10 PAUSE
AGAIN ;
F: } ;F
\ загрузить файл правил расцветки
: LoadRules ( asc #--> ) Color{ [COMPILE] View{ INCLUDED [ PREVIOUS ] PREVIOUS ;
EndUnit
POCKET FileName \ для хранения имени файла
\ отобразить содержимое указанного файла
: VIEW ( asc # --> )
FileName <| s" file: " KEEPS KEEPS |> ~title
View{ s" color.rule" LoadRules
0 FileName load
HideCur scr#
Viewer CATCH DROP
1stLine free
ShowCur
cVid Remove
} ;
source file: color.rule
\ правила расцветки исходных текстов m0leg 22.07.2013
\ ?init: ?stop ADMIT DEF N?DEFINED init: \ пока не понятно как с ними быть
\ имена словарей и слова работающие с ними
vocab's All ones: FORTH NUMBERS ROOT HIDDEN HEAP IMPORT FORTH-WORDLIST
vocab's All ones: ALSO ONLY only SEAL PREVIOUS WITH INSIDE UNDER
vocab's All ones: CURRENT GET-CURRENT DEFINITIONS RECENT THIS SVOCAB
vocab's All ones: UNMOUNT MOUNT RMVID init-order
vocab's All ones: CONTEXT SAVE-ORDER RESTORE-ORDER SET-CURRENT SET-ORDER
\ подсветка слов управляющих структур
control's All ones: BEGIN WHILE WHILENOT *WHILE REPEAT AGAIN UNTIL
control's All ones: IF -IF *IF IFNOT ELSE THEN
control's All ones: CASE OF uOF ENDOF ENDCASE
control's All ones: NOW SINCE FOR TILL NEXT
control's All ones: DO ?DO LOOP +LOOP LEAVE I J
control's All ones: SWITCH: ;SWITCH
\ простые имена из словаря FORTH
simple's All ones: !voc-flag (1С=) (<C) (ABORT) (ACCEPT) (ALLOCATE) (API-CODE)
simple's All ones: #TIB ! (Allot) (BOX) (BYE) (C!) (C#) (C+) (C@) (CLOSE-FILE)
simple's All ones: (CONSOLE-HANDLES) (CONST) (CR) (DLIT) (DOES) (EMIT) (ENTER)
simple's All ones: (CREATE) (EXC) (INCLUDED) (FREE) (INIT) (INTERPRET) (PAIRS)
simple's All ones: (EvalSrc) (READ-LINE) (QUIT) (JOIN) (LIT) (OPTIONS) (PAUSE)
simple's All ones: (OK) ([) (MESSAGE) (REFILL) (SYSMSG>) (TYPE) (USER) (TITLE)
simple's All ones: (]) (check-voc) (code) (conclude) (flag) (get-attr) (mount)
simple's All ones: (d.) (id>asc) (invalid) (iso-<c) (iso-c!) (iso-c#) (iso-c+)
simple's All ones: (iso-c@) (latest) (link-voc) (name) (prev) (prompt) (vdlit)
simple's All ones: (n.) (sHeader) (set-attr) (uvalue) (size) (switch) (ustore)
simple's All ones: (store) (value) (vlit) (voc-search) (~ERROR) (~EXC) *BRANCH
simple's All ones: (~Place) * + +! , - -1 -BRANCH -ROT . / <BACK <C <> >NUMBER
simple's All ones: < <EOL <EXC-DUMP> <MAIN> <MARK <Node <RESOLVE >List ?BRANCH
simple's All ones: <resolve >ASCIIZ >ASCIIZ> >CIPHER ?ABSENT >MARK >IN >stderr
simple's All ones: > = >UPPER >lower >number >DIGIT ?BIT ?COMP ?LockMutex @API
simple's All ones: ?COMPLETE ?EXEC ?EXISTS ?SMUDGED ?LINES ?SHEADER ?separator
simple's All ones: ?hex-pref ?IMMEDIATE ?SIGN ?STACK ?NewLine ?WORD @ @ATTR A!
simple's All ones: ?NOTFOUND ?UNIQUE A, ABS ACCEPT ACHANGE ALIGN-BYTES ALIGNED
simple's All ones: A@ ADDR, ALIGN ALLOCATE ALLOT ANSI><OEM ANSI>OEM ASCIIZ> B@
simple's All ones: AND API-CALL AR@ ApiAddr ATIB AddExHandler BOUNDS BRANCH C!
simple's All ones: AT-SOURCE B! B, CMOVE BASE@ BETWEEN BIT CLOSE-FILE C# C+ C,
simple's All ones: C@ CALL, CELLS CHANGE CODE-ALIGN CIPHER CONSOLE-HANDLES DS/
simple's All ones: COMPARE COMPARE-NAMES COMPILE COMPILE, CONSIDER CREATE-FILE
simple's All ones: CSTREAM CURSRC CUT-PATH COUNT CharCode CR CharAddr CookLine
simple's All ones: CookAsc D! CONTENT CompBuf D+ D, D. DABS DDROP DECODE-ERROR
simple's All ones: DIGIT DLIT, DOVER DSWAP CloseSource D@ DLITERAL DTUCK ERASE
simple's All ones: dliteral DNEGATE DNIP DP DDUP DROP EVAL-TOKEN EXIT, FREFILL
simple's All ones: DU* FENCE EMIT EOL> ER-A ER-U ERRORS EvalSrcWith ExitSource
simple's All ones: F>HEAP FILE-POSITION FILE>HEAP DUP FileSource FindThread H.
simple's All ones: EvalSource FILL HASH ID>ASC INTERPRET IN-EXCEPTION INCLUDED
simple's All ones: ISO> HANDLER HERE HLD INI-FILE FREE GET-ATTR FRAME INIT-MEM
simple's All ones: INIT? INPUT-STREAM JUMP, LAST-NAME LINK>XTI LIT, LP@ LSHIFT
simple's All ones: LAST LATEST LEXEME LINK-VOC LinkLast LINK> LoadDll MISSTILL
simple's All ones: LoadInit LoadMess MESSAGE MAX LINK>C MissOne MissSeparators
simple's All ones: MOD MissLexeme ModuleDirName NEGATE MIN ModuleName N?BRANCH
simple's All ones: NewSource N. NEW-WORDLIST NIP MAINX NEXT-WORD NOOP NOTFOUND
simple's All ones: NextChar NextOne NextWord MSG-FILE OEM>ANSI OFF OK ON PARSE
simple's All ones: ON-SOURCE-EXIT ON-SOURCE-START PassLexeme OVER QUIT PAD-TOP
simple's All ones: PAUSE PIECE OPTIONS OPEN-FILE OPEN-FILE-SHARED PAD PeekChar
simple's All ones: OR PRESENT PROCESS PROMPT ParseFileName REFILL-STDIN RECOIL
simple's All ones: REGULAR PeekOne ProcessHeap READ-FILE QUEST REPOSITION-FILE
simple's All ones: READ-LINE RSHIFT REF, ROUND RET, REFILL PLACE RESOLVE> REST
simple's All ones: ROT RdLine S", S>VAL S-O REF! REF@ S, SEARCH S>HEAP SA SAVE
simple's All ones: SCNT! SCNT, SET-ATTR SCOPY SDP S>D SIGN SKIP1 SKIPn SOURCE!
simple's All ones: SCNT@ SEARCH-NAME SEEN-ERROR SFIND TLS-INIT SOURCE-NAME SP@
simple's All ones: SLIT, SWAP TOKEN@ TDROP TIB TOKEN! SpaceLine StrSource TUCK
simple's All ones: SetSource SOURCE SYSMSG> USER-HERE TlsIndex@ TranslateFlow
simple's All ones: TYPE U. U< U> U>D UA! UA@ VLISTUM/MOD SkipChar UNLINK-LAST
simple's All ones: USER-ALLOT USER-OFFS USER-PLACE atod UnlockMutex WRITE-FILE
simple's All ones: VIEWPOINT WITHIN VOC-LIST W! WIN-ERR UM* controls WINAPLINK
simple's All ones: WaitUnlock Waiting WithList XOR aGetChar create-file expose
simple's All ones: W, W@ cmdline> cur-err-h entry equivalent is_path_delimiter
simple's All ones: err-handler find-msg-body check-voc suNumber voc-table ~fha
simple's All ones: find-msg-num identify init-input literal last-number linkto
simple's All ones: no-umount last-msg load-messages msg-list reffered no-mount
simple's All ones: num-msg new-msg nDROP prefer restore restore-: s## s?number
simple's All ones: sFindIn sNumLfa save-dp search-thread system_buff source-id
simple's All ones: state stream-type ~ErrPlace snNumber unique-msg vAllot
simple's All ones: THRID setxy getxy
\ литералы
literal's All ones: #compbuf #err-handlers &ALS &DAS &IMM &NON &PRI &SMG &code
literal's All ones: &VOC &name &prev &size &v-dyn &v-std &vinit /cfa /lfa /ffa
literal's All ones: /header /SrcRec /msgRecord /nfa /sList /source /vocabulary
literal's All ones: /chartype /vtable /winrec /wordlist H-STDIN BUILD-DATE Bl_
literal's All ones: IMAGE-BEGIN CELL CFL Cr_ H-STDERR H-STDOUT IMAGE-BASE ADDR
literal's All ones: C/L FALSE REF LIMIT R/W LTL Lf_ MESS? NewLine OS> PAD# R/O
literal's All ones: L0 LT R0 S0 SCNT# THREADS# TLS# TOKEN comma Tab_ WORDLISTS
literal's All ones: TRUE VERSION W/O imm_word point std_word tab# nil
\ слова для работы с локальным стеком данных
local's All ones: >L L> L@ LDUP LDROP DL@ D>L { } AL@ A>L AL> AL+ ALDROP ALDUP
local's All ones: DL> L+
\
def's All ones: EndStruct EndUnit DOES> CREATED ?EXIT <: ;> EXIT ;THEN SHEADER
def's All ones: ;CREATE /struct HEADER WORDLIST
\ потенциально опасные слова, требующие внимания и обработка исключений
danger's All ones: >R R> R@ RDROP R+ DR> D>R A>R AR> DR@ ARDROP N>R NR> rnDROP
danger's All ones: EXECUTE PERFORM JUMP LEAP CATCH THROW DEMAND REJECT ERROR
danger's All ones: IMMEDIATE unfeasible SMUDGE HIDE IT-DOES PRIMITIVE VOC 0>R'
danger's All ones: LITERAL WARNING >STDERR CR>ERR ON-ERROR EXIT-ERROR ON-CATCH
danger's All ones: BYE HALT ERR-EXIT ExitProcess FATAL-HANDLER
danger's All ones: HEX BASE DECIMAL always
danger's All ones: [IF] [ELSE] [THEN] ' [ ]
danger's All ones: ClearDStack ClearLStack LP! SP! RP! RP@ FS! FS@ TlsIndex!
\ подсветка отладочных определений
hilight's All ones: .S DUMP DUMP~ ORDER
\ форматное преобразование чисел и строк
format's All ones: {# <# # #S HOLD HOLDS #> #} <| KEEP KEEPS |> BLANK BLANKS
\ работа с VALUE и VECT переменными
confer's All pair: TO IS FROM HAS
\ литералы
literal's All pair: [CHAR] [COMPILE] WHO ['] LFA CHAR" 1CHAR= ^
\ подключаемые библиотеки
literal's All pair: rel/ root/ vocs/ os/ branch/ memory/ string/ transl/
literal's All pair: math/ exc/ stack/ util/
\ --------------------- более сложные правила расцветки -----------------------
comment's rule: \ _eol ;r \ коментарий до конца строки
hilight's rule: \? _eol ;r \ подсвеченый коментарий
hilight's rule: \! _eol ;r \ подсвеченый коментарий
literal's rule: s" [CHAR] " _toch ;r \ однострочные строковые литералы
literal's rule: S" [CHAR] " _toch ;r \ однострочные строковые литералы
diagram's rule: ( [CHAR] ) _toch ;r \ однострочные стековые коментарии
literal's rule: .( [CHAR] ) _toch ;r \ однострочные сообщения
literal's rule: ." [CHAR] " _toch ;r \ однострочные сообщения
literal's rule: STRING" [CHAR] " _toch ;r \ строка сообщения
errmes's rule: ERROR" [CHAR] " _toch ;r \ сообщение об ошибке
errmes's rule: ABORT" [CHAR] " _toch ;r \ сообщение об ошибке
literal's rule: NOTICE" [CHAR] " _toch ;r \ строка сообщения
\ следущие определения автоматически добавляют в словарь правила раскраски
\ определения различных переменных
s" USER" def's ruleS: dodef ;r
s" VALUE" def's ruleS: dodef ;r
s" DVALUE" def's ruleS: dodef ;r
s" VARIABLE" def's ruleS: dodef ;r
s" DVARIABLE" def's ruleS: dodef ;r
s" USER-VALUE" def's ruleS: dodef ;r
s" USER-DVAL" def's ruleS: dodef ;r
s" CONSTANT" def's ruleS: dodef ;r
s" VECT" def's ruleS: dodef ;r
s" DEFER" def's ruleS: dodef ;r
s" USER-VECT" def's ruleS: dodef ;r
s" USER-CREATE" def's ruleS: dodef ;r
s" CREATE" def's ruleS: dodef ;r
s" POCKET" def's ruleS: dodef ;r
s" ALIAS" def's ruleS: doals ;r
\ создание словарей
s" Unit:" vocdef's ruleS: dovoc ;r
s" VOCABULARY" vocdef's ruleS: dovoc ;r
s" CONTAINER" vocdef's ruleS: dovoc ;r
s" Struct:" vocdef's ruleS: dovoc ;r
s" struct:" vocdef's ruleS: dovoc ;r
\ поля структур
s" Cell[]" filed's ruleS: dofld ;r
s" Addr[]" filed's ruleS: dofld ;r
s" Zero[]" filed's ruleS: dofld ;r
s" addr[]" filed's ruleS: dofld ;r
s" byte[]" filed's ruleS: dofld ;r
s" --" filed's ruleS: dofld ;r
\ определяющие слова
s" :" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r
s" :>" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r
s" S:" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r
s" F:" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r
\ слова завершающие определения
s" ;" def's ruleS: FALSE TO ?State ;r
s" ;F" def's ruleS: FALSE TO ?State ;r
s" ;stop" def's ruleS: FALSE TO ?State ;r