├── .gitignore
├── LICENSE
├── README.md
├── Screen Shot.png
└── src
├── SynFacilBasic.pas
├── SynFacilHighlighter.pas
├── brackets.ico
├── ico.lrs
├── jshl.xml
├── jsonhelper.ico
├── jsonhelper.lpi
├── jsonhelper.lpr
├── jsonhelper.lps
├── jsonhelper.res
├── main.lfm
└── main.pas
/.gitignore:
--------------------------------------------------------------------------------
1 | .DS_Store
2 | /src/backup/
3 | /src/dist/
4 | /src/lib/
5 | .bak
6 | *.md.bak
7 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | The GNU General Public License is a free, copyleft license for
11 | software and other kinds of works.
12 |
13 | The licenses for most software and other practical works are designed
14 | to take away your freedom to share and change the works. By contrast,
15 | the GNU General Public License is intended to guarantee your freedom to
16 | share and change all versions of a program--to make sure it remains free
17 | software for all its users. We, the Free Software Foundation, use the
18 | GNU General Public License for most of our software; it applies also to
19 | any other work released this way by its authors. You can apply it to
20 | your programs, too.
21 |
22 | When we speak of free software, we are referring to freedom, not
23 | price. Our General Public Licenses are designed to make sure that you
24 | have the freedom to distribute copies of free software (and charge for
25 | them if you wish), that you receive source code or can get it if you
26 | want it, that you can change the software or use pieces of it in new
27 | free programs, and that you know you can do these things.
28 |
29 | To protect your rights, we need to prevent others from denying you
30 | these rights or asking you to surrender the rights. Therefore, you have
31 | certain responsibilities if you distribute copies of the software, or if
32 | you modify it: responsibilities to respect the freedom of others.
33 |
34 | For example, if you distribute copies of such a program, whether
35 | gratis or for a fee, you must pass on to the recipients the same
36 | freedoms that you received. You must make sure that they, too, receive
37 | or can get the source code. And you must show them these terms so they
38 | know their rights.
39 |
40 | Developers that use the GNU GPL protect your rights with two steps:
41 | (1) assert copyright on the software, and (2) offer you this License
42 | giving you legal permission to copy, distribute and/or modify it.
43 |
44 | For the developers' and authors' protection, the GPL clearly explains
45 | that there is no warranty for this free software. For both users' and
46 | authors' sake, the GPL requires that modified versions be marked as
47 | changed, so that their problems will not be attributed erroneously to
48 | authors of previous versions.
49 |
50 | Some devices are designed to deny users access to install or run
51 | modified versions of the software inside them, although the manufacturer
52 | can do so. This is fundamentally incompatible with the aim of
53 | protecting users' freedom to change the software. The systematic
54 | pattern of such abuse occurs in the area of products for individuals to
55 | use, which is precisely where it is most unacceptable. Therefore, we
56 | have designed this version of the GPL to prohibit the practice for those
57 | products. If such problems arise substantially in other domains, we
58 | stand ready to extend this provision to those domains in future versions
59 | of the GPL, as needed to protect the freedom of users.
60 |
61 | Finally, every program is threatened constantly by software patents.
62 | States should not allow patents to restrict development and use of
63 | software on general-purpose computers, but in those that do, we wish to
64 | avoid the special danger that patents applied to a free program could
65 | make it effectively proprietary. To prevent this, the GPL assures that
66 | patents cannot be used to render the program non-free.
67 |
68 | The precise terms and conditions for copying, distribution and
69 | modification follow.
70 |
71 | TERMS AND CONDITIONS
72 |
73 | 0. Definitions.
74 |
75 | "This License" refers to version 3 of the GNU General Public License.
76 |
77 | "Copyright" also means copyright-like laws that apply to other kinds of
78 | works, such as semiconductor masks.
79 |
80 | "The Program" refers to any copyrightable work licensed under this
81 | License. Each licensee is addressed as "you". "Licensees" and
82 | "recipients" may be individuals or organizations.
83 |
84 | To "modify" a work means to copy from or adapt all or part of the work
85 | in a fashion requiring copyright permission, other than the making of an
86 | exact copy. The resulting work is called a "modified version" of the
87 | earlier work or a work "based on" the earlier work.
88 |
89 | A "covered work" means either the unmodified Program or a work based
90 | on the Program.
91 |
92 | To "propagate" a work means to do anything with it that, without
93 | permission, would make you directly or secondarily liable for
94 | infringement under applicable copyright law, except executing it on a
95 | computer or modifying a private copy. Propagation includes copying,
96 | distribution (with or without modification), making available to the
97 | public, and in some countries other activities as well.
98 |
99 | To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies. Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 |
103 | An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License. If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 |
112 | 1. Source Code.
113 |
114 | The "source code" for a work means the preferred form of the work
115 | for making modifications to it. "Object code" means any non-source
116 | form of a work.
117 |
118 | A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 |
123 | The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form. A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 |
134 | The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities. However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work. For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 |
147 | The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 |
151 | The Corresponding Source for a work in source code form is that
152 | same work.
153 |
154 | 2. Basic Permissions.
155 |
156 | All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met. This License explicitly affirms your unlimited
159 | permission to run the unmodified Program. The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work. This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 |
164 | You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force. You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright. Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 |
175 | Conveying under any other circumstances is permitted solely under
176 | the conditions stated below. Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 |
179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 |
181 | No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 |
187 | When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 |
195 | 4. Conveying Verbatim Copies.
196 |
197 | You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 |
205 | You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 |
208 | 5. Conveying Modified Source Versions.
209 |
210 | You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 |
214 | a) The work must carry prominent notices stating that you modified
215 | it, and giving a relevant date.
216 |
217 | b) The work must carry prominent notices stating that it is
218 | released under this License and any conditions added under section
219 | 7. This requirement modifies the requirement in section 4 to
220 | "keep intact all notices".
221 |
222 | c) You must license the entire work, as a whole, under this
223 | License to anyone who comes into possession of a copy. This
224 | License will therefore apply, along with any applicable section 7
225 | additional terms, to the whole of the work, and all its parts,
226 | regardless of how they are packaged. This License gives no
227 | permission to license the work in any other way, but it does not
228 | invalidate such permission if you have separately received it.
229 |
230 | d) If the work has interactive user interfaces, each must display
231 | Appropriate Legal Notices; however, if the Program has interactive
232 | interfaces that do not display Appropriate Legal Notices, your
233 | work need not make them do so.
234 |
235 | A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit. Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 |
245 | 6. Conveying Non-Source Forms.
246 |
247 | You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 |
252 | a) Convey the object code in, or embodied in, a physical product
253 | (including a physical distribution medium), accompanied by the
254 | Corresponding Source fixed on a durable physical medium
255 | customarily used for software interchange.
256 |
257 | b) Convey the object code in, or embodied in, a physical product
258 | (including a physical distribution medium), accompanied by a
259 | written offer, valid for at least three years and valid for as
260 | long as you offer spare parts or customer support for that product
261 | model, to give anyone who possesses the object code either (1) a
262 | copy of the Corresponding Source for all the software in the
263 | product that is covered by this License, on a durable physical
264 | medium customarily used for software interchange, for a price no
265 | more than your reasonable cost of physically performing this
266 | conveying of source, or (2) access to copy the
267 | Corresponding Source from a network server at no charge.
268 |
269 | c) Convey individual copies of the object code with a copy of the
270 | written offer to provide the Corresponding Source. This
271 | alternative is allowed only occasionally and noncommercially, and
272 | only if you received the object code with such an offer, in accord
273 | with subsection 6b.
274 |
275 | d) Convey the object code by offering access from a designated
276 | place (gratis or for a charge), and offer equivalent access to the
277 | Corresponding Source in the same way through the same place at no
278 | further charge. You need not require recipients to copy the
279 | Corresponding Source along with the object code. If the place to
280 | copy the object code is a network server, the Corresponding Source
281 | may be on a different server (operated by you or a third party)
282 | that supports equivalent copying facilities, provided you maintain
283 | clear directions next to the object code saying where to find the
284 | Corresponding Source. Regardless of what server hosts the
285 | Corresponding Source, you remain obligated to ensure that it is
286 | available for as long as needed to satisfy these requirements.
287 |
288 | e) Convey the object code using peer-to-peer transmission, provided
289 | you inform other peers where the object code and Corresponding
290 | Source of the work are being offered to the general public at no
291 | charge under subsection 6d.
292 |
293 | A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 |
297 | A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling. In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage. For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product. A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 |
310 | "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source. The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 |
318 | If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information. But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 |
329 | The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed. Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 |
337 | Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 |
343 | 7. Additional Terms.
344 |
345 | "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law. If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 |
354 | When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it. (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.) You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 |
361 | Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 |
365 | a) Disclaiming warranty or limiting liability differently from the
366 | terms of sections 15 and 16 of this License; or
367 |
368 | b) Requiring preservation of specified reasonable legal notices or
369 | author attributions in that material or in the Appropriate Legal
370 | Notices displayed by works containing it; or
371 |
372 | c) Prohibiting misrepresentation of the origin of that material, or
373 | requiring that modified versions of such material be marked in
374 | reasonable ways as different from the original version; or
375 |
376 | d) Limiting the use for publicity purposes of names of licensors or
377 | authors of the material; or
378 |
379 | e) Declining to grant rights under trademark law for use of some
380 | trade names, trademarks, or service marks; or
381 |
382 | f) Requiring indemnification of licensors and authors of that
383 | material by anyone who conveys the material (or modified versions of
384 | it) with contractual assumptions of liability to the recipient, for
385 | any liability that these contractual assumptions directly impose on
386 | those licensors and authors.
387 |
388 | All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10. If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term. If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 |
398 | If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 |
403 | Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 |
407 | 8. Termination.
408 |
409 | You may not propagate or modify a covered work except as expressly
410 | provided under this License. Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 |
415 | However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 |
422 | Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 |
429 | Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License. If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 |
435 | 9. Acceptance Not Required for Having Copies.
436 |
437 | You are not required to accept this License in order to receive or
438 | run a copy of the Program. Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance. However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work. These actions infringe copyright if you do
443 | not accept this License. Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 |
446 | 10. Automatic Licensing of Downstream Recipients.
447 |
448 | Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License. You are not responsible
451 | for enforcing compliance by third parties with this License.
452 |
453 | An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations. If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 |
463 | You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License. For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 |
471 | 11. Patents.
472 |
473 | A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based. The
475 | work thus licensed is called the contributor's "contributor version".
476 |
477 | A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version. For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 |
487 | Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 |
492 | In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement). To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 |
499 | If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients. "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 |
513 | If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 |
521 | A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License. You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 |
536 | Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 |
540 | 12. No Surrender of Others' Freedom.
541 |
542 | If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License. If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all. For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 |
552 | 13. Use with the GNU Affero General Public License.
553 |
554 | Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work. The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 |
563 | 14. Revised Versions of this License.
564 |
565 | The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time. Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 |
570 | Each version is given a distinguishing version number. If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation. If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 |
579 | If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 |
584 | Later license versions may give you additional or different
585 | permissions. However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 |
589 | 15. Disclaimer of Warranty.
590 |
591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 |
600 | 16. Limitation of Liability.
601 |
602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 |
612 | 17. Interpretation of Sections 15 and 16.
613 |
614 | If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 |
621 | END OF TERMS AND CONDITIONS
622 |
623 | How to Apply These Terms to Your New Programs
624 |
625 | If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 |
629 | To do so, attach the following notices to the program. It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 |
634 |
635 | Copyright (C)
636 |
637 | This program is free software: you can redistribute it and/or modify
638 | it under the terms of the GNU General Public License as published by
639 | the Free Software Foundation, either version 3 of the License, or
640 | (at your option) any later version.
641 |
642 | This program is distributed in the hope that it will be useful,
643 | but WITHOUT ANY WARRANTY; without even the implied warranty of
644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
645 | GNU General Public License for more details.
646 |
647 | You should have received a copy of the GNU General Public License
648 | along with this program. If not, see .
649 |
650 | Also add information on how to contact you by electronic and paper mail.
651 |
652 | If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 |
655 | Copyright (C)
656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 | This is free software, and you are welcome to redistribute it
658 | under certain conditions; type `show c' for details.
659 |
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License. Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 |
664 | You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | .
668 |
669 | The GNU General Public License does not permit incorporating your program
670 | into proprietary programs. If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library. If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License. But first, please read
674 | .
675 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # JSON Helper
2 | Desktop tool to validate and prettify json
3 |
4 |
5 |
6 |
7 | ### OSX
8 | Unzip and run, the app is codesigned
9 |
10 | ### Linux
11 | Unzip the file, use terminal to `chmod +x jsonhelper-linux` (Or whatever you rename it to), now you can start it by double clicking the icon
12 |
13 | ### Windows
14 | Unzip the file, double click to start
15 |
16 | ## License
17 | GPLv3
18 |
--------------------------------------------------------------------------------
/Screen Shot.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MFernstrom/jsonhelper/1cf3ee67f226f336ae3529b6692d4d412e99467e/Screen Shot.png
--------------------------------------------------------------------------------
/src/SynFacilBasic.pas:
--------------------------------------------------------------------------------
1 | { SynFacilBasic
2 | Unidad con rutinas básicas de SynFacilSyn.
3 | Incluye la definición de la clase base: TSynFacilSynBase, que es la clase padre
4 | de TSYnFacilSyn.
5 | Además icnluye la definición del tipo "tFaTokContent" y el procesamiento de
6 | expresiones regulares que son usadas por TSynFacilSyn.
7 |
8 | Por Tito Hinostroza 02/12/2014 - Lima Perú
9 | }
10 | unit SynFacilBasic;
11 | {$mode objfpc}{$H+}
12 | interface
13 | uses
14 | SysUtils, Classes, SynEditHighlighter, strutils, Graphics, DOM, LCLIntf,
15 | LCLProc, SynEditHighlighterFoldBase, SynEditTypes;
16 |
17 | type
18 | ///////// Definiciones para manejo de tokens por contenido ///////////
19 |
20 | //Tipo de expresión regular soportada. Las exp. regulares soportadas son
21 | //simples. Solo incluyen literales de cadena o listas.
22 | tFaRegExpType = (
23 | tregTokPos, //Posición de token
24 | tregString, //Literal de cadena: "casa"
25 | tregChars, //Lista de caracteres: [A-Z]
26 | tregChars01, //Lista de caracteres: [A-Z]?
27 | tregChars0_, //Lista de caracteres: [A-Z]*
28 | tregChars1_ //Lista de caracteres: [A-Z]+
29 | );
30 |
31 | //Acciones a ejecutar en las comparaciones
32 | tFaActionOnMatch = (
33 | aomNext, //pasa a la siguiente instrucción
34 | aomExit, //termina la exploración
35 | aomMovePar, //Se mueve a una posición específica
36 | aomExitpar //termina la exploración retomando una posición específica.
37 | );
38 |
39 | //Estructura para almacenar una instrucción de token por contenido
40 | tFaTokContentInst = record
41 | Chars : array[#0..#255] of ByteBool; //caracteres
42 | Text : string; //cadena válida
43 | tokPos : integer; //Cuando se usa posición del token
44 | expTyp : tFaRegExpType; //tipo de expresión
45 | aMatch : integer; //atributo asignado en caso TRUE
46 | aFail : integer; //atributo asignado en caso TRUE
47 | //Campos para ejecutar instrucciones, cuando No cumple
48 | actionFail : tFaActionOnMatch;
49 | destOnFail : integer; //posición destino
50 | //Campos para ejecutar instrucciones, cuando cumple
51 | actionMatch: tFaActionOnMatch;
52 | destOnMatch: integer; //posición destino
53 |
54 | posFin : integer; //para guardar posición
55 | end;
56 | tFaTokContentInstPtr = ^tFaTokContentInst;
57 |
58 | ESynFacilSyn = class(Exception); //excepción del resaltador
59 |
60 | { tFaTokContent }
61 | //Estructura para almacenar la descripción de los token por contenido
62 | tFaTokContent = class
63 | TokTyp : integer; //tipo de token por contenido
64 | CaseSensitive: boolean; //Usado para comparación de literales de cadena
65 | Instrucs : array of tFaTokContentInst; //Instrucciones del token por contenido
66 | nInstruc : integer; //Cantidad de instrucciones
67 | procedure Clear;
68 | procedure AddInstruct(exp: string; ifTrue: string = ''; ifFalse: string = '';
69 | atMatch: integer = - 1; atFail: integer = - 1);
70 | procedure AddRegEx(exp: string; Complete: boolean=false);
71 | private
72 | function AddItem(expTyp: tFaRegExpType; ifMatch, ifFail: string): integer;
73 | procedure AddOneInstruct(var exp: string; ifTrue: string; ifFalse: string;
74 | atMatch: integer = -1; atFail: integer = -1);
75 | end;
76 |
77 | ///////// Definiciones básicas para el resaltador ///////////
78 |
79 | //Identifica si un token es el delimitador inicial
80 | TFaTypeDelim =(tdNull, //no es delimitado
81 | tdUniLin, //es delimitador inicial de token delimitado de una línea
82 | tdMulLin, //es delimitador inicial de token delimitado multilínea
83 | tdConten1, //es delimitador inicial de token por contenido 1
84 | tdConten2, //es delimitador inicial de token por contenido 2
85 | tdConten3, //es delimitador inicial de token por contenido 3
86 | tdConten4); //es delimitador inicial de token por contenido 4
87 | //Tipos de coloreado de bloques
88 | TFaColBlock = (cbNull, //sin coloreado
89 | cbLevel, //colorea bloques por nivel
90 | cbBlock); //colorea bloques usando el color definido para cada bloque
91 |
92 | TFaProcMetTable = procedure of object; //Tipo de procedimiento para procesar el token de
93 | //acuerdo al caracter inicial.
94 | TFaProcRange = procedure of object; //Procedimiento para procesar en medio de un rango.
95 |
96 | TFaSynBlock = class; //definición adelantada
97 |
98 | //Descripción de tokens especiales (identificador o símbolo)
99 | TTokSpec = record
100 | txt : string; //palabra clave (puede cambiar la caja y no incluir el primer caracter)
101 | orig : string; //palabra clave tal cual se indica
102 | TokPos: integer; //posición del token dentro de la línea
103 | tTok : integer; //tipo de token
104 | typDel: TFaTypeDelim; {indica si el token especial actual, es en realidad, el
105 | delimitador inicial de un token delimitado o por contenido}
106 | dEnd : string; //delimitador final (en caso de que sea delimitador)
107 | pRange: TFaProcRange; //procedimiento para procesar el token o rango(si es multilinea)
108 | folTok: boolean; //indica si el token delimitado, tiene plegado
109 | chrEsc: char; //Caracter de escape de token delimitado. Si no se usa, contiene #0.
110 | //propiedades para manejo de bloques y plegado de código
111 | openBlk : boolean; //indica si el token es inicio de bloque de plegado
112 | BlksToOpen: array of TFaSynBlock; //lista de referencias a los bloques que abre
113 | closeBlk : boolean; //indica si el token es fin de bloque de plegado
114 | BlksToClose: array of TFaSynBlock; //lista de referencias a los bloques que cierra
115 | OpenSec : boolean; //indica si el token es inicio de sección de bloque
116 | SecsToOpen: array of TFaSynBlock; //lista de bloques de los que es inicio de sección
117 | firstSec : TFaSynBlock; //sección que se debe abrir al abrir el bloque
118 | end;
119 |
120 | TEvBlockOnOpen = procedure(blk: TFaSynBlock; var Cancel: boolean) of object;
121 |
122 | TArrayTokSpec = array of TTokSpec;
123 | //clase para manejar la definición de bloques de sintaxis
124 | TFaSynBlock = class
125 | name : string; //nombre del bloque
126 | index : integer; //indica su posición dentro de TFaListBlocks
127 | showFold : boolean; //indica si se mostrará la marca de plegado
128 | parentBlk : TFaSynBlock; //bloque padre (donde es válido el bloque)
129 | BackCol : TColor; //color de fondo de un bloque
130 | IsSection : boolean; //indica si es un bloque de tipo sección
131 | UniqSec : boolean; //índica que es sección única
132 | CloseParent : boolean; //indica que debe cerrar al blqoue padre al cerrarse
133 | OnBeforeOpen : TEvBlockOnOpen; //evento de apertura de bloque
134 | OnBeforeClose : TEvBlockOnOpen; //evento de cierre de bloque
135 | end;
136 |
137 | TPtrATokEspec = ^TArrayTokSpec; //puntero a tabla
138 | TPtrTokEspec = ^TTokSpec; //puntero a tabla
139 |
140 | //Guarda información sobre un atributo de un nodo XML
141 | TFaXMLatrib = record //atributo XML
142 | hay: boolean; //bandera de existencia
143 | val: string; //valor en cadena
144 | n : integer; //valor numérico
145 | bol: boolean; //valor booleando (si aplica)
146 | col: TColor; //valor de color (si aplica)
147 | end;
148 |
149 | { TSynFacilSynBase }
150 | //Clase con métodos básicos para el resaltador
151 | TSynFacilSynBase = class(TSynCustomFoldHighlighter)
152 | protected
153 | fLine : PChar; //Puntero a línea de trabajo
154 | tamLin : integer; //Tamaño de línea actual
155 | fProcTable : array[#0..#255] of TFaProcMetTable; //tabla de métodos
156 | fAtriTable : array[#0..#255] of integer; //tabla de atributos de tokens
157 | posIni : Integer; //índice a inicio de token
158 | posFin : Integer; //índice a siguiente token
159 | fStringLen : Integer; //Tamaño del token actual
160 | fToIdent : PChar; //Puntero a identificador
161 | fTokenID : integer; //Id del token actual
162 | charIni : char; //caracter al que apunta fLine[posFin]
163 | posTok : integer; //para identificar el ordinal del token en una línea
164 |
165 | CaseSensitive: boolean; //Para ignorar mayúscula/minúscula
166 | charsIniIden: Set of char; //caracteres iniciales de identificador
167 | lisTmp : TStringList; //lista temporal
168 | fSampleSource: string; //código de muestra
169 | function GetSampleSource: String; override;
170 | protected //identificadores especiales
171 | CharsIdentif: array[#0..#255] of ByteBool; //caracteres válidos para identificadores
172 | tc1, tc2, tc3, tc4: tFaTokContent;
173 | //Tablas para identificadores especiales
174 | mA, mB, mC, mD, mE, mF, mG, mH, mI, mJ,
175 | mK, mL, mM, mN, mO, mP, mQ, mR, mS, mT,
176 | mU, mV, mW, mX, mY, mZ: TArrayTokSpec; //para mayúsculas
177 | mA_,mB_,mC_,mD_,mE_,mF_,mG_,mH_,mI_,mJ_,
178 | mK_,mL_,mM_,mN_,mO_,mP_,mQ_,mR_,mS_,mT_,
179 | mU_,mV_,mW_,mX_,mY_,mZ_: TArrayTokSpec; //para minúsculas
180 | m_, mDol, mArr, mPer, mAmp, mC3 : TArrayTokSpec;
181 | mSym : TArrayTokSpec; //tabla de símbolos especiales
182 | mSym0 : TArrayTokSpec; //tabla temporal para símbolos especiales.
183 | TabMayusc : array[#0..#255] of Char; //Tabla para conversiones rápidas a mayúscula
184 | protected //funciones básicas
185 | function BuscTokEspec(var mat: TArrayTokSpec; cad: string; out n: integer;
186 | TokPos: integer = 0): boolean;
187 | function ToListRegex(list: TFaXMLatrib): string;
188 | function dStartRegex(tStart, tCharsStart: TFaXMLatrib): string;
189 | procedure VerifDelim(delim: string);
190 | procedure ValidAsigDelim(delAct, delNue: TFaTypeDelim; delim: string);
191 | procedure ValidateParamStart(Start: string; var ListElem: TStringList);
192 | function KeyComp(var r: TTokSpec): Boolean;
193 | function CreaBuscTokEspec(var mat: TArrayTokSpec; cad: string; out i: integer;
194 | TokPos: integer = 0): boolean;
195 | //procesamiento de XML
196 | procedure CheckXMLParams(n: TDOMNode; listAtrib: string);
197 | function ReadXMLParam(n: TDOMNode; nomb: string): TFaXMLatrib;
198 | protected //Métodos para tokens por contenido
199 | procedure metTokCont(const tc: tFaTokContent); //inline;
200 | procedure metTokCont1;
201 | procedure metTokCont2;
202 | procedure metTokCont3;
203 | procedure metTokCont4;
204 | protected //Procesamiento de otros elementos
205 | procedure metIdent;
206 | procedure metIdentUTF8;
207 | procedure metNull;
208 | procedure metSpace;
209 | procedure metSymbol;
210 | public //Funciones públicas
211 | procedure DefTokIdentif(dStart, Content: string );
212 | public //Atributos y sus propiedades de acceso
213 | //Atributos predefinidos
214 | tkEol : TSynHighlighterAttributes;
215 | tkSymbol : TSynHighlighterAttributes;
216 | tkSpace : TSynHighlighterAttributes;
217 | tkIdentif : TSynHighlighterAttributes;
218 | tkNumber : TSynHighlighterAttributes;
219 | tkKeyword : TSynHighlighterAttributes;
220 | tkString : TSynHighlighterAttributes;
221 | tkComment : TSynHighlighterAttributes;
222 | //ID para los tokens
223 | tnEol : integer; //id para los tokens salto de línea
224 | tnSymbol : integer; //id para los símbolos
225 | tnSpace : integer; //id para los espacios
226 | tnIdentif : integer; //id para los identificadores
227 | tnNumber : integer; //id para los números
228 | tnKeyword : integer; //id para las palabras claves
229 | tnString : integer; //id para las cadenas
230 | tnComment : integer; //id para los comentarios
231 | {Se crea el contenedor adicional Attrib[], para los atributos, porque aunque ya se
232 | tiene Attribute[] en TSynCustomHighlighter, este está ordenado pro defecto y no
233 | ayuda en ubicar a los attributos por su índice}
234 | Attrib: array of TSynHighlighterAttributes;
235 | function NewTokAttrib(TypeName: string; out TokID: integer
236 | ): TSynHighlighterAttributes;
237 | function NewTokType(TypeName: string; out TokAttrib: TSynHighlighterAttributes
238 | ): integer;
239 | function NewTokType(TypeName: string): integer;
240 | procedure CreateAttributes; //limpia todos loa atributos
241 | function GetAttribByName(txt: string): TSynHighlighterAttributes;
242 | function GetAttribIDByName(txt: string): integer;
243 | function IsAttributeName(txt: string): boolean;
244 | protected
245 | function ProcXMLattribute(nodo: TDOMNode): boolean;
246 | public //Inicializacoón
247 | constructor Create(AOwner: TComponent); override;
248 | end;
249 |
250 | function ExtractRegExp(var exp: string; out str: string; out listChars: string): tFaRegExpType;
251 | function ExtractRegExpN(var exp: string; out RegexTyp: tFaRegExpType ): string;
252 | function ReplaceEscape(str: string): string;
253 | function ColorFromStr(cad: string): TColor;
254 | implementation
255 | const
256 | //Mensajes de error generales
257 | // ERR_START_NO_EMPTY = 'Parámetro "Start" No puede ser nulo';
258 | // ERR_EXP_MUST_BE_BR = 'Expresión debe ser de tipo [lista de caracteres]';
259 | // ERR_TOK_DELIM_NULL = 'Delimitador de token no puede ser nulo';
260 | // ERR_NOT_USE_START = 'No se puede usar "Start" y "CharsStart" simultáneamente.';
261 | // ERR_PAR_START_CHARS = 'Se debe definir el parámetro "Start" o "CharsStart".';
262 | // ERR_TOK_DEL_IDE_ERR = 'Delimitador de token erróneo: %s (debe ser identificador)';
263 | // ERR_IDEN_ALREA_DEL = 'Identificador "%s" ya es delimitador inicial.';
264 | // ERR_INVAL_ATTR_LAB = 'Atributo "%s" no válido para etiqueta <%s>';
265 | // ERR_BAD_PAR_STR_IDEN = 'Parámetro "Start" debe ser de la forma: "[A-Z]", en identificadores';
266 | // ERR_BAD_PAR_CON_IDEN = 'Parámetro "Content" debe ser de la forma: "[A-Z]*", en identificadores';
267 |
268 | ERR_START_NO_EMPTY = 'Parameter "Start" can not be null';
269 | ERR_EXP_MUST_BE_BR = 'Expression must be like: [list of chars]';
270 | ERR_TOK_DELIM_NULL = 'Token delimiter can not be null';
271 | ERR_NOT_USE_START = 'Cannot use "Start" and "CharsStart" simultaneously.';
272 | ERR_PAR_START_CHARS = 'It must be defined "Start" or "CharsStart" parameter.';
273 | ERR_TOK_DEL_IDE_ERR = 'Bad Token delimiter: %s (must be identifier)';
274 | ERR_IDEN_ALREA_DEL = 'Identifier "%s" is already a Start delimiter.';
275 | ERR_INVAL_ATTR_LAB = 'Invalid attribute "%s" for label <%s>';
276 | ERR_BAD_PAR_STR_IDEN = 'Parameter "Start" must be like: "[A-Z]", in identifiers';
277 | ERR_BAD_PAR_CON_IDEN = 'Parameter "Content" must be like: "[A-Z]*", in identifiers';
278 |
279 | //Mensajes de tokens por contenido
280 | // ERR_EMPTY_INTERVAL = 'Error: Intervalo vacío.';
281 | // ERR_EMPTY_EXPRES = 'Expresión vacía.';
282 | // ERR_EXPECTED_BRACK = 'Se esperaba "]".';
283 | // ERR_UNSUPPOR_EXP_ = 'Expresión no soportada.';
284 | // ERR_INC_ESCAPE_SEQ = 'Secuencia de escape incompleta.';
285 | // ERR_SYN_PAR_IFFAIL_ = 'Error de sintaxis en parámetro "IfFail": ';
286 | // ERR_SYN_PAR_IFMATCH_ = 'Error de sintaxis en parámetro "IfMarch": ';
287 | ERR_EMPTY_INTERVAL = 'Error: Empty Interval.';
288 | ERR_EMPTY_EXPRES = 'Empty expression.';
289 | ERR_EXPECTED_BRACK = 'Expected "]".';
290 | ERR_UNSUPPOR_EXP_ = 'Unsupported expression: ';
291 | ERR_INC_ESCAPE_SEQ = 'Incomplete Escape sequence';
292 | ERR_SYN_PAR_IFFAIL_ = 'Syntax error on Parameter "IfFail": ';
293 | ERR_SYN_PAR_IFMATCH_ = 'Syntax error on Parameter "IfMarch": ';
294 |
295 | var
296 | bajos: string[128];
297 | altos: string[128];
298 |
299 | function copyEx(txt: string; p: integer): string;
300 | //Versión sobrecargada de copy con 2 parámetros
301 | begin
302 | Result := copy(txt, p, length(txt));
303 | end;
304 | //Funciones para el manejo de expresiones regulares
305 | function ExtractChar(var txt: string; out escaped: boolean; convert: boolean): string;
306 | //Extrae un caracter de una expresión regular. Si el caracter es escapado, devuelve
307 | //TRUE en "escaped"
308 | //Si covert = TRUE, reemplaza el caracter compuesto por uno solo.
309 | var
310 | c: byte;
311 | begin
312 | escaped := false;
313 | Result := ''; //valor por defecto
314 | if txt = '' then exit;
315 | if txt[1] = '\' then begin //caracter escapado
316 | escaped := true;
317 | if length(txt) = 1 then //verificación
318 | raise ESynFacilSyn.Create(ERR_INC_ESCAPE_SEQ);
319 | if txt[2] in ['x','X'] then begin
320 | //caracter en hexadecimal
321 | if length(txt) < 4 then //verificación
322 | raise ESynFacilSyn.Create(ERR_INC_ESCAPE_SEQ);
323 | if convert then begin //toma caracter hexdecimal
324 | c := StrToInt('$'+copy(txt,3,2));
325 | Result := Chr(c);
326 | end else begin //no tranforma
327 | Result := copy(txt, 1,4);
328 | end;
329 | txt := copyEx(txt,5);
330 | end else begin //se supone que es de tipo \A
331 | //secuencia normal de dos caracteres
332 | if convert then begin //hay que convertirlo
333 | Result := txt[2];
334 | end else begin //lo toma tal cual
335 | Result := copy(txt,1,2);
336 | end;
337 | txt := copyEx(txt,3);
338 | end;
339 | end else begin //caracter normal
340 | Result := txt[1];
341 | txt := copyEx(txt,2);
342 | end;
343 | end;
344 | function ExtractChar(var txt: string): char;
345 | //Versión simplificada de ExtractChar(). Extrae un caracter ya convertido. Si no hay
346 | //más caracteres, devuelve #0
347 | var
348 | escaped: boolean;
349 | tmp: String;
350 | begin
351 | if txt = '' then Result := #0
352 | else begin
353 | tmp := ExtractChar(txt, escaped, true);
354 | Result := tmp[1]; //se supone que siempre será de un solo caracter
355 | end;
356 | end;
357 | function ExtractCharN(var txt: string): string;
358 | //Versión simplificada de ExtractChar(). Extrae un caracter sin convertir.
359 | var
360 | escaped: boolean;
361 | begin
362 | Result := ExtractChar(txt, escaped, false);
363 | end;
364 | function ReplaceEscape(str: string): string;
365 | {Reemplaza las secuencias de escape por su caracter real. Las secuencias de
366 | escape recnocidas son:
367 | * Secuencia de 2 caracteres: "\#", donde # es un caracter cualquiera, excepto"x".
368 | Esta secuencia equivale al caracter "#".
369 | * Secuencia de 4 caracteres: "\xHH" o "\XHH", donde "HH" es un número hexadecimnal.
370 | Esta secuencia representa a un caracter ASCII.
371 |
372 | Dentro de las expresiones regulares de esta librería, los caracteres: "[", "*", "?",
373 | "*", y "\", tienen significado especial, por eso deben "escaparse".
374 |
375 | "\\" -> "\"
376 | "\[" -> "["
377 | "\*" -> "*"
378 | "\?" -> "?"
379 | "\+" -> "+"
380 | "\x$$" -> caracter ASCII $$
381 | }
382 | begin
383 | Result := '';
384 | while str<>'' do
385 | Result += ExtractChar(str);
386 | end;
387 | function EscapeText(str: string): string;
388 | //Comvierte los caracteres que pueden tener significado especial en secuencias de
389 | //escape para que se procesen como caracteres normales.
390 | begin
391 | str := StringReplace(str, '\', '\\',[rfReplaceAll]); //debe hacerse primero
392 | str := StringReplace(str, '[', '\[',[rfReplaceAll]);
393 | str := StringReplace(str, '*', '\*',[rfReplaceAll]);
394 | str := StringReplace(str, '?', '\?',[rfReplaceAll]);
395 | str := StringReplace(str, '+', '\+',[rfReplaceAll]);
396 | Result := str;
397 | end;
398 | function PosChar(ch: char; txt: string): integer;
399 | //Similar a Pos(). Devuelve la posición de un caracter que no este "escapado"
400 | var
401 | f: SizeInt;
402 | begin
403 | f := Pos(ch,txt);
404 | if f=1 then exit(1); //no hay ningún caracter antes.
405 | while (f>0) and (txt[f-1]='\') do begin
406 | f := PosEx(ch, txt, f+1);
407 | end;
408 | Result := f;
409 | end;
410 | function ExtractRegExp(var exp: string; out str: string; out listChars: string): tFaRegExpType;
411 | {Extrae parte de una expresión regular y devuelve el tipo. Esta función se basa en
412 | que toda expresión regular se puede reducir a literales de cadenas o listas (con o
413 | sin cuantificador).
414 | En los casos de listas de caracteres, expande los intervalos de tipo: A..Z, reemplaza
415 | las secuencias de escape y devuelve la lista en "listChars".
416 | En el caso de que sea un literal de cadena, reemplaza las secuencias de escape y
417 | devuelve la cadena en "str".
418 | Soporta todas las formas definidas en "tFaRegExpType".
419 | Si encuentra error, genera una excepción.}
420 | procedure ValidateInterval(var cars: string);
421 | {Valida un conjunto de caracteres, expandiendo los intervalos de tipo "A-Z", y
422 | remplazando las secuencias de escape como: "\[", "\\", "\-", ...
423 | El caracter "-", se considera como indicador de intervalo, a menos que se encuentre
424 | en el primer o ùltimo caracter de la cadena, o esté escapado.
425 | Si hay error genera una excepción.}
426 | var
427 | c, car1, car2: char;
428 | car: string;
429 | tmp: String;
430 | Invert: Boolean;
431 | carsSet: set of char;
432 | begin
433 | //reemplaza intervalos
434 | if cars = '' then
435 | raise ESynFacilSyn.Create(ERR_EMPTY_INTERVAL);
436 | //Verifica si es lista invertida
437 | Invert := false;
438 | if cars[1] = '^' then begin
439 | Invert := true; //marca
440 | cars := copyEx(cars,2); //quita "^"
441 | end;
442 | //Procesa contenido, reemplazando los caracteres escapados.
443 | //Si el primer caracter es "-". lo toma literal, sin asumir error.
444 | car1 := ExtractChar(cars); //Extrae caracter convertido. Se asume que es inicio de intervalo.
445 | tmp := car1; //inicia cadena para acumular.
446 | car := ExtractCharN(cars); //Eextrae siguiente. Sin convertir porque puede ser "\-"
447 | while car<>'' do begin
448 | if car = '-' then begin
449 | //es intervalo
450 | car2 := ExtractChar(cars); //caracter final
451 | if car2 = #0 then begin
452 | //Es intervalo incompleto, podría genera error, pero mejor asumimos que es el caracter "-"
453 | tmp += '-';
454 | break; //sale por que se supone que ya no hay más caracteres
455 | end;
456 | //se tiene un intervalo que hay que reemplazar
457 | for c := Chr(Ord(car1)+1) to car2 do //No se incluye "car1", porque ya se agregó
458 | tmp += c;
459 | end else begin //simplemente acumula
460 | car1 := ExtractChar(car); //Se asume que es inicio de intervalo. No importa perder "car"
461 | tmp += car1; //Es necesario, porque puede estar escapado
462 | end;
463 | car := ExtractCharN(cars); //extrae siguiente
464 | end;
465 | cars := StringReplace(tmp, '%HIGH%', altos,[rfReplaceAll]);
466 | cars := StringReplace(cars, '%ALL%', bajos+altos,[rfReplaceAll]);
467 | //Verifica si debe invertir lista
468 | if Invert then begin
469 | //Convierte a conjunto
470 | carsSet := [];
471 | for c in cars do carsSet += [c];
472 | //Agrega caracteres
473 | cars := '';
474 | for c := #1 to #255 do //no considera #0
475 | if not (c in carsSet) then cars += c;
476 | end;
477 | end;
478 | var
479 | tmp: string;
480 | lastAd: String;
481 | begin
482 | if exp= '' then
483 | raise ESynFacilSyn.Create(ERR_EMPTY_EXPRES);
484 | //Verifica la forma TokPos=1
485 | if UpCase(copy(exp,1,7)) = 'TOKPOS=' then begin
486 | //Caso especial de la forma TokPos=n
487 | str := copy(exp,8,2); //Aquí se devuelve "n"
488 | exp := ''; //ya no quedan caracteres
489 | Result := tregTokPos;
490 | exit;
491 | end;
492 | //Reemplaza secuencias conocidas que equivalen a listas.
493 | if copy(exp,1,2) = '\d' then begin
494 | exp := '[0-9]' + copyEx(exp,3);
495 | end else if copy(exp,1,2) = '\D' then begin
496 | exp := '[^0-9]' + copyEx(exp,3);
497 | end else if copy(exp,1,2) = '\a' then begin
498 | exp := '[A-Za-z]' + copyEx(exp,3);
499 | end else if copy(exp,1,2) = '\w' then begin
500 | exp := '[A-Za-z0-9_]' + copyEx(exp,3);
501 | end else if copy(exp,1,2) = '\W' then begin
502 | exp := '[^A-Za-z0-9_]' + copyEx(exp,3);
503 | end else if copy(exp,1,2) = '\s' then begin
504 | exp := ' ' + copyEx(exp,3);
505 | end else if copy(exp,1,2) = '\S' then begin
506 | exp := '[^ ]' + copyEx(exp,3);
507 | end else if copy(exp,1,2) = '\t' then begin
508 | exp := '\x09' + copyEx(exp,3);
509 | end else if copy(exp,1,1) = '.' then begin
510 | exp := '[\x01-\xFF]' + copyEx(exp,2);
511 | end;
512 | //analiza la secuencia
513 | if (exp[1] = '[') and (length(exp)>1) then begin //Es lista de caracteres
514 | //Captura interior del intervalo.
515 | exp := CopyEx(exp,2);
516 | listChars := '';
517 | tmp := ExtractCharN(exp); //No convierte para no confundir "\]"
518 | while (exp<>'') and (tmp<>']') do begin
519 | listChars += tmp;
520 | tmp := ExtractCharN(exp); //No convierte para no confundir "\]"
521 | end;
522 | if (tmp<>']') then //no se encontró ']'
523 | raise ESynFacilSyn.Create(ERR_EXPECTED_BRACK);
524 | //la norma es tener aquí, el contenido de la lista, pero manteniendo los caracteres escapados
525 | ValidateInterval(listChars); //puede simplificar "listChars". También puede generar excepción
526 | if exp = '' then begin //Lista de tipo "[ ... ]"
527 | Result := tregChars;
528 | end else if exp[1] = '*' then begin //Lista de tipo "[ ... ]* ... "
529 | exp := copyEx(exp,2); //extrae parte procesada
530 | Result := tregChars0_
531 | end else if exp[1] = '?' then begin //Lista de tipo "[ ... ]? ... "
532 | exp := copyEx(exp,2); //extrae parte procesada
533 | Result := tregChars01
534 | end else if exp[1] = '+' then begin //Lista de tipo "[ ... ]+ ... "
535 | exp := copyEx(exp,2); //extrae parte procesada
536 | Result := tregChars1_
537 | end else begin
538 | //No sigue ningún cuantificador, podrías er algún literal
539 | Result := tregChars; //Lista de tipo "[ ... ] ... "
540 | end;
541 | end else if (length(exp)=1) and (exp[1] in ['*','?','+','[']) then begin
542 | //Caso especial, no se usa escape, pero no es lista, ni cuantificador. Se asume
543 | //caracter único
544 | listChars := exp; //'['+exp+']'
545 | exp := ''; //ya no quedan caracteres
546 | Result := tregChars;
547 | exit;
548 | end else begin
549 | //No inicia con lista. Se puede suponer que inicia con literal cadena.
550 | {Pueden ser los casos:
551 | Caso 0) "abc" (solo literal cadena, se extraerá la cadena "abc")
552 | Caso 1) "abc[ ... " (válido, se extraerá la cadena "abc")
553 | Caso 2) "a\[bc[ ... " (válido, se extraerá la cadena "a[bc")
554 | Caso 3) "abc* ... " (válido, pero se debe procesar primero "ab")
555 | Caso 4) "ab\\+ ... " (válido, pero se debe procesar primero "ab")
556 | Caso 5) "a? ... " (válido, pero debe transformarse en lista)
557 | Caso 6) "\[* ... " (válido, pero debe transformarse en lista)
558 | }
559 | str := ''; //para acumular
560 | tmp := ExtractCharN(exp);
561 | lastAd := ''; //solo por seguridad
562 | while tmp<>'' do begin
563 | if tmp = '[' then begin
564 | //Empieza una lista. Caso 1 o 2
565 | exp:= '[' + exp; //devuelve el caracter
566 | str := ReplaceEscape(str);
567 | { if length(str) = 1 then begin //verifica si tiene un caracter
568 | listChars := str; //'['+str+']'
569 | Result := tregChars; //devuelve como lista de un caracter
570 | exit;
571 | end;}
572 | Result := tregString; //es literal cadena
573 | exit; //sale con lo acumulado en "str"
574 | end else if (tmp = '*') or (tmp = '?') or (tmp = '+') then begin
575 | str := copy(str, 1, length(str)-length(lastAd)); //no considera el último caracter
576 | if str <> '' then begin
577 | //Hay literal cadena, antes de caracter y cuantificador. Caso 3 o 4
578 | exp:= lastAd + tmp + exp; //devuelve el último caracter agregado y el cuantificador
579 | str := ReplaceEscape(str);
580 | if length(str) = 1 then begin //verifica si tiene un caracter
581 | listChars := str; //'['+str+']'
582 | Result := tregChars; //devuelve como lista de un caracter
583 | exit;
584 | end;
585 | Result := tregString; //es literal cadena
586 | exit;
587 | end else begin
588 | //Hay caracter y cuantificador. . Caso 5 o 6
589 | listChars := ReplaceEscape(lastAd); //'['+lastAd+']'
590 | //de "exp" ya se quitó:
591 | if tmp = '*' then begin //Lista de tipo "[a]* ... "
592 | Result := tregChars0_
593 | end else if tmp = '?' then begin //Lista de tipo "[a]? ... "
594 | Result := tregChars01
595 | end else if tmp = '+' then begin //Lista de tipo "[a]+ ... "
596 | Result := tregChars1_
597 | end; //no hay otra opción
598 | exit;
599 | end;
600 | end;
601 | str += tmp; //agrega caracter
602 | lastAd := tmp; //guarda el último caracter agregado
603 | tmp := ExtractCharN(exp); //siguiente caracter
604 | end;
605 | //Si llega aquí es porque no encontró cuantificador ni lista (Caso 0)
606 | str := ReplaceEscape(str);
607 | { if length(str) = 1 then begin //verifica si tiene un caracter
608 | listChars := str; //'['+str+']'
609 | Result := tregChars; //devuelve como lista de un caracter
610 | exit;
611 | end;}
612 | Result := tregString;
613 | end;
614 | end;
615 | function ExtractRegExpN(var exp: string; out RegexTyp: tFaRegExpType): string;
616 | {Extrae parte de una expresión regular y la devuelve como cadena . Actualiza el
617 | tipo de expresión obtenida en "RegexTyp".
618 | No Reemplaza las secuencias de excape ni los intervalos, devuelve el texto tal cual}
619 | var
620 | listChars, str: string;
621 | exp0: String;
622 | tam: Integer;
623 | begin
624 | exp0 := exp; //guarda expresión tal cual
625 | RegexTyp := ExtractRegExp(exp, str, listChars);
626 | tam := length(exp0) - length(exp); //ve diferencia de tamaño
627 | Result := copy(exp0, 1, tam)
628 | end;
629 | function ColorFromStr(cad: string): TColor;
630 | //Convierte una cadena a Color
631 | function EsHexa(txt: string; out num: integer): boolean;
632 | //Convierte un texto en un número entero. Si es numérico devuelve TRUE
633 | var i: integer;
634 | begin
635 | Result := true; //valor por defecto
636 | num := 0; //valor por defecto
637 | for i:=1 to length(txt) do begin
638 | if not (txt[i] in ['0'..'9','a'..'f','A'..'F']) then exit(false); //no era
639 | end;
640 | //todos los dígitos son numéricos
641 | num := StrToInt('$'+txt);
642 | end;
643 | var
644 | r, g, b: integer;
645 | begin
646 | if (cad<>'') and (cad[1] = '#') and (length(cad)=7) then begin
647 | //es código de color. Lo lee de la mejor forma
648 | EsHexa(copy(cad,2,2),r);
649 | EsHexa(copy(cad,4,2),g);
650 | EsHexa(copy(cad,6,2),b);
651 | Result:=RGB(r,g,b);
652 | end else begin //constantes de color
653 | case UpCase(cad) of
654 | 'WHITE' : Result :=rgb($FF,$FF,$FF);
655 | 'SILVER' : Result :=rgb($C0,$C0,$C0);
656 | 'GRAY' : Result :=rgb($80,$80,$80);
657 | 'BLACK' : Result :=rgb($00,$00,$00);
658 | 'RED' : Result :=rgb($FF,$00,$00);
659 | 'MAROON' : Result :=rgb($80,$00,$00);
660 | 'YELLOW' : Result :=rgb($FF,$FF,$00);
661 | 'OLIVE' : Result :=rgb($80,$80,$00);
662 | 'LIME' : Result :=rgb($00,$FF,$00);
663 | 'GREEN' : Result :=rgb($00,$80,$00);
664 | 'AQUA' : Result :=rgb($00,$FF,$FF);
665 | 'TEAL' : Result :=rgb($00,$80,$80);
666 | 'BLUE' : Result :=rgb($00,$00,$FF);
667 | 'NAVY' : Result :=rgb($00,$00,$80);
668 | 'FUCHSIA' : Result :=rgb($FF,$00,$FF);
669 | 'PURPLE' : Result :=rgb($80,$00,$80);
670 |
671 | 'MAGENTA' : Result :=rgb($FF,$00,$FF);
672 | 'CYAN' : Result :=rgb($00,$FF,$FF);
673 | 'BLUE VIOLET': Result :=rgb($8A,$2B,$E2);
674 | 'GOLD' : Result :=rgb($FF,$D7,$00);
675 | 'BROWN' : Result :=rgb($A5,$2A,$2A);
676 | 'CORAL' : Result :=rgb($FF,$7F,$50);
677 | 'VIOLET' : Result :=rgb($EE,$82,$EE);
678 | end;
679 | end;
680 | end;
681 |
682 | { tFaTokContent }
683 | procedure tFaTokContent.Clear;
684 | begin
685 | CaseSensitive := false; //por defecto
686 | nInstruc := 0;
687 | setLength(Instrucs,0);
688 | end;
689 | function tFaTokContent.AddItem(expTyp: tFaRegExpType; ifMatch, ifFail: string): integer;
690 | //Agrega un ítem a la lista Instrucs[]. Devuelve el número de ítems.
691 | //Configura el comportamiento de la instrucción usando "ifMatch".
692 | var
693 | ifMatch0, ifFail0: string;
694 |
695 | function extractIns(var txt: string): string;
696 | //Extrae una instrucción (identificador)
697 | var
698 | p: Integer;
699 | begin
700 | txt := trim(txt);
701 | if txt = '' then exit('');
702 | p := 1;
703 | while (p<=length(txt)) and (txt[p] in ['A'..'Z']) do inc(p);
704 | Result := copy(txt,1,p-1);
705 | txt := copyEx(txt, p);
706 | // Result := copy(txt,1,p);
707 | // txt := copyEx(txt, p+1);
708 | end;
709 | function extractPar(var txt: string; errMsg: string): integer;
710 | //Extrae un valor numérico
711 | var
712 | p, p0: Integer;
713 | sign: Integer;
714 | begin
715 | txt := trim(txt);
716 | if txt = '' then exit(0);
717 | if txt[1] = '(' then begin
718 | //caso esperado
719 | p := 2; //explora
720 | if not (txt[2] in ['+','-','0'..'9']) then //validación
721 | raise ESynFacilSyn.Create(errMsg + ifFail0);
722 | sign := 1; //signo por defecto
723 | if txt[2] = '+' then begin
724 | p := 3; //siguiente caracter
725 | sign := 1;
726 | if not (txt[3] in ['0'..'9']) then
727 | raise ESynFacilSyn.Create(errMsg + ifFail0);
728 | end;
729 | if txt[2] = '-' then begin
730 | p := 3; //siguiente caracter
731 | sign := -1;
732 | if not (txt[3] in ['0'..'9']) then
733 | raise ESynFacilSyn.Create(errMsg + ifFail0);
734 | end;
735 | //Aquí se sabe que en txt[p], viene un númaro
736 | p0 := p; //guarda posición de inicio
737 | while (p<=length(txt)) and (txt[p] in ['0'..'9']) do inc(p);
738 | Result := StrToInt(copy(txt,p0,p-p0)) * Sign; //lee como número
739 | if txt[p]<>')' then raise ESynFacilSyn.Create(errMsg + ifFail0);
740 | inc(p);
741 | txt := copyEx(txt, p+1);
742 | end else begin
743 | raise ESynFacilSyn.Create(errMsg + ifFail0);
744 | end;
745 | end;
746 | function HavePar(var txt: string): boolean;
747 | //Verifica si la cadena empieza con "("
748 | begin
749 | Result := false;
750 | txt := trim(txt);
751 | if txt = '' then exit;
752 | if txt[1] = '(' then begin //caso esperado
753 | Result := true;
754 | end;
755 | end;
756 |
757 | var
758 | inst: String;
759 | n: Integer;
760 | begin
761 | ifMatch0 := ifMatch; //guarda valor original
762 | ifFail0 := ifFail; //guarda valor original
763 | inc(nInstruc);
764 | n := nInstruc-1; //último índice
765 | setlength(Instrucs, nInstruc);
766 | Instrucs[n].expTyp := expTyp; //tipo
767 | Instrucs[n].actionMatch := aomNext; //valor por defecto
768 | Instrucs[n].actionFail := aomExit; //valor por defecto
769 | Instrucs[n].destOnMatch:=0; //valor por defecto
770 | Instrucs[n].destOnFail:= 0; //valor por defecto
771 | Result := nInstruc;
772 | //Configura comportamiento
773 | if ifMatch<>'' then begin
774 | ifMatch := UpCase(ifMatch);
775 | while ifMatch<>'' do begin
776 | inst := extractIns(ifMatch);
777 | if inst = 'NEXT' then begin //se pide avanzar al siguiente
778 | Instrucs[n].actionMatch := aomNext;
779 | end else if inst = 'EXIT' then begin //se pide salir
780 | if HavePar(ifMatch) then begin //EXIT con parámetro
781 | Instrucs[n].actionMatch := aomExitpar;
782 | Instrucs[n].destOnMatch := n + extractPar(ifMatch, ERR_SYN_PAR_IFMATCH_);
783 | end else begin //EXIT sin parámetros
784 | Instrucs[n].actionMatch := aomExit;
785 | end;
786 | end else if inst = 'MOVE' then begin
787 | Instrucs[n].actionMatch := aomMovePar; //Mover a una posición
788 | Instrucs[n].destOnMatch := n + extractPar(ifMatch, ERR_SYN_PAR_IFMATCH_);
789 | end else begin
790 | raise ESynFacilSyn.Create(ERR_SYN_PAR_IFMATCH_ + ifMatch0);
791 | end;
792 | ifMatch := Trim(ifMatch);
793 | if (ifMatch<>'') and (ifMatch[1] = ';') then //quita delimitador
794 | ifMatch := copyEx(ifMatch,2);
795 | end;
796 | end;
797 | if ifFail<>'' then begin
798 | ifFail := UpCase(ifFail);
799 | while ifFail<>'' do begin
800 | inst := extractIns(ifFail);
801 | if inst = 'NEXT' then begin //se pide avanzar al siguiente
802 | Instrucs[n].actionFail := aomNext;
803 | end else if inst = 'EXIT' then begin //se pide salir
804 | if HavePar(ifFail) then begin //EXIT con parámetro
805 | Instrucs[n].actionFail := aomExitpar;
806 | Instrucs[n].destOnFail := n + extractPar(ifFail, ERR_SYN_PAR_IFFAIL_);
807 | end else begin //EXIT sin parámetros
808 | Instrucs[n].actionFail := aomExit;
809 | end;
810 | end else if inst = 'MOVE' then begin
811 | Instrucs[n].actionFail := aomMovePar; //Mover a una posición
812 | Instrucs[n].destOnFail := n + extractPar(ifFail, ERR_SYN_PAR_IFFAIL_);
813 | end else begin
814 | raise ESynFacilSyn.Create(ERR_SYN_PAR_IFFAIL_ + ifFail0);
815 | end;
816 | ifFail := Trim(ifFail);
817 | if (ifFail<>'') and (ifFail[1] = ';') then //quita delimitador
818 | ifFail := copyEx(ifFail,2);
819 | end;
820 | end;
821 | end;
822 | procedure tFaTokContent.AddOneInstruct(var exp: string; ifTrue: string; ifFalse: string;
823 | atMatch: integer=-1; atFail: integer=-1);
824 | {Agrega una y solo instrucción al token por contenido. Si encuentra más de una
825 | instrucción, genera una excepción. Si se pone ifTrue en blnnco, se asumirá 'next',
826 | si se pone "ifFalse" en blanco, se se asumirá 'exit'.
827 | Este es el punto de entrada único para agregar una instrucción de Regex a
828 | tFaTokContent}
829 | var
830 | list: String;
831 | str: string;
832 | n: Integer;
833 | c: Char;
834 | expr: string;
835 | t: tFaRegExpType;
836 | begin
837 | if exp='' then exit;
838 | //analiza
839 | expr := exp; //guarda, porque se va a trozar
840 | t := ExtractRegExp(exp, str, list);
841 | case t of
842 | tregChars, //Es de tipo lista de caracteres [...]
843 | tregChars01, //Es de tipo lista de caracteres [...]?
844 | tregChars0_, //Es de tipo lista de caracteres [...]*
845 | tregChars1_: //Es de tipo lista de caracteres [...]+
846 | begin
847 | n := AddItem(t, ifTrue, ifFalse)-1; //agrega
848 | Instrucs[n].aMatch:= atMatch;
849 | Instrucs[n].aFail := atFail;
850 | //Configura caracteres de contenido
851 | for c := #0 to #255 do Instrucs[n].Chars[c] := False;
852 | for c in list do Instrucs[n].Chars[c] := True;
853 | end;
854 | tregString: begin //Es de tipo texto literal
855 | n := AddItem(t, ifTrue, ifFalse)-1; //agrega
856 | Instrucs[n].aMatch:= atMatch;
857 | Instrucs[n].aFail := atFail;
858 | //configura cadena
859 | if CaseSensitive then Instrucs[n].Text := str
860 | else Instrucs[n].Text := UpCase(str); //ignora caja
861 | end;
862 | tregTokPos: begin
863 | n := AddItem(t, ifTrue, ifFalse)-1; //agrega
864 | Instrucs[n].aMatch:= atMatch;
865 | Instrucs[n].aFail := atFail;
866 | //configura cadena
867 | Instrucs[n].tokPos:= StrToInt(str); //Orden de token
868 | end;
869 | else
870 | raise ESynFacilSyn.Create(ERR_UNSUPPOR_EXP_ + expr);
871 | end;
872 | end;
873 | procedure tFaTokContent.AddInstruct(exp: string; ifTrue: string=''; ifFalse: string='';
874 | atMatch: integer=-1; atFail: integer=-1);
875 | //Agrega una instrucción para el procesamiento del token por contenido.
876 | //Solo se debe indicar una instrucción, de otra forma se generará un error.
877 | var
878 | expr: String;
879 | begin
880 | expr := exp; //guarda, porque se va a trozar
881 | AddOneInstruct(exp, ifTrue, ifFalse, atMatch, atFail); //si hay error genera excepción
882 | //Si llegó aquí es porque se obtuvo una expresión válida, pero la
883 | //expresión continua.
884 | if exp<>'' then begin
885 | raise ESynFacilSyn.Create(ERR_UNSUPPOR_EXP_ + expr);
886 | end;
887 | end;
888 | procedure tFaTokContent.AddRegEx(exp: string; Complete: boolean = false);
889 | {Agrega una expresión regular (un conjunto de instrucciones sin opciones de control), al
890 | token por contenido. Las expresiones regulares deben ser solo las soportadas.
891 | Ejemplos son: "[0..9]*[\.][0..9]", "[A..Za..z]*"
892 | Las expresiones se evalúan parte por parte. Si un token no coincide completamente con la
893 | expresión regular, se considera al token, solamente hasta el punto en que coincide.
894 | Si se produce algún error se generará una excepción.}
895 | var
896 | dToStart: Integer;
897 | begin
898 | if Complete then begin
899 | //Cuando no coincide completamente, retrocede hasta el demimitador incial
900 | dToStart := 0; //distamcia al inicio
901 | while exp<>'' do begin
902 | AddOneInstruct(exp,'','exit(-'+ IntToStr(dToStart) + ')');
903 | Inc(dToStart);
904 | end;
905 | end else begin
906 | //La coinicidencia puede ser parcial
907 | while exp<>'' do begin
908 | AddOneInstruct(exp,'',''); //en principio, siempre debe coger una expresión
909 | end;
910 | end;
911 | end;
912 |
913 | { TSynFacilSynBase }
914 | function TSynFacilSynBase.GetSampleSource: String;
915 | begin
916 | Result := fSampleSource;
917 | end;
918 | //funciones básicas
919 | function TSynFacilSynBase.BuscTokEspec(var mat: TArrayTokSpec; cad: string;
920 | out n: integer; TokPos: integer = 0): boolean;
921 | //Busca una cadena en una matriz TArrayTokSpec. Si la ubica devuelve el índice en "n".
922 | var i : integer;
923 | begin
924 | Result := false;
925 | if TokPos = 0 then begin //búsqueda normal
926 | for i := 0 to High(mat) do begin
927 | if mat[i].txt = cad then begin
928 | n:= i;
929 | exit(true);
930 | end;
931 | end;
932 | end else begin //búsqueda con TokPos
933 | for i := 0 to High(mat) do begin
934 | if (mat[i].txt = cad) and (TokPos = mat[i].TokPos) then begin
935 | n:= i;
936 | exit(true);
937 | end;
938 | end;
939 | end;
940 | end;
941 | function TSynFacilSynBase.ToListRegex(list: TFaXMLatrib): string;
942 | //Reemplaza el contenido de una lista en foramto XML (p.ej. "A..Z") al formato de
943 | //listas de expresiones regulares; "[A-Z]"
944 | //Los caracteres "..", cambian a "-" y el caracter "-", cambia a "\-"
945 | var
946 | tmp: String;
947 | begin
948 | tmp := StringReplace(list.val, '-', '\-',[rfReplaceAll]);
949 | tmp := StringReplace(tmp, '..', '-',[rfReplaceAll]);
950 | Result := '[' + tmp + ']'; //completa con llaves
951 | end;
952 | function TSynFacilSynBase.dStartRegex(tStart, tCharsStart: TFaXMLatrib): string;
953 | //Lee los parámetros XML "Start" y "CharsStart"; y extrae el delimitador inicial
954 | //a usar en formato de Expresión Regular.
955 | begin
956 | //validaciones
957 | if tStart.hay and tCharsStart.hay then begin
958 | //No es un caso válido que se den los dos parámetros
959 | raise ESynFacilSyn.Create(ERR_NOT_USE_START);
960 | end;
961 | if not tStart.hay and not tCharsStart.hay then begin
962 | //Tampoco es un caso válido que no se de ninguno.
963 | raise ESynFacilSyn.Create(ERR_PAR_START_CHARS);
964 | end;
965 | //Hay uno u otro parámetro definido
966 | if tStart.hay then begin
967 | Result := EscapeText(tStart.val); //protege a los caracteres especiales
968 | end else if tCharsStart.hay then begin
969 | Result := ToListRegex(tCharsStart); //convierte a expresión regular como [a..z]
970 | end;
971 | end;
972 | procedure TSynFacilSynBase.VerifDelim(delim: string);
973 | //Verifica la validez de un delimitador para un token delimitado.
974 | //Si hay error genera una excepción.
975 | var c:char;
976 | tmp: string;
977 | begin
978 | //verifica contenido
979 | if delim = '' then
980 | raise ESynFacilSyn.Create(ERR_TOK_DELIM_NULL);
981 | //verifica si inicia con caracter de identificador.
982 | if delim[1] in charsIniIden then begin
983 | //Empieza como identificador. Hay que verificar que todos los demás caracteres
984 | //sean también de identificador, de otra forma no se podrá reconocer el token.
985 | tmp := copy(delim, 2, length(delim) );
986 | for c in tmp do
987 | if not CharsIdentif[c] then begin
988 | raise ESynFacilSyn.Create(format(ERR_TOK_DEL_IDE_ERR,[delim]));
989 | end;
990 | end;
991 | end;
992 | procedure TSynFacilSynBase.ValidateParamStart(Start: string; var ListElem: TStringList);
993 | {Valida si la expresión del parámetro es de tipo o [], de
994 | otra forma generará una excepción.
995 | Si es de tipo , valida que sea un delimitador válido.
996 | Devuelve en "ListElem" una lista con con los caracteres (En el caso de [])
997 | o un solo elemento con una cadena (En el caso de ). Por ejemplo:
998 | Si Start = 'cadena', entonces se tendrá: ListElem = [ 'cadena' ]
999 | Si Start = '[1..5]', entonces se tendrá: ListElem = ['0','1','2','3','4','5']
1000 | Si encuentra error, genera excepción.}
1001 | var
1002 | t: tFaRegExpType;
1003 | listChars: string;
1004 | str: string;
1005 | c: Char;
1006 | begin
1007 | if Start= '' then raise ESynFacilSyn.Create(ERR_START_NO_EMPTY);
1008 | t := ExtractRegExp(Start, str, listChars);
1009 | ListElem.Clear;
1010 | if Start<>'' then //la expresión es más compleja
1011 | raise ESynFacilSyn.Create(ERR_EXP_MUST_BE_BR);
1012 | if t = tregChars then begin
1013 | for c in listChars do begin
1014 | ListElem.Add(c);
1015 | end;
1016 | end else if t = tregString then begin //lista simple o literal cadena
1017 | VerifDelim(str); //valida reglas
1018 | lisTmp.Add(str);
1019 | end else //expresión de otro tipo
1020 | raise ESynFacilSyn.Create(ERR_EXP_MUST_BE_BR);
1021 | end;
1022 | procedure TSynFacilSynBase.ValidAsigDelim(delAct, delNue: TFaTypeDelim; delim: string);
1023 | //Verifica si la asignación de delimitadores es válida. Si no lo es devuelve error.
1024 | begin
1025 | if delAct = tdNull then exit; //No estaba inicializado, es totalente factible
1026 | //valida asignación de delimitador
1027 | if (delAct in [tdUniLin, tdMulLin]) and
1028 | (delNue in [tdUniLin, tdMulLin]) then begin
1029 | raise ESynFacilSyn.Create(Format(ERR_IDEN_ALREA_DEL,[delim]));
1030 | end;
1031 | end;
1032 | function TSynFacilSynBase.KeyComp(var r: TTokSpec): Boolean; inline;
1033 | {Compara rápidamente una cadena con el token actual, apuntado por "fToIden".
1034 | El tamaño del token debe estar en "fStringLen"}
1035 | var
1036 | i: Integer;
1037 | Temp: PChar;
1038 | begin
1039 | Temp := fToIdent;
1040 | if Length(r.txt) = fStringLen then begin //primera comparación
1041 | if (r.TokPos <> 0) and (r.TokPos<>posTok) then exit(false); //no coincide
1042 | Result := True; //valor por defecto
1043 | for i := 1 to fStringLen do begin
1044 | if TabMayusc[Temp^] <> r.txt[i] then exit(false);
1045 | inc(Temp);
1046 | end;
1047 | end else //definitívamente es diferente
1048 | Result := False;
1049 | end;
1050 | function TSynFacilSynBase.CreaBuscTokEspec(var mat: TArrayTokSpec; cad: string;
1051 | out i:integer; TokPos: integer = 0): boolean;
1052 | {Busca o crea el token especial indicado en "cad". Si ya existe, devuelve TRUE y
1053 | actualiza "i" con su posición. Si no existe. Crea el token especial y devuelve la
1054 | referencia en "i". Se le debe indicar la tabla a buscar en "mat"}
1055 | var
1056 | r:TTokSpec;
1057 | begin
1058 | if not CaseSensitive then cad:= UpCase(cad); //cambia caja si es necesario
1059 | if BuscTokEspec(mat, cad, i, TokPos) then exit(true); //ya existe, devuelve en "i"
1060 | //no existe, hay que crearlo. Aquí se definen las propiedades por defecto
1061 | r.txt:=cad; //se asigna el nombre
1062 | r.TokPos:=TokPos; //se asigna ordinal del token
1063 | r.tTok:=-1; //sin tipo asignado
1064 | r.typDel:=tdNull; //no es delimitador
1065 | r.dEnd:=''; //sin delimitador final
1066 | r.pRange:=nil; //sin función de rango
1067 | r.folTok:=false; //sin plegado de token
1068 | r.chrEsc := #0; //sin caracter de escape
1069 | r.openBlk:=false; //sin plegado de bloque
1070 | r.closeBlk:=false; //sin plegado de bloque
1071 | r.OpenSec:=false; //no es sección de bloque
1072 | r.firstSec:=nil; //inicialmente no abre ningún bloque
1073 |
1074 | i := High(mat)+1; //siguiente posición
1075 | SetLength(mat,i+1); //hace espacio
1076 | mat[i] := r; //copia todo el registro
1077 | //sale indicando que se ha creado
1078 | Result := false;
1079 | end;
1080 | //procesamiento de XML
1081 | function TSynFacilSynBase.ReadXMLParam(n: TDOMNode; nomb:string): TFaXMLatrib;
1082 | //Explora un nodo para ver si existe un atributo, y leerlo. Ignora la caja.
1083 | var
1084 | i: integer;
1085 | cad: string;
1086 | atri: TDOMNode;
1087 | function EsEntero(txt: string; out num: integer): boolean;
1088 | //convierte un texto en un número entero. Si es numérico devuelve TRUE
1089 | var i: integer;
1090 | begin
1091 | Result := true; //valor por defecto
1092 | num := 0; //valor por defecto
1093 | for i:=1 to length(txt) do begin
1094 | if not (txt[i] in ['0'..'9']) then exit(false); //no era
1095 | end;
1096 | //todos los dígitos son numéricos
1097 | num := StrToInt(txt);
1098 | end;
1099 | begin
1100 | Result.hay := false; //Se asume que no existe
1101 | Result.val:=''; //si no encuentra devuelve vacío
1102 | Result.bol:=false; //si no encuentra devuelve Falso
1103 | Result.n:=0; //si no encuentra devuelve 0
1104 | for i:= 0 to n.Attributes.Length-1 do begin
1105 | atri := n.Attributes.Item[i];
1106 | if UpCase(AnsiString(atri.NodeName)) = UpCase(nomb) then begin
1107 | Result.hay := true; //marca bandera
1108 | Result.val := AnsiString(atri.NodeValue); //lee valor
1109 | Result.bol := UpCase(atri.NodeValue) = 'TRUE'; //lee valor booleano
1110 | cad := trim(AnsiString(atri.NodeValue)); //valor sin espacios
1111 | //lee número
1112 | if (cad<>'') and (cad[1] in ['0'..'9']) then //puede ser número
1113 | EsEntero(cad,Result.n); //convierte
1114 | //Lee color
1115 | Result.col := ColorFromStr(cad);
1116 | end;
1117 | end;
1118 | end;
1119 | procedure TSynFacilSynBase.CheckXMLParams(n: TDOMNode; listAtrib: string);
1120 | //Valida la existencia completa de los nodos indicados. Si encuentra alguno más
1121 | //genera excepción. Los nodos deben estar separados por espacios.
1122 | var i,j : integer;
1123 | atri : TDOMNode;
1124 | nombre, tmp : string;
1125 | hay : boolean;
1126 | begin
1127 | //Carga lista de atributos
1128 | lisTmp.Clear; //usa lista temproal
1129 | lisTmp.Delimiter := ' ';
1130 | //StringReplace(listSym, #13#10, ' ',[rfReplaceAll]);
1131 | lisTmp.DelimitedText := listAtrib;
1132 | //Realiza la verificación
1133 | for i:= 0 to n.Attributes.Length-1 do begin
1134 | atri := n.Attributes.Item[i];
1135 | nombre := UpCase(AnsiString(atri.NodeName));
1136 | //verifica existencia
1137 | hay := false;
1138 | for j:= 0 to lisTmp.Count -1 do begin
1139 | tmp := trim(lisTmp[j]);
1140 | if nombre = UpCase(tmp) then begin
1141 | hay := true; break;
1142 | end;
1143 | end;
1144 | //verifica si no existe
1145 | if not hay then begin //Este atributo está demás
1146 | raise ESynFacilSyn.Create(format(ERR_INVAL_ATTR_LAB,[atri.NodeName, n.NodeName]));
1147 | end;
1148 | end;
1149 | end;
1150 | ////Métodos para tokens por contenido
1151 | procedure TSynFacilSynBase.metTokCont(const tc: tFaTokContent); //inline;
1152 | //Procesa tokens por contenido
1153 | var
1154 | n,i : Integer;
1155 | posFin0: Integer;
1156 | nf : Integer;
1157 | tam1: Integer;
1158 | inst: tFaTokContentInstPtr;
1159 | begin
1160 | fTokenID := tc.TokTyp; //No debería ser necesario ya que se asignará después.
1161 | inc(posFin); //para pasar al siguiente caracter
1162 | n := 0;
1163 | while n-1 then fTokenID := inst^.aMatch; //pone atributo
1172 | case inst^.actionMatch of
1173 | aomNext:; //no hace nada, pasa al siguiente elemento
1174 | aomExit: break; //simplemente sale
1175 | aomExitpar: begin //sale con parámetro
1176 | nf := inst^.destOnMatch; //lee posición final
1177 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1178 | break;
1179 | end;
1180 | aomMovePar: begin //se mueve a una posición
1181 | n := inst^.destOnMatch; //ubica posición
1182 | continue;
1183 | end;
1184 | end;
1185 | end else begin //no cumple
1186 | if inst^.aFail<>-1 then fTokenID := inst^.aFail; //pone atributo
1187 | case inst^.actionFail of
1188 | aomNext:; //no hace nada, pasa al siguiente elemento
1189 | aomExit: break; //simplemente sale
1190 | aomExitpar: begin //sale con parámetro
1191 | nf := inst^.destOnFail; //lee posición final
1192 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1193 | break;
1194 | end;
1195 | aomMovePar: begin //se mueve a una posición
1196 | n := inst^.destOnFail; //ubica posición
1197 | continue;
1198 | end;
1199 | end;
1200 | end;
1201 | end;
1202 |
1203 | tregString: begin //texo literal
1204 | //Rutina de comparación de cadenas
1205 | posFin0 := posFin; //para poder restaurar
1206 | i := 1;
1207 | tam1 := length(inst^.Text)+1; //tamaño +1
1208 | if CaseSensitive then begin //sensible a caja
1209 | while (i-1 then fTokenID := inst^.aMatch; //pone atributo
1222 | case inst^.actionMatch of
1223 | aomNext:; //no hace nada, pasa al siguiente elemento
1224 | aomExit: break; //simplemente sale
1225 | aomExitpar: begin //sale con parámetro
1226 | nf := inst^.destOnMatch; //lee posición final
1227 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1228 | break;
1229 | end;
1230 | aomMovePar: begin //se mueve a una posición
1231 | n := inst^.destOnMatch; //ubica posición
1232 | continue;
1233 | end;
1234 | end;
1235 | end else begin //no cumple
1236 | if inst^.aFail<>-1 then fTokenID := inst^.aFail; //pone atributo
1237 | posFin := posFin0; //restaura posición
1238 | case inst^.actionFail of
1239 | aomNext:; //no hace nada, pasa al siguiente elemento
1240 | aomExit: break; //simplemente sale
1241 | aomExitpar: begin //sale con parámetro
1242 | nf := inst^.destOnFail; //lee posición final
1243 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1244 | break;
1245 | end;
1246 | aomMovePar: begin //se mueve a una posición
1247 | n := inst^.destOnFail; //ubica posición
1248 | continue;
1249 | end;
1250 | end;
1251 | end;
1252 | end;
1253 | tregChars: begin //conjunto de caracteres: [ ... ]
1254 | //debe existir solo una vez
1255 | if inst^.Chars[fLine[posFin]] then begin
1256 | //cumple el caracter
1257 | if inst^.aMatch<>-1 then fTokenID := inst^.aMatch; //pone atributo
1258 | inc(posFin); //pasa a la siguiente instrucción
1259 | //Cumple el caracter
1260 | case inst^.actionMatch of
1261 | aomNext:; //no hace nada, pasa al siguiente elemento
1262 | aomExit: break; //simplemente sale
1263 | aomExitpar: begin //sale con parámetro
1264 | nf := inst^.destOnMatch; //lee posición final
1265 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1266 | break;
1267 | end;
1268 | aomMovePar: begin //se mueve a una posición
1269 | n := inst^.destOnMatch; //ubica posición
1270 | continue;
1271 | end;
1272 | end;
1273 | end else begin
1274 | //no se encuentra ningún caracter de la lista
1275 | if inst^.aFail<>-1 then fTokenID := inst^.aFail; //pone atributo
1276 | case inst^.actionFail of
1277 | aomNext:; //no hace nada, pasa al siguiente elemento
1278 | aomExit: break; //simplemente sale
1279 | aomExitpar: begin //sale con parámetro
1280 | nf := inst^.destOnFail; //lee posición final
1281 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1282 | break;
1283 | end;
1284 | aomMovePar: begin //se mueve a una posición
1285 | n := inst^.destOnFail; //ubica posición
1286 | continue;
1287 | end;
1288 | end;
1289 | end;
1290 | end;
1291 | tregChars01: begin //conjunto de caracteres: [ ... ]?
1292 | //debe existir cero o una vez
1293 | if inst^.Chars[fLine[posFin]] then begin
1294 | inc(posFin); //pasa a la siguiente instrucción
1295 | end;
1296 | //siempre cumplirá este tipo, no hay nada que verificar
1297 | if inst^.aMatch<>-1 then fTokenID := inst^.aMatch; //pone atributo
1298 | case inst^.actionMatch of
1299 | aomNext:; //no hace nada, pasa al siguiente elemento
1300 | aomExit: break; //simplemente sale
1301 | aomExitpar: begin //sale con parámetro
1302 | nf := inst^.destOnMatch; //lee posición final
1303 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1304 | break;
1305 | end;
1306 | aomMovePar: begin //se mueve a una posición
1307 | n := inst^.destOnMatch; //ubica posición
1308 | continue;
1309 | end;
1310 | end;
1311 | end;
1312 | tregChars0_: begin //conjunto de caracteres: [ ... ]*
1313 | //debe exitir 0 o más veces
1314 | while inst^.Chars[fLine[posFin]] do begin
1315 | inc(posFin);
1316 | end;
1317 | //siempre cumplirá este tipo, no hay nada que verificar
1318 | if inst^.aMatch<>-1 then fTokenID := inst^.aMatch; //pone atributo
1319 | //¿No debería haber código aquí también?
1320 | end;
1321 | tregChars1_: begin //conjunto de caracteres: [ ... ]+
1322 | //debe existir una o más veces
1323 | posFin0 := posFin; //para poder comparar
1324 | while inst^.Chars[fLine[posFin]] do begin
1325 | inc(posFin);
1326 | end;
1327 | if posFin>posFin0 then begin //Cumple el caracter
1328 | if inst^.aMatch<>-1 then fTokenID := inst^.aMatch; //pone atributo
1329 | case inst^.actionMatch of
1330 | aomNext:; //no hace nada, pasa al siguiente elemento
1331 | aomExit: break; //simplemente sale
1332 | aomExitpar: begin //sale con parámetro
1333 | nf := inst^.destOnMatch; //lee posición final
1334 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1335 | break;
1336 | end;
1337 | aomMovePar: begin //se mueve a una posición
1338 | n := inst^.destOnMatch; //ubica posición
1339 | continue;
1340 | end;
1341 | end;
1342 | end else begin //No cumple
1343 | if inst^.aFail<>-1 then fTokenID := inst^.aFail; //pone atributo
1344 | case inst^.actionFail of
1345 | aomNext:; //no hace nada, pasa al siguiente elemento
1346 | aomExit: break; //simplemente sale
1347 | aomExitpar: begin //sale con parámetro
1348 | nf := inst^.destOnFail; //lee posición final
1349 | posFin := tc.Instrucs[nf].posFin; //Debe moverse antes de salir
1350 | break;
1351 | end;
1352 | aomMovePar: begin //se mueve a una posición
1353 | n := inst^.destOnFail; //ubica posición
1354 | continue;
1355 | end;
1356 | end;
1357 | end;
1358 | end;
1359 | end;
1360 | inc(n);
1361 | end;
1362 | end;
1363 | procedure TSynFacilSynBase.metTokCont1; //Procesa tokens por contenido 1
1364 | begin
1365 | metTokCont(tc1);
1366 | end;
1367 | procedure TSynFacilSynBase.metTokCont2; //Procesa tokens por contenido 2
1368 | begin
1369 | metTokCont(tc2);
1370 | end;
1371 | procedure TSynFacilSynBase.metTokCont3; //Procesa tokens por contenido 3
1372 | begin
1373 | metTokCont(tc3);
1374 | end;
1375 | procedure TSynFacilSynBase.metTokCont4; //Procesa tokens por contenido 3
1376 | begin
1377 | metTokCont(tc4);
1378 | end;
1379 | //Procesamiento de otros elementos
1380 | procedure TSynFacilSynBase.metIdent;
1381 | //Procesa el identificador actual
1382 | begin
1383 | inc(posFin); {debe incrementarse, para pasar a comparar los caracteres siguientes,
1384 | o de otra forma puede quedarse en un lazo infinito}
1385 | while CharsIdentif[fLine[posFin]] do inc(posFin);
1386 | fTokenID := tnIdentif; //identificador común
1387 | end;
1388 | procedure TSynFacilSynBase.metIdentUTF8;
1389 | //Procesa el identificador actual. considerando que empieza con un caracter UTF8 (dos bytes)
1390 | begin
1391 | inc(posFin); {es UTF8, solo filtra por el primer caracter (se asume que el segundo
1392 | es siempre válido}
1393 | inc(posFin); {debe incrementarse, para pasar a comparar los caracteres siguientes,
1394 | o de otra forma puede quedarse en un lazo infinito}
1395 | while CharsIdentif[fLine[posFin]] do inc(posFin);
1396 | fTokenID := tnIdentif; //identificador común
1397 | end;
1398 | procedure TSynFacilSynBase.metNull;
1399 | //Procesa la ocurrencia del cacracter #0
1400 | begin
1401 | fTokenID := tnEol; //Solo necesita esto para indicar que se llegó al final de la línae
1402 | end;
1403 | procedure TSynFacilSynBase.metSpace;
1404 | //Procesa caracter que es inicio de espacio
1405 | begin
1406 | fTokenID := tnSpace;
1407 | repeat //captura todos los que sean espacios
1408 | Inc(posFin);
1409 | until (fLine[posFin] > #32) or (posFin = tamLin);
1410 | end;
1411 | procedure TSynFacilSynBase.metSymbol;
1412 | begin
1413 | inc(posFin);
1414 | while (fProcTable[fLine[posFin]] = @metSymbol)
1415 | do inc(posFin);
1416 | fTokenID := tnSymbol;
1417 | end;
1418 | //Funciones públicas
1419 | procedure TSynFacilSynBase.DefTokIdentif(dStart, Content: string );
1420 | {Define token para identificadores. Los parámetros deben ser intervalos.
1421 | El parámetro "dStart" deben ser de la forma: "[A..Za..z]"
1422 | El parámetro "charsCont" deben ser de la forma: "[A..Za..z]*"
1423 | Si los parámetros no cumplen con el formato se generará una excepción.
1424 | Se debe haber limpiado previamente con "ClearMethodTables"}
1425 | var
1426 | c : char;
1427 | t : tFaRegExpType;
1428 | listChars: string;
1429 | str: string;
1430 | begin
1431 | /////// Configura caracteres de inicio
1432 | if dStart = '' then exit; //protección
1433 | t := ExtractRegExp(dStart, str, listChars);
1434 | if (t <> tregChars) or (dStart<>'') then //solo se permite el formato [ ... ]
1435 | raise ESynFacilSyn.Create(ERR_BAD_PAR_STR_IDEN);
1436 | //Agrega evento manejador en caracteres iniciales
1437 | charsIniIden := []; //inicia
1438 | for c in listChars do begin //permite cualquier caracter inicial
1439 | if c<#128 then begin //caracter normal
1440 | fProcTable[c] := @metIdent;
1441 | charsIniIden += [c]; //agrega
1442 | end else begin //caracter UTF-8
1443 | fProcTable[c] := @metIdentUTF8;
1444 | charsIniIden += [c]; //agrega
1445 | end;
1446 | end;
1447 | /////// Configura caracteres de contenido
1448 | t := ExtractRegExp(Content, str, listChars);
1449 | if (t <> tregChars0_) or (Content<>'') then //solo se permite el formato [ ... ]*
1450 | raise ESynFacilSyn.Create(ERR_BAD_PAR_CON_IDEN);
1451 | //limpia matriz
1452 | for c := #0 to #255 do begin
1453 | CharsIdentif[c] := False;
1454 | //aprovecha para crear la tabla de mayúsculas para comparaciones
1455 | if CaseSensitive then
1456 | TabMayusc[c] := c
1457 | else begin //pasamos todo a mayúscula
1458 | TabMayusc[c] := UpCase(c);
1459 | end;
1460 | end;
1461 | //marca las posiciones apropiadas
1462 | for c in listChars do CharsIdentif[c] := True;
1463 | end;
1464 | //Manejo de atributos
1465 | function TSynFacilSynBase.NewTokAttrib(TypeName: string; out TokID: integer
1466 | ): TSynHighlighterAttributes;
1467 | {Crea un nuevo atributo y lo agrega al resaltador. Este debe ser el único punto de
1468 | entrada, para crear atributos en SynFacilSyn. En tokID, se devuelve el ID del nuevo tipo.
1469 | No hay funciones para eliminar atributs creados.}
1470 | var
1471 | n: Integer;
1472 | begin
1473 | Result := TSynHighlighterAttributes.Create(TypeName);
1474 | n := High(Attrib)+1; //tamaño
1475 | setlength(Attrib, n + 1); //incrementa tamaño
1476 | Attrib[n] := Result; //guarda la referencia
1477 | tokID := n; //devuelve ID
1478 | AddAttribute(Result); //lo registra en el resaltador
1479 | end;
1480 | function TSynFacilSynBase.NewTokType(TypeName: string; out
1481 | TokAttrib: TSynHighlighterAttributes): integer;
1482 | {Crea un nuevo tipo de token, y devuelve la referencia al atributo en "TokAttrib".}
1483 | begin
1484 | TokAttrib := NewTokAttrib(TypeName, Result);
1485 | end;
1486 |
1487 | function TSynFacilSynBase.NewTokType(TypeName: string): integer;
1488 | {Versión simplificada de NewTokType, que devuelve directamente el ID del token}
1489 | begin
1490 | NewTokAttrib(TypeName, Result);
1491 | end;
1492 |
1493 | procedure TSynFacilSynBase.CreateAttributes;
1494 | //CRea los atributos por defecto
1495 | begin
1496 | //Elimina todos los atributos creados, los fijos y los del usuario.
1497 | FreeHighlighterAttributes;
1498 | setlength(Attrib, 0); //limpia
1499 | { Crea los atributos que siempre existirán. }
1500 | tkEol := NewTokAttrib('Eol', tnEol); //atributo de nulos
1501 | tkSymbol := NewTokAttrib('Symbol', tnSymbol); //atributo de símbolos
1502 | tkSpace := NewTokAttrib('Space', tnSpace); //atributo de espacios.
1503 | tkIdentif := NewTokAttrib('Identifier', tnIdentif); //Atributo para identificadores.
1504 | tkNumber := NewTokAttrib('Number', tnNumber); //atributo de números
1505 | tkNumber.Foreground := clFuchsia;
1506 | tkKeyword := NewTokAttrib('Keyword',tnKeyword); //atribuuto de palabras claves
1507 | tkKeyword.Foreground:=clGreen;
1508 | tkString := NewTokAttrib('String', tnString); //atributo de cadenas
1509 | tkString.Foreground := clBlue;
1510 | tkComment := NewTokAttrib('Comment', tnComment); //atributo de comentarios
1511 | tkComment.Style := [fsItalic];
1512 | tkComment.Foreground := clGray;
1513 | end;
1514 | function TSynFacilSynBase.GetAttribByName(txt: string): TSynHighlighterAttributes;
1515 | {Devuelve la referencia de un atributo, recibiendo su nombre. Si no lo encuentra
1516 | devuelve NIL.}
1517 | var
1518 | i: Integer;
1519 | begin
1520 | txt := UpCase(txt); //ignora la caja
1521 | //También lo puede buscar en Attrib[]
1522 | for i:=0 to AttrCount-1 do begin
1523 | if Upcase(Attribute[i].Name) = txt then begin
1524 | Result := Attribute[i]; //devuelve índice
1525 | exit;
1526 | end;
1527 | end;
1528 | //No se encontró
1529 | exit(nil);
1530 | end;
1531 | function TSynFacilSynBase.GetAttribIDByName(txt: string): integer;
1532 | {Devuelve el identificador de un atributo, recibiendo su nombre. Si no lo encuentra
1533 | devuelve -1.}
1534 | var
1535 | i: Integer;
1536 | begin
1537 | txt := UpCase(txt); //ignora la caja
1538 | //Se tiene que buscar en Attrib[], proque allí están con los índices cprrectos
1539 | for i:=0 to AttrCount-1 do begin
1540 | if Upcase(Attrib[i].Name) = txt then begin
1541 | Result := i; //devuelve índice
1542 | exit;
1543 | end;
1544 | end;
1545 | //No se encontró
1546 | exit(-1);
1547 | end;
1548 |
1549 | function TSynFacilSynBase.IsAttributeName(txt: string): boolean;
1550 | //Verifica si una cadena corresponde al nombre de un atributo.
1551 | begin
1552 | //primera comparación
1553 | if GetAttribByName(txt) <> nil then exit(true);
1554 | //puede que haya sido "NULL"
1555 | if UpCase(txt) = 'NULL' then exit(true);
1556 | //definitivamente no es
1557 | Result := False;
1558 | end;
1559 | function TSynFacilSynBase.ProcXMLattribute(nodo: TDOMNode): boolean;
1560 | //Verifica si el nodo tiene la etiqueta . De ser así, devuelve TRUE y lo
1561 | //procesa. Si encuentra error, genera una excepción.
1562 | var
1563 | tName: TFaXMLatrib;
1564 | tBackCol: TFaXMLatrib;
1565 | tForeCol: TFaXMLatrib;
1566 | tFrameCol: TFaXMLatrib;
1567 | tFrameEdg: TFaXMLatrib;
1568 | tFrameSty: TFaXMLatrib;
1569 | tStyBold: TFaXMLatrib;
1570 | tStyItal: TFaXMLatrib;
1571 | tStyUnder: TFaXMLatrib;
1572 | tStyStrike: TFaXMLatrib;
1573 | tStyle: TFaXMLatrib;
1574 | tipTok: TSynHighlighterAttributes;
1575 | Atrib: TSynHighlighterAttributes;
1576 | tokId: integer;
1577 | begin
1578 | if UpCase(nodo.NodeName) <> 'ATTRIBUTE' then exit(false);
1579 | Result := true; //encontró
1580 | ////////// Lee parámetros //////////
1581 | tName := ReadXMLParam(nodo,'Name');
1582 | tBackCol := ReadXMLParam(nodo,'BackCol');
1583 | tForeCol := ReadXMLParam(nodo,'ForeCol');
1584 | tFrameCol:= ReadXMLParam(nodo,'FrameCol');
1585 | tFrameEdg:= ReadXMLParam(nodo,'FrameEdg');
1586 | tFrameSty:= ReadXMLParam(nodo,'FrameSty');
1587 | tStyBold := ReadXMLParam(nodo,'Bold');
1588 | tStyItal := ReadXMLParam(nodo,'Italic');
1589 | tStyUnder:= ReadXMLParam(nodo,'Underline');
1590 | tStyStrike:=ReadXMLParam(nodo,'StrikeOut');
1591 | tStyle := ReadXMLParam(nodo,'Style');
1592 | CheckXMLParams(nodo, 'Name BackCol ForeCol FrameCol FrameEdg FrameSty '+
1593 | 'Bold Italic Underline StrikeOut Style');
1594 | ////////// cambia atributo //////////
1595 | if IsAttributeName(tName.val) then begin
1596 | tipTok := GetAttribByName(tName.val); //tipo de atributo
1597 | end else begin
1598 | //No existe, se crea.
1599 | tipTok := NewTokAttrib(tName.val, tokId);
1600 | end;
1601 | //obtiene referencia
1602 | Atrib := tipTok;
1603 | //asigna la configuración del atributo
1604 | if Atrib <> nil then begin
1605 | if tBackCol.hay then Atrib.Background:=tBackCol.col;
1606 | if tForeCol.hay then Atrib.Foreground:=tForeCol.col;
1607 | if tFrameCol.hay then Atrib.FrameColor:=tFrameCol.col;
1608 | if tFrameEdg.hay then begin
1609 | case UpCase(tFrameEdg.val) of
1610 | 'AROUND':Atrib.FrameEdges:=sfeAround;
1611 | 'BOTTOM':Atrib.FrameEdges:=sfeBottom;
1612 | 'LEFT': Atrib.FrameEdges:=sfeLeft;
1613 | 'NONE': Atrib.FrameEdges:=sfeNone;
1614 | end;
1615 | end;
1616 | if tFrameSty.hay then begin
1617 | case UpCase(tFrameSty.val) of
1618 | 'SOLID': Atrib.FrameStyle:=slsSolid;
1619 | 'DASHED':Atrib.FrameStyle:=slsDashed;
1620 | 'DOTTED':Atrib.FrameStyle:=slsDotted;
1621 | 'WAVED': Atrib.FrameStyle:=slsWaved;
1622 | end;
1623 | end;
1624 | if tStyBold.hay then begin //negrita
1625 | if tStyBold.bol then Atrib.Style:=Atrib.Style+[fsBold]
1626 | else Atrib.Style:=Atrib.Style-[fsBold];
1627 | end;
1628 | if tStyItal.hay then begin //cursiva
1629 | if tStyItal.bol then Atrib.Style:=Atrib.Style+[fsItalic]
1630 | else Atrib.Style:=Atrib.Style-[fsItalic];
1631 | end;
1632 | if tStyUnder.hay then begin //subrayado
1633 | if tStyUnder.bol then Atrib.Style:=Atrib.Style+[fsUnderline]
1634 | else Atrib.Style:=Atrib.Style-[fsUnderline];
1635 | end;
1636 | if tStyStrike.hay then begin //tachado
1637 | if tStyStrike.bol then Atrib.Style:=Atrib.Style+[fsStrikeOut]
1638 | else Atrib.Style:=Atrib.Style-[fsStrikeOut];
1639 | end;
1640 | if tStyle.hay then begin //forma alternativa
1641 | Atrib.Style:=Atrib.Style-[fsBold]-[fsItalic]-[fsUnderline]-[fsStrikeOut];
1642 | if Pos('b', tStyle.val)<>0 then Atrib.Style:=Atrib.Style+[fsBold];
1643 | if Pos('i', tStyle.val)<>0 then Atrib.Style:=Atrib.Style+[fsItalic];
1644 | if Pos('u', tStyle.val)<>0 then Atrib.Style:=Atrib.Style+[fsUnderline];
1645 | if Pos('s', tStyle.val)<>0 then Atrib.Style:=Atrib.Style+[fsStrikeOut];
1646 | end;
1647 | end;
1648 | end;
1649 | constructor TSynFacilSynBase.Create(AOwner: TComponent);
1650 | begin
1651 | inherited Create(AOwner);
1652 | setlength(Attrib, 0);
1653 | end;
1654 |
1655 | var
1656 | i: integer;
1657 | initialization
1658 | //prepara definición de comodines
1659 | bajos[0] := #127;
1660 | for i:=1 to 127 do bajos[i] := chr(i); //todo menos #0
1661 | altos[0] := #128;
1662 | for i:=1 to 128 do altos[i] := chr(i+127);
1663 |
1664 | end.
1665 |
1666 |
--------------------------------------------------------------------------------
/src/brackets.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MFernstrom/jsonhelper/1cf3ee67f226f336ae3529b6692d4d412e99467e/src/brackets.ico
--------------------------------------------------------------------------------
/src/ico.lrs:
--------------------------------------------------------------------------------
1 | LazarusResources.Add('brackets','ICO',[
2 | #0#0#1#0#1#0#16#16#0#0#1#0' '#0'h'#4#0#0#22#0#0#0'('#0#0#0#16#0#0#0' '#0#0#0#1
3 | +#0' '#0#0#0#0#0#0#4#0#0'#.'#0#0'#.'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
4 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
5 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
6 | +'b'#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0'b'#0#0#0#0#0#0#0#0#0#0#0#0#0#0
7 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#228#0#0#0'2'#0#0#0
8 | +#0#0#0#0#0#0#0#0'2'#0#0#0#227#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
9 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#254#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#1#0
10 | +#0#0#254#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
11 | +#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0
12 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#12#0#0#0
13 | +#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#242#0#0#0#12#0#0#0#0#0#0#0#0#0#0#0
14 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'U'#0#0#0#176#0#0#0#0#0#0#0#0
15 | +#0#0#0#0#0#0#0#0#0#0#0#177#0#0#0'U'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
16 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#248#0#0#0'-'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
17 | +#0'.'#0#0#0#248#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
18 | +#0#0#0#0'U'#0#0#0#176#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#177#0#0#0'U'#0#0
19 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#12#0#0#0
20 | +#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#242#0#0#0#12#0#0#0#0#0#0#0#0#0#0#0
21 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0
22 | +#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
23 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#254#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#1#0#0
24 | +#0#254#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
25 | +#0#0#0#0#0#0#0#0#228#0#0#0'3'#0#0#0#0#0#0#0#0#0#0#0'3'#0#0#0#227#0#0#0#0#0#0
26 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'b'
27 | +#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0'b'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
28 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
29 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
30 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
31 | +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#249#159#0#0#249#159#0#0#249
32 | +#159#0#0#251#223#0#0#243#207#0#0#243#207#0#0#243#207#0#0#243#207#0#0#243#207
33 | +#0#0#251#223#0#0#249#159#0#0#249#159#0#0#249#159#0#0#255#255#0#0#255#255#0#0
34 | ]);
35 |
--------------------------------------------------------------------------------
/src/jshl.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 | null true false
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
--------------------------------------------------------------------------------
/src/jsonhelper.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MFernstrom/jsonhelper/1cf3ee67f226f336ae3529b6692d4d412e99467e/src/jsonhelper.ico
--------------------------------------------------------------------------------
/src/jsonhelper.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
--------------------------------------------------------------------------------
/src/jsonhelper.lpr:
--------------------------------------------------------------------------------
1 | program jsonhelper;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}{$IFDEF UseCThreads}
7 | cthreads,
8 | {$ENDIF}{$ENDIF}
9 | Interfaces, // this includes the LCL widgetset
10 | Forms, main;
11 |
12 | {$R *.res}
13 |
14 | begin
15 | RequireDerivedFormResource:=True;
16 | Application.Scaled:=True;
17 | Application.Initialize;
18 | Application.CreateForm(Tjsonhelperform, jsonhelperform);
19 | Application.Run;
20 | end.
21 |
22 |
--------------------------------------------------------------------------------
/src/jsonhelper.lps:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 |
167 |
168 |
169 |
170 |
171 |
172 |
173 |
174 |
175 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
190 |
191 |
192 |
193 |
194 |
195 |
196 |
197 |
198 |
199 |
200 |
201 |
202 |
203 |
204 |
205 |
206 |
207 |
208 |
209 |
210 |
211 |
212 |
213 |
214 |
215 |
216 |
217 |
218 |
219 |
220 |
221 |
222 |
223 |
224 |
225 |
226 |
227 |
228 |
--------------------------------------------------------------------------------
/src/jsonhelper.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MFernstrom/jsonhelper/1cf3ee67f226f336ae3529b6692d4d412e99467e/src/jsonhelper.res
--------------------------------------------------------------------------------
/src/main.lfm:
--------------------------------------------------------------------------------
1 | object jsonhelperform: Tjsonhelperform
2 | Left = 69
3 | Height = 360
4 | Top = 92
5 | Width = 640
6 | Caption = 'JSON Helper v0.3.9 (https://github.com/MFernstrom/jsonhelper)'
7 | ClientHeight = 360
8 | ClientWidth = 640
9 | OnCreate = FormCreate
10 | LCLVersion = '2.0.0.3'
11 | object JsonInputMemo: TMemo
12 | AnchorSideLeft.Control = Owner
13 | AnchorSideRight.Control = Splitter1
14 | AnchorSideBottom.Control = Owner
15 | AnchorSideBottom.Side = asrBottom
16 | Left = 0
17 | Height = 320
18 | Top = 40
19 | Width = 184
20 | Anchors = [akTop, akLeft, akRight, akBottom]
21 | Font.Height = -14
22 | Lines.Strings = ( )
23 | OnKeyUp = JsonInputMemoKeyUp
24 | ParentFont = False
25 | ScrollBars = ssAutoBoth
26 | TabOrder = 0
27 | end
28 | object Splitter1: TSplitter
29 | AnchorSideTop.Control = JsonInputMemo
30 | AnchorSideBottom.Control = Owner
31 | AnchorSideBottom.Side = asrBottom
32 | Left = 184
33 | Height = 320
34 | Top = 40
35 | Width = 5
36 | Align = alNone
37 | Anchors = [akTop, akBottom]
38 | end
39 | object ClearButton: TButton
40 | Left = 8
41 | Height = 20
42 | Top = 8
43 | Width = 60
44 | AutoSize = True
45 | Caption = 'Clear'
46 | OnClick = ClearButtonClick
47 | ParentFont = False
48 | TabOrder = 2
49 | end
50 | object StatusLabel: TLabel
51 | AnchorSideLeft.Control = InvalidLabel
52 | AnchorSideLeft.Side = asrBottom
53 | AnchorSideTop.Control = InvalidLabel
54 | Left = 278
55 | Height = 16
56 | Top = 10
57 | Width = 72
58 | BorderSpacing.Left = 10
59 | Caption = 'StatusLabel'
60 | ParentColor = False
61 | ParentFont = False
62 | Visible = False
63 | end
64 | object InvalidLabel: TLabel
65 | AnchorSideLeft.Control = CopyButton
66 | AnchorSideLeft.Side = asrBottom
67 | AnchorSideTop.Control = CopyButton
68 | AnchorSideTop.Side = asrCenter
69 | Left = 191
70 | Height = 16
71 | Top = 10
72 | Width = 77
73 | BorderSpacing.Left = 10
74 | Caption = 'Invalid JSON'
75 | Font.Color = clRed
76 | ParentColor = False
77 | ParentFont = False
78 | Visible = False
79 | end
80 | object FontComboBox: TComboBox
81 | AnchorSideTop.Control = ClearButton
82 | AnchorSideRight.Control = Owner
83 | AnchorSideRight.Side = asrBottom
84 | Left = 573
85 | Height = 20
86 | Top = 8
87 | Width = 57
88 | Anchors = [akTop, akRight]
89 | BorderSpacing.Right = 10
90 | ItemHeight = 19
91 | ItemIndex = 2
92 | Items.Strings = (
93 | '8'
94 | '9'
95 | '10'
96 | '11'
97 | '12'
98 | '14'
99 | '16'
100 | '18'
101 | '20'
102 | )
103 | OnChange = FontComboBoxChange
104 | ParentFont = False
105 | TabOrder = 3
106 | Text = '10'
107 | end
108 | object FontLabel: TLabel
109 | AnchorSideTop.Control = FontComboBox
110 | AnchorSideTop.Side = asrCenter
111 | AnchorSideRight.Control = FontComboBox
112 | Left = 510
113 | Height = 16
114 | Top = 10
115 | Width = 55
116 | Anchors = [akTop, akRight]
117 | BorderSpacing.Right = 8
118 | Caption = 'Font size'
119 | ParentColor = False
120 | ParentFont = False
121 | end
122 | inline JSONSynEdit: TSynEdit
123 | AnchorSideLeft.Control = Splitter1
124 | AnchorSideLeft.Side = asrBottom
125 | AnchorSideRight.Control = Owner
126 | AnchorSideRight.Side = asrBottom
127 | AnchorSideBottom.Control = Owner
128 | AnchorSideBottom.Side = asrBottom
129 | Left = 189
130 | Height = 320
131 | Top = 40
132 | Width = 451
133 | Anchors = [akTop, akLeft, akRight, akBottom]
134 | Font.Height = 15
135 | Font.Name = 'Courier New'
136 | Font.Pitch = fpFixed
137 | Font.Quality = fqNonAntialiased
138 | ParentColor = False
139 | ParentFont = False
140 | TabOrder = 4
141 | OnKeyUp = JSONSynEditKeyUp
142 | Gutter.Visible = False
143 | Gutter.Width = 59
144 | Gutter.MouseActions = <>
145 | RightGutter.Visible = False
146 | RightGutter.Width = 0
147 | RightGutter.MouseActions = <>
148 | Keystrokes = <
149 | item
150 | Command = ecUp
151 | ShortCut = 38
152 | end
153 | item
154 | Command = ecSelUp
155 | ShortCut = 8230
156 | end
157 | item
158 | Command = ecScrollUp
159 | ShortCut = 16422
160 | end
161 | item
162 | Command = ecDown
163 | ShortCut = 40
164 | end
165 | item
166 | Command = ecSelDown
167 | ShortCut = 8232
168 | end
169 | item
170 | Command = ecScrollDown
171 | ShortCut = 16424
172 | end
173 | item
174 | Command = ecLeft
175 | ShortCut = 37
176 | end
177 | item
178 | Command = ecSelLeft
179 | ShortCut = 8229
180 | end
181 | item
182 | Command = ecWordLeft
183 | ShortCut = 16421
184 | end
185 | item
186 | Command = ecSelWordLeft
187 | ShortCut = 24613
188 | end
189 | item
190 | Command = ecRight
191 | ShortCut = 39
192 | end
193 | item
194 | Command = ecSelRight
195 | ShortCut = 8231
196 | end
197 | item
198 | Command = ecWordRight
199 | ShortCut = 16423
200 | end
201 | item
202 | Command = ecSelWordRight
203 | ShortCut = 24615
204 | end
205 | item
206 | Command = ecPageDown
207 | ShortCut = 34
208 | end
209 | item
210 | Command = ecSelPageDown
211 | ShortCut = 8226
212 | end
213 | item
214 | Command = ecPageBottom
215 | ShortCut = 16418
216 | end
217 | item
218 | Command = ecSelPageBottom
219 | ShortCut = 24610
220 | end
221 | item
222 | Command = ecPageUp
223 | ShortCut = 33
224 | end
225 | item
226 | Command = ecSelPageUp
227 | ShortCut = 8225
228 | end
229 | item
230 | Command = ecPageTop
231 | ShortCut = 16417
232 | end
233 | item
234 | Command = ecSelPageTop
235 | ShortCut = 24609
236 | end
237 | item
238 | Command = ecLineStart
239 | ShortCut = 36
240 | end
241 | item
242 | Command = ecSelLineStart
243 | ShortCut = 8228
244 | end
245 | item
246 | Command = ecEditorTop
247 | ShortCut = 16420
248 | end
249 | item
250 | Command = ecSelEditorTop
251 | ShortCut = 24612
252 | end
253 | item
254 | Command = ecLineEnd
255 | ShortCut = 35
256 | end
257 | item
258 | Command = ecSelLineEnd
259 | ShortCut = 8227
260 | end
261 | item
262 | Command = ecEditorBottom
263 | ShortCut = 16419
264 | end
265 | item
266 | Command = ecSelEditorBottom
267 | ShortCut = 24611
268 | end
269 | item
270 | Command = ecToggleMode
271 | ShortCut = 45
272 | end
273 | item
274 | Command = ecCopy
275 | ShortCut = 16429
276 | end
277 | item
278 | Command = ecPaste
279 | ShortCut = 8237
280 | end
281 | item
282 | Command = ecDeleteChar
283 | ShortCut = 46
284 | end
285 | item
286 | Command = ecCut
287 | ShortCut = 8238
288 | end
289 | item
290 | Command = ecDeleteLastChar
291 | ShortCut = 8
292 | end
293 | item
294 | Command = ecDeleteLastChar
295 | ShortCut = 8200
296 | end
297 | item
298 | Command = ecDeleteLastWord
299 | ShortCut = 16392
300 | end
301 | item
302 | Command = ecUndo
303 | ShortCut = 32776
304 | end
305 | item
306 | Command = ecRedo
307 | ShortCut = 40968
308 | end
309 | item
310 | Command = ecLineBreak
311 | ShortCut = 13
312 | end
313 | item
314 | Command = ecSelectAll
315 | ShortCut = 16449
316 | end
317 | item
318 | Command = ecCopy
319 | ShortCut = 16451
320 | end
321 | item
322 | Command = ecBlockIndent
323 | ShortCut = 24649
324 | end
325 | item
326 | Command = ecLineBreak
327 | ShortCut = 16461
328 | end
329 | item
330 | Command = ecInsertLine
331 | ShortCut = 16462
332 | end
333 | item
334 | Command = ecDeleteWord
335 | ShortCut = 16468
336 | end
337 | item
338 | Command = ecBlockUnindent
339 | ShortCut = 24661
340 | end
341 | item
342 | Command = ecPaste
343 | ShortCut = 16470
344 | end
345 | item
346 | Command = ecCut
347 | ShortCut = 16472
348 | end
349 | item
350 | Command = ecDeleteLine
351 | ShortCut = 16473
352 | end
353 | item
354 | Command = ecDeleteEOL
355 | ShortCut = 24665
356 | end
357 | item
358 | Command = ecUndo
359 | ShortCut = 16474
360 | end
361 | item
362 | Command = ecRedo
363 | ShortCut = 24666
364 | end
365 | item
366 | Command = ecGotoMarker0
367 | ShortCut = 16432
368 | end
369 | item
370 | Command = ecGotoMarker1
371 | ShortCut = 16433
372 | end
373 | item
374 | Command = ecGotoMarker2
375 | ShortCut = 16434
376 | end
377 | item
378 | Command = ecGotoMarker3
379 | ShortCut = 16435
380 | end
381 | item
382 | Command = ecGotoMarker4
383 | ShortCut = 16436
384 | end
385 | item
386 | Command = ecGotoMarker5
387 | ShortCut = 16437
388 | end
389 | item
390 | Command = ecGotoMarker6
391 | ShortCut = 16438
392 | end
393 | item
394 | Command = ecGotoMarker7
395 | ShortCut = 16439
396 | end
397 | item
398 | Command = ecGotoMarker8
399 | ShortCut = 16440
400 | end
401 | item
402 | Command = ecGotoMarker9
403 | ShortCut = 16441
404 | end
405 | item
406 | Command = ecSetMarker0
407 | ShortCut = 24624
408 | end
409 | item
410 | Command = ecSetMarker1
411 | ShortCut = 24625
412 | end
413 | item
414 | Command = ecSetMarker2
415 | ShortCut = 24626
416 | end
417 | item
418 | Command = ecSetMarker3
419 | ShortCut = 24627
420 | end
421 | item
422 | Command = ecSetMarker4
423 | ShortCut = 24628
424 | end
425 | item
426 | Command = ecSetMarker5
427 | ShortCut = 24629
428 | end
429 | item
430 | Command = ecSetMarker6
431 | ShortCut = 24630
432 | end
433 | item
434 | Command = ecSetMarker7
435 | ShortCut = 24631
436 | end
437 | item
438 | Command = ecSetMarker8
439 | ShortCut = 24632
440 | end
441 | item
442 | Command = ecSetMarker9
443 | ShortCut = 24633
444 | end
445 | item
446 | Command = EcFoldLevel1
447 | ShortCut = 41009
448 | end
449 | item
450 | Command = EcFoldLevel2
451 | ShortCut = 41010
452 | end
453 | item
454 | Command = EcFoldLevel3
455 | ShortCut = 41011
456 | end
457 | item
458 | Command = EcFoldLevel4
459 | ShortCut = 41012
460 | end
461 | item
462 | Command = EcFoldLevel5
463 | ShortCut = 41013
464 | end
465 | item
466 | Command = EcFoldLevel6
467 | ShortCut = 41014
468 | end
469 | item
470 | Command = EcFoldLevel7
471 | ShortCut = 41015
472 | end
473 | item
474 | Command = EcFoldLevel8
475 | ShortCut = 41016
476 | end
477 | item
478 | Command = EcFoldLevel9
479 | ShortCut = 41017
480 | end
481 | item
482 | Command = EcFoldLevel0
483 | ShortCut = 41008
484 | end
485 | item
486 | Command = EcFoldCurrent
487 | ShortCut = 41005
488 | end
489 | item
490 | Command = EcUnFoldCurrent
491 | ShortCut = 41003
492 | end
493 | item
494 | Command = EcToggleMarkupWord
495 | ShortCut = 32845
496 | end
497 | item
498 | Command = ecNormalSelect
499 | ShortCut = 24654
500 | end
501 | item
502 | Command = ecColumnSelect
503 | ShortCut = 24643
504 | end
505 | item
506 | Command = ecLineSelect
507 | ShortCut = 24652
508 | end
509 | item
510 | Command = ecTab
511 | ShortCut = 9
512 | end
513 | item
514 | Command = ecShiftTab
515 | ShortCut = 8201
516 | end
517 | item
518 | Command = ecMatchBracket
519 | ShortCut = 24642
520 | end
521 | item
522 | Command = ecColSelUp
523 | ShortCut = 40998
524 | end
525 | item
526 | Command = ecColSelDown
527 | ShortCut = 41000
528 | end
529 | item
530 | Command = ecColSelLeft
531 | ShortCut = 40997
532 | end
533 | item
534 | Command = ecColSelRight
535 | ShortCut = 40999
536 | end
537 | item
538 | Command = ecColSelPageDown
539 | ShortCut = 40994
540 | end
541 | item
542 | Command = ecColSelPageBottom
543 | ShortCut = 57378
544 | end
545 | item
546 | Command = ecColSelPageUp
547 | ShortCut = 40993
548 | end
549 | item
550 | Command = ecColSelPageTop
551 | ShortCut = 57377
552 | end
553 | item
554 | Command = ecColSelLineStart
555 | ShortCut = 40996
556 | end
557 | item
558 | Command = ecColSelLineEnd
559 | ShortCut = 40995
560 | end
561 | item
562 | Command = ecColSelEditorTop
563 | ShortCut = 57380
564 | end
565 | item
566 | Command = ecColSelEditorBottom
567 | ShortCut = 57379
568 | end>
569 | MouseActions = <>
570 | MouseTextActions = <>
571 | MouseSelActions = <>
572 | Options = [eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoSmartTabs, eoTabsToSpaces, eoTrimTrailingSpaces]
573 | VisibleSpecialChars = [vscSpace, vscTabAtLast]
574 | RightEdge = 0
575 | SelectedColor.BackPriority = 50
576 | SelectedColor.ForePriority = 50
577 | SelectedColor.FramePriority = 50
578 | SelectedColor.BoldPriority = 50
579 | SelectedColor.ItalicPriority = 50
580 | SelectedColor.UnderlinePriority = 50
581 | SelectedColor.StrikeOutPriority = 50
582 | BracketHighlightStyle = sbhsBoth
583 | BracketMatchColor.Background = clNone
584 | BracketMatchColor.Foreground = clNone
585 | BracketMatchColor.Style = [fsBold]
586 | FoldedCodeColor.Background = clNone
587 | FoldedCodeColor.Foreground = clGray
588 | FoldedCodeColor.FrameColor = clGray
589 | MouseLinkColor.Background = clNone
590 | MouseLinkColor.Foreground = clBlue
591 | LineHighlightColor.Background = clNone
592 | LineHighlightColor.Foreground = clNone
593 | inline SynLeftGutterPartList1: TSynGutterPartList
594 | object SynGutterMarks1: TSynGutterMarks
595 | Width = 24
596 | MouseActions = <>
597 | end
598 | object SynGutterLineNumber1: TSynGutterLineNumber
599 | Width = 19
600 | MouseActions = <>
601 | MarkupInfo.Background = clBtnFace
602 | MarkupInfo.Foreground = clNone
603 | DigitCount = 2
604 | ShowOnlyLineNumbersMultiplesOf = 1
605 | ZeroStart = False
606 | LeadingZeros = False
607 | end
608 | object SynGutterChanges1: TSynGutterChanges
609 | Width = 4
610 | MouseActions = <>
611 | ModifiedColor = 59900
612 | SavedColor = clGreen
613 | end
614 | object SynGutterSeparator1: TSynGutterSeparator
615 | Width = 2
616 | MouseActions = <>
617 | MarkupInfo.Background = clWhite
618 | MarkupInfo.Foreground = clGray
619 | end
620 | object SynGutterCodeFolding1: TSynGutterCodeFolding
621 | MouseActions = <>
622 | MarkupInfo.Background = clNone
623 | MarkupInfo.Foreground = clGray
624 | MouseActionsExpanded = <>
625 | MouseActionsCollapsed = <>
626 | end
627 | end
628 | end
629 | object SearchInput: TEdit
630 | AnchorSideTop.Control = JSONSynEdit
631 | AnchorSideRight.Control = Owner
632 | AnchorSideRight.Side = asrBottom
633 | Left = 508
634 | Height = 22
635 | Hint = 'Search'
636 | Top = 45
637 | Width = 110
638 | Anchors = [akTop, akRight]
639 | BorderSpacing.Top = 5
640 | BorderSpacing.Right = 22
641 | OnKeyUp = SearchInputKeyUp
642 | ParentFont = False
643 | ParentShowHint = False
644 | ShowHint = True
645 | TabOrder = 5
646 | TextHint = 'Search'
647 | end
648 | object CopyButton: TButton
649 | AnchorSideLeft.Control = ClearButton
650 | AnchorSideLeft.Side = asrBottom
651 | AnchorSideTop.Control = ClearButton
652 | Left = 78
653 | Height = 20
654 | Top = 8
655 | Width = 103
656 | AutoSize = True
657 | BorderSpacing.Left = 10
658 | Caption = 'Copy output'
659 | OnClick = CopyButtonClick
660 | ParentFont = False
661 | TabOrder = 6
662 | end
663 | object CopiedLabel: TLabel
664 | AnchorSideLeft.Control = CopyButton
665 | AnchorSideLeft.Side = asrBottom
666 | AnchorSideTop.Control = CopyButton
667 | AnchorSideTop.Side = asrCenter
668 | Left = 191
669 | Height = 16
670 | Top = 10
671 | Width = 87
672 | BorderSpacing.Left = 10
673 | Caption = 'Output copied'
674 | ParentColor = False
675 | ParentFont = False
676 | Visible = False
677 | end
678 | object TimerCopiedLabel: TTimer
679 | Enabled = False
680 | Interval = 2000
681 | OnTimer = TimerCopiedLabelTimer
682 | OnStartTimer = TimerCopiedLabelStartTimer
683 | left = 432
684 | top = 4
685 | end
686 | end
687 |
--------------------------------------------------------------------------------
/src/main.pas:
--------------------------------------------------------------------------------
1 | unit main;
2 |
3 | {
4 | Version 0.3.9
5 | Updated May 24, 2019
6 | Author Marcus Fernstrom
7 | Copyright Marcus Fernstrom, 2018
8 | License GPLv3
9 | GitHub https://github.com/MFernstrom/jsonhelper
10 | }
11 |
12 | {$mode objfpc}{$H+}
13 |
14 | interface
15 |
16 | uses
17 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
18 | jsonparser, fpjson, LCLType, Clipbrd, LResources, SynEdit,
19 | SynHighlighterJScript, SynFacilHighlighter;
20 |
21 | type
22 |
23 | { Tjsonhelperform }
24 |
25 | Tjsonhelperform = class(TForm)
26 | CopyButton: TButton;
27 | ClearButton: TButton;
28 | CopiedLabel: TLabel;
29 | SearchInput: TEdit;
30 | FontComboBox: TComboBox;
31 | FontLabel: TLabel;
32 | InvalidLabel: TLabel;
33 | StatusLabel: TLabel;
34 | JsonInputMemo: TMemo;
35 | Splitter1: TSplitter;
36 | JSONSynEdit: TSynEdit;
37 | TimerCopiedLabel: TTimer;
38 | procedure ClearButtonClick(Sender: TObject);
39 | procedure CopyButtonClick(Sender: TObject);
40 | procedure SearchInputKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
41 | procedure FontComboBoxChange(Sender: TObject);
42 | procedure FormCreate(Sender: TObject);
43 | procedure HideButtonClick(Sender: TObject);
44 | procedure JSONSynEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
45 | procedure QuitButtonClick(Sender: TObject);
46 | procedure JsonInputMemoKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
47 | procedure CopiedLabelTimerStartTimer(Sender: TObject);
48 | procedure TimerCopiedLabelStartTimer(Sender: TObject);
49 | procedure TimerCopiedLabelTimer(Sender: TObject);
50 | procedure TrayIcon1Click(Sender: TObject);
51 | private
52 |
53 | public
54 |
55 | end;
56 |
57 | var
58 | jsonhelperform: Tjsonhelperform;
59 | jData : TJSONData;
60 | jsonHighlighter : TSynFacilSyn;
61 |
62 | implementation
63 |
64 | {$R *.lfm}
65 |
66 | { Tjsonhelperform }
67 |
68 | procedure Tjsonhelperform.ClearButtonClick(Sender: TObject);
69 | begin
70 | JsonInputMemo.Clear;
71 | JSONSynEdit.Clear;
72 | end;
73 |
74 | procedure Tjsonhelperform.CopyButtonClick(Sender: TObject);
75 | begin
76 | Clipboard.AsText := JSONSynEdit.Text;
77 | TimerCopiedLabel.Enabled := true;
78 | end;
79 |
80 | procedure Tjsonhelperform.SearchInputKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
81 | begin
82 | if Key <> VK_RETURN then begin
83 | JSONSynEdit.CaretX:=0;
84 | JSONSynEdit.CaretY:=0;
85 | end;
86 | JSONSynEdit.SearchReplace(SearchInput.Text, '', []);
87 | end;
88 |
89 | procedure Tjsonhelperform.FontComboBoxChange(Sender: TObject);
90 | var
91 | fsize: Integer;
92 | begin
93 | fsize := StrtoInt(FontComboBox.Items[FontComboBox.ItemIndex]);
94 | JsonInputMemo.font.Size := fsize;
95 | JSONSynEdit.font.Size := fsize;
96 | end;
97 |
98 | procedure Tjsonhelperform.FormCreate(Sender: TObject);
99 | begin
100 | jsonHighlighter := TSynFacilSyn.Create(self);
101 | JSONSynEdit.Highlighter := jsonHighlighter;
102 | jsonHighlighter.LoadFromResourceName(HInstance, 'JSHL');
103 | end;
104 |
105 | procedure Tjsonhelperform.HideButtonClick(Sender: TObject);
106 | begin
107 | jsonhelperform.visible := false;
108 | jsonhelperform.Hide;
109 | end;
110 |
111 | procedure Tjsonhelperform.JSONSynEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
112 | begin
113 | if ((Shift = [ssMeta]) or (Shift = [ssCtrl])) and (Key = VK_C) then begin
114 | if JSONSynEdit.SelAvail then begin
115 | Clipboard.AsText := JSONSynEdit.SelText
116 | end else begin
117 | Clipboard.AsText := JSONSynEdit.Text;
118 | end;
119 | end;
120 | end;
121 |
122 | procedure Tjsonhelperform.QuitButtonClick(Sender: TObject);
123 | begin
124 | Halt;
125 | end;
126 |
127 | procedure Tjsonhelperform.JsonInputMemoKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
128 | var
129 | temp: String;
130 | begin
131 | // Keyup for left-hand memo
132 | if (Shift = [ssMeta]) and (Key = VK_C) then begin
133 | if JsonInputMemo.SelLength > 0 then
134 | Clipboard.AsText := JsonInputMemo.SelText
135 | else
136 | Clipboard.AsText := JsonInputMemo.Text;
137 | end else begin
138 | try
139 | InvalidLabel.Visible:=false;
140 | StatusLabel.Visible:=false;
141 |
142 | JSONSynEdit.Clear;
143 |
144 | temp := Trim(JsonInputMemo.Text);
145 |
146 | jData := GetJSON(temp);
147 |
148 | if length(temp) > 0 then
149 | JSONSynEdit.Text := jData.FormatJSON;
150 |
151 | except
152 | on E: Exception do begin
153 | InvalidLabel.Visible:=true;
154 | StatusLabel.Caption:=E.Message;
155 | StatusLabel.Visible:=true;
156 | end;
157 | end;
158 | end;
159 | end;
160 |
161 | procedure Tjsonhelperform.CopiedLabelTimerStartTimer(Sender: TObject);
162 | begin
163 | ShowMessage('Started');
164 | CopiedLabel.show();
165 | end;
166 |
167 | procedure Tjsonhelperform.TimerCopiedLabelStartTimer(Sender: TObject);
168 | begin
169 | CopiedLabel.Show();
170 | end;
171 |
172 | procedure Tjsonhelperform.TimerCopiedLabelTimer(Sender: TObject);
173 | begin
174 | CopiedLabel.Hide();
175 | TimerCopiedLabel.Enabled := false;
176 | end;
177 |
178 | procedure Tjsonhelperform.TrayIcon1Click(Sender: TObject);
179 | begin
180 | jsonhelperform.visible := true;
181 | jsonhelperform.Show;
182 | end;
183 |
184 | initialization
185 | {$I ico.lrs}
186 |
187 | end.
188 |
--------------------------------------------------------------------------------