Есть ли функция удаления всех комментариев?

← →
Точка Ру (2006-05-08 04:06) [0]

Чтобы не пугать иностранцев русским языком. Комментарии бывают разных типов, и поэтому удалить их все очень не легко.

← →
Джо © (2006-05-08 04:21) [1]

Стандартного ничего такого нету, остается:
1. Написать самому, выйдет не очень уж и сложный конечный автомат;
2. Поискать из уже написанного. Тут указать, например, на RemObjects PascalScript — он бесплатен и с исходниками. Но, честно говоря, разбираться в той туче коду себе дороже :) Легче, ИМХО, п. 1.

← →
Точка Ру (2006-05-08 04:27) [2]

Так дайте функцию то?

← →
Джо © (2006-05-08 04:34) [3]

> [2] Точка Ру (08.05.06 04:27)
> Так дайте функцию то?

А почему ты решил, что я за тебя ее напишу?

← →
Anatoly Podgoretsky © (2006-05-08 09:06) [4]

Точка Ру (08.05.06 04:27) [2]
Одной функцией не обойдешься.
Алгоритм довольно сложный и требует алгоритмического склада ума.
А готовую работу можно получить на www.job.ru

← →
TUser © (2006-05-08 10:06) [5]

Можно и тут. Я готов реализивать п. 1 из [1]. Мыло в анкете.

← →
atruhin © (2006-05-08 11:28) [6]

> Алгоритм довольно сложный

Это шутка или как? Думаю не более 2-3 часов работы.

← →
wicked © (2006-05-08 11:29) [7]

есть еще рецепт - не писать комменты по-русски.... ну или по-украински, белорусски, казахски итыды....
я, например, комментарии пишу по-английски, а описание уже на том языке, на котором нужно.....

← →
Юрий Зотов © (2006-05-08 12:54) [8]

> atruhin © (08.05.06 11:28) [6]

Думаю, что все же побольше выйдет. :o)

← →
easy © (2006-05-08 13:02) [9]

> Есть ли функция удаления всех комментариев?

uses RegExpr; (* http://regexpstudio.com/RU/TRegExpr/TRegExpr.html *) const commentexpr = "(?is)({.*?})|($\*.*?\*$)|(//.+?)\n"; begin Memo1.Text:= ReplaceRegExpr(commentexpr, Memo1.Text, "");

потестировать, доработать commentexpr - и будет функция

← →
homm © (2006-05-08 13:17) [10]

> "(?is)({.*?})|($\*.*?\*$)|(//.+?)\n";

Какая выразительность языка :)

← →
TUser © (2006-05-08 13:48) [11]

Символы (**) {} и // могут встречаться в строковых константах, - это первоек очевидное замечание к такому регэкспу.

Зы. Берусь на спор написать соответствующий автомат за 2 часа. Ставлю ящик пива :)

← →
Плохиш © (2006-05-08 13:50) [12]

> TUser © (08.05.06 13:48) [11]
> Зы. Берусь на спор написать соответствующий автомат за 2
> часа. Ставлю ящик пива

А если не уложишься, то два ящика?

← →
Юрий Зотов © (2006-05-08 14:17) [13]

> TUser © (08.05.06 13:48) [11]

Удовлетворюсь даже одной виртуальной бутылкой. К 16:30 по Москве жду код. Неглючный, конечно.
:о)

← →
Юрий © (2006-05-08 14:23) [14]

Не совсем понятна ставка :о) т.е. если TUser победит ему ящик? А если проиграет то от него Юрию Зотову бутылку пива?

← →
Юрий Зотов © (2006-05-08 14:54) [15]

> Юрий © (08.05.06 14:23) [14]

А какая разница? Пиво каждый из нас и сам может себе купить, без напряга. Не в нем дело.

Если TUser победит, то комьюнити получит еще один полезный инструмент. А если проиграет, то комьюнити убедится, что эта задачка хотя и несложная, конечно, но и не так проста, как это кажется на первый взгляд. В любом случай польза.

← →
Юрий © (2006-05-08 14:58) [16]

> [15] Юрий Зотов © (08.05.06 14:54)

Конечно ;) Но всё равно азарт, нужен азарт!!!

← →
KilkennyCat © (2006-05-08 15:00) [17]

> Юрий Зотов ©

если только русский комментарий, задача несложная, особенно для тех вариантов, где делфи еще не поддерживает русские имена переменных, если память не изменяет, до 2005-ой... :)

← →
saa (2006-05-08 15:02) [18]

А еше полезнее утилита, которая бы автоматически их перевела.

← →
KilkennyCat © (2006-05-08 15:02) [19]

и удалила :)))

← →
Привидение Хозяина (2006-05-08 15:04) [20]

Удалено модератором

← →
Пусик © (2006-05-08 15:05) [21]

Задача не сложная. Опыта в использовании конечных автоматов вполне достаточно. И даже 2 часа на это не нужно. достаточно 1.

← →
Юрий Зотов © (2006-05-08 15:15) [22]

> Пусик © (08.05.06 15:05) [21]

Так в чем же дело? :о)

← →
Привидение Хозяина (2006-05-08 15:16) [23]

Удалено модератором

← →
KilkennyCat © (2006-05-08 15:16) [24]

> Пусик © (08.05.06 15:05)

если конечный автомат - это руки, то да... за один час я дофига удалю. приблизительно 3660 строк комментариев.

← →
Sergey Masloff (2006-05-08 15:17) [25]

Пусик © (08.05.06 15:05) [21]
Срок известен, задачи определены - за дело, товарищи. До 16-30 как раз час - уложитесь

← →
KilkennyCat © (2006-05-08 15:57) [26]

Осталось полчаса :)

← →
Привидение Хозяина (2006-05-08 16:07) [27]

Удалено модератором

← →
Пусик © (2006-05-08 16:21) [28]

Те условия, которые смогла определить, реализовала. Конечно, могла что-нибудь и пропустить, но, как мне кажется, работает:

unit uParseComment; interface uses Sysutils; type TStateParse=(spNone,spSlash1,spSlash2,spLeft1,spLeft2,spFLeft1,spFLeft2,spRight1 ,spLiteral1); TParseError=Exception; function DeleteComments(const s: String): String; implementation function DeleteComments(const s: String): String; var i: Integer; State: TStateParse; Len: Integer; begin State := spNone; Result := ""; Len := Length(s); i := 1; while i<=Len do begin case State of spNone: begin if s[i]="/" then begin State := spSlash1; Inc(i); Continue; end; if s[i]="(" then begin State := spLeft1; Inc(i); Continue; end; if s[i]="{" then begin State := spFLeft1; Inc(i); Continue; end; if s[i]="""" then begin State := spLiteral1; Result := Result + s[i]; Inc(i); Continue; end; Result := Result + s[i]; Inc(i); end; spSlash1: begin if s[i]="/" then begin Inc(i); State := spSlash2; end else begin State := spNone; Result := Result + s[i-1]; end; Continue; end; spSlash2: begin if s[i]=#13 then begin State := spNone; end; Inc(i); Continue; end; spLeft1: begin if s[i]="*" then begin Inc(i); State := spLeft2 end else begin State := spNone; Result := Result + s[i-1]; end; Continue; end; spFLeft1: begin if s[i]<>"$" then State := spFLeft2 else begin State := spNone; Result := Result + s[i-1]; Result := Result + s[i]; end; Inc(i); Continue; end; spLeft2: begin if s[i]="*" then begin State := spRight1; Inc(i); Continue; end else Result := Result + s[i]; end; spFLeft2: begin if s[i]="}" then State := spNone; Inc(i); end; spRight1: begin if s[i]=")" then State := spNone else State := spLeft2; Inc(i); end; spLiteral1: begin if s[i]="""" then begin if i<>Len then begin if s[i+1]="""" then begin Result := Result + s[i+1]; Inc(i,2); end else begin State := spNone; Result := Result + s[i]; Inc(i); end; end else Inc(i); Continue; end else Result := Result + s[i]; Inc(i); end; end; end; if State<>spNone then raise TParseError.Create("Ошибка в синтаксисе"); end; end.

← →
Пусик © (2006-05-08 16:22) [29]

Не уверена за точность с определением литералов с апострофами внутри строки...

← →
sniknik © (2006-05-08 16:38) [30]

Пусик © (08.05.06 16:21) [28]
не проверял, но судя по всему после этой процедуры и от всех директив компилятора тоже останутся "рожки да ножки" наряду с комментариями...

глюк`с.

← →
sniknik © (2006-05-08 16:40) [31]

хотя может и нет...
> if s[i]<>"$" then State := spFLeft2

надо бы всетаки проверить

← →
Пусик © (2006-05-08 16:41) [32]

> не проверял, но судя по всему после этой процедуры и от
> всех директив компилятора тоже останутся "рожки да ножки"
> наряду с комментариями...

Вряд ли. Этот пунктик учтен.

← →
KilkennyCat © (2006-05-08 16:45) [33]

и этот?
(*$NOINCLUDE CommCtrl *)

← →
KilkennyCat © (2006-05-08 16:47) [34]

Однако, TUser опаздывает ;)

← →
Пусик © (2006-05-08 16:51) [35]

> KilkennyCat © (08.05.06 16:45) [33]
>
> и этот?
> (*$NOINCLUDE CommCtrl *)

А это что за незнакомая конструкция? Вроде бы простой комментарий - удален будет.

← →
sniknik © (2006-05-08 16:52) [36]

сглючило на таком
// -= Prepare Definations =- //

на этом повисло
(*$NOINCLUDE CommCtrl *)

← →
KilkennyCat © (2006-05-08 16:52) [37]

unit Controls;

{$P+,S-,W-,R-,T-,H+,X+}
{ WARN SYMBOL_PLATFORM OFF}
{$C PRELOAD}

interface

{$R Controls.res}

{ CommCtrl.hpp is not required in Controls.hpp }
(*$NOINCLUDE CommCtrl *)

← →
Пусик © (2006-05-08 16:57) [38]

(*$NOINCLUDE CommCtrl *) у меня вообще невозможно в программу добавить. При компиляции выдает ошибку - Undeclared IDentifier "CommCtrl"

← →
Вовчик (2006-05-08 17:07) [39]

Удалено модератором

← →
KilkennyCat © (2006-05-08 17:08) [40]

это из генофонда. controls.pas
компилятор не считает это комментарием.

← →
sniknik © (2006-05-08 17:08) [41]

Пусик © (08.05.06 16:57) [38]
CommCtrl обьяви в модуле, после исключай

и еще попробуй
procedure TForm1.Button1Click(Sender: TObject); begin (*$IFDEF name*) if OpenDialog1.Execute then Memo1.Lines.LoadFromFile(OpenDialog1.FileName); (*$ENDIF*) end;

← →
KilkennyCat © (2006-05-08 17:09) [42]

> компилятор не считает это комментарием.

тем более, что выдает ошибку :))

← →
sniknik © (2006-05-08 17:10) [43]

> компилятор не считает это комментарием.
директива компилятора, в принципе это и есть комментарий (в код не включается)... но только он нужен.

← →
KilkennyCat © (2006-05-08 17:12) [44]

> [43] sniknik © (08.05.06 17:10)

ну уж нет. комментарий - это комментарий, а директива - это директива :)

← →
Пусик © (2006-05-08 17:12) [45]

Вот одна ошибка исправлена:
spLeft2: begin if s[i]="*" then State := spRight1 else Result := Result + s[i]; Inc(i); Continue; end;

А разве директивы компилятора не только в {} могут быть, но и в (* *) ?

← →
Пусик © (2006-05-08 17:14) [46]

A compiler directive starts with a $ as the first character after the opening comment delimiter, immediately followed by a name (one or more letters) that designates the particular directive. You can include comments after the directive and any necessary parameters.

← →
Пусик © (2006-05-08 17:15) [47]

Действительно, этот момент не знала.
Сейчас буду подправлять.

← →
sniknik © (2006-05-08 17:17) [48]

а смысл? время то тютю.
пора Зотову пиво слать... факсом ;о))

← →
Юрий Зотов © (2006-05-08 17:18) [49]

> Пусик © (08.05.06 16:21) [28]

Увы, протестировать код не удалось - после запуска программа надолго ушла в глубокую задумчивость. Ждал минут 10, но так и не дождался, пока она все же закончит работу.

Тестирующий код:
procedure TForm1.Button1Click(Sender: TObject); begin with TOpenDialog.Create(nil) do try if Execute then begin with TStringList.Create do try LoadFromFile(FileName); Text := DeleteComments(Text); SaveToFile(ChangeFileExt(FileName, ".new")) finally Free end end finally Free end end;
Тестовые данные:
unit Unit2; interface {$R+} {$DEFINE CompilerOption} const Literal = "// This { is } a (* string *)"; (* comment 1 *) A = 0; { comment 2 } B = 0; // comment 3 C = 0; (* { comment 4 } *) (* // comment 5 *) { (* comment 6 *) } { // comment 7 } // (* comment 8 *) // { comment 9 } implementation end.
Если имелось в виду, что за час можно написать код, который не работает, то с этим я полностью согласен. Даже более того - неработающий код можно написать и еще намного быстрее.
:o)

← →
KilkennyCat © (2006-05-08 17:19) [50]

> Ждал минут 10, но так и не дождался

машина слабая? :))

← →
sniknik © (2006-05-08 17:19) [51]

если для народа стараешся то убери еще глюк с
> // -= Prepare Definations =- //
символы лишние остаются

← →
Привидение Хозяина (2006-05-08 17:20) [52]

Удалено модератором

← →
sniknik © (2006-05-08 17:22) [53]

> машина слабая? :))
да не, оно виснет, также как и это (*$NOINCLUDE CommCtrl *)

← →
KilkennyCat © (2006-05-08 17:25) [54]

мне, что ли, написать....
в принципе, у меня есть парсер самодельный для НТМЛ.... эт тоже самое.

← →
Пусик © (2006-05-08 17:29) [55]

> Юрий Зотов © (08.05.06 17:18) [49]

Сейчас на этом коде потестирую, тем более, что уже подправила.

← →
Привидение Хозяина (2006-05-08 17:31) [56]

Удалено модератором

← →
Пусик © (2006-05-08 17:31) [57]

Проверила.
Вот подправленный код:

unit uParseComment; interface uses Sysutils; type TStateParse=(spNone,spSlash1,spSlash2,spLeft1,spLeft2,spFLeft1,spFLeft2,spRight1 ,spLiteral1); TParseError=Exception; function DeleteComments(const s: String): String; implementation function DeleteComments(const s: String): String; var i: Integer; State: TStateParse; Len: Integer; begin State := spNone; Result := ""; Len := Length(s); i := 1; while i<=Len do begin case State of spNone: begin if s[i]="/" then begin State := spSlash1; Inc(i); Continue; end; if s[i]="(" then begin State := spLeft1; Inc(i); Continue; end; if s[i]="{" then begin State := spFLeft1; Inc(i); Continue; end; if s[i]="""" then begin State := spLiteral1; Result := Result + s[i]; Inc(i); Continue; end; Result := Result + s[i]; Inc(i); end; spSlash1: begin if s[i]="/" then begin Inc(i); State := spSlash2; end else begin State := spNone; Result := Result + s[i-1]; end; Continue; end; spSlash2: begin if s[i]=#13 then begin State := spNone; end; Inc(i); Continue; end; spLeft1: begin if s[i]="*" then begin if i<Len then begin if s[i+1]<>"$" then State := spRight1 else begin Result := Result+s[i-1]; State := spNone; Continue; end; end; Inc(i); State := spLeft2; end else begin State := spNone; Result := Result + s[i-1]; end; Continue; end; spFLeft1: begin if s[i]<>"$" then State := spFLeft2 else begin State := spNone; Result := Result + s[i-1]; Result := Result + s[i]; end; Inc(i); Continue; end; spLeft2: begin if s[i]="*" then State := spRight1; Inc(i); Continue; end; spFLeft2: begin if s[i]="}" then State := spNone; Inc(i); end; spRight1: begin if s[i]=")" then State := spNone else State := spLeft2; Inc(i); end; spLiteral1: begin if s[i]="""" then begin if i<>Len then begin if s[i+1]="""" then begin Result := Result + s[i+1]; Inc(i,2); end else begin State := spNone; Result := Result + s[i]; Inc(i); end; end else Inc(i); Continue; end else Result := Result + s[i]; Inc(i); end; end; end; if State<>spNone then raise TParseError.Create("Ошибка в синтаксисе"); end; end.

Вот результат обработки примера Ю. Зотова:

unit Unit2; interface {$R+} {$DEFINE CompilerOption} const Literal = "// This { is } a (* string *)"; A = 0; B = 0; implementation end.

← →
Пусик © (2006-05-08 17:36) [58]

Строка (*$NOINCLUDE CommCtrl *) сейчас тоже корректно обрабатывается.

← →
KilkennyCat © (2006-05-08 17:44) [59]

и все-таки что-то мне кажется, что можно гораздо проще...

← →
Пусик © (2006-05-08 17:47) [60]

> Если имелось в виду, что за час можно написать код, который
> не работает, то с этим я полностью согласен. Даже более
> того - неработающий код можно написать и еще намного быстрее.
>

К сожалению, не удалось за час все варианты отработать. Но думаю, что работающий код(пусть он и не самый красивый), здесь все-таки есть.

← →
KilkennyCat © (2006-05-08 17:47) [61]

Начинаю. Как раз два часа есть. Скоро будет мой неработающий вариант :)

← →
sniknik © (2006-05-08 17:51) [62]

> Строка (*$NOINCLUDE CommCtrl *) сейчас тоже корректно обрабатывается.
зато коверкаются cтроки
Caption:= "Ok""";

+ там хинт на строке
if s[i+1]<>"$" then State := spRight1
значение не используется... зачастую это ошибка в логике.

← →
Пусик © (2006-05-08 17:54) [63]

> sniknik © (08.05.06 17:51) [62]

Да, действительно, хинт был, правильный код
spLeft1: begin if s[i]="*" then begin if i<Len then begin if s[i+1]<>"$" then begin Inc(i); State := spRight1; Continue; end

> Caption:= "Ok""";

Значит, есть еще над чем работать.
Спасибо за замечания.

← →
sniknik © (2006-05-08 17:55) [64]

> Начинаю. Как раз два часа есть. Скоро будет мой неработающий вариант :)
это будет нечестно, имхо, ты уже в курсе всех "подводных камней" на которые Пусик "напоролся". т.е. вникая в задачу на чужом примере ты уже считай начал ей заниматься...

← →
Пусик © (2006-05-08 17:57) [65]

>sniknik
Вот на последнее замечание исправление:

spLiteral1: begin if s[i]="""" then begin if i<>Len then begin if s[i+1]="""" then begin Result := Result + s[i]; Result := Result + s[i+1]; Inc(i,2); end

← →
KilkennyCat © (2006-05-08 17:58) [66]

> это будет нечестно, имхо, ты уже в курсе всех "подводных
> камней"

я изначально был в курсе.
К тому же, я занимался парсингом, это плюс.
К тому же, мне неизвестны конечные автоматы, это, наверное, минус.
И вообще. :))

← →
Пусик © (2006-05-08 17:59) [67]

Удалено модератором

← →
KilkennyCat © (2006-05-08 18:02) [68]

> [67] Пусик © (08.05.06 17:59)

Понятно. Феминистка.

← →
Palladin © (2006-05-08 18:36) [69]

мда... 25 минут с перерывами на наполнение стакана пивом и поглощение колбасы... в основном тупил из-за Copy :) сколько куда отсчитывать...

Function RemoveComments(Const s:String):String; // { // (* // // var i:Integer; IsString,IsComm:Boolean; strComm:String; nCommType:Integer; Begin Result:=""; strComm:=""; IsString:=False; IsComm:=False; For i:=1 to Length(s) Do Begin If (s[i]=#39) and (i<>1) and (s[i-1]<>#39) Then IsString:=Not IsString; If IsString Then Result:=Result+s[i] Else If IsComm Then Begin strComm:=strComm+s[i]; Case nCommType Of 0 : If Length(strComm)>=1 Then IsComm:=strComm[Length(strComm)]<>"}"; 1 : If Length(strComm)>=2 Then IsComm:=Copy(strComm,Length(strComm)-1,2)<>"*)"; 2 : If Length(strComm)>=2 Then IsComm:=Copy(strComm,Length(strComm)-1,2)<>#13#10; End; End Else Begin strComm:=""; If (Copy(s,i,2)="(*") and (Copy(s,i,3)<>"(*$") Then Begin IsComm:=True; nCommType:=1; End Else If (s[i]="{") and (Copy(s,i,2)<>"{$") Then Begin IsComm:=True; nCommType:=0; End Else If Copy(s,i,2)="//" Then Begin IsComm:=True; nCommType:=2; End; If Not IsComm Then Result:=Result+s[i]; End; End; End;

← →
Palladin © (2006-05-08 18:43) [70]

> If (s[i]=#39) and (i<>1) and (s[i-1]<>#39) Then IsString:
> =Not IsString;

+15 минут на исправление этого безобразия ибо в случае """" исполнится фигня и на добавление условия на под {$ }

итого 50 минут... ну пусть час...

← →
Пусик © (2006-05-08 18:44) [71]

> Palladin © (08.05.06 18:36) [69]

Не смешно. Функция совершенно нерабочая.

Для примера обработай вот такие комментарии(выжимка из моего файла):

DF1 := TDrawFigureThread.Create(FOrm1.Canvas,tfRectangle,{ """}Form1.ClientRect);

// ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Application.OnActivate := OnCreateApp;

end;

procedure TForm1.FormShow(Sender: TObject);
begin

end;
end;
(*
qwe lqwie oqiwue oiqwue oiqwu e
qw eoiqwu eoiqweu oiqwu oqwieu//""""{ }
*)

← →
Пусик © (2006-05-08 18:45) [72]

И это учитывая, что здесь уже были замечания опубликованы.

← →
Palladin © (2006-05-08 18:47) [73]

> Пусик © (08.05.06 18:44) [71]

см [70]

← →
Пусик © (2006-05-08 18:49) [74]

> Palladin © (08.05.06 18:47) [73]
>
>
> > Пусик © (08.05.06 18:44) [71]
>
> см [70]

А что там? Непонятно, что означает тот пост.

← →
Пусик © (2006-05-08 18:54) [75]

А-а, понятно. Надо те строки закомментировать?
Ну тогда вроде работает:-)

← →
Palladin © (2006-05-08 18:59) [76]

Означает что нужно отработать поподробней работу со строковыми константами.

← →
Palladin © (2006-05-08 19:02) [77]

> Пусик © (08.05.06 18:54) [75]

Кто сказал? Нет, их комментировать не нужно, их нужно исправить. На самом деле все равно то что я привел это чушь... Хоть и лаконичная, но чушь. Выработка условий приоритета между определением начала комментария и начала строковой константы довольно сложна. И если начать в это углубляться, то уж лучше сразу поставить задачу парсинга синтаксиса Паскаля.

← →
Пусик © (2006-05-08 19:02) [78]

> Palladin © (08.05.06 18:59) [76]
>
> Означает что нужно отработать поподробней работу со строковыми
> константами.

+ Оптимизировать код на предмет постоянного перераспределения памяти под строки.

← →
KilkennyCat © (2006-05-08 19:03) [79]

а я мучался-мучался, родил такую жуть:

function RemComm(Data : String) : string; var l, i : integer; fsString, fsSlash, fsDir, fsFig, fsScob : boolean; begin result := ""; i := 0; l := length(data); fsString := false; fsSlash := false; fsFig := false; fsScob := false; repeat inc(i); case data[i] of """" : begin if fsString then begin result := result + data[i]; end; fsString := not fsString; end; "/" : if not fsString then if i < l then if data[i+1] = "/" then fsSlash := true; "{" : if not fsString then fsFig := true; "}" : if not fsString then begin fsFig := false; Continue; end; "(" : if not fsString then if data[i+1] = "*" then fsScob := true; ")" : if not fsString then if data[i-1] = "*" then begin fsScob := false; continue; end; else if ord(data[i]) = 13 then fsslash := false; end; if fsString then result := result + data[i] else begin if not fsSlash and not fsFig and not fsScob then result := result + data[i]; end until i = l; end;

не учитывает директивы пока. ну и фиг. я сдаюсь. не хочу пива.

← →
KilkennyCat © (2006-05-08 19:04) [80]

Но у меня шустрее всех работать будет.

> Пусик © (08.05.06 19:02) [78]

Поверь, это пока не самая важная задача :) Ну установлю я SetLength(Result,Length(s))
посчитаю сколько я там наназначал резалту, ну обрежу, смысл?

function RemComm(Data : String) : string; var l, i : integer; fsString, fsSlash, fsDir, fsFig, fsScob : boolean; begin result := ""; i := 0; l := length(data); fsString := false; fsSlash := false; fsFig := false; fsScob := false; fsDir := false; repeat inc(i); case data[i] of """" : begin if fsString then result := result + data[i]; fsString := not fsString; end; "/" : if not fsString then if i < l then if data[i+1] = "/" then fsSlash := true; "{" : if not fsString then if data[i+1] <> "$" then fsFig := true else fsDir := true; "}" : if not fsString then begin if fsDir then result := result + data[i]; fsFig := false; fsDir := false; Continue; end; "(" : if not fsString then if data[i+1] = "*" then fsScob := true; ")" : if not fsString then if data[i-1] = "*" then begin fsScob := false; continue; end; else if ord(data[i]) = 13 then fsslash := false; end; if fsString then result := result + data[i] else if not fsSlash and not fsFig and not fsScob then result := result + data[i]; until i = l; end;

с учетом директив, кроме хитрой.

Пусик, респект! Красивый код :-)
> [66] KilkennyCat © (08.05.06 17:58)
>
> > это будет нечестно, имхо, ты уже в курсе всех "подводных
>
> > камней"
>
>
> я изначально был в курсе.
> К тому же, я занимался парсингом, это плюс.
> К тому же, мне неизвестны конечные автоматы, это, наверное,
> минус.

Хм... После того как я два года назад познакомился с конечными автоматами, а в прошлом году изучал их в универе, выстраивая автоматы Милли и Мура на триггерах, я себе смутно представляю хороший парсер без их использования.

В 16:30 ждете, хе, я только сечас Ваш пост прочитал, так что звиняйте.

> Есть ли функция удаления всех комментариев?

http://www.zeitungsjunge.de DIPP is a Pascal Preprocessor. The purpose of DIPP is to manipulate Pascal source code files. DIPP can remove comments process compiler directives and switches remove compiler conditionals by wild card masks remove compiler directives by wild card masks insert, read, or skip include files by wild card masks extract units" interface sections

Сам пользуюсь - иногда очень полезная весЧь

program RemRem.dpr; {$apptype console} uses Classes; { started at 19:40 finished at 20:32 } type TState = (stNone, stFigStarted, stFig, stAstStarted, stAst, stAstEnded, stLineStarted, stLine, stApstr, stString); var Txt: TStrings; var Comms: array of array [0..1] of integer; procedure Add (B, E: integer); begin if B <= 0 then exit; SetLength (Comms, length (Comms) + 1); Comms [high(Comms)][0] := B; Comms [high(Comms)][1] := E; end; procedure Preprocess; var i: integer; s: TState; started: integer; begin s := stNone; started := -1; //for i := 1 to length (Txt.Text) do i:=1; while i <= length (Txt.Text) do begin case s of stNone: begin case Txt.Text[i] of "{": begin s:=stFigStarted; started := i; end; "/": begin s:=stLineStarted; started := i; end; "(": begin s:=stAstStarted; started := i; end; """": s:=stString; end; end; stFigStarted: begin case Txt.Text[i] of "$": begin started := -1; s := stFig; end; "}": begin s := stNone; Add (started, i); end; else s := stFig; end; end; stFig: begin case Txt.Text[i] of "}": begin s := stNone; Add (Started, i); end; end; end; stAstStarted: begin case Txt.Text[i] of "*": s := stAst; else begin s := stNone; dec (i); end; end; end; stAst: begin case Txt.Text[i] of "*": s := stAstEnded; end; end; stAstEnded: begin case Txt.Text[i] of ")": begin s := stNone; Add (started, i); end; else s := stAst; end; end; stLineStarted: begin case Txt.Text[i] of "/": s := stLine; else begin s := stNone; dec (i); end; end; end; stLine: begin case Txt.Text[i] of #10, #13: begin s := stNone; Add (started, i - 1); end; end; end; stString: begin case Txt.Text[i] of """": s := stApstr; #10, #13: s := stNone; // unterminated string; end; end; stApstr: begin case Txt.Text[i] of """": s := stString; else s := stNone; // possible untstr end; end; end; inc (i); end; end; procedure Print; var i, j , k: integer; begin i := 0; for j := 0 to high (Comms) do begin for k := i + 1 to Comms[j][0] - 1 do write (Txt.Text[k]); i := Comms[j][1]; end; for k := i + 1 to length (Txt.Text) do write (Txt.Text[k]); end; begin Txt := TStringList.Create; Txt.LoadFromFile (ParamStr(1)); Preprocess; Print; Txt.Free; end.

Сразу честно признаюсь, что предыдущие решения и комментарии к ним я не читал, код долбать надо было )

И дабы ненужные подозрения сразу пресечь - приведенный в [88] хронометраж абсолютно правильный, а раньше я не постил не потому, почему некоторые может быть подумали, а потому что приглашения Юрия не видел.

> All

Просто мне как-то довелось писать нечто подобное. Сама задача была, конечно, куда более сложной, но подзадача выделения комментариев была ее составной частью. Тоже сначала подумал, что это - ерунда, раз плюнуть, но когда начал писать, то убедился, что не все уж так совсем просто, как это показалось с первого взгляда. Хотя и несложно, конечно.

Думаю, мы в этом убедились - все же с первого захода никто не привел полностью рабочего варианта. Обязательно что-то или не обрабатывалось, или обрабатывалось как-то не так, или еще какие-то глюки. А ведь программа правит святая святых - сырцы. Здесь цена ошибки может быть ОЧЕНЬ высокой и поэтому она должна работать безукоризненно. Отсюда и выползает время, которое надо на нее потратить.

Видать мне тоже делать нечего. Сделал такой вариант за 50 минут (Кроме функции GetFileText - это из старого кода):
program COmmentCutter; {$APPTYPE CONSOLE} {$O-} uses SysUtils; type TLexemType = (ltMainContent, ltString, ltDirective, ltComment, ltSingleLineComment); function CutAllComments(const s: string): string; var CurPos, CurLength: Integer; CurLexemType: TLexemType; procedure DoComment(const CommentStart, CommentEnd: string); var EndOfComment: PChar; begin EndOfComment := StrPos(@s[CurPos + Length(CommentStart)], PChar(CommentEnd)); if EndOfComment = nil then raise Exception.CreateFmt("Unterminated comment at pos %u:"#13#10"%s", [CurPos, Copy(s, CurPos, 100)]); if (CurLexemType = ltComment) and (s[CurPos + Length(CommentStart)] = "$") then CurLexemType := ltDirective; if (CurLexemType = ltSingleLineComment) then Dec(EndOfComment, Length(CommentEnd)); CurLength := (EndOfComment - PChar(s) + 1) - CurPos + Length(CommentEnd); end; function GetNextLexem: Boolean; begin Inc(CurPos, CurLength); if Length(s) < CurPos then begin Result := False; Exit; end; Result := True; case s[CurPos] of "{": begin CurLexemType := ltComment; DoComment("{", "}"); Exit; end; """": begin CurLexemType := ltString; DoComment("""", """"); Exit; end; "(": begin if (Length(s) >= CurPos + 1) and (s[CurPos + 1] = "*") then begin CurLexemType := ltComment; DoComment("(*", "*)"); Exit; end; end; "/": begin if (Length(s) >= CurPos + 1) and (s[CurPos + 1] = "/") then begin CurLexemType := ltSingleLineComment; DoComment("//", #13#10); Exit; end; end; end;//case s[CurPos] CurLength := 1; CurLexemType := ltMainContent; end; procedure WriteCurLexem; begin Result := Result + Copy(s, CurPos, CurLength); end; begin Result := ""; CurPos := 1; CurLength := 0; while GetNextLexem do if not (CurLexemType in [ltComment, ltSIngleLineComment]) then WriteCurLexem; end; function GetFileText(const FileName: string): string; var f: file; LastMode: Integer; begin LastMode := FileMode; FileMode := fmOpenRead; try assign(f, FileName); reset(f, 1); try SetLength(Result, FileSize(f)); BlockRead(f, PChar(Result)^, Length(Result)); finally close(f); end; finally FileMode := LastMode; end; end; procedure WriteUsageInfoAndExit; begin writeln("This program cuts all comments from Delphi source file"); writeln("Usage: ThisProgram.exe SrcFle > DestFile"); Halt; end; begin if ParamCount <> 1 then WriteUsageInfoAndExit; writeln(CutAllComments(GetFileText(ParamStr(1)))); end.

> все же с первого захода никто не привел полностью рабочего варианта.

Как насчет [88]?

Не знал, что такие бывают. Высылаю пиво :(
http://monkey.belozersky.msu.ru/~evgeniy/remrem.dpr

procedure RemoveComments(var S: string); var CharIndex: Integer; procedure RemoveFromCurrent(const LimitStr: string); var Temp: Integer; begin Temp := PosEx(LimitStr, S, CharIndex); if Temp <= 0 then Exit; S := Copy(S, 1, CharIndex - 1) + Copy(S, Temp + Length(LimitStr), MaxInt); end; procedure SkipLiteralString; begin Inc(CharIndex); while CharIndex <= Length(S) do begin if S[CharIndex] = """" then begin Inc(CharIndex); if S[CharIndex + 1] <> """" then Exit; end; Inc(CharIndex); end; end; begin CharIndex := 1; while CharIndex <= Length(S) - 1 do begin case S[CharIndex] of "/": if S[CharIndex + 1] = "/" then RemoveFromCurrent(#13#10) else Inc(CharIndex); "(": if (S[CharIndex + 1] = "*") and (S[CharIndex + 2] <> "$")then RemoveFromCurrent("*)") else Inc(CharIndex); "{": if S[CharIndex + 1] <> "$" then RemoveFromCurrent("}") else Inc(CharIndex); """": SkipLiteralString; else Inc(CharIndex); end; end; end;

Криво и тормознуто, конечно, но вроде работает.. За 1 час написано..

в php удаление коментариев полезнее
ведь они при каждом выполнении читаются
хотя и бесполезны ведь на сервере их никто не видит
поэтому сделал для php а может даже и для C и javы
и заодно лишние пробелы удаляются
{$B-} procedure RemoveComments(var S: string); var r: string; k,k1,k2,kk,p2: boolean; i: integer; c: char; begin r:=""; k:=false; k1:=false; k2:=false; kk:=false; for i:=1 to length(s) do begin c:=s[i]; if not k and not kk and (i>1) then begin if (c=""") and k2 and not k1 and ((s[i-1])<>"\") then k2:=false else if (c=""") and not k2 and not k1 then k2:=true; if (c="""") and k1 and not k2 and ((s[i-1])<>"\") then k1:=false else if (c="""") and not k1 and not k2 then k1:=true; end; if not k1 and not k2 and (i<length(s)) then begin if (c="/") and (s[i+1]="/") and not kk and not k then k:=true; if (c="/") and (s[i+1]="*") and not k and not k then kk:=true; if (i>2) and (s[i-2]="*") and (s[i-1]="/") and kk and not k then kk:=false; if c<" " then k:=false; end; p2:=(c=" ") and (i>1) and (s[i-1]<=" ") and not k2 and not k1; if not k and not kk and not p2 then r:=r+s[i]; end; s:=r; end;

А lex незаслуженно забыт ? :)

> Вовчик (08.05.06 17:07) [39]
>
> рад приветствовать еще одну женщину-программистку

Спасибо, конечно. А ты себя к мужчинам-программистам причисляешь?
Ссылочку на твои вопросы/ответы дашь? Чтобы заценить?

> [98] Пусик © (09.05.06 00:11)
> Ссылочку на твои вопросы/ответы дашь? Чтобы заценить?

Пока у Вовчика один вопрос: "Фотку вышлешь?", да и тот остается без ответа :)

приличный код, только за неприличную фотку! ;)

← →
Левчик (2006-05-09 09:23) [104]

Удалено модератором

← →
Левчик (2006-05-09 09:29) [105]

Удалено модератором
Примечание: п. 5.

← →
Вовчик (2006-05-09 09:35) [106]

Удалено модератором
Примечание: п. 5.

> А lex незаслуженно забыт ? :)

Надо чтобы он был под рукой, а также уметь им пользоваться. А когда секундомер тикает учиться как-то не хочется - кнопки жать надо. А так конечно, lexx, yacc, GOLD и кто там еще полезны были бы.

> дициметрах?

Как такое отношение может измеряться в дециметрах?

procedure RemoveComments(var S: string); const q=4; z: array[1..q,1..5] of string=( ( "//", #0, #13#10, "", #13#10 ), ( "{", "{$", "}", "", " " ), ( "(*", "(*$", "*)", "", "" ), ( """", #0, """", "1", """" )); var r: string; i,j,n: integer; begin r:=""; i:=1; s:=s+" "; while i<=length(s) do begin n:=i; for j:=1 to q do if (s[i]=z[j,1][1]) and (copy(s,i,length(z[j,1]))= z[j,1]) and (copy(s,i,length(z[j,2]))<>z[j,2]) then begin while (i<=length(s)) and ((copy(s,i,length(z[j,3]))<> z[j,3]) or (i=n)) do begin if z[j,4]<>"" then r:=r+s[i]; inc(i); end; r:=r+z[j,5]; inc(i,length(z[j,3])-1); break; end; if n=i then r:=r+s[i]; inc(i); end; s:=copy(r,1,length(r)-3); end;

Эта же процедура может работать для html php java
а может и для всех языков и для lex тоже
если заменить константы
q=3; //html z: array[1..q,1..5] of string=( ( "", "", "" ), ( """", #0, """", "1", """" ), ( """, #0, """, "1", """ )); q=4; //php java z: array[1..q,1..5] of string=( ( "//", #0, #13#10, "", #13#10 ), ( "/*", #0, "*/", "", "" ), ( """", #0, """", "1", """" ), ( """, #0, """, "1", """ ));

Предлагю проверить еще случай
begin i:=1{коментарий}end;
У меня оставляет пробел.

И есть более тяжелый случай когда после правильного удаления
коментариев программа не компилируется
потому что delphi удаляет методы form если в них ничего нет
а их присвоение не удаляет

> И есть более тяжелый случай когда после правильного удаления
> коментариев программа не компилируется
> потому что delphi удаляет методы form если в них ничего
> нет а их присвоение не удаляет

Все он удаляет что надо. И в IDE, и в консоли компилируется.

>TUser © (09.05.06 13:54) [109]

Я сейчас не проверял сам.

что если в тексте программы где-то имеет место присваивание

SomeObject.OnCick := SomeMethod;

А потом SomeMethod "исчезнет" вышеописанным способом?

> TUser © (09.05.06 13:54)

Иммется ввиду следующее:

procedure TForm1.Button1Click(Sender: TObject);
begin
//
end;

Button1.OnClick := Button1Click;

Скомпилируется ли программа после удаления всех комментариев?

> Скомпилируется ли программа после удаления всех комментариев?

Да, на таком примере и проверял. dcc32 Project1.exe - нормально компилируется! Только IDE вольничает, но то ж для "удобства".

Зы. Именно поэтому тут кто-то рекомендовал не вставлять пустого комментария, а писать например {Do nothing}.

> Зы. Именно поэтому тут кто-то рекомендовал не вставлять
> пустого комментария, а писать например {Do nothing}.

В данном случае разницы-то нет, удаляются все комментарии.

Это да, только редко ставится задача удалить все комментарии. Чаще ставится обратная задача - написать их :(

{$warnings off}
{$Do nothing :}
{$warnings on}

>Это да, только редко ставится задача удалить все комментарии

Здесь как раз тот редкий случай. :)

Есть ли функция удаления всех комментариев? Найти похожие ветки