| View script | License | Download script | History | Other scripts by: luce80 |
30-Apr 20:06 UTC
[0.043] 21.723k
[0.043] 21.723k
 | Archive version of: parse-aid.r ... version: 1 ... luce80 3-Sep-2011Amendment note: new script || Publicly available? Yes REBOL [
title: "Parse Aid"
file: %parse-aid.r
author: "Marco Antoniazzi"
Copyright: "(C) 2011 Marco Antoniazzi. All Rights reserved"
email: [luce80 AT libero DOT it]
date: 03-09-2011
version: 0.5.1
Purpose: "Help make and test parse rules"
History: [
0.5.1 [03-09-2011 "First version"]
]
comment: "28-Aug-2011 GUI automatically generated by VID_build. Author: Marco Antoniazzi"
library: [
level: 'intermediate
platform: 'all
type: 'tool
domain: 'parse
tested-under: [View 2.7.8.3.1]
support: none
license: 'BSD
see-also: none
]
]
; file
change_title: func [/modified] [
clear find/tail main-window/text "- "
if modified [append main-window/text "*"]
append main-window/text to-string last split-path any [job-name %Untitled]
main-window/changes: [text] show main-window
]
open_file: func [/local file-name temp-list job] [
until [
file-name: request-file/title/keep/only/filter "Load a rules file" "Load" "*.r"
if none? file-name [exit]
exists? file-name
]
job-name: file-name
temp-list: load file-name
if not-equal? first temp-list 'Parse_Aid-block [exit]
job: temp-list
set-face check-clear-res get job/clear-res
set-face check-spaces get job/spaces
set-face field-main-rule job/main-rule
set-face area-charsets trim mold/only job/charsets
set-face area-rules trim mold/only job/rules
set-face area-test job/test
named: yes
change_title
saved?: yes
]
save_file: func [/as /local file-name filt ext response job] [
;if empty? job [return false]
if not named [as: true]
if as [
filt: "*.r"
ext: %.r
file-name: request-file/title/keep/only/filter "Save as Rebol file" "Save" filt
if none? file-name [return false]
if not-equal? suffix? file-name ext [append file-name ext]
response: true
if exists? file-name [response: request rejoin [{File "} last split-path file-name {" already exists, overwrite it?}]]
if response <> true [return false]
job-name: file-name
named: yes
]
flash/with join "Saving to: " job-name main-window
job: reduce [
'Parse_Aid-block 1
'clear-res get-face check-clear-res
'spaces get-face check-spaces
'main-rule get-face field-main-rule
'charsets load get-face area-charsets
'rules load get-face area-rules
'test get-face area-test
]
save job-name job
wait 1.3
unview
change_title
saved?: yes
]
; rules
charsets-block: copy [
digit: charset [#"0" - #"9"]
upper: charset [#"A" - #"Z"]
lower: charset [#"a" - #"z"]
alpha: union upper lower
alpha_: union alpha charset "_"
alphadigit: union alpha_ digit
hexdigit: union digit charset [#"a" - #"f" #"A" - #"F"]
bindigit: charset "01"
space: charset [#" " #"^(09)" #"^(0D)" #"^(13)"]
]
rules-block: copy [
digits: [some digit]
sp*: [any space]
sp+: [some space]
area-code: ["(" 3 digit ")"]
local-code: [3 digit "-" 4 digit]
phone-num: [opt area-code copy var local-code (print ["number:" var])]
]
err?: func [blk /local arg1 arg2 arg3 message err][;11-Feb-2007 Guest2
if not error? err: try blk [return :err]
err: disarm err
set [arg1 arg2 arg3] reduce [err/arg1 err/arg2 err/arg3]
message: get err/id
if block? message [bind message 'arg1]
print ["**ERROR: " form reduce message]
]
prin: func [value] [
if 100000 > length? get-face area-results [ ; avoid fill mem
set-face area-results append get-face area-results form reduce value
]
]
print: func [value] [prin append form reduce value #"^/"]
parse_test: func [/local result] [
if get-face check-clear-res [reset-face area-results]
result: err? [
do get-face area-charsets
do get-face area-rules
do pick [parse/all parse] get-face check-spaces copy get-face area-test get load get-face field-main-rule
]
text-parsed/color: white
show text-parsed
wait .1 ; to see the activity
either logic? result [
text-parsed/color: 80 + either result [green] [red]
text-parsed/text: uppercase form result
] [
text-parsed/text: "ERROR"
]
show text-parsed
]
; gui
do decompress ; Copyright: {GNU Less General Public License (LGPL) - Copyright (C) Didier Cadieu 2004}
#{
789CED596B8FDBC615FDECF915172A0AEF2E2C717763A4AD36EEC2750BA7809D
0445121420B8C02C3914C7A648851CADA418EE6FCFB977862F59B6E3A21F8BD8
16E7755F731FE74EFEF58FBF7DFF8A6295DBD22CE98FBA317ADEA64D5D96F3D6
1D4AB36894B38ED766CFB1463BEB0AF21B4CD392EC9929BD7545DD60CFDF6D66
4D432F347EB674A64BAB5BC2A479713E5366AD6DB9A4B8316F6A5B513CCBB090
CEC8D5F3B4D00D7DFD9466CEB6294ECDE80FB3C58C6679334B1295690701AEFF
327FB32D0FF3EBCBCBA7EA01DC6D5D2DE96A71B9B8549B6DB3A95B6C7AA77E2C
6C4BF8A3A9323B6285BC945E74EC6AED3D4620E02C5891AEB2A86E08F2DB5FEB
CA61A6576FA1FEE9489765BDA3D6942675E048754ECEEC1DD55BD7427E720588
59B3D34C55D8812215FA0123C2309BD75579A0759D99857AAF5ED49B43635785
83AC2FBFFB895E99B6A597A6320D38FFB0BD2F6D4AAF6C6AAAD6D0D9AB973FBC
3AA739F587E8ECC5394D8DCCE678AFA0B4AB9B03ACABC4226CADCB3F89ADE85D
6E9B1647214C794E1BCFA38142BA358BF72AC17FCA5F3CDB6929E6B2BF1A901A
B9C3D2EB26468C95BAA18B8B0B125BE7DBCA5B06DF6C8CB4DE56CE341BDD3836
56F0260C35BC6C3F6F4B58AD91F152CE82DCBB752DE6F26BA4D3B46E325BADBC
A5736BCA2CD0C124447639BDF34B3A35EF558BA13F1A75771756A2C6648D5ED1
3B5DB63585010B79B41D3BCB9ABDC1AD372C8763656E483FD37BDB3EC1E099AD
7045D4C22E4FB0FC8C3F3A57500954B0395575656EC9E511EB46B1D95B9728DB
2E794AF6CFC9642B33E76FDEA7C06C496B84C2D5FE8A19CEBBC3D15A372BCC0F
13F04E3FD1C27198C05CF407911BFAD634F06E18BEA81103A21E8BBD80875474
6F28835C747FC0C5AC418BCDEAA56F6863D3B762E67084C0A23389BAC1FD185C
37ABED1588F6F4D7FEFB40F155125F270ADB30C7C77111116215136BBDA74BAF
5AAF82271C2D35456C667CB0D1C29DC4381A3EFD29DBFA9D4CE90A5A6394A8B6
E050CCBDC32EE9A173CDA2FB68CB7C29F7A082DBED6CE60A6489AF1F3D7A7443
99C9F5B674BD8E24CB9D377F877CB183E3C18D6B6A3726B5F981761ACE9C0D39
E1C9D16189760E73E2305F28218060D96C0C16740533799A296298E2847D25C8
4D313254D42BE19A2D2790559BA862BCA138B1A193C1EB47310C6921E7CA34B7
B223BAF667A756F02B0912235CC7131A12549C977A35E7B091C4392CF88D4877
60C7FE7BBC73B4E2B7E2766ED89ECFD314C9AD6E5A91ADE1034B4290953E02B7
F742829D936D88DC308A4CA5E5307BD25B437E00CBB5C609E38B2E750889075D
6E4D8222261CF8DF4837CAFFCAC9A83F47C301BF2137A68C74F666DBBA909A5A
D9032D56A7982571A01F7100262A451A6D4E6DFB8434A3339ED7E72469CC49C5
3FC96474E67733E1BC32E2E2ADCBB3819344BECF3FCA7FF6B3484D67D774E13D
9EEFD8DB49DCA2FF929D095DEE2F93730E7E59E8A3418D87519DE75020DA7B76
C32F1879A623D786F41DB5624AAD98523B042AFDEF47A875773CD2F7037127D2
7AE3819EFF3921CF449CB07D1F741A187EEC7EF8767DA1F689C556D6713C70BE
0336C9D546571C5D3EC928662F4977D7E8CD2DC57D0EE1DC98702AAC6A0F7916
433EC3194E55C467C8540C6890195D613197D625EA458EBF5348C38CE4B6EF51
3FDFDEFA7D2D5DD3332A4DB572453785BC17440F5BAEFE7CB9087F13B011C939
B148F6D50FB5CDC05A3BFA19D80A258CA06F091C0827EFB30F2BEECF848CF302
C239D3A517BF89614B6735361271E5E0AC32F7178F3CEF1DF8B1009C1871C07C
B2DE985239B822006005DA3DFE95D009588813156C6E2A1F75B2E65AC569420A
93240CE5EB230FF94B01D0987969DBB0A51F2A8F8F784E9013474F5F8E7B0BDC
F28671028EE57E633EC663F81520AD27C35FCADBDE4FF86F483FC2C8BADCE903
60BD7192DAFD7D9CB5A6D3E6FC09030D008AC74E2AA35CD1D427E54C6029C73B
1D96E29149576D5FD719D75761CE5ECF266618188D515A5F6A0B53013C59C7F8
2F1078CE904E672364D863F35D8176A6C3EC980720B5E504B133DB8562BEA1C4
A46E2F902A622E746FA14F0C46F7D6B13140785B4927002CF0D61C0207209563
84DF8FE768A9702F4B1C64702CCED4330189768EBEC702E6032673FBC36C6677
DFDECDEFFE73F7FAEEDF773FDFFD380B6EFD5A577A159A0B1F880342CEEB74CB
7D18FB7D074546E129C6DC4DAAA54E1DB74149DCC72ED49095C72134432C4B7C
F4D1AB8661EF88DA27DAC11D85CC20C257F4CD900746E4043133F81C4F0A1A05
A8A4AF124FE71B80CD43EBCC3AE2FE0A0E0CEC30F7C5EAD4F1CF9DF1F913C268
0EA523839807C42D8526006EC81081B9B46878D242B6C42AAB77685B5550BEAA
DDDCFCB2D565509B195E8C38B265E47284BD5F4D718788475F8DD80164C29F17
1142A1120DFD91027D5FC9BD1FDA33B454CB0FA6117A01F37E290F7FA58D74D7
1E3433BE0ED64228365D5FD32B3AE2F07906D41FA793AA507C5AC33197E4B4BA
5FA8E9A7F44403839C4731927C81002ACD349FF8AEF7289F700C2FC6549F2AF8
8CEFE52616903E687F399D9C0FA849C1CDA6204ABEA73DE030D577815F08B506
0A1D0E604959301610327063D937957DF51A1FC10EA8F8DFDE465A57394ADBD4
0E1FA8FA81A2839D861B3B0D5EB71BB941D4E8CDE8FED8FB8CC94CD6C331BEAE
60AFC11FA8A7CEEEE0ECDA08B1C66C00277E47799149A93125DD6F9DF36F21E1
85255B08883AD2DDAF6B671F0C17BE1DEA0D4428B8933F1B2F88F560098EC648
1C55C89C7B7F3BE5562308D2B97FEF9B9CD83A97E4EFFF7BE2674CF73FF551C6
0D8C293C306018D19234EE273035274D6FD08F1657060DB7410F269DDB71F90F
F06358E78AC2D86664595FF456EC8E1D02D0F294F711054209BDE99FFEF087FB
7960A2BCA9D7B842F8C1A6E496D46F62221E5E1DC1E69AA154F7F284DBC1F51C
F19CF4B9BE908C614900E95263A1334A34BFDC4D978E5E1B3B60298A6277D087
75EF70193D965E0A935D948458800F6DB4E5E627DB4A650F18A06F06C7FD6312
A3A3091B8A8F6E80213D380F90AA83E652A082078C81BE3942FABE2310BCAFD4
B6C58C34353D64462D150023ED461F5168233D7AFE09D9CABAC3F07A8B6493FA
F6A9BF2735A1D8DD088891CDF614B1C51946B6937E8A1B5A6EAA60CB5E149C18
F5559A5F779CBCDE7FF888337A2E9E5E67979EC7AD5CDB8DD03977FB5AD5F64E
1AFAC1FEADBF7FDB847D876787FE056E6A40DDFA3B1FDF1C85370134FAD7E032
66826EFAE8FF1F3097E139A2F834978EF07ECAEF4AF966DEAC37EE703BD6331E
BE3B37185E7EFA871CEF37929EBAF8FD0D55CCF2A1F3190000
}
;append system/view/VID/vid-styles area-style ; add to master style-sheet
main-window: center-face layout [
styles area-style
do [sp: 4x4] origin sp space sp
Across
btn "(O)pen..." #"^O" [open_file]
btn "(S)ave" #"^S" [save_file]
pad (sp * -1x0)
btn "as..." [save_file/as]
;check-line "save also test" on
pad 350
btn "Clear (t)est" #"^T" [reset-face area-test]
btn "Clear (R)esults" #"^R" [reset-face area-results]
check-clear-res: check-line "before every parse"
return
btn "(P)arse" #"^P" yellow [parse_test]
check-spaces: check-line "also spaces" on
;check-line "on rules update" on
text "with this rule:" bold
field-main-rule: field "phone-num" 300x22
text bold "Result:"
text-parsed: text bold as-is " NONE " black white center
return
Below
guide
style area-scroll area-scroll 400x200 hscroll vscroll font-name font-fixed para [origin: 2x0 Tabs: 10]
text bold "Charsets"
area-charsets: area-scroll wrap
text-rules: text bold "Rules"
area-rules: area-scroll wrap
return
text-test: text bold "Test"
area-test: area-scroll "(707)467-8000"
text-results: text bold "Results"
area-results: area-scroll silver read-only
key (escape) (sp * 0x-1) [ask_close]
]
main-window/user-data: reduce ['size main-window/size]
insert-event-func func [face event /local siz] [
switch event/type [
close [
ask_close
return none
]
resize [
face: main-window
siz: face/size - face/user-data/size / 2 ; compute size difference / 2
face/user-data/size: face/size ; store new size
resize-face area-charsets area-charsets/size + siz
text-rules/offset/y: text-rules/offset/y + siz/y
area-rules/offset/y: area-rules/offset/y + siz/y
resize-face area-rules area-rules/size + siz
text-test/offset/x: text-test/offset/x + siz/x
area-test/offset/x: area-test/offset/x + siz/x
resize-face area-test area-test/size + siz
text-results/offset: text-results/offset + siz
area-results/offset: area-results/offset + siz
resize-face area-results area-results/size + siz
show main-window
]
]
event
]
ask_close: does [
either not saved? [
switch request ["Exit without saving?" "Yes" "Save" "No"] reduce [
yes [quit]
no [if save_file [quit]]
]
][
if confirm "Exit now?" [quit]
;quit
]
]
; main
set-face area-charsets trim mold/only charsets-block
set-face area-rules trim mold/only rules-block
job-name: none
named: no
saved?: yes
main-title: join copy System/script/header/title " - Untitled"
view/title/options main-window main-title reduce ['resize 'min-size main-window/size + system/view/title-size + 8x10 + system/view/resize-border] |