Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Oberon
Перезагрузить страницу Подсветка синтаксиса в BlackBox собственными руками
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию Подсветка синтаксиса в BlackBox собственными руками - 18.11.2004, 20:31

Написал прогу, которая делает элементарную подсветку синтаксиса в BlackBox:
Код:
MODULE  SimpleTextColorizer;
IMPORT  StdLog, TextModels, TextMappers, Views, TextViews, Ports, Fonts, TextControllers;

PROCEDURE Read(r: TextModels.Reader; VAR str: ARRAY OF CHAR; VAR char: CHAR);
VAR n: INTEGER;
BEGIN
    FOR n := 0 TO LEN(str)-1 DO str[n] := CHR(0) END;
    n := 0;
    LOOP
  ASSERT(n < LEN(str));
  r.ReadChar(char); 
  IF r.eot OR (char = 0EX) OR (char = 0DX) OR (char = 09X) OR (char = " ") OR (char = ";")
      OR (char = "(") OR (char = ")") OR (char = "[") OR (char = "]") OR (char = "{") OR (char = "}")
      OR (char = ".") OR (char = ",") OR (char = ":") OR (char = "+") OR (char = "^") OR (char = "*")
      OR (char = "/") OR (char = "$") OR (char = "~") OR (char = "#") OR (char = 02X)
  THEN EXIT ELSE str[n] := char; INC(n) END
    END
END Read;

PROCEDURE Colorize* ();
VAR
    newtext, oldtext: TextModels.Model; 
    f: TextMappers.Formatter; v: Views.View;
    c: TextControllers.Controller;
    r: TextModels.Reader;
    str: ARRAY 4000 OF CHAR;
    char: CHAR;
    AttrDef, AttrKeyWord, AttrExit, AttrPrimeType, AttrOper, AttrNew, AttrConst: TextModels.Attributes;
BEGIN
    c := TextControllers.Focus(); 
    IF c = NIL THEN
  StdLog.String("No TextControllers.Focus"); StdLog.Ln(); RETURN;
    END;
    oldtext := c.text; 
    newtext := TextModels.dir.New(); f.ConnectTo(newtext);
    r := oldtext.NewReader(NIL);
    AttrDef := TextModels.dir.attr;
    AttrKeyWord := TextModels.NewColor(AttrDef, Ports.blue);
    AttrExit := TextModels.NewWeight(TextModels.NewColor(AttrDef, 0AA0000H), Fonts.bold);
    AttrPrimeType := TextModels.NewColor(AttrDef, 0AA00BBH);
    AttrOper := TextModels.NewColor(AttrDef, 0007000H);
    AttrNew := TextModels.NewColor(AttrDef, 00000FFH);
    AttrConst := TextModels.NewColor(AttrDef, 0000090H);
    REPEAT
  Read(r, str, char);
  IF    (str$ = "BEGIN") OR (str$ = "END") 
      OR (str$ = "MODULE") OR (str$ = "IMPORT") OR (str$ = "CLOSE")
      OR (str$ = "TYPE") OR (str$ = "CONST") OR (str$ = "VAR") OR (str$ = "IN") OR (str$ = "OUT")    
      OR (str$ = "PROCEDURE")
      OR (str$ = "IF") OR (str$ = "THEN") OR (str$ = "ELSIF") OR (str$ = "ELSE")
      OR (str$ = "REPEAT") OR (str$ = "UNTIL")
      OR (str$ = "WHILE") OR (str$ = "DO")
      OR (str$ = "LOOP")
      OR (str$ = "FOR") OR (str$ = "TO") OR (str$ = "BY")
      OR (str$ = "RECORD") OR (str$ = "POINTER")
      OR (str$ = "ABSTRACT") OR (str$ = "EXTENSIBLE") OR (str$ = "LIMITED") OR (str$ = "EMPTY")
      OR (str$ = "ARRAY") OR (str$ = "OF")
      OR (str$ = "CASE")
      OR (str$ = "WITH") OR (str$ = "IS")
  THEN
      f.rider.SetAttr(AttrKeyWord);
  ELSIF (str$ = "RETURN") OR (str$ = "EXIT") OR (str$ = "HALT") OR (str$ = "ASSERT")
  THEN
      f.rider.SetAttr(AttrExit);
  ELSIF (str$ = "BYTE") OR (str$ = "CHAR") OR (str$ = "INTEGER") OR (str$ = "LONGINT") 
      OR (str$ = "REAL") OR (str$ = "BOOLEAN") OR (str$ = "SET") OR (str$ = "SHORTCHAR")
      OR (str$ = "SHORTINT") OR (str$ = "SHORTREAL") OR (str$ = "ANYPTR") OR (str$ = "ANYREC")
  THEN
      f.rider.SetAttr(AttrPrimeType);
  ELSIF (str$ = "OR") OR (str$ = "&") OR (str$ = "|") OR (str$ = "DIV") OR (str$ = "MOD")
      OR (str$ = "/") OR (str$ = "*") OR (str$ = "+") OR (str$ = "-") OR (str$ = ":") OR (str$ = ".")
      OR (str$ = ":=") OR (str$ = "=") OR (str$ = "<") OR (str$ = ">") OR (str$ = ">=") OR (str$ = "<=")
      OR (str$ = "ORD") OR (str$ = "CHR") OR (str$ = "ODD") OR (str$ = "MAX") OR (str$ = "MIN")
      OR (str$ = "INC") OR (str$ = "DEC") OR (str$ = "INCL") OR (str$ = "EXCL") OR (str$ = "LEN")
      OR (str$ = "ABS") OR (str$ = "BITS") OR (str$ = "SHORT") OR (str$ = "SIZE") OR (str$ = "LONG")
      OR (str$ = "ENTIER") OR (str$ = "CAP") OR (str$ = "ASH")
  THEN
      f.rider.SetAttr(AttrOper);
  ELSIF (str$ = "NEW")
  THEN
      f.rider.SetAttr(AttrNew);
  ELSIF (str$ = "NIL") OR (str$ = "0") OR (str$ = "TRUE") OR (str$ = "FALSE") OR (str$ = "INF")
      OR (str$ = "09X") OR (str$ = "0DX") OR (str$ = "0EX") OR (str$ = "00X") OR (str$ = "FINALIZE")
      OR (str$ = "0X")
  THEN
      f.rider.SetAttr(AttrConst);
  ELSE
      f.rider.SetAttr(AttrDef);
  END;
  f.WriteString(str$);
  f.rider.SetAttr(AttrDef);
  IF (char = 09X) OR (char = 02X) THEN f.WriteTab() 
  ELSIF char = 0DX THEN f.WriteLn() 
  ELSIF char = 0EX THEN f.WritePara()
  ELSIF char # 00X THEN f.WriteChar(char)
  END;
    UNTIL r.eot;
    v := TextViews.dir.New(newtext);
    Views.OpenView(v);
END Colorize;

END SimpleTextColorizer.
Надо сохранить этот модуль под именем BlackBoxSimpleModTextColorizer.odc. После чего скомпилировать его. Затем добавить пункт меню:
Info -> Menus -> "Dev/Rsrc/Menus" -> добавить строку: "Colorizing" "C" "SimpleTextColorizer.Colorize" "TextCmds.FocusGuard"
Код:
...
MENU "Tools"
   "Colorizing"    "C"    "SimpleTextColorizer.Colorize"    "TextCmds.FocusGuard"   
    SEPARATOR    
    "Document Size..."    ""    "StdCmds.InitLayoutDialog; StdCmds.OpenToolDialog('Std/Rsrc/Cmds1', 'Document Size')"
...
Затем сделать Info -> Update Menus. Вот и все. Открываете любой документ с исходным кодом, и нажимаете Ctrl+C появится новый раскрашенный документ. Естественно, вместо буквы "C" можете использовать какую-нибудь другую, только тогда в Menus напишите эту другую букву. Ну и еще, тоже естественно, эта программа очень простая, так что особых претензий к ней предъявлять не стоит.
Ответить с цитированием
  (#2 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 19.11.2004, 14:06

Вторая версия проги:

1) Работает сильно быстрее.
2) Умеет подсвечивать синтаксис прямо в том же самом документе, а не только в его копии. Причем, если в документ внедрены какие-то View, то они от этого не ломаются.
Код:
MODULE  SimpleTextColorizer;
IMPORT  StdLog, TextModels, TextMappers, Views, TextViews, Ports, Fonts, TextControllers;

CONST
    tabulator_key_num = 09H;
    line_separator_num = 0DH;    
    string_terminator_num = 00H;
    paragraph_separator_num = 0EH;
    view_mask_character_num = 02H;
    
VAR
    separators: ARRAY 65536 OF BOOLEAN;

    AttrDef, AttrKeyWord, AttrExit, AttrPrimeType, 
    AttrOper, AttrNew, AttrConst: TextModels.Attributes;

PROCEDURE FindAttributes (VAR str: ARRAY OF CHAR; OUT a: TextModels.Attributes);
BEGIN
    a := AttrDef;
    IF (str$ = "BEGIN") 
  OR (str$ = "END") 
  OR (str$ = "MODULE")
  OR (str$ = "DEFINITION")  
  OR (str$ = "IMPORT")
  OR (str$ = "CLOSE")
  OR (str$ = "TYPE")
  OR (str$ = "CONST")
  OR (str$ = "VAR")
  OR (str$ = "IN")
  OR (str$ = "OUT")
  OR (str$ = "PROCEDURE")
  OR (str$ = "IF")
  OR (str$ = "THEN")
  OR (str$ = "ELSIF")
  OR (str$ = "ELSE")
  OR (str$ = "REPEAT")
  OR (str$ = "UNTIL")
  OR (str$ = "WHILE")
  OR (str$ = "DO")
  OR (str$ = "LOOP")
  OR (str$ = "FOR")
  OR (str$ = "TO")
  OR (str$ = "BY")
  OR (str$ = "RECORD")
  OR (str$ = "POINTER")
  OR (str$ = "ABSTRACT") 
  OR (str$ = "EXTENSIBLE")
  OR (str$ = "LIMITED")
  OR (str$ = "EMPTY")
  OR (str$ = "ARRAY")
  OR (str$ = "OF")
  OR (str$ = "CASE")
  OR (str$ = "WITH")
  OR (str$ = "IS")
    THEN a := AttrKeyWord
    ELSIF (str$ = "RETURN")
  OR (str$ = "EXIT")
  OR (str$ = "HALT")
  OR (str$ = "ASSERT")
    THEN a := AttrExit
    ELSIF (str$ = "BYTE")
  OR (str$ = "CHAR")
  OR (str$ = "INTEGER")
  OR (str$ = "LONGINT") 
  OR (str$ = "REAL")
  OR (str$ = "BOOLEAN")
  OR (str$ = "SET")
  OR (str$ = "SHORTCHAR")
  OR (str$ = "SHORTINT")
  OR (str$ = "SHORTREAL")
  OR (str$ = "ANYPTR")
  OR (str$ = "ANYREC")
    THEN a := AttrPrimeType
    ELSIF (str$ = "OR") 
  OR (str$ = "&")
  OR (str$ = "|")
  OR (str$ = "DIV")
  OR (str$ = "MOD")
  OR (str$ = "/")
  OR (str$ = "*")
  OR (str$ = "+")
  OR (str$ = "-")
  OR (str$ = ":")
  OR (str$ = ".")
  OR (str$ = ":=")
  OR (str$ = "=")
  OR (str$ = "<")
  OR (str$ = ">")
  OR (str$ = ">=")
  OR (str$ = "<=")
  OR (str$ = "ORD")
  OR (str$ = "CHR")
  OR (str$ = "ODD")
  OR (str$ = "MAX")
  OR (str$ = "MIN")
  OR (str$ = "INC")
  OR (str$ = "DEC")
  OR (str$ = "INCL")
  OR (str$ = "EXCL")
  OR (str$ = "LEN")
  OR (str$ = "ABS")
  OR (str$ = "BITS")
  OR (str$ = "SHORT")
  OR (str$ = "SIZE")
  OR (str$ = "LONG")
  OR (str$ = "ENTIER")
  OR (str$ = "CAP")
  OR (str$ = "ASH")
    THEN a := AttrOper
    ELSIF (str$ = "NEW") THEN a := AttrNew
    ELSIF (str$ = "NIL")
  OR (str$ = "0")
  OR (str$ = "TRUE")
  OR (str$ = "FALSE")
  OR (str$ = "INF")
  OR (str$ = "09X")
  OR (str$ = "0DX")
  OR (str$ = "0EX")
  OR (str$ = "00X")
  OR (str$ = "FINALIZE")
  OR (str$ = "0X")
  OR (str$ = "02X")
    THEN a := AttrConst END;
END FindAttributes;

PROCEDURE CopyColorize* ();
VAR
    newtext, oldtext: TextModels.Model; 
    f: TextMappers.Formatter; newview: Views.View;
    c: TextControllers.Controller;
    r: TextModels.Reader;
    str: ARRAY 4000 OF CHAR;
    char: CHAR;
    a: TextModels.Attributes; 
    n: INTEGER;
BEGIN
    c := TextControllers.Focus(); 
    IF c = NIL THEN
  StdLog.String("No TextControllers.Focus"); StdLog.Ln(); RETURN;
    END;
    oldtext := c.text; 
    newtext := TextModels.dir.New(); f.ConnectTo(newtext);
    r := oldtext.NewReader(NIL);
    REPEAT
  n := 0; r.ReadChar(char);
  WHILE ~r.eot & ~separators[ORD(char)] DO
      str[n] := char; INC(n); r.ReadChar(char);
  END;
  str[n] := CHR(0);
  FindAttributes(str, a);
  f.rider.SetAttr(a); f.WriteString(str$);
  f.rider.SetAttr(AttrDef);
  IF (char = 09X) OR (char = 02X) THEN f.WriteTab() 
  ELSIF char = 0DX THEN f.WriteLn() 
  ELSIF char = 0EX THEN f.WritePara()
  ELSIF char # 00X THEN f.WriteChar(char) END;
    UNTIL r.eot;
    newview := TextViews.dir.New(newtext);
    Views.OpenView(newview);
END CopyColorize;


PROCEDURE InnerColorize* ();
VAR
    text, buff: TextModels.Model; 
    f: TextMappers.Formatter;
    c: TextControllers.Controller;
    r: TextModels.Reader;
    str: ARRAY 4000 OF CHAR;
    char: CHAR;
    a: TextModels.Attributes; 
    n, beg, end, caret: INTEGER;
BEGIN
    c := TextControllers.Focus(); 
    IF c = NIL THEN
  StdLog.String("No TextControllers.Focus"); StdLog.Ln(); RETURN;
    END;
    text := c.text; caret := c.CaretPos();
    r := text.NewReader(NIL);
    REPEAT
  n := 0; beg := r.Pos(); r.ReadChar(char);
  WHILE ~r.eot & ~separators[ORD(char)] DO
      str[n] := char; INC(n); r.ReadChar(char);
  END;
  end := r.Pos() - 1;
  str[n] := CHR(0);
  FindAttributes(str, a);
  IF a # AttrDef THEN
      buff := TextModels.dir.New(); f.ConnectTo(buff);
      f.rider.SetAttr(a); f.WriteString(str$);
      text.Replace(beg, end, buff, 0, buff.Length());
  END;
    UNTIL r.eot;
    c.SetCaret(caret);
END InnerColorize;

PROCEDURE InitSeparators ();
VAR  i: INTEGER;
BEGIN
    FOR i := 0 TO LEN(separators) - 1 DO separators[i] := FALSE END;
    separators[ORD(" ")] := TRUE; 
    separators[ORD(";")] := TRUE; 
    separators[ORD("(")] := TRUE;
    separators[ORD(")")] := TRUE; 
    separators[ORD("[")] := TRUE; 
    separators[ORD("]")] := TRUE;
    separators[ORD("{")] := TRUE; 
    separators[ORD("}")] := TRUE; 
    separators[ORD(".")] := TRUE;
    separators[ORD(",")] := TRUE; 
    separators[ORD(":")] := TRUE; 
    separators[ORD("+")] := TRUE;
    separators[ORD("-")] := TRUE; 
    separators[ORD("*")] := TRUE; 
    separators[ORD("/")] := TRUE;
    separators[ORD("|")] := TRUE; 
    separators[ORD("^")] := TRUE; 
    separators[ORD("$")] := TRUE;
    separators[ORD("~")] := TRUE; 
    separators[ORD("#")] := TRUE;
    separators[tabulator_key_num] := TRUE;
    separators[line_separator_num] := TRUE;
    separators[string_terminator_num] := TRUE;
    separators[paragraph_separator_num] := TRUE;
    separators[view_mask_character_num] := TRUE;
END InitSeparators;

PROCEDURE InitAttributes ();
BEGIN
    AttrDef := TextModels.dir.attr;
    AttrKeyWord := TextModels.NewColor(AttrDef, Ports.blue);
    AttrExit := TextModels.NewWeight(TextModels.NewColor(AttrDef, 0AA0050H), Fonts.bold);
    AttrPrimeType := TextModels.NewColor(AttrDef, 0AA00BBH);
    AttrOper := TextModels.NewColor(AttrDef, 0007000H);
    AttrNew := TextModels.NewColor(AttrDef, 00000FFH);
    AttrConst := TextModels.NewColor(AttrDef, 0000090H);
END InitAttributes;

BEGIN
    InitSeparators(); InitAttributes();
END SimpleTextColorizer.
Изменения в Menu:
Код:
MENU "Tools"
    "Colorizing this"    "C"    "SimpleTextColorizer.InnerColorize"    "TextCmds.FocusGuard"    
    "Colorizing copy"    "*C"    "SimpleTextColorizer.CopyColorize"    "TextCmds.FocusGuard"    
    SEPARATOR
То есть теперь Ctrl+C раскрашивает текст в текущем документе, а Ctrl+Shift+C раскрашивает текст в копии документа (в копии View не копируются - только текст).
Ответить с цитированием
  (#3 (permalink)) Старый
Trurl Trurl вне форума
Member
 
Сообщений: 108
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 26.08.2004
По умолчанию 19.11.2004, 14:49

Простой способ ускорения: case по первому символу, а потом уже сравнение строк.
Ответить с цитированием
  (#4 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 20.11.2004, 22:27

Цитата:
Originally posted by Trurl
[b]Простой способ ускорения: case по первому символу, а потом уже сравнение строк.
Можно, потом. А сейчас можно еще более сильно ускорить работу
1) Не заменять участи текста, а лишь перекрашивать
2) Не перекрашивать то, что и так уже хорошего цвета

Итого:
Код:
PROCEDURE ColorizeTextController* (controller: TextControllers.Controller);
VAR
    char: CHAR;
    n, beg, end, caret: INTEGER;    
    string: ARRAY 4000 OF CHAR;
    text: TextModels.Model; 
    reader: TextModels.Reader;
    attr, curr: TextModels.Attributes; 
BEGIN
    IF controller = NIL THEN RETURN END;
    text := controller.text; caret := controller.CaretPos();
    reader := text.NewReader(NIL);
    LOOP
  beg := reader.Pos(); reader.ReadChar(char);
  IF reader.eot THEN EXIT END; 
  n := 0;
  WHILE ~reader.eot & ~separators[ORD(char)] DO
      string[n] := char; INC(n); curr := reader.attr; reader.ReadChar(char);
  END;
  string[n] := CHR(0); end := reader.Pos() - 1;
  FindAttributes(string, attr);
  IF ~attr.Equals(curr) THEN text.SetAttr(beg, end, attr) END;
    END;
    controller.SetCaret(caret);
END ColorizeTextController;


PROCEDURE InnerColorize* ();
BEGIN
    ColorizeTextController(TextControllers.Focus())
END InnerColorize;
Красит все со скоростью звука. А если текст уже окрашен и надо покрасить чуть-чуть, то красит со скоростью света.
Ответить с цитированием
  (#5 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 22.11.2004, 12:45

Чуток более структурированно (дисциплинированно):
Код:
PROCEDURE ReadString (
    reader: TextModels.Reader; 
    VAR string: ARRAY OF CHAR; 
    OUT beg, end: INTEGER; 
    OUT strAttr: TextModels.Attributes): BOOLEAN;
VAR  
    char: CHAR; n: INTEGER;
BEGIN
    beg := reader.Pos(); reader.ReadChar(char);
    IF reader.eot THEN RETURN FALSE END;
    n := 0; strAttr := reader.attr;
    WHILE ~reader.eot & ~separators[ORD(char)] DO
  string[n] := char; INC(n); reader.ReadChar(char)
    END;
    string[n] := 0X; end := reader.Pos() - 1;
    RETURN TRUE;
END ReadString;


PROCEDURE ColorizeTextModel* (text: TextModels.Model);
VAR
    beg, end: INTEGER;    
    newAttr, strAttr: TextModels.Attributes; 
    string: ARRAY 4000 OF CHAR;    
    reader: TextModels.Reader;
BEGIN
    reader := text.NewReader(NIL);
    WHILE ReadString(reader, string, beg, end, strAttr) DO
  FindAttributes(string, newAttr);
  IF ~newAttr.Equals(strAttr) THEN text.SetAttr(beg, end, newAttr) END;
    END;
END ColorizeTextModel;


PROCEDURE InnerColorize* ();
VAR    
    controller: TextControllers.Controller;
    caret: INTEGER;
BEGIN
    controller := TextControllers.Focus(); 
    IF controller = NIL THEN RETURN END;
    caret := controller.CaretPos();
    ColorizeTextModel(controller.text);
    controller.SetCaret(caret);
END InnerColorize;
Ответить с цитированием
Ads.
  (#6 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 22.11.2004, 12:45

Чуток более структурированно (дисциплинированно):
Код:
PROCEDURE ReadString (
    reader: TextModels.Reader; 
    VAR string: ARRAY OF CHAR; 
    OUT beg, end: INTEGER; 
    OUT strAttr: TextModels.Attributes): BOOLEAN;
VAR  
    char: CHAR; n: INTEGER;
BEGIN
    beg := reader.Pos(); reader.ReadChar(char);
    IF reader.eot THEN RETURN FALSE END;
    n := 0; strAttr := reader.attr;
    WHILE ~reader.eot & ~separators[ORD(char)] DO
  string[n] := char; INC(n); reader.ReadChar(char)
    END;
    string[n] := 0X; end := reader.Pos() - 1;
    RETURN TRUE;
END ReadString;


PROCEDURE ColorizeTextModel* (text: TextModels.Model);
VAR
    beg, end: INTEGER;    
    newAttr, strAttr: TextModels.Attributes; 
    string: ARRAY 4000 OF CHAR;    
    reader: TextModels.Reader;
BEGIN
    reader := text.NewReader(NIL);
    WHILE ReadString(reader, string, beg, end, strAttr) DO
  FindAttributes(string, newAttr);
  IF ~newAttr.Equals(strAttr) THEN text.SetAttr(beg, end, newAttr) END;
    END;
END ColorizeTextModel;


PROCEDURE InnerColorize* ();
VAR    
    controller: TextControllers.Controller;
    caret: INTEGER;
BEGIN
    controller := TextControllers.Focus(); 
    IF controller = NIL THEN RETURN END;
    caret := controller.CaretPos();
    ColorizeTextModel(controller.text);
    controller.SetCaret(caret);
END InnerColorize;
Ответить с цитированием
  (#7 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:18

Свершилось! Довел все до ума.

Теперь красит еще "строки". Вдобавок разные числовые константы в зависимости от их типа (INTEGER, L, H, X, REAL) красятся в разные цвета. Вобщем, красит ВСЕ!

Собрал подсистему. В ней 3 функциональных модуля. Вот их интерфейсы:
Код:
DEFINITION MasterColorScanner;

    IMPORT TextModels;

    TYPE
  Scanner = POINTER TO LIMITED RECORD 
      beg-, end-: INTEGER;
      attr-: TextModels.Attributes;
      (scanner: Scanner) Scan (): BOOLEAN, NEW
  END;

  SyntaxAttributes = POINTER TO RECORD 
      String, Symbol, Comment, Integer, Float,
      HexDigit, LongDigit, Char, Error, Def,
      Ident, System, KeyWord, Exit,
      PrimeType, Oper, New, 
      Const: TextModels.Attributes
  END;

    PROCEDURE InitSyntaxAttributes (VAR a: SyntaxAttributes);
    PROCEDURE NewScanner (reader: TextModels.Reader; a: SyntaxAttributes): Scanner;

END MasterColorScanner.
Код:
DEFINITION MasterColors;

    IMPORT TextModels, MasterColorScanner;

    VAR
  syntax: MasterColorScanner.SyntaxAttributes;

    PROCEDURE Colorize;
    PROCEDURE ColorizeText (text: TextModels.Model);

END MasterColors.
Код:
DEFINITION MasterColorViews;

    IMPORT Views, Stores, Models, TextModels;

    TYPE
  View = POINTER TO LIMITED RECORD (Views.View)
      (v: View) Colorize, NEW;
      (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
      (v: View) Externalize- (VAR wr: Stores.Writer);
      (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
      (v: View) HandlePropMsg- (VAR msg: Views.PropMessage);
      (v: View) InitContext (context: Models.Context);
      (v: View) Internalize- (VAR rd: Stores.Reader);
      (v: View) Neutralize;
      (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
      (v: View) ThisModel (): Models.Model
  END;

    PROCEDURE NewEditor;
    PROCEDURE NewView (text: TextModels.Model): View;

END MasterColorViews.
Их исходники приведу ниже, сейчас о функциональности.

1) Чтобы раскрасить активный документ надо вызвать процедуру: MasterColors.Colorize

2) Параметры раскраски задаются в переменной
MasterColors.syntax типа MasterColorScanner.SyntaxAttributes; Если они не заданы (NIL), то инициализируются автоматически.

3) MasterColorViews.View - это обертка над обычной текстовой View. В ней переопределен обработчик события
Код:
    PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
    BEGIN
  (* here comes the behavior which is specific to this wrapper -
      it modifies the wrapped view's behavior *)
  WITH
      msg: Controllers.EditMsg DO v.Colorize(); v.needRefresh := TRUE |
      msg: Controllers.TickMsg DO IF v.needRefresh THEN v.needRefresh := FALSE; v.Colorize() END |
  ELSE
  END;
  focus := v.inner; (* forward all controller messages to wrapped view *)
    END HandleCtrlMsg;
то есть все автоматом раскрашивается в реальном режиме времени.

Создал новое меню
Код:
MENU "Master"
    "Подсветить синтаксис в активном документе"    "^F9"    "MasterColors.Colorize"    "TextCmds.FocusGuard"
    SEPARATOR
    "Новый редактор с автоподсветкой синтаксиса"    ""    "MasterColorViews.NewEditor"    ""
END
Чтобы создать такое меню, этот текст надо поместить в файл:
BlackBoxMasterRsrcMenus.odc

Таким образом, сейчас есть два режима работы:
1) Пишем текст в обычном документе иногда нажимая Ctrl+F9 для раскраски.
2) Заходим в пункт меню Master --> "Новый редактор с автоподсветкой синтаксиса". Открывается новый документ, на вид не отличимый от обычного, но только с подмененной вьюхой, которая автоматом все раскрашивает стоит только внести малейшее изменение.

У второго способа, кроме очевидного достоинства (не надо каждый раз нажимать на горячие клавиши для расцветки), есть два недостатка.
а) Документ использует нестандартную View, следовательно сохраненный документ можно будет открыть только если в системе присутсвует модуль MasterColorViews. То есть распространять такие документы можно будет только одновременно с распространением самой подсистемы Master.
б) При скроллинге документа с помощью прокрутки колеса мыши наблюдается мерцание (это не связано с подстветкой синтаксиса, а связано только с тем, что используется не "настоящая" TextView, а обертка над ней). Ни в каких других случаях торможений или мерцаний не замечено.

Исходники ниже...
Ответить с цитированием
  (#8 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:18

Свершилось! Довел все до ума.

Теперь красит еще "строки". Вдобавок разные числовые константы в зависимости от их типа (INTEGER, L, H, X, REAL) красятся в разные цвета. Вобщем, красит ВСЕ!

Собрал подсистему. В ней 3 функциональных модуля. Вот их интерфейсы:
Код:
DEFINITION MasterColorScanner;

    IMPORT TextModels;

    TYPE
  Scanner = POINTER TO LIMITED RECORD 
      beg-, end-: INTEGER;
      attr-: TextModels.Attributes;
      (scanner: Scanner) Scan (): BOOLEAN, NEW
  END;

  SyntaxAttributes = POINTER TO RECORD 
      String, Symbol, Comment, Integer, Float,
      HexDigit, LongDigit, Char, Error, Def,
      Ident, System, KeyWord, Exit,
      PrimeType, Oper, New, 
      Const: TextModels.Attributes
  END;

    PROCEDURE InitSyntaxAttributes (VAR a: SyntaxAttributes);
    PROCEDURE NewScanner (reader: TextModels.Reader; a: SyntaxAttributes): Scanner;

END MasterColorScanner.
Код:
DEFINITION MasterColors;

    IMPORT TextModels, MasterColorScanner;

    VAR
  syntax: MasterColorScanner.SyntaxAttributes;

    PROCEDURE Colorize;
    PROCEDURE ColorizeText (text: TextModels.Model);

END MasterColors.
Код:
DEFINITION MasterColorViews;

    IMPORT Views, Stores, Models, TextModels;

    TYPE
  View = POINTER TO LIMITED RECORD (Views.View)
      (v: View) Colorize, NEW;
      (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
      (v: View) Externalize- (VAR wr: Stores.Writer);
      (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
      (v: View) HandlePropMsg- (VAR msg: Views.PropMessage);
      (v: View) InitContext (context: Models.Context);
      (v: View) Internalize- (VAR rd: Stores.Reader);
      (v: View) Neutralize;
      (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
      (v: View) ThisModel (): Models.Model
  END;

    PROCEDURE NewEditor;
    PROCEDURE NewView (text: TextModels.Model): View;

END MasterColorViews.
Их исходники приведу ниже, сейчас о функциональности.

1) Чтобы раскрасить активный документ надо вызвать процедуру: MasterColors.Colorize

2) Параметры раскраски задаются в переменной
MasterColors.syntax типа MasterColorScanner.SyntaxAttributes; Если они не заданы (NIL), то инициализируются автоматически.

3) MasterColorViews.View - это обертка над обычной текстовой View. В ней переопределен обработчик события
Код:
    PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
    BEGIN
  (* here comes the behavior which is specific to this wrapper -
      it modifies the wrapped view's behavior *)
  WITH
      msg: Controllers.EditMsg DO v.Colorize(); v.needRefresh := TRUE |
      msg: Controllers.TickMsg DO IF v.needRefresh THEN v.needRefresh := FALSE; v.Colorize() END |
  ELSE
  END;
  focus := v.inner; (* forward all controller messages to wrapped view *)
    END HandleCtrlMsg;
то есть все автоматом раскрашивается в реальном режиме времени.

Создал новое меню
Код:
MENU "Master"
    "Подсветить синтаксис в активном документе"    "^F9"    "MasterColors.Colorize"    "TextCmds.FocusGuard"
    SEPARATOR
    "Новый редактор с автоподсветкой синтаксиса"    ""    "MasterColorViews.NewEditor"    ""
END
Чтобы создать такое меню, этот текст надо поместить в файл:
BlackBoxMasterRsrcMenus.odc

Таким образом, сейчас есть два режима работы:
1) Пишем текст в обычном документе иногда нажимая Ctrl+F9 для раскраски.
2) Заходим в пункт меню Master --> "Новый редактор с автоподсветкой синтаксиса". Открывается новый документ, на вид не отличимый от обычного, но только с подмененной вьюхой, которая автоматом все раскрашивает стоит только внести малейшее изменение.

У второго способа, кроме очевидного достоинства (не надо каждый раз нажимать на горячие клавиши для расцветки), есть два недостатка.
а) Документ использует нестандартную View, следовательно сохраненный документ можно будет открыть только если в системе присутсвует модуль MasterColorViews. То есть распространять такие документы можно будет только одновременно с распространением самой подсистемы Master.
б) При скроллинге документа с помощью прокрутки колеса мыши наблюдается мерцание (это не связано с подстветкой синтаксиса, а связано только с тем, что используется не "настоящая" TextView, а обертка над ней). Ни в каких других случаях торможений или мерцаний не замечено.

Исходники ниже...
Ответить с цитированием
  (#9 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:21

BlackBoxMasterModColorScanner.odc
Код:
MODULE  MasterColorScanner;
IMPORT  StdLog, TextModels, TextControllers;
    
TYPE
    Scanner* = POINTER TO LIMITED RECORD
  beg-, end-: INTEGER; 
  attr-: TextModels.Attributes;
  _reader: TextModels.Reader;
  eos, eot: BOOLEAN;
  char, last: CHAR;
  syntax: SyntaxAttributes;
    END;

    ScanAction = PROCEDURE (VAR scanner: Scanner);
    ScanActions = POINTER TO ARRAY 128 OF ScanAction;

    SyntaxAttributes* = POINTER TO RECORD
  String*, Symbol*, Comment*, Integer*, Float*, 
  HexDigit*, LongDigit*, Char*, Error*, Def*, 
  Ident*, System*, KeyWord*, Exit*, PrimeType*,
  Oper*, New*, Const*: TextModels.Attributes;
    END;

VAR
    actions: ScanActions;
    default: ScanAction;
    symbols: POINTER TO ARRAY 128 OF BOOLEAN;
    separators: POINTER TO ARRAY 256 OF BOOLEAN;    

PROCEDURE InitSyntaxAttributes* (VAR a: SyntaxAttributes);
BEGIN
    IF a = NIL THEN NEW(a) END;
    IF a.Def = NIL THEN 
  a.Def := TextModels.NewColor(TextModels.dir.attr, 0);
  a.Def := TextModels.NewTypeface(a.Def, "Verdana")
    END;  
    IF a.Ident = NIL THEN a.Ident := a.Def END;
    IF a.String = NIL THEN a.String := TextModels.NewColor(a.Def, 0007000H) END;
    IF a.Symbol = NIL THEN a.Symbol := TextModels.NewColor(a.Def, 0AA0000H) END;
    IF a.Comment = NIL THEN a.Comment := TextModels.NewColor(a.Def, 0909090H) END;
    IF a.Integer = NIL THEN a.Integer := TextModels.NewColor(a.Def, 00000BBH) END;
    IF a.Float = NIL THEN a.Float := TextModels.NewColor(a.Def, 09000FFH) END;
    IF a.HexDigit = NIL THEN a.HexDigit := TextModels.NewColor(a.Def, 0C050FFH) END;
    IF a.LongDigit = NIL THEN a.LongDigit := TextModels.NewColor(a.Def, 00000DDH) END;
    IF a.Char = NIL THEN a.Char := TextModels.NewColor(a.Def, 000BB50H) END;
    IF a.Error = NIL THEN 
  a.Error := TextModels.NewColor(a.Def, 00000FFH);
  a.Error := TextModels.NewStyle(a.Error, {0, 2})
    END;    
    IF a.System = NIL THEN a.System := TextModels.NewColor(a.Def, 0AA0000H) END;
    IF a.KeyWord = NIL THEN a.KeyWord := TextModels.NewColor(a.Def, 0BB0000H) END;
    IF a.Exit = NIL THEN 
  a.Exit := TextModels.NewColor(a.Def, 0AA00FFH);
(*    a.Exit := TextModels.NewTypeface(a.Exit, "Stencil"); *)
    END;
    IF a.PrimeType = NIL THEN a.PrimeType := TextModels.NewColor(a.Def, 0AA00BBH) END;
    IF a.Oper = NIL THEN a.Oper := TextModels.NewColor(a.Def, 0006000H) END;
    IF a.New = NIL THEN a.New := TextModels.NewColor(a.Def, 00000FFH) END;
    IF a.Const = NIL THEN a.Const := TextModels.NewColor(a.Def, 0000090H) END;
END InitSyntaxAttributes;

PROCEDURE NewScanner* (reader: TextModels.Reader; a: SyntaxAttributes): Scanner;
VAR scanner: Scanner;
BEGIN
    NEW(scanner);
    InitSyntaxAttributes(a);
    scanner.syntax := a;
    scanner.attr := NIL;
    scanner.beg := 0;
    scanner.end := 0;
    scanner.eos := FALSE;
    scanner._reader := reader;
    scanner._reader.Read();
    scanner.char:= scanner._reader.char;
    scanner.last:= 0X;    
    scanner.eot:= scanner._reader.eot;
    RETURN scanner;
END NewScanner;

PROCEDURE (scanner: Scanner) Start (), NEW;
BEGIN
    scanner.attr := scanner._reader.attr;
    scanner.char:= scanner._reader.char;
    scanner.last := 0X;    
    scanner.beg := scanner._reader.Pos() - 1;
    scanner.eos := scanner._reader.eot;
END Start;

PROCEDURE (scanner: Scanner) Read (), NEW;
BEGIN
    scanner.last := scanner._reader.char;
    scanner._reader.Read(); 
    scanner.char:= scanner._reader.char;
    scanner.eot:= scanner._reader.eot;
    IF scanner._reader.eot THEN 
  scanner.eos := TRUE;
  scanner.char := 0X;
    END;
    IF (scanner.attr # NIL) & (scanner.attr # scanner._reader.attr) THEN scanner.attr := NIL END
END Read;

PROCEDURE (scanner: Scanner) End (attr: TextModels.Attributes), NEW;
BEGIN
    IF scanner.attr # attr THEN
  scanner.attr := attr;
  scanner.end := scanner._reader.Pos();
  scanner.eos := TRUE;
    END;
    scanner.last := scanner._reader.char;    
    scanner._reader.Read();
    scanner.eot:= scanner._reader.eot;
    scanner.char:= scanner._reader.char;
    IF scanner._reader.eot THEN scanner.eos := TRUE END
END End;

PROCEDURE (scanner: Scanner) EndPrev (attr: TextModels.Attributes), NEW;
BEGIN
    IF scanner.attr # attr THEN
  scanner.attr := attr;    
  scanner.end := scanner._reader.Pos() - 1;
  scanner.eos := TRUE;
    END;
END EndPrev;

PROCEDURE (scanner: Scanner) Scan* (): BOOLEAN, NEW;
VAR result: BOOLEAN;
BEGIN
    result := ~scanner.eot;
    IF result THEN
  REPEAT 
      IF ORD(scanner.char) < LEN(actions) THEN 
    actions[ORD(scanner.char)](scanner) 
      ELSE default(scanner) END
  UNTIL scanner.eos;
    END;
    RETURN result;
END Scan;

PROCEDURE (scanner: Scanner) CharIsDigit (): BOOLEAN, NEW;
BEGIN
    RETURN ('0' <= scanner.char) & (scanner.char <= '9')
END CharIsDigit;

PROCEDURE (scanner: Scanner) CharIsDigit16 (): BOOLEAN, NEW;
BEGIN
    RETURN (('0' <= scanner.char) & (scanner.char <= '9')) 
  OR (('A' <= scanner.char) & (scanner.char <= 'F'))
END CharIsDigit16;

PROCEDURE (scanner: Scanner) PassDigits (), NEW;
BEGIN
    REPEAT scanner.Read() UNTIL ~scanner.CharIsDigit()
END PassDigits;

PROCEDURE (scanner: Scanner) ReadCapital (VAR buff: ARRAY OF CHAR), NEW;
VAR n: INTEGER;
BEGIN
    n := 0;
    WHILE ('A' <= scanner.char) & (scanner.char <= 'Z') DO 
  buff[n] := scanner.char; INC(n); scanner.Read();
    END;
    buff[n] := 0X;
END ReadCapital;

PROCEDURE (scanner: Scanner) CharIsSeparator (): BOOLEAN, NEW;
BEGIN
    RETURN (ORD(scanner.char) >= LEN(separators)) 
  OR ((ORD(scanner.char) < LEN(separators)) & separators[ORD(scanner.char)])
END CharIsSeparator;

PROCEDURE (scanner: Scanner) CharIsSpace (): BOOLEAN, NEW;
BEGIN
    RETURN (scanner.char = 02X) OR (scanner.char = 09X) 
  OR (scanner.char = 0DX) OR (scanner.char = 0EX) OR (scanner.char = 20X)
END CharIsSpace;

PROCEDURE ScanString (VAR scanner: Scanner);
VAR bound: CHAR;
BEGIN
    bound := scanner.char; 
    scanner.Start();
    REPEAT scanner.Read() UNTIL scanner.eot OR (scanner.char = bound);
    scanner.End(scanner.syntax.String);
END ScanString;

PROCEDURE ScanComment (VAR scanner: Scanner);
BEGIN
    scanner.Start(); scanner.Read();
    IF scanner.char = '*' THEN
  scanner.Read();
  REPEAT scanner.Read() UNTIL scanner.eot OR ((scanner.last = '*') & (scanner.char = ')' ));
  scanner.End(scanner.syntax.Comment)
    ELSE
  scanner.EndPrev(scanner.syntax.Symbol)
    END
END ScanComment;

PROCEDURE ScanNumber (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    scanner.PassDigits();
    IF scanner.char = '.' THEN
  scanner.PassDigits();
  IF scanner.char = 'E' THEN
      scanner.Read(); 
      IF (scanner.char = '+') OR (scanner.char = '-') OR scanner.CharIsDigit() 
    THEN scanner.PassDigits() END
  END;
  scanner.EndPrev(scanner.syntax.Float)
    ELSIF (('A' <= scanner.char) & (scanner.char <= 'F')) OR (scanner.char = 'H') 
  OR (scanner.char = 'X')  OR (scanner.char = 'L') THEN
  WHILE (('0' <= scanner.char) & (scanner.char <= '9')) 
      OR (('A' <= scanner.char) & (scanner.char <= 'F')) DO scanner.Read() END;
  CASE scanner.char OF 
      'H': scanner.End(scanner.syntax.HexDigit) | 
      'X': scanner.End(scanner.syntax.Char) | 
      'L': scanner.End(scanner.syntax.LongDigit) 
      ELSE scanner.EndPrev(scanner.syntax.Error) 
  END
    ELSE
  scanner.EndPrev(scanner.syntax.Integer)
    END
END ScanNumber;

PROCEDURE ScanSpace (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    WHILE scanner.CharIsSpace() DO scanner.Read() END;
    scanner.EndPrev(scanner.syntax.Def)
END ScanSpace;

PROCEDURE ScanSymbol (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    WHILE (ORD(scanner.char) < LEN(symbols)) & symbols[ORD(scanner.char)] 
  DO scanner.Read() END;
    scanner.EndPrev(scanner.syntax.Symbol)
END ScanSymbol;

PROCEDURE ScanIdent (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    REPEAT scanner.Read() UNTIL scanner.CharIsSeparator();
    scanner.EndPrev(scanner.syntax.Ident)
END ScanIdent;

PROCEDURE (scanner: Scanner) GetAttributes (IN str: ARRAY OF CHAR): TextModels.Attributes, NEW;
VAR a: TextModels.Attributes;
BEGIN
    a := scanner.syntax.Ident;
    IF (str$ = "BEGIN") OR (str$ = "END") OR (str$ = "MODULE") 
  OR (str$ = "DEFINITION") OR (str$ = "IMPORT") 
  OR (str$ = "CLOSE") OR (str$ = "TYPE") OR (str$ = "CONST")
  OR (str$ = "VAR") OR (str$ = "IN") OR (str$ = "OUT") 
  OR (str$ = "PROCEDURE") OR (str$ = "IF") OR (str$ = "THEN")
  OR (str$ = "ELSIF") OR (str$ = "ELSE") OR (str$ = "REPEAT")
  OR (str$ = "UNTIL") OR (str$ = "WHILE") OR (str$ = "DO")
  OR (str$ = "LOOP") OR (str$ = "FOR") OR (str$ = "TO") OR (str$ = "BY")
  OR (str$ = "RECORD") OR (str$ = "POINTER") OR (str$ = "ABSTRACT") 
  OR (str$ = "EXTENSIBLE") OR (str$ = "LIMITED") OR (str$ = "EMPTY")
  OR (str$ = "ARRAY") OR (str$ = "OF") OR (str$ = "CASE")
  OR (str$ = "WITH") OR (str$ = "IS") OR (str$ = "MENU")
   OR (str$ = "SEPARATOR")
    THEN a := scanner.syntax.KeyWord
    ELSIF (str$ = "RETURN") OR (str$ = "EXIT") OR (str$ = "HALT") 
  OR (str$ = "ASSERT")
    THEN a := scanner.syntax.Exit
    ELSIF (str$ = "BYTE") OR (str$ = "CHAR") OR (str$ = "INTEGER")
  OR (str$ = "LONGINT") OR (str$ = "REAL") OR (str$ = "BOOLEAN")
  OR (str$ = "SET") OR (str$ = "SHORTCHAR") OR (str$ = "SHORTINT")
  OR (str$ = "SHORTREAL") OR (str$ = "ANYPTR") OR (str$ = "ANYREC")
    THEN a := scanner.syntax.PrimeType
    ELSIF (str$ = "OR") OR (str$ = "DIV") OR (str$ = "MOD") OR (str$ = "ORD")
  OR (str$ = "CHR") OR (str$ = "ODD") OR (str$ = "MAX") OR (str$ = "MIN")
  OR (str$ = "INC") OR (str$ = "DEC") OR (str$ = "INCL") OR (str$ = "EXCL")
  OR (str$ = "LEN") OR (str$ = "ABS") OR (str$ = "BITS") OR (str$ = "SHORT")
  OR (str$ = "SIZE") OR (str$ = "LONG") OR (str$ = "ENTIER") OR (str$ = "CAP")
  OR (str$ = "ASH")
    THEN a := scanner.syntax.Oper
    ELSIF (str$ = "NEW") THEN a := scanner.syntax.New
    ELSIF (str$ = "NIL") OR (str$ = "TRUE") OR (str$ = "FALSE") OR (str$ = "INF") 
  OR (str$ = "FINALIZE")
    THEN a := scanner.syntax.Const END;
    RETURN a;
END GetAttributes;

PROCEDURE ScanSystem (VAR scanner: Scanner);
VAR buff: ARRAY 4000 OF CHAR;
BEGIN
    scanner.Start();
    scanner.ReadCapital(buff);
    IF scanner.CharIsSeparator() THEN
  scanner.EndPrev(scanner.GetAttributes(buff))
    ELSE
  REPEAT scanner.Read() UNTIL scanner.CharIsSeparator();
  scanner.EndPrev(scanner.syntax.Ident)    
    END
END ScanSystem;

PROCEDURE NewScanActions (): ScanActions;
VAR a: ScanActions; n: INTEGER;
BEGIN
    NEW(a); FOR n := 0 TO LEN(a) - 1 DO a[n] := ScanIdent END;
    a[02H] := ScanSpace;
    a[09H] := ScanSpace;
    a[0DH] := ScanSpace;
    a[0EH] := ScanSpace;
    a[20H] := ScanSpace;
    (* //////////////////////// *)    
    a[ORD('"')] := ScanString;
    a[ORD("'")] := ScanString;
    (* //////////////////////// *)
    a[ORD('0')] := ScanNumber;
    a[ORD('1')] := ScanNumber;
    a[ORD('2')] := ScanNumber;
    a[ORD('3')] := ScanNumber;
    a[ORD('4')] := ScanNumber;
    a[ORD('5')] := ScanNumber;
    a[ORD('6')] := ScanNumber;
    a[ORD('7')] := ScanNumber;
    a[ORD('8')] := ScanNumber;
    a[ORD('9')] := ScanNumber;
    (* //////////////////////// *)
    a[ORD('(')] := ScanComment;
    (* //////////////////////// *)    
    a[ORD('~')] := ScanSymbol;
    a[ORD('#')] := ScanSymbol;
    a[ORD('^')] := ScanSymbol;
    a[ORD('&')] := ScanSymbol;
    a[ORD('*')] := ScanSymbol;
    a[ORD(')')] := ScanSymbol;
    a[ORD('-')] := ScanSymbol;
    a[ORD('+')] := ScanSymbol;
    a[ORD('=')] := ScanSymbol;
    a[ORD('|')] := ScanSymbol;
    a[ORD('/')] := ScanSymbol;
    a[ORD('[')] := ScanSymbol;
    a[ORD(']')] := ScanSymbol;
    a[ORD('{')] := ScanSymbol;
    a[ORD('}')] := ScanSymbol;
    a[ORD(':')] := ScanSymbol;
    a[ORD(';')] := ScanSymbol;
    a[ORD('.')] := ScanSymbol;
    a[ORD(',')] := ScanSymbol;
    a[ORD('$')] := ScanSymbol;
    a[ORD('<')] := ScanSymbol;
    a[ORD('>')] := ScanSymbol;
    (* //////////////////////// *)
    a[ORD('A')] := ScanSystem;
    a[ORD('B')] := ScanSystem;
    a[ORD('C')] := ScanSystem;
    a[ORD('D')] := ScanSystem;
    a[ORD('E')] := ScanSystem;
    a[ORD('F')] := ScanSystem;
    a[ORD('I')] := ScanSystem;
    a[ORD('L')] := ScanSystem;
    a[ORD('M')] := ScanSystem;
    a[ORD('N')] := ScanSystem;
    a[ORD('O')] := ScanSystem;
    a[ORD('P')] := ScanSystem;
    a[ORD('R')] := ScanSystem;
    a[ORD('T')] := ScanSystem;
    a[ORD('U')] := ScanSystem;
    a[ORD('V')] := ScanSystem;
    a[ORD('W')] := ScanSystem;
    a[ORD('H')] := ScanSystem;
    a[ORD('S')] := ScanSystem;    
    RETURN a;
END NewScanActions;

PROCEDURE InitSymbols();
VAR  n: INTEGER;
BEGIN
    NEW(symbols);
    FOR n := 0 TO LEN(symbols) - 1 DO symbols[n] := FALSE END;
    symbols[ORD('~')] := TRUE;
    symbols[ORD('#')] := TRUE;
    symbols[ORD('^')] := TRUE;
    symbols[ORD('&')] := TRUE;
    symbols[ORD('*')] := TRUE;
    symbols[ORD(')')] := TRUE;
    symbols[ORD('-')] := TRUE;
    symbols[ORD('+')] := TRUE;
    symbols[ORD('=')] := TRUE;
    symbols[ORD('|')] := TRUE;
    symbols[ORD('/')] := TRUE;
    symbols[ORD('[')] := TRUE;
    symbols[ORD(']')] := TRUE;
    symbols[ORD('{')] := TRUE;
    symbols[ORD('}')] := TRUE;
    symbols[ORD(':')] := TRUE;
    symbols[ORD(';')] := TRUE;
    symbols[ORD('.')] := TRUE;
    symbols[ORD(',')] := TRUE;
    symbols[ORD('$')] := TRUE;
    symbols[ORD('<')] := TRUE;
    symbols[ORD('>')] := TRUE;
END InitSymbols;

PROCEDURE InitSeparators();
VAR  n: INTEGER;
BEGIN
    NEW(separators);
    FOR n := 0 TO LEN(separators) - 1 DO separators[n] := FALSE END;
    separators[0H] := TRUE;
    separators[02H] := TRUE;
    separators[09H] := TRUE;
    separators[0DH] := TRUE;
    separators[0EH] := TRUE;
    separators[20H] := TRUE;
    separators[ORD('"')] := TRUE;
    separators[ORD("'")] := TRUE;
    separators[ORD('~')] := TRUE;
    separators[ORD('#')] := TRUE;
    separators[ORD('^')] := TRUE;
    separators[ORD('&')] := TRUE;
    separators[ORD('*')] := TRUE;
    separators[ORD(')')] := TRUE;
    separators[ORD('(')] := TRUE;
    separators[ORD('-')] := TRUE;
    separators[ORD('+')] := TRUE;
    separators[ORD('=')] := TRUE;
    separators[ORD('|')] := TRUE;
    separators[ORD('/')] := TRUE;
    separators[ORD('[')] := TRUE;
    separators[ORD(']')] := TRUE;
    separators[ORD('{')] := TRUE;
    separators[ORD('}')] := TRUE;
    separators[ORD(':')] := TRUE;
    separators[ORD(';')] := TRUE;
    separators[ORD('.')] := TRUE;
    separators[ORD(',')] := TRUE;
    separators[ORD('$')] := TRUE;
    separators[ORD('<')] := TRUE;
    separators[ORD('>')] := TRUE;
END InitSeparators;

PROCEDURE Init ();
BEGIN
    InitSymbols();
    InitSeparators();
    default := ScanIdent;
    actions := NewScanActions();
END Init;

BEGIN
    Init();
END MasterColorScanner.
Ответить с цитированием
  (#10 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:21

BlackBoxMasterModColorScanner.odc
Код:
MODULE  MasterColorScanner;
IMPORT  StdLog, TextModels, TextControllers;
    
TYPE
    Scanner* = POINTER TO LIMITED RECORD
  beg-, end-: INTEGER; 
  attr-: TextModels.Attributes;
  _reader: TextModels.Reader;
  eos, eot: BOOLEAN;
  char, last: CHAR;
  syntax: SyntaxAttributes;
    END;

    ScanAction = PROCEDURE (VAR scanner: Scanner);
    ScanActions = POINTER TO ARRAY 128 OF ScanAction;

    SyntaxAttributes* = POINTER TO RECORD
  String*, Symbol*, Comment*, Integer*, Float*, 
  HexDigit*, LongDigit*, Char*, Error*, Def*, 
  Ident*, System*, KeyWord*, Exit*, PrimeType*,
  Oper*, New*, Const*: TextModels.Attributes;
    END;

VAR
    actions: ScanActions;
    default: ScanAction;
    symbols: POINTER TO ARRAY 128 OF BOOLEAN;
    separators: POINTER TO ARRAY 256 OF BOOLEAN;    

PROCEDURE InitSyntaxAttributes* (VAR a: SyntaxAttributes);
BEGIN
    IF a = NIL THEN NEW(a) END;
    IF a.Def = NIL THEN 
  a.Def := TextModels.NewColor(TextModels.dir.attr, 0);
  a.Def := TextModels.NewTypeface(a.Def, "Verdana")
    END;  
    IF a.Ident = NIL THEN a.Ident := a.Def END;
    IF a.String = NIL THEN a.String := TextModels.NewColor(a.Def, 0007000H) END;
    IF a.Symbol = NIL THEN a.Symbol := TextModels.NewColor(a.Def, 0AA0000H) END;
    IF a.Comment = NIL THEN a.Comment := TextModels.NewColor(a.Def, 0909090H) END;
    IF a.Integer = NIL THEN a.Integer := TextModels.NewColor(a.Def, 00000BBH) END;
    IF a.Float = NIL THEN a.Float := TextModels.NewColor(a.Def, 09000FFH) END;
    IF a.HexDigit = NIL THEN a.HexDigit := TextModels.NewColor(a.Def, 0C050FFH) END;
    IF a.LongDigit = NIL THEN a.LongDigit := TextModels.NewColor(a.Def, 00000DDH) END;
    IF a.Char = NIL THEN a.Char := TextModels.NewColor(a.Def, 000BB50H) END;
    IF a.Error = NIL THEN 
  a.Error := TextModels.NewColor(a.Def, 00000FFH);
  a.Error := TextModels.NewStyle(a.Error, {0, 2})
    END;    
    IF a.System = NIL THEN a.System := TextModels.NewColor(a.Def, 0AA0000H) END;
    IF a.KeyWord = NIL THEN a.KeyWord := TextModels.NewColor(a.Def, 0BB0000H) END;
    IF a.Exit = NIL THEN 
  a.Exit := TextModels.NewColor(a.Def, 0AA00FFH);
(*    a.Exit := TextModels.NewTypeface(a.Exit, "Stencil"); *)
    END;
    IF a.PrimeType = NIL THEN a.PrimeType := TextModels.NewColor(a.Def, 0AA00BBH) END;
    IF a.Oper = NIL THEN a.Oper := TextModels.NewColor(a.Def, 0006000H) END;
    IF a.New = NIL THEN a.New := TextModels.NewColor(a.Def, 00000FFH) END;
    IF a.Const = NIL THEN a.Const := TextModels.NewColor(a.Def, 0000090H) END;
END InitSyntaxAttributes;

PROCEDURE NewScanner* (reader: TextModels.Reader; a: SyntaxAttributes): Scanner;
VAR scanner: Scanner;
BEGIN
    NEW(scanner);
    InitSyntaxAttributes(a);
    scanner.syntax := a;
    scanner.attr := NIL;
    scanner.beg := 0;
    scanner.end := 0;
    scanner.eos := FALSE;
    scanner._reader := reader;
    scanner._reader.Read();
    scanner.char:= scanner._reader.char;
    scanner.last:= 0X;    
    scanner.eot:= scanner._reader.eot;
    RETURN scanner;
END NewScanner;

PROCEDURE (scanner: Scanner) Start (), NEW;
BEGIN
    scanner.attr := scanner._reader.attr;
    scanner.char:= scanner._reader.char;
    scanner.last := 0X;    
    scanner.beg := scanner._reader.Pos() - 1;
    scanner.eos := scanner._reader.eot;
END Start;

PROCEDURE (scanner: Scanner) Read (), NEW;
BEGIN
    scanner.last := scanner._reader.char;
    scanner._reader.Read(); 
    scanner.char:= scanner._reader.char;
    scanner.eot:= scanner._reader.eot;
    IF scanner._reader.eot THEN 
  scanner.eos := TRUE;
  scanner.char := 0X;
    END;
    IF (scanner.attr # NIL) & (scanner.attr # scanner._reader.attr) THEN scanner.attr := NIL END
END Read;

PROCEDURE (scanner: Scanner) End (attr: TextModels.Attributes), NEW;
BEGIN
    IF scanner.attr # attr THEN
  scanner.attr := attr;
  scanner.end := scanner._reader.Pos();
  scanner.eos := TRUE;
    END;
    scanner.last := scanner._reader.char;    
    scanner._reader.Read();
    scanner.eot:= scanner._reader.eot;
    scanner.char:= scanner._reader.char;
    IF scanner._reader.eot THEN scanner.eos := TRUE END
END End;

PROCEDURE (scanner: Scanner) EndPrev (attr: TextModels.Attributes), NEW;
BEGIN
    IF scanner.attr # attr THEN
  scanner.attr := attr;    
  scanner.end := scanner._reader.Pos() - 1;
  scanner.eos := TRUE;
    END;
END EndPrev;

PROCEDURE (scanner: Scanner) Scan* (): BOOLEAN, NEW;
VAR result: BOOLEAN;
BEGIN
    result := ~scanner.eot;
    IF result THEN
  REPEAT 
      IF ORD(scanner.char) < LEN(actions) THEN 
    actions[ORD(scanner.char)](scanner) 
      ELSE default(scanner) END
  UNTIL scanner.eos;
    END;
    RETURN result;
END Scan;

PROCEDURE (scanner: Scanner) CharIsDigit (): BOOLEAN, NEW;
BEGIN
    RETURN ('0' <= scanner.char) & (scanner.char <= '9')
END CharIsDigit;

PROCEDURE (scanner: Scanner) CharIsDigit16 (): BOOLEAN, NEW;
BEGIN
    RETURN (('0' <= scanner.char) & (scanner.char <= '9')) 
  OR (('A' <= scanner.char) & (scanner.char <= 'F'))
END CharIsDigit16;

PROCEDURE (scanner: Scanner) PassDigits (), NEW;
BEGIN
    REPEAT scanner.Read() UNTIL ~scanner.CharIsDigit()
END PassDigits;

PROCEDURE (scanner: Scanner) ReadCapital (VAR buff: ARRAY OF CHAR), NEW;
VAR n: INTEGER;
BEGIN
    n := 0;
    WHILE ('A' <= scanner.char) & (scanner.char <= 'Z') DO 
  buff[n] := scanner.char; INC(n); scanner.Read();
    END;
    buff[n] := 0X;
END ReadCapital;

PROCEDURE (scanner: Scanner) CharIsSeparator (): BOOLEAN, NEW;
BEGIN
    RETURN (ORD(scanner.char) >= LEN(separators)) 
  OR ((ORD(scanner.char) < LEN(separators)) & separators[ORD(scanner.char)])
END CharIsSeparator;

PROCEDURE (scanner: Scanner) CharIsSpace (): BOOLEAN, NEW;
BEGIN
    RETURN (scanner.char = 02X) OR (scanner.char = 09X) 
  OR (scanner.char = 0DX) OR (scanner.char = 0EX) OR (scanner.char = 20X)
END CharIsSpace;

PROCEDURE ScanString (VAR scanner: Scanner);
VAR bound: CHAR;
BEGIN
    bound := scanner.char; 
    scanner.Start();
    REPEAT scanner.Read() UNTIL scanner.eot OR (scanner.char = bound);
    scanner.End(scanner.syntax.String);
END ScanString;

PROCEDURE ScanComment (VAR scanner: Scanner);
BEGIN
    scanner.Start(); scanner.Read();
    IF scanner.char = '*' THEN
  scanner.Read();
  REPEAT scanner.Read() UNTIL scanner.eot OR ((scanner.last = '*') & (scanner.char = ')' ));
  scanner.End(scanner.syntax.Comment)
    ELSE
  scanner.EndPrev(scanner.syntax.Symbol)
    END
END ScanComment;

PROCEDURE ScanNumber (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    scanner.PassDigits();
    IF scanner.char = '.' THEN
  scanner.PassDigits();
  IF scanner.char = 'E' THEN
      scanner.Read(); 
      IF (scanner.char = '+') OR (scanner.char = '-') OR scanner.CharIsDigit() 
    THEN scanner.PassDigits() END
  END;
  scanner.EndPrev(scanner.syntax.Float)
    ELSIF (('A' <= scanner.char) & (scanner.char <= 'F')) OR (scanner.char = 'H') 
  OR (scanner.char = 'X')  OR (scanner.char = 'L') THEN
  WHILE (('0' <= scanner.char) & (scanner.char <= '9')) 
      OR (('A' <= scanner.char) & (scanner.char <= 'F')) DO scanner.Read() END;
  CASE scanner.char OF 
      'H': scanner.End(scanner.syntax.HexDigit) | 
      'X': scanner.End(scanner.syntax.Char) | 
      'L': scanner.End(scanner.syntax.LongDigit) 
      ELSE scanner.EndPrev(scanner.syntax.Error) 
  END
    ELSE
  scanner.EndPrev(scanner.syntax.Integer)
    END
END ScanNumber;

PROCEDURE ScanSpace (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    WHILE scanner.CharIsSpace() DO scanner.Read() END;
    scanner.EndPrev(scanner.syntax.Def)
END ScanSpace;

PROCEDURE ScanSymbol (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    WHILE (ORD(scanner.char) < LEN(symbols)) & symbols[ORD(scanner.char)] 
  DO scanner.Read() END;
    scanner.EndPrev(scanner.syntax.Symbol)
END ScanSymbol;

PROCEDURE ScanIdent (VAR scanner: Scanner);
BEGIN
    scanner.Start();
    REPEAT scanner.Read() UNTIL scanner.CharIsSeparator();
    scanner.EndPrev(scanner.syntax.Ident)
END ScanIdent;

PROCEDURE (scanner: Scanner) GetAttributes (IN str: ARRAY OF CHAR): TextModels.Attributes, NEW;
VAR a: TextModels.Attributes;
BEGIN
    a := scanner.syntax.Ident;
    IF (str$ = "BEGIN") OR (str$ = "END") OR (str$ = "MODULE") 
  OR (str$ = "DEFINITION") OR (str$ = "IMPORT") 
  OR (str$ = "CLOSE") OR (str$ = "TYPE") OR (str$ = "CONST")
  OR (str$ = "VAR") OR (str$ = "IN") OR (str$ = "OUT") 
  OR (str$ = "PROCEDURE") OR (str$ = "IF") OR (str$ = "THEN")
  OR (str$ = "ELSIF") OR (str$ = "ELSE") OR (str$ = "REPEAT")
  OR (str$ = "UNTIL") OR (str$ = "WHILE") OR (str$ = "DO")
  OR (str$ = "LOOP") OR (str$ = "FOR") OR (str$ = "TO") OR (str$ = "BY")
  OR (str$ = "RECORD") OR (str$ = "POINTER") OR (str$ = "ABSTRACT") 
  OR (str$ = "EXTENSIBLE") OR (str$ = "LIMITED") OR (str$ = "EMPTY")
  OR (str$ = "ARRAY") OR (str$ = "OF") OR (str$ = "CASE")
  OR (str$ = "WITH") OR (str$ = "IS") OR (str$ = "MENU")
   OR (str$ = "SEPARATOR")
    THEN a := scanner.syntax.KeyWord
    ELSIF (str$ = "RETURN") OR (str$ = "EXIT") OR (str$ = "HALT") 
  OR (str$ = "ASSERT")
    THEN a := scanner.syntax.Exit
    ELSIF (str$ = "BYTE") OR (str$ = "CHAR") OR (str$ = "INTEGER")
  OR (str$ = "LONGINT") OR (str$ = "REAL") OR (str$ = "BOOLEAN")
  OR (str$ = "SET") OR (str$ = "SHORTCHAR") OR (str$ = "SHORTINT")
  OR (str$ = "SHORTREAL") OR (str$ = "ANYPTR") OR (str$ = "ANYREC")
    THEN a := scanner.syntax.PrimeType
    ELSIF (str$ = "OR") OR (str$ = "DIV") OR (str$ = "MOD") OR (str$ = "ORD")
  OR (str$ = "CHR") OR (str$ = "ODD") OR (str$ = "MAX") OR (str$ = "MIN")
  OR (str$ = "INC") OR (str$ = "DEC") OR (str$ = "INCL") OR (str$ = "EXCL")
  OR (str$ = "LEN") OR (str$ = "ABS") OR (str$ = "BITS") OR (str$ = "SHORT")
  OR (str$ = "SIZE") OR (str$ = "LONG") OR (str$ = "ENTIER") OR (str$ = "CAP")
  OR (str$ = "ASH")
    THEN a := scanner.syntax.Oper
    ELSIF (str$ = "NEW") THEN a := scanner.syntax.New
    ELSIF (str$ = "NIL") OR (str$ = "TRUE") OR (str$ = "FALSE") OR (str$ = "INF") 
  OR (str$ = "FINALIZE")
    THEN a := scanner.syntax.Const END;
    RETURN a;
END GetAttributes;

PROCEDURE ScanSystem (VAR scanner: Scanner);
VAR buff: ARRAY 4000 OF CHAR;
BEGIN
    scanner.Start();
    scanner.ReadCapital(buff);
    IF scanner.CharIsSeparator() THEN
  scanner.EndPrev(scanner.GetAttributes(buff))
    ELSE
  REPEAT scanner.Read() UNTIL scanner.CharIsSeparator();
  scanner.EndPrev(scanner.syntax.Ident)    
    END
END ScanSystem;

PROCEDURE NewScanActions (): ScanActions;
VAR a: ScanActions; n: INTEGER;
BEGIN
    NEW(a); FOR n := 0 TO LEN(a) - 1 DO a[n] := ScanIdent END;
    a[02H] := ScanSpace;
    a[09H] := ScanSpace;
    a[0DH] := ScanSpace;
    a[0EH] := ScanSpace;
    a[20H] := ScanSpace;
    (* //////////////////////// *)    
    a[ORD('"')] := ScanString;
    a[ORD("'")] := ScanString;
    (* //////////////////////// *)
    a[ORD('0')] := ScanNumber;
    a[ORD('1')] := ScanNumber;
    a[ORD('2')] := ScanNumber;
    a[ORD('3')] := ScanNumber;
    a[ORD('4')] := ScanNumber;
    a[ORD('5')] := ScanNumber;
    a[ORD('6')] := ScanNumber;
    a[ORD('7')] := ScanNumber;
    a[ORD('8')] := ScanNumber;
    a[ORD('9')] := ScanNumber;
    (* //////////////////////// *)
    a[ORD('(')] := ScanComment;
    (* //////////////////////// *)    
    a[ORD('~')] := ScanSymbol;
    a[ORD('#')] := ScanSymbol;
    a[ORD('^')] := ScanSymbol;
    a[ORD('&')] := ScanSymbol;
    a[ORD('*')] := ScanSymbol;
    a[ORD(')')] := ScanSymbol;
    a[ORD('-')] := ScanSymbol;
    a[ORD('+')] := ScanSymbol;
    a[ORD('=')] := ScanSymbol;
    a[ORD('|')] := ScanSymbol;
    a[ORD('/')] := ScanSymbol;
    a[ORD('[')] := ScanSymbol;
    a[ORD(']')] := ScanSymbol;
    a[ORD('{')] := ScanSymbol;
    a[ORD('}')] := ScanSymbol;
    a[ORD(':')] := ScanSymbol;
    a[ORD(';')] := ScanSymbol;
    a[ORD('.')] := ScanSymbol;
    a[ORD(',')] := ScanSymbol;
    a[ORD('$')] := ScanSymbol;
    a[ORD('<')] := ScanSymbol;
    a[ORD('>')] := ScanSymbol;
    (* //////////////////////// *)
    a[ORD('A')] := ScanSystem;
    a[ORD('B')] := ScanSystem;
    a[ORD('C')] := ScanSystem;
    a[ORD('D')] := ScanSystem;
    a[ORD('E')] := ScanSystem;
    a[ORD('F')] := ScanSystem;
    a[ORD('I')] := ScanSystem;
    a[ORD('L')] := ScanSystem;
    a[ORD('M')] := ScanSystem;
    a[ORD('N')] := ScanSystem;
    a[ORD('O')] := ScanSystem;
    a[ORD('P')] := ScanSystem;
    a[ORD('R')] := ScanSystem;
    a[ORD('T')] := ScanSystem;
    a[ORD('U')] := ScanSystem;
    a[ORD('V')] := ScanSystem;
    a[ORD('W')] := ScanSystem;
    a[ORD('H')] := ScanSystem;
    a[ORD('S')] := ScanSystem;    
    RETURN a;
END NewScanActions;

PROCEDURE InitSymbols();
VAR  n: INTEGER;
BEGIN
    NEW(symbols);
    FOR n := 0 TO LEN(symbols) - 1 DO symbols[n] := FALSE END;
    symbols[ORD('~')] := TRUE;
    symbols[ORD('#')] := TRUE;
    symbols[ORD('^')] := TRUE;
    symbols[ORD('&')] := TRUE;
    symbols[ORD('*')] := TRUE;
    symbols[ORD(')')] := TRUE;
    symbols[ORD('-')] := TRUE;
    symbols[ORD('+')] := TRUE;
    symbols[ORD('=')] := TRUE;
    symbols[ORD('|')] := TRUE;
    symbols[ORD('/')] := TRUE;
    symbols[ORD('[')] := TRUE;
    symbols[ORD(']')] := TRUE;
    symbols[ORD('{')] := TRUE;
    symbols[ORD('}')] := TRUE;
    symbols[ORD(':')] := TRUE;
    symbols[ORD(';')] := TRUE;
    symbols[ORD('.')] := TRUE;
    symbols[ORD(',')] := TRUE;
    symbols[ORD('$')] := TRUE;
    symbols[ORD('<')] := TRUE;
    symbols[ORD('>')] := TRUE;
END InitSymbols;

PROCEDURE InitSeparators();
VAR  n: INTEGER;
BEGIN
    NEW(separators);
    FOR n := 0 TO LEN(separators) - 1 DO separators[n] := FALSE END;
    separators[0H] := TRUE;
    separators[02H] := TRUE;
    separators[09H] := TRUE;
    separators[0DH] := TRUE;
    separators[0EH] := TRUE;
    separators[20H] := TRUE;
    separators[ORD('"')] := TRUE;
    separators[ORD("'")] := TRUE;
    separators[ORD('~')] := TRUE;
    separators[ORD('#')] := TRUE;
    separators[ORD('^')] := TRUE;
    separators[ORD('&')] := TRUE;
    separators[ORD('*')] := TRUE;
    separators[ORD(')')] := TRUE;
    separators[ORD('(')] := TRUE;
    separators[ORD('-')] := TRUE;
    separators[ORD('+')] := TRUE;
    separators[ORD('=')] := TRUE;
    separators[ORD('|')] := TRUE;
    separators[ORD('/')] := TRUE;
    separators[ORD('[')] := TRUE;
    separators[ORD(']')] := TRUE;
    separators[ORD('{')] := TRUE;
    separators[ORD('}')] := TRUE;
    separators[ORD(':')] := TRUE;
    separators[ORD(';')] := TRUE;
    separators[ORD('.')] := TRUE;
    separators[ORD(',')] := TRUE;
    separators[ORD('$')] := TRUE;
    separators[ORD('<')] := TRUE;
    separators[ORD('>')] := TRUE;
END InitSeparators;

PROCEDURE Init ();
BEGIN
    InitSymbols();
    InitSeparators();
    default := ScanIdent;
    actions := NewScanActions();
END Init;

BEGIN
    Init();
END MasterColorScanner.
Ответить с цитированием
  (#11 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:23

BlackBoxMasterModColors.odc
Код:
MODULE  MasterColors;
IMPORT  StdLog, TextModels, TextControllers, MasterColorScanner;
    
VAR
    syntax*: MasterColorScanner.SyntaxAttributes;
    
PROCEDURE ColorizeText* (text: TextModels.Model);
VAR scanner: MasterColorScanner.Scanner;
BEGIN
    scanner := MasterColorScanner.NewScanner(text.NewReader(NIL), syntax);
    WHILE scanner.Scan() DO
  text.SetAttr(scanner.beg, scanner.end, scanner.attr)
    END
END ColorizeText;

PROCEDURE Colorize* ();
VAR controller: TextControllers.Controller; caret: INTEGER;
BEGIN
    controller := TextControllers.Focus(); 
    IF controller # NIL THEN 
  caret := controller.CaretPos();
  ColorizeText(controller.text);
  controller.SetCaret(caret);
    END;
END Colorize;

BEGIN
    MasterColorScanner.InitSyntaxAttributes(syntax);
END MasterColors.
Ответить с цитированием
  (#12 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:23

BlackBoxMasterModColors.odc
Код:
MODULE  MasterColors;
IMPORT  StdLog, TextModels, TextControllers, MasterColorScanner;
    
VAR
    syntax*: MasterColorScanner.SyntaxAttributes;
    
PROCEDURE ColorizeText* (text: TextModels.Model);
VAR scanner: MasterColorScanner.Scanner;
BEGIN
    scanner := MasterColorScanner.NewScanner(text.NewReader(NIL), syntax);
    WHILE scanner.Scan() DO
  text.SetAttr(scanner.beg, scanner.end, scanner.attr)
    END
END ColorizeText;

PROCEDURE Colorize* ();
VAR controller: TextControllers.Controller; caret: INTEGER;
BEGIN
    controller := TextControllers.Focus(); 
    IF controller # NIL THEN 
  caret := controller.CaretPos();
  ColorizeText(controller.text);
  controller.SetCaret(caret);
    END;
END Colorize;

BEGIN
    MasterColorScanner.InitSyntaxAttributes(syntax);
END MasterColors.
Ответить с цитированием
Ads
  (#13 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:25

BlackBoxMasterModColorViews.odc
Код:
MODULE MasterColorViews;

    IMPORT Dialog, Stores, Models, Views, Controllers, Services, Properties, StdLog, 
  TextViews, TextModels, TextMappers, MasterColors;

    CONST minVersion = 2; maxVersion = 2;

    TYPE
  View* = POINTER TO LIMITED RECORD (Views.View)
      inner: Views.View;    (* v # NIL *)
      colorizing, needRefresh: BOOLEAN;
  END;

    PROCEDURE (v: View) Colorize* (), NEW;
    BEGIN
  IF ~v.colorizing THEN
      v.colorizing := TRUE;
      MasterColors.ColorizeText(v.inner.ThisModel()(TextModels.Model));
      v.colorizing := FALSE
  END
    END Colorize;

    PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader);
  VAR version: INTEGER;
    BEGIN
  rd.ReadVersion(minVersion, maxVersion, version);
  IF ~rd.cancelled THEN
      Views.ReadView(rd, v.inner)    (* generate Views.Alien if necessary *)
  END
    END Internalize;

    PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer);
    BEGIN
  wr.WriteVersion(maxVersion);
  Views.WriteView(wr, v.inner)    (* handle Views.Alien if necessary *)
    END Externalize;

    PROCEDURE (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
    BEGIN
  WITH source: View DO
      IF model = NIL THEN
    v.inner := Views.CopyOf(source.inner, Views.deep)
      ELSE
    v.inner := Views.CopyWithNewModel(source.inner, model)
      END
  END
    END CopyFromModelView;

    PROCEDURE (v: View) ThisModel* (): Models.Model;
    BEGIN
  RETURN v.inner.ThisModel()
    END ThisModel;

    PROCEDURE (v: View) InitContext* (context: Models.Context);
    BEGIN
  v.InitContext^(context);
  v.inner.InitContext(context)    (* wrapper and wrapped view share the same context *)
    END InitContext;

    PROCEDURE (v: View) Neutralize*;
    BEGIN
  v.inner.Neutralize
    END Neutralize;

    (* GetNewFrame: wrapper uses standard frame *)
    (* GetBackground: wrapper has no intrinsic background color *)

    PROCEDURE (v: View) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
    BEGIN
  (* create and install wrapped view's frame *)
  Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE)
  (* Из-за этого тормозит при прокрутке мышиного колеса *)
    END Restore;

    (* RestoreMarks: wrapper has no intrinsic marks, wrapped view's RestoreMarks is called by framework *)
    (* HandleModelMsg: framework performs message propagation *)
    (* HandleViewMsg: framework performs message propagation *)

    PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
    BEGIN
  (* here comes the behavior which is specific to this wrapper -
      it modifies the wrapped view's behavior *)
  WITH
      msg: Controllers.EditMsg DO v.Colorize(); v.needRefresh := TRUE |
      msg: Controllers.TickMsg DO IF v.needRefresh THEN v.needRefresh := FALSE; v.Colorize() END |
  ELSE
  END;
  focus := v.inner; (* forward all controller messages to wrapped view *)
    END HandleCtrlMsg;

    PROCEDURE (v: View) HandlePropMsg- (VAR msg: Properties.Message);
    BEGIN
  Views.HandlePropMsg(v.inner, msg)    (* forward all property messages to wrapped view *)
    END HandlePropMsg;


PROCEDURE NewView* (text: TextModels.Model): View;
VAR  v: View;
BEGIN
    ASSERT(text # NIL, 20);
    NEW(v);
    v.colorizing := FALSE;
    v.inner := TextViews.dir.New(text);
    Stores.Join(v, v.inner);
    RETURN v
END NewView;

PROCEDURE NewModule (): TextModels.Model;
VAR text: TextModels.Model; f: TextMappers.Formatter;
BEGIN
    text := TextModels.dir.New();
    f.ConnectTo(text);
    f.WriteString('(*'); f.WriteLn();
    f.WriteString('  Внимание! Этот редактор использует MasterColorViews.View.'); f.WriteLn();
    f.WriteString('  После сохранения этого документа его можно будет открыть'); f.WriteLn();
    f.WriteString('  только при наличии в системе модуля MasterColorViews.'); f.WriteLn();    
    f.WriteString('*)'); f.WriteLn();
    f.WriteString('MODULE;'); f.WriteLn();
    f.WriteString('IMPORT StdLog;'); f.WriteLn();
    f.WriteLn();
    f.WriteLn();
    f.WriteString('BEGIN'); f.WriteLn();
    f.WriteTab(); f.WriteString('(* Initialization *)'); f.WriteLn();
    f.WriteString('CLOSE'); f.WriteLn();    
    f.WriteTab(); f.WriteString('(* Finalization *)'); f.WriteLn();
    f.WriteString('END .'); f.WriteLn();
    f.WriteLn();
    RETURN text;
END NewModule;

PROCEDURE NewEditor* ();
VAR  v: View;
BEGIN
    v := NewView(NewModule());
    Views.OpenView(v); 
END NewEditor;

END MasterColorViews.
Ответить с цитированием
  (#14 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:25

BlackBoxMasterModColorViews.odc
Код:
MODULE MasterColorViews;

    IMPORT Dialog, Stores, Models, Views, Controllers, Services, Properties, StdLog, 
  TextViews, TextModels, TextMappers, MasterColors;

    CONST minVersion = 2; maxVersion = 2;

    TYPE
  View* = POINTER TO LIMITED RECORD (Views.View)
      inner: Views.View;    (* v # NIL *)
      colorizing, needRefresh: BOOLEAN;
  END;

    PROCEDURE (v: View) Colorize* (), NEW;
    BEGIN
  IF ~v.colorizing THEN
      v.colorizing := TRUE;
      MasterColors.ColorizeText(v.inner.ThisModel()(TextModels.Model));
      v.colorizing := FALSE
  END
    END Colorize;

    PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader);
  VAR version: INTEGER;
    BEGIN
  rd.ReadVersion(minVersion, maxVersion, version);
  IF ~rd.cancelled THEN
      Views.ReadView(rd, v.inner)    (* generate Views.Alien if necessary *)
  END
    END Internalize;

    PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer);
    BEGIN
  wr.WriteVersion(maxVersion);
  Views.WriteView(wr, v.inner)    (* handle Views.Alien if necessary *)
    END Externalize;

    PROCEDURE (v: View) CopyFromModelView- (source: Views.View; model: Models.Model);
    BEGIN
  WITH source: View DO
      IF model = NIL THEN
    v.inner := Views.CopyOf(source.inner, Views.deep)
      ELSE
    v.inner := Views.CopyWithNewModel(source.inner, model)
      END
  END
    END CopyFromModelView;

    PROCEDURE (v: View) ThisModel* (): Models.Model;
    BEGIN
  RETURN v.inner.ThisModel()
    END ThisModel;

    PROCEDURE (v: View) InitContext* (context: Models.Context);
    BEGIN
  v.InitContext^(context);
  v.inner.InitContext(context)    (* wrapper and wrapped view share the same context *)
    END InitContext;

    PROCEDURE (v: View) Neutralize*;
    BEGIN
  v.inner.Neutralize
    END Neutralize;

    (* GetNewFrame: wrapper uses standard frame *)
    (* GetBackground: wrapper has no intrinsic background color *)

    PROCEDURE (v: View) Restore* (f: Views.Frame; l, t, r, b: INTEGER);
    BEGIN
  (* create and install wrapped view's frame *)
  Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE)
  (* Из-за этого тормозит при прокрутке мышиного колеса *)
    END Restore;

    (* RestoreMarks: wrapper has no intrinsic marks, wrapped view's RestoreMarks is called by framework *)
    (* HandleModelMsg: framework performs message propagation *)
    (* HandleViewMsg: framework performs message propagation *)

    PROCEDURE (v: View) HandleCtrlMsg* (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
    BEGIN
  (* here comes the behavior which is specific to this wrapper -
      it modifies the wrapped view's behavior *)
  WITH
      msg: Controllers.EditMsg DO v.Colorize(); v.needRefresh := TRUE |
      msg: Controllers.TickMsg DO IF v.needRefresh THEN v.needRefresh := FALSE; v.Colorize() END |
  ELSE
  END;
  focus := v.inner; (* forward all controller messages to wrapped view *)
    END HandleCtrlMsg;

    PROCEDURE (v: View) HandlePropMsg- (VAR msg: Properties.Message);
    BEGIN
  Views.HandlePropMsg(v.inner, msg)    (* forward all property messages to wrapped view *)
    END HandlePropMsg;


PROCEDURE NewView* (text: TextModels.Model): View;
VAR  v: View;
BEGIN
    ASSERT(text # NIL, 20);
    NEW(v);
    v.colorizing := FALSE;
    v.inner := TextViews.dir.New(text);
    Stores.Join(v, v.inner);
    RETURN v
END NewView;

PROCEDURE NewModule (): TextModels.Model;
VAR text: TextModels.Model; f: TextMappers.Formatter;
BEGIN
    text := TextModels.dir.New();
    f.ConnectTo(text);
    f.WriteString('(*'); f.WriteLn();
    f.WriteString('  Внимание! Этот редактор использует MasterColorViews.View.'); f.WriteLn();
    f.WriteString('  После сохранения этого документа его можно будет открыть'); f.WriteLn();
    f.WriteString('  только при наличии в системе модуля MasterColorViews.'); f.WriteLn();    
    f.WriteString('*)'); f.WriteLn();
    f.WriteString('MODULE;'); f.WriteLn();
    f.WriteString('IMPORT StdLog;'); f.WriteLn();
    f.WriteLn();
    f.WriteLn();
    f.WriteString('BEGIN'); f.WriteLn();
    f.WriteTab(); f.WriteString('(* Initialization *)'); f.WriteLn();
    f.WriteString('CLOSE'); f.WriteLn();    
    f.WriteTab(); f.WriteString('(* Finalization *)'); f.WriteLn();
    f.WriteString('END .'); f.WriteLn();
    f.WriteLn();
    RETURN text;
END NewModule;

PROCEDURE NewEditor* ();
VAR  v: View;
BEGIN
    v := NewView(NewModule());
    Views.OpenView(v); 
END NewEditor;

END MasterColorViews.
Ответить с цитированием
  (#15 (permalink)) Старый
S.Yu.Gubanov S.Yu.Gubanov вне форума
Member
 
Сообщений: 587
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 03.12.2002
По умолчанию 24.11.2004, 13:39

На счет мерцания при прокрутке мышиного колеса. Процедура перерисовки такая:
Код:
PROCEDURE (v: View) Restore* (f: Views.Frame; l, t, r, b: INTEGER); 
BEGIN 
  Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE) 
END Restore;
Если написать ее по простому: v.inner.Restore(f, l, t, r, b); то ничего хорошего из этого не выйдет, так как прокрутка пропадет вообще (все время будет показываться только начало документа). Как быть?
Ответить с цитированием
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Подсветка синтаксиса как реализовать Exmap .NET 3 04.10.2008 20:50
NVIDIA и ATi должны обладать собственными фабриками для войны с Intel ORTODOX О производителях 0 25.04.2008 13:51
Подсветка синтаксиса на форуме Mnior Prolog 12 06.11.2006 18:31
Меню BlackBox как в нем исправить ошибки delpher Oberon 12 25.02.2006 12:43
Подсветка синтаксиса wils0n Eclipse 2 16.12.2005 18:36
Минимальная программа на BlackBox sacred1972 Oberon 1 17.11.2005 13:58
Как создать EXE файл в BlackBox ais Oberon 8 01.08.2005 05:48
Проблемы с DirectInput + VS 6.0 и собственными модулями(ООП) Мелкий Программирование графики 1 22.07.2005 12:22
подсветка Smarty-синтаксиса kost PHP 2 12.06.2005 13:12
Как получить BlackBox PROnya Oberon 12 22.02.2005 07:21
Подсветка синтаксиса в слитном тексте Начинающий Visual C++ 0 30.04.2004 22:58
BlackBox под Linux где найти в интернете Anonymous Oberon 3 13.04.2003 04:46



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов