├── .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 | <Scaled Value="True"/> 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <XPManifest> 13 | <DpiAware Value="True"/> 14 | </XPManifest> 15 | <Icon Value="0"/> 16 | <Resources Count="1"> 17 | <Resource_0 FileName="jshl.xml" Type="RCDATA" ResourceName="JSHL"/> 18 | </Resources> 19 | </General> 20 | <BuildModes Count="2"> 21 | <Item1 Name="Windows" Default="True"/> 22 | <Item2 Name="Linux"> 23 | <CompilerOptions> 24 | <Version Value="11"/> 25 | <Target> 26 | <Filename Value="dist/$(TargetOS)/jsonhelper"/> 27 | </Target> 28 | <SearchPaths> 29 | <IncludeFiles Value="$(ProjOutDir)"/> 30 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 31 | </SearchPaths> 32 | <CodeGeneration> 33 | <TargetOS Value="linux"/> 34 | <Optimizations> 35 | <OptimizationLevel Value="3"/> 36 | </Optimizations> 37 | <SmallerCode Value="True"/> 38 | </CodeGeneration> 39 | <Linking> 40 | <Debugging> 41 | <GenerateDebugInfo Value="False"/> 42 | </Debugging> 43 | <Options> 44 | <Win32> 45 | <GraphicApplication Value="True"/> 46 | </Win32> 47 | </Options> 48 | </Linking> 49 | </CompilerOptions> 50 | </Item2> 51 | </BuildModes> 52 | <PublishOptions> 53 | <Version Value="2"/> 54 | <DestinationDirectory Value="/Users/marcusfernstrom/Documents/Coding/repos/jsonhelper/src"/> 55 | <CompressFinally Value="False"/> 56 | <UseFileFilters Value="True"/> 57 | <FileFilter Value="*.(pas|pp|inc|lpr|lfm|lrs|lpi|lpk|xml|sh|ico)"/> 58 | </PublishOptions> 59 | <RunParams> 60 | <FormatVersion Value="2"/> 61 | <Modes Count="0"/> 62 | </RunParams> 63 | <RequiredPackages Count="2"> 64 | <Item1> 65 | <PackageName Value="SynEdit"/> 66 | </Item1> 67 | <Item2> 68 | <PackageName Value="LCL"/> 69 | </Item2> 70 | </RequiredPackages> 71 | <Units Count="5"> 72 | <Unit0> 73 | <Filename Value="jsonhelper.lpr"/> 74 | <IsPartOfProject Value="True"/> 75 | </Unit0> 76 | <Unit1> 77 | <Filename Value="main.pas"/> 78 | <IsPartOfProject Value="True"/> 79 | <ComponentName Value="jsonhelperform"/> 80 | <HasResources Value="True"/> 81 | <ResourceBaseClass Value="Form"/> 82 | </Unit1> 83 | <Unit2> 84 | <Filename Value="../.gitignore.txt"/> 85 | <IsPartOfProject Value="True"/> 86 | </Unit2> 87 | <Unit3> 88 | <Filename Value="SynFacilBasic.pas"/> 89 | <IsPartOfProject Value="True"/> 90 | </Unit3> 91 | <Unit4> 92 | <Filename Value="SynFacilHighlighter.pas"/> 93 | <IsPartOfProject Value="True"/> 94 | </Unit4> 95 | </Units> 96 | </ProjectOptions> 97 | <CompilerOptions> 98 | <Version Value="11"/> 99 | <Target> 100 | <Filename Value="dist/$(TargetOS)/jsonhelper"/> 101 | </Target> 102 | <SearchPaths> 103 | <IncludeFiles Value="$(ProjOutDir)"/> 104 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 105 | </SearchPaths> 106 | <CodeGeneration> 107 | <TargetOS Value="win64"/> 108 | <Optimizations> 109 | <OptimizationLevel Value="3"/> 110 | </Optimizations> 111 | <SmallerCode Value="True"/> 112 | </CodeGeneration> 113 | <Linking> 114 | <Debugging> 115 | <GenerateDebugInfo Value="False"/> 116 | </Debugging> 117 | <Options> 118 | <Win32> 119 | <GraphicApplication Value="True"/> 120 | </Win32> 121 | </Options> 122 | </Linking> 123 | </CompilerOptions> 124 | </CONFIG> 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 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="11"/> 6 | <BuildModes Count="1" Active="OSX"> 7 | <Item1 Name="OSX"> 8 | <CompilerOptions> 9 | <Version Value="11"/> 10 | <Target> 11 | <Filename Value="dist/$(TargetOS)/jsonhelper"/> 12 | </Target> 13 | <SearchPaths> 14 | <IncludeFiles Value="$(ProjOutDir)"/> 15 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 16 | </SearchPaths> 17 | <CodeGeneration> 18 | <TargetOS Value="darwin"/> 19 | <Optimizations> 20 | <OptimizationLevel Value="3"/> 21 | </Optimizations> 22 | <SmallerCode Value="True"/> 23 | </CodeGeneration> 24 | <Linking> 25 | <Debugging> 26 | <GenerateDebugInfo Value="False"/> 27 | </Debugging> 28 | <Options> 29 | <Win32> 30 | <GraphicApplication Value="True"/> 31 | </Win32> 32 | </Options> 33 | </Linking> 34 | </CompilerOptions> 35 | </Item1> 36 | </BuildModes> 37 | <Units Count="7"> 38 | <Unit0> 39 | <Filename Value="jsonhelper.lpr"/> 40 | <IsPartOfProject Value="True"/> 41 | <EditorIndex Value="-1"/> 42 | <CursorPos Y="21"/> 43 | <UsageCount Value="273"/> 44 | </Unit0> 45 | <Unit1> 46 | <Filename Value="main.pas"/> 47 | <IsPartOfProject Value="True"/> 48 | <ComponentName Value="jsonhelperform"/> 49 | <HasResources Value="True"/> 50 | <ResourceBaseClass Value="Form"/> 51 | <IsVisibleTab Value="True"/> 52 | <TopLine Value="5"/> 53 | <CursorPos X="19" Y="9"/> 54 | <UsageCount Value="273"/> 55 | <Loaded Value="True"/> 56 | <LoadedDesigner Value="True"/> 57 | </Unit1> 58 | <Unit2> 59 | <Filename Value="..\.gitignore.txt"/> 60 | <IsPartOfProject Value="True"/> 61 | <EditorIndex Value="-1"/> 62 | <CursorPos X="11"/> 63 | <UsageCount Value="272"/> 64 | <DefaultSyntaxHighlighter Value="None"/> 65 | </Unit2> 66 | <Unit3> 67 | <Filename Value="SynFacilBasic.pas"/> 68 | <IsPartOfProject Value="True"/> 69 | <EditorIndex Value="-1"/> 70 | <WindowIndex Value="-1"/> 71 | <TopLine Value="-1"/> 72 | <CursorPos X="-1" Y="-1"/> 73 | <UsageCount Value="20"/> 74 | </Unit3> 75 | <Unit4> 76 | <Filename Value="SynFacilHighlighter.pas"/> 77 | <IsPartOfProject Value="True"/> 78 | <EditorIndex Value="-1"/> 79 | <WindowIndex Value="-1"/> 80 | <TopLine Value="-1"/> 81 | <CursorPos X="-1" Y="-1"/> 82 | <UsageCount Value="20"/> 83 | </Unit4> 84 | <Unit5> 85 | <Filename Value="..\..\..\Laz\SynFacilSyn-1.21\SynFacilHighlighter.pas"/> 86 | <EditorIndex Value="-1"/> 87 | <TopLine Value="1043"/> 88 | <CursorPos X="16" Y="1048"/> 89 | <UsageCount Value="268"/> 90 | </Unit5> 91 | <Unit6> 92 | <Filename Value="C:\fpcupdeluxe\lazarus\components\synedit\synedit.pp"/> 93 | <UnitName Value="SynEdit"/> 94 | <EditorIndex Value="-1"/> 95 | <TopLine Value="541"/> 96 | <CursorPos X="21" Y="562"/> 97 | <UsageCount Value="132"/> 98 | </Unit6> 99 | </Units> 100 | <JumpHistory Count="30" HistoryIndex="29"> 101 | <Position1> 102 | <Filename Value="main.pas"/> 103 | <Caret Line="74" Column="24" TopLine="57"/> 104 | </Position1> 105 | <Position2> 106 | <Filename Value="main.pas"/> 107 | <Caret Line="71" Column="3" TopLine="57"/> 108 | </Position2> 109 | <Position3> 110 | <Filename Value="main.pas"/> 111 | <Caret Line="7" Column="8"/> 112 | </Position3> 113 | <Position4> 114 | <Filename Value="main.pas"/> 115 | <Caret Line="26" Column="9"/> 116 | </Position4> 117 | <Position5> 118 | <Filename Value="main.pas"/> 119 | <Caret Line="37" Column="19"/> 120 | </Position5> 121 | <Position6> 122 | <Filename Value="main.pas"/> 123 | <Caret Line="69" Column="31" TopLine="31"/> 124 | </Position6> 125 | <Position7> 126 | <Filename Value="main.pas"/> 127 | <Caret Line="7" Column="7"/> 128 | </Position7> 129 | <Position8> 130 | <Filename Value="main.pas"/> 131 | <Caret Line="26" Column="9"/> 132 | </Position8> 133 | <Position9> 134 | <Filename Value="main.pas"/> 135 | <Caret Line="71" Column="40" TopLine="64"/> 136 | </Position9> 137 | <Position10> 138 | <Filename Value="main.pas"/> 139 | <Caret Line="72" Column="40" TopLine="65"/> 140 | </Position10> 141 | <Position11> 142 | <Filename Value="main.pas"/> 143 | <Caret Line="74" Column="40" TopLine="67"/> 144 | </Position11> 145 | <Position12> 146 | <Filename Value="main.pas"/> 147 | <Caret Line="160" Column="12" TopLine="158"/> 148 | </Position12> 149 | <Position13> 150 | <Filename Value="main.pas"/> 151 | <Caret Line="161" Column="31" TopLine="134"/> 152 | </Position13> 153 | <Position14> 154 | <Filename Value="main.pas"/> 155 | <Caret Line="76" Column="31" TopLine="44"/> 156 | </Position14> 157 | <Position15> 158 | <Filename Value="main.pas"/> 159 | <Caret Line="163" Column="22" TopLine="52"/> 160 | </Position15> 161 | <Position16> 162 | <Filename Value="main.pas"/> 163 | <Caret Line="76" Column="30" TopLine="52"/> 164 | </Position16> 165 | <Position17> 166 | <Filename Value="main.pas"/> 167 | <Caret Line="75" Column="30" TopLine="51"/> 168 | </Position17> 169 | <Position18> 170 | <Filename Value="main.pas"/> 171 | <Caret Line="74" Column="40" TopLine="52"/> 172 | </Position18> 173 | <Position19> 174 | <Filename Value="main.pas"/> 175 | <Caret Line="76" Column="40" TopLine="54"/> 176 | </Position19> 177 | <Position20> 178 | <Filename Value="main.pas"/> 179 | <Caret Line="174" Column="27" TopLine="6"/> 180 | </Position20> 181 | <Position21> 182 | <Filename Value="main.pas"/> 183 | <Caret Line="78" Column="26" TopLine="75"/> 184 | </Position21> 185 | <Position22> 186 | <Filename Value="main.pas"/> 187 | <Caret Line="175" Column="22" TopLine="173"/> 188 | </Position22> 189 | <Position23> 190 | <Filename Value="main.pas"/> 191 | <Caret Line="48" Column="44" TopLine="27"/> 192 | </Position23> 193 | <Position24> 194 | <Filename Value="main.pas"/> 195 | <Caret Line="166" Column="38" TopLine="144"/> 196 | </Position24> 197 | <Position25> 198 | <Filename Value="main.pas"/> 199 | <Caret Line="169" Column="5" TopLine="19"/> 200 | </Position25> 201 | <Position26> 202 | <Filename Value="main.pas"/> 203 | <Caret Line="166" Column="33" TopLine="143"/> 204 | </Position26> 205 | <Position27> 206 | <Filename Value="main.pas"/> 207 | <Caret Line="164" Column="5" TopLine="143"/> 208 | </Position27> 209 | <Position28> 210 | <Filename Value="main.pas"/> 211 | <Caret Line="172" TopLine="144"/> 212 | </Position28> 213 | <Position29> 214 | <Filename Value="main.pas"/> 215 | <Caret Line="156" Column="11" TopLine="149"/> 216 | </Position29> 217 | <Position30> 218 | <Filename Value="main.pas"/> 219 | <Caret Line="19" Column="26" TopLine="5"/> 220 | </Position30> 221 | </JumpHistory> 222 | <RunParams> 223 | <FormatVersion Value="2"/> 224 | <Modes Count="0" ActiveMode=""/> 225 | </RunParams> 226 | </ProjectSession> 227 | </CONFIG> 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 | --------------------------------------------------------------------------------