├── COPYING
├── README.md
├── admin
└── Rakefile
├── doc
├── apps
│ └── FirstApp
│ │ ├── alpha.mylang
│ │ └── alpha.mylang.faceup
├── mylang-font-lock-test-apps.el
├── mylang-font-lock-test-simple.el
├── mylang.el
└── result.txt
├── faceup.el
└── test
├── faceup-test-basics.el
├── faceup-test-files.el
├── faceup-test-mode.el
├── faceup-test-setup.el
├── faceup-test-this-file-directory.el
└── files
├── test1.txt
└── test1.txt.faceup
/COPYING:
--------------------------------------------------------------------------------
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 | # faceup - Markup language for faces and font-lock regression testing
2 |
3 | *Author:* Anders Lindgren
4 | *Version:* 0.0.5
5 | *URL:* [https://github.com/Lindydancer/faceup](https://github.com/Lindydancer/faceup)
6 |
7 | Emacs is capable of highlighting buffers based on language-specific
8 | `font-lock` rules. This package makes it possible to perform
9 | regression test for packages that provide font-lock rules.
10 |
11 | The underlying idea is to convert text with highlights ("faces")
12 | into a plain text representation using the Faceup markup
13 | language. This language is semi-human readable, for example:
14 |
15 | «k:this» is a keyword
16 |
17 | By comparing the current highlight with a highlight performed with
18 | stable versions of a package, it's possible to automatically find
19 | problems that otherwise would have been hard to spot.
20 |
21 | This package is designed to be used in conjunction with Ert, the
22 | standard Emacs regression test system.
23 |
24 | The Faceup markup language is a generic markup language, regression
25 | testing is merely one way to use it.
26 |
27 | ## Regression test examples
28 |
29 | This section describes the two typical ways regression testing with
30 | this package is performed.
31 |
32 | ### Full source file highlighting
33 |
34 | The most straight-forward way to perform regression testing is to
35 | collect a number of representative source files. From each source
36 | file, say `alpha.mylang`, you can use M-x faceup-write-file RET
37 | to generate a Faceup file named `alpha.mylang.faceup`, this file
38 | use the Faceup markup language to represent the text with
39 | highlights and is used as a reference in future tests.
40 |
41 | An Ert test case can be defined as follows:
42 |
43 | (require 'faceup)
44 |
45 | (defvar mylang-font-lock-test-dir (faceup-this-file-directory))
46 |
47 | (defun mylang-font-lock-test-apps (file)
48 | "Test that the mylang FILE is fontifies as the .faceup file describes."
49 | (faceup-test-font-lock-file 'mylang-mode
50 | (concat mylang-font-lock-test-dir file)))
51 | (faceup-defexplainer mylang-font-lock-test-apps)
52 |
53 | (ert-deftest mylang-font-lock-file-test ()
54 | (should (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
55 | ;; ... Add more test files here ...
56 | )
57 |
58 | To execute the tests, run something like M-x ert RET t RET.
59 |
60 | ### Source snippets
61 |
62 | To test smaller snippets of code, you can use the
63 | `faceup-test-font-lock-string`. It takes a major mode and a string
64 | written using the Faceup markup language. The functions strips away
65 | the Faceup markup, inserts the plain text into a temporary buffer,
66 | highlights it, converts the result back into the Faceup markup
67 | language, and finally compares the result with the original Faceup
68 | string.
69 |
70 | For example:
71 |
72 | (defun mylang-font-lock-test (faceup)
73 | (faceup-test-font-lock-string 'mylang-mode faceup))
74 | (faceup-defexplainer mylang-font-lock-test)
75 |
76 | (ert-deftest mylang-font-lock-test-simple ()
77 | "Simple MyLang font-lock tests."
78 | (should (mylang-font-lock-test "«k:this» is a keyword"))
79 | (should (mylang-font-lock-test "«k:function» «f:myfunc» («v:var»)")))
80 |
81 |
82 | ## Executing the tests
83 |
84 | Once the tests have been defined, you can use M-x ert RET t RET
85 | to execute them. Hopefully, you will be given the "all clear".
86 | However, if there is a problem, you will be presented with
87 | something like:
88 |
89 | F mylang-font-lock-file-test
90 | (ert-test-failed
91 | ((should
92 | (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
93 | :form
94 | (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang")
95 | :value nil :explanation
96 | ((on-line 2
97 | ("but_«k:this»_is_not_a_keyword")
98 | ("but_this_is_not_a_keyword")))))
99 |
100 | You should read this that on line 2, the old font-lock rules
101 | highlighted `this` inside `but_this_is_not_a_keyword` (which is
102 | clearly wrong), whereas the new doesn't. Of course, if this is the
103 | desired result (for example, the result of a recent change) you can
104 | simply regenerate the .faceup file and store it as the reference
105 | file for the future.
106 |
107 | ## The Faceup markup language
108 |
109 | The Faceup markup language is designed to be human-readable and
110 | minimalistic.
111 |
112 | The two special characters `«` and `»` marks the start and end of a
113 | range of a face.
114 |
115 | ### Compact format for special faces
116 |
117 | The compact format `«:text»` is used for a number of common
118 | faces. For example, `«U:abc»` means that the text `abc` is
119 | underlined.
120 |
121 | See `faceup-face-short-alist` for the known faces and the
122 | corresponding letter.
123 |
124 | ### Full format
125 |
126 | The format `«::text»` is used use to encode other
127 | faces.
128 |
129 | For example `«:my-special-face:abc»` meanst that `abc` has the face
130 | `my-special-face`.
131 |
132 | ### Anonymous faces
133 |
134 | An "anonymous face" is when the `face` property contains a property
135 | list (plist) on the form `(:key value)`. This is represented using
136 | a variant of the full format: `«:(:key value):text»`.
137 |
138 | For example, `«:(:background "red"):abc»` represent the text `abc`
139 | with a red background.
140 |
141 | ### Multiple properties
142 |
143 | In case a text contains more than one face property, they are
144 | represented using nested sections.
145 |
146 | For example:
147 |
148 | * `«B:abc«U:def»»` represent the text `abcdef` that is both *bold*
149 | and *underlined*.
150 | * `«W:abc«U:def»ghi»` represent the text `abcdefghi` where the
151 | entire text is in *warning* face and `def` is *underlined*.
152 |
153 | In case two faces partially overlap, the ranges will be split when
154 | represented in Faceup. For example:
155 |
156 | * `«B:abc«U:def»»«U:ghi»` represent the text `abcdefghi` where
157 | `abcdef` is bold and `defghi` is underlined.
158 |
159 | ### Escaping start and end markers
160 |
161 | Any occurrence of the start or end markers in the original text
162 | will be escaped using the start marker in the Faceup
163 | representation. In other words, the sequences `««` and `«»`
164 | represent a start and end marker, respectively.
165 |
166 | ### Other properties
167 |
168 | In addition to representing the `face` property (or, more
169 | correctly, the value of `faceup-default-property`) other properties
170 | can be encoded. The variable `faceup-properties` contains a list of
171 | properties to track. If a property behaves like the `face`
172 | property, it is encoded as described above, with the addition of
173 | the property name placed in parentheses, for example:
174 | `«(my-face)U:abd»`.
175 |
176 | The variable `faceup-face-like-properties` contains a list of
177 | properties considered face-like.
178 |
179 | Properties that are not considered face-like are always encoded
180 | using the full format and the don't nest. For example:
181 | `«(my-fibonacci-property):(1 1 2 3 5 8):abd»`.
182 |
183 | Examples of properties that could be tracked are:
184 |
185 | * `font-lock-face` -- an alias to `face` when `font-lock-mode` is
186 | enabled.
187 | * `syntax-table` -- used by a custom `syntax-propertize` to
188 | override the default syntax table.
189 | * `help-echo` -- provides tooltip text displayed when the mouse is
190 | held over a text.
191 |
192 | ## Reference section
193 |
194 | ### Faceup commands and functions
195 |
196 | M-x faceup-write-file RET - generate a Faceup file based on the
197 | current buffer.
198 |
199 | M-x faceup-view-file RET - view the current buffer converted to
200 | Faceup.
201 |
202 | `faceup-markup-{string,buffer}` - convert text with properties to
203 | the Faceup markup language.
204 |
205 | `faceup-render-view-buffer` - convert buffer with Faceup markup to
206 | a buffer with real text properties and display it.
207 |
208 | `faceup-render-string` - return string with real text properties
209 | from a string with Faceup markup.
210 |
211 | `faceup-render-to-{buffer,string}` - convert buffer with Faceup
212 | markup to a buffer/string with real text properties.
213 |
214 | `faceup-clean-{buffer,string}` - remove Faceup markup from buffer
215 | or string.
216 |
217 | ### Regression test support
218 |
219 | The following functions can be used as Ert test functions, or can
220 | be used to implement new Ert test functions.
221 |
222 | `faceup-test-equal` - Test function, work like Ert:s `equal`, but
223 | more ergonomically when reporting multi-line string errors.
224 | Concretely, it breaks down multi-line strings into lines and
225 | reports which line number the error occurred on and the content of
226 | that line.
227 |
228 | `faceup-test-font-lock-buffer` - Test that a buffer is highlighted
229 | according to a reference Faceup text, for a specific major mode.
230 |
231 | `faceup-test-font-lock-string` - Test that a text with Faceup
232 | markup is refontified to match the original Faceup markup.
233 |
234 | `faceup-test-font-lock-file` - Test that a file is highlighted
235 | according to a reference .faceup file.
236 |
237 | `faceup-defexplainer` - Macro, define an explainer function and set
238 | the `ert-explainer` property on the original function, for
239 | functions based on the above test functions.
240 |
241 | `faceup-this-file-directory` - Macro, the directory of the current
242 | file.
243 |
244 | ## Real-world examples
245 |
246 | The following are examples of real-world package that use faceup to
247 | test their font-lock keywords.
248 |
249 | * [cmake-font-lock](https://github.com/Lindydancer/cmake-font-lock)
250 | an advanced set of font-lock keywords for the CMake language
251 | * [objc-font-lock](https://github.com/Lindydancer/objc-font-lock)
252 | highlight Objective-C function calls.
253 |
254 |
255 | ## Other Font Lock Tools
256 |
257 | This package is part of a suite of font-lock tools. The other
258 | tools in the suite are:
259 |
260 | ### [Font Lock Studio](https://github.com/Lindydancer/font-lock-studio)
261 |
262 | Interactive debugger for font-lock keywords (Emacs syntax
263 | highlighting rules).
264 |
265 | Font Lock Studio lets you *single-step* Font Lock keywords --
266 | matchers, highlights, and anchored rules, so that you can see what
267 | happens when a buffer is fontified. You can set *breakpoints* on
268 | or inside rules and *run* until one has been hit. When inside a
269 | rule, matches are *visualized* using a palette of background
270 | colors. The *explainer* can describe a rule in plain-text English.
271 | Tight integration with *Edebug* allows you to step into Lisp
272 | expressions that are part of the Font Lock keywords.
273 |
274 | ### [Font Lock Profiler](https://github.com/Lindydancer/font-lock-profiler)
275 |
276 | A profiler for font-lock keywords. This package measures time and
277 | counts the number of times each part of a font-lock keyword is
278 | used. For matchers, it counts the total number and the number of
279 | successful matches.
280 |
281 | The result is presented in table that can be sorted by count or
282 | time. The table can be expanded to include each part of the
283 | font-lock keyword.
284 |
285 | In addition, this package can generate a log of all font-lock
286 | events. This can be used to verify font-lock implementations,
287 | concretely, this is used for back-to-back tests of the real
288 | font-lock engine and Font Lock Studio, an interactive debugger for
289 | font-lock keywords.
290 |
291 | ### [Highlight Refontification](https://github.com/Lindydancer/highlight-refontification)
292 |
293 | Minor mode that visualizes how font-lock refontifies a buffer.
294 | This is useful when developing or debugging font-lock keywords,
295 | especially for keywords that span multiple lines.
296 |
297 | The background of the buffer is painted in a rainbow of colors,
298 | where each band in the rainbow represent a region of the buffer
299 | that has been refontified. When the buffer is modified, the
300 | rainbow is updated.
301 |
302 | ### [Face Explorer](https://github.com/Lindydancer/face-explorer)
303 |
304 | Library and tools for faces and text properties.
305 |
306 | This library is useful for packages that convert syntax highlighted
307 | buffers to other formats. The functions can be used to determine
308 | how a face or a face text property looks, in terms of primitive
309 | face attributes (e.g. foreground and background colors). Two sets
310 | of functions are provided, one for existing frames and one for
311 | fictitious displays, like 8 color tty.
312 |
313 | In addition, the following tools are provided:
314 |
315 | - `face-explorer-list-faces` -- list all available faces. Like
316 | `list-faces-display` but with information on how a face is
317 | defined. In addition, a sample for the selected frame and for a
318 | fictitious display is shown.
319 | - `face-explorer-describe-face` -- Print detailed information on
320 | how a face is defined, and list all underlying definitions.
321 | - `face-explorer-describe-face-prop` -- Describe the `face` text
322 | property at the point in terms of primitive face attributes.
323 | Also show how it would look on a fictitious display.
324 | - `face-explorer-list-display-features` -- Show which features a
325 | display supports. Most graphical displays support all, or most,
326 | features. However, many tty:s don't support, for example,
327 | strike-through. Using specially constructed faces, the resulting
328 | buffer will render differently in different displays, e.g. a
329 | graphical frame and a tty connected using `emacsclient -nw`.
330 | - `face-explorer-list-face-prop-examples` -- Show a buffer with an
331 | assortment of `face` text properties. A sample text is shown in
332 | four variants: Native, a manually maintained reference vector,
333 | the result of `face-explorer-face-prop-attributes` and
334 | `face-explorer-face-prop-attributes-for-fictitious-display`. Any
335 | package that convert a buffer to another format (like HTML, ANSI,
336 | or LaTeX) could use this buffer to ensure that everything work as
337 | intended.
338 | - `face-explorer-list-overlay-examples` -- Show a buffer with a
339 | number of examples of overlays, some are mixed with `face` text
340 | properties. Any package that convert a buffer to another format
341 | (like HTML, ANSI, or LaTeX) could use this buffer to ensure that
342 | everything work as intended.
343 | - `face-explorer-tooltip-mode` -- Minor mode that shows tooltips
344 | containing text properties and overlays at the mouse pointer.
345 | - `face-explorer-simulate-display-mode` -- Minor mode for make a
346 | buffer look like it would on a fictitious display. Using this
347 | you can, for example, see how a theme would look in using dark or
348 | light background, a 8 color tty, or on a grayscale graphical
349 | monitor.
350 |
351 | ### [Font Lock Regression Suite](https://github.com/Lindydancer/font-lock-regression-suite)
352 |
353 | A collection of example source files for a large number of
354 | programming languages, with ERT tests to ensure that syntax
355 | highlighting does not accidentally change.
356 |
357 | For each source file, font-lock reference files are provided for
358 | various Emacs versions. The reference files contains a plain-text
359 | representation of source file with syntax highlighting, using the
360 | format "faceup".
361 |
362 | Of course, the collection source file can be used for other kinds
363 | of testing, not limited to font-lock regression testing.
364 |
365 |
366 | ---
367 | Converted from `faceup.el` by [*el2markdown*](https://github.com/Lindydancer/el2markdown).
368 |
--------------------------------------------------------------------------------
/admin/Rakefile:
--------------------------------------------------------------------------------
1 | ################################ -*- Ruby -*- #################################
2 | # Common tasks
3 | #
4 |
5 | require("../../../admin/rakehelper.rb")
6 |
7 | desc "Generate README.md"
8 | task "readme" do
9 | sh "emacs", "-batch",
10 | "-l", "../../font-lock-tools-admin/font-lock-tools-admin.el",
11 | "-L", "../../el2markdown",
12 | "../faceup.el", "-f", "font-lock-tools-admin-write-readme"
13 | end
14 |
15 | desc "Generating html"
16 | task "html" => ["readme"] do
17 | File.open(File.join("..", "README.html"), "w") do |fh|
18 | fh.puts("")
19 | fh.puts(" ")
20 | fh.puts("")
21 | end
22 | sh "Markdown.pl ../README.md >> ../README.html"
23 | end
24 |
--------------------------------------------------------------------------------
/doc/apps/FirstApp/alpha.mylang:
--------------------------------------------------------------------------------
1 | this is a keyword
2 | but_this_is_not_a_keyword
3 |
--------------------------------------------------------------------------------
/doc/apps/FirstApp/alpha.mylang.faceup:
--------------------------------------------------------------------------------
1 | «k:this» is a keyword
2 | but_«k:this»_is_not_a_keyword
3 |
--------------------------------------------------------------------------------
/doc/mylang-font-lock-test-apps.el:
--------------------------------------------------------------------------------
1 | ;;; mylang-font-lock-test-apps.el --- Faceup example for MyLang
2 |
3 | ;;; Code:
4 |
5 | (require 'faceup)
6 |
7 | (defvar mylang-font-lock-test-dir (faceup-this-file-directory))
8 |
9 | (defun mylang-font-lock-test-apps (file)
10 | "Test that FILE is fontifies as the .faceup file describes."
11 | (faceup-test-font-lock-file 'mylang-mode
12 | (concat mylang-font-lock-test-dir file)))
13 | (faceup-defexplainer mylang-font-lock-test-apps)
14 |
15 | (ert-deftest mylang-font-lock-file-test ()
16 | (should (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
17 | ;; ... Add more test files here ...
18 | )
19 |
20 | ;;; mylang-font-lock-test-apps.el ends here
21 |
--------------------------------------------------------------------------------
/doc/mylang-font-lock-test-simple.el:
--------------------------------------------------------------------------------
1 | ;;; mylang-font-lock-test-simple.el --- Example of inlined faceup tests
2 |
3 | (defun mylang-font-lock-test (faceup)
4 | (faceup-test-font-lock-string 'mylang-mode faceup))
5 | (faceup-defexplainer 'mylang-font-lock-test)
6 |
7 | (ert-deftest mylang-font-lock-test-simple ()
8 | "Simple MyLang font-lock tests."
9 | (should (mylang-font-lock-test "«k:this» is a keyword"))
10 | (should (mylang-font-lock-test "«k:function» «f:myfunc» («v:var»)"))
11 |
12 | ;;; mylang-font-lock-test-simple.el ends here
13 |
--------------------------------------------------------------------------------
/doc/mylang.el:
--------------------------------------------------------------------------------
1 | ;;; mylang.el --- example major mode with font-lock support.
2 |
3 | ;;; Code:
4 |
5 | ;; The .faceup file was generated with the following "old" set of
6 | ;; rules. The new rules, below, 1) define "is" to be a keyword and 2)
7 | ;; ensure that "this" oesn't match in a context like
8 | ;; "and_this_should_not_be_a_keyword".
9 | ;;
10 | ;; When running `ert' two (expected) errors are triggers. You as a
11 | ;; user can inspect both of then and, when satisifed, regenerate the
12 | ;; .faceup file.
13 |
14 | ;; Old rules used when generating the .faceup file:
15 | ;;
16 | ;;(defvar mylang-font-lock-keywords
17 | ;; '(("\\" (0 font-lock-keyword-face))))
18 |
19 | (defvar mylang-font-lock-keywords
20 | '(("\\_" (0 font-lock-keyword-face))))
21 |
22 | (defun mylang-mode ()
23 | "Example major mode with font-lock support."
24 | (interactive)
25 | (kill-all-local-variables)
26 | (setq major-mode 'mylang-mode)
27 | (setq mode-name "MyLang")
28 | (set (make-local-variable 'font-lock-defaults)
29 | '(mylang-font-lock-keywords))
30 | (run-hooks 'mylang-mode-hook))
31 |
32 | ;;; mylang.el ends here
33 |
--------------------------------------------------------------------------------
/doc/result.txt:
--------------------------------------------------------------------------------
1 | Selector: t
2 | Passed: 0
3 | Failed: 1 (1 unexpected)
4 | Skipped: 0
5 | Total: 1/1
6 |
7 | Started at: 2014-09-19 15:17:07+0200
8 | Finished.
9 | Finished at: 2014-09-19 15:17:07+0200
10 |
11 | F
12 |
13 | F mylang-font-lock-file-test
14 | (ert-test-failed
15 | ((should
16 | (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
17 | :form
18 | (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang")
19 | :value nil :explanation
20 | ((on-line 1
21 | ("«k:this» is a keyword")
22 | ("«k:this» «k:is» a keyword"))
23 | (on-line 2
24 | ("and_«k:this»_should_not_be_a_keyword")
25 | ("and_this_should_not_be_a_keyword")))))
26 |
--------------------------------------------------------------------------------
/faceup.el:
--------------------------------------------------------------------------------
1 | ;;; faceup.el --- Markup language for faces and font-lock regression testing
2 |
3 | ;; Copyright (C) 2013-2017 Anders Lindgren
4 |
5 | ;; Author: Anders Lindgren
6 | ;; Version: 0.0.5
7 | ;; Created: 2013-01-21
8 | ;; Keywords: faces languages
9 | ;; URL: https://github.com/Lindydancer/faceup
10 |
11 | ;; This program is free software: you can redistribute it and/or modify
12 | ;; it under the terms of the GNU General Public License as published by
13 | ;; the Free Software Foundation, either version 3 of the License, or
14 | ;; (at your option) any later version.
15 | ;;
16 | ;; This program is distributed in the hope that it will be useful,
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 | ;; GNU General Public License for more details.
20 | ;;
21 | ;; You should have received a copy of the GNU General Public License
22 | ;; along with this program. If not, see .
23 |
24 | ;;; Commentary:
25 |
26 | ;; Emacs is capable of highlighting buffers based on language-specific
27 | ;; `font-lock' rules. This package makes it possible to perform
28 | ;; regression test for packages that provide font-lock rules.
29 | ;;
30 | ;; The underlying idea is to convert text with highlights ("faces")
31 | ;; into a plain text representation using the Faceup markup
32 | ;; language. This language is semi-human readable, for example:
33 | ;;
34 | ;; «k:this» is a keyword
35 | ;;
36 | ;; By comparing the current highlight with a highlight performed with
37 | ;; stable versions of a package, it's possible to automatically find
38 | ;; problems that otherwise would have been hard to spot.
39 | ;;
40 | ;; This package is designed to be used in conjunction with Ert, the
41 | ;; standard Emacs regression test system.
42 | ;;
43 | ;; The Faceup markup language is a generic markup language, regression
44 | ;; testing is merely one way to use it.
45 |
46 | ;; Regression test examples:
47 | ;;
48 | ;; This section describes the two typical ways regression testing with
49 | ;; this package is performed.
50 | ;;
51 | ;;
52 | ;; Full source file highlighting:
53 | ;;
54 | ;; The most straight-forward way to perform regression testing is to
55 | ;; collect a number of representative source files. From each source
56 | ;; file, say `alpha.mylang', you can use `M-x faceup-write-file RET'
57 | ;; to generate a Faceup file named `alpha.mylang.faceup', this file
58 | ;; use the Faceup markup language to represent the text with
59 | ;; highlights and is used as a reference in future tests.
60 | ;;
61 | ;; An Ert test case can be defined as follows:
62 | ;;
63 | ;; (require 'faceup)
64 | ;;
65 | ;; (defvar mylang-font-lock-test-dir (faceup-this-file-directory))
66 | ;;
67 | ;; (defun mylang-font-lock-test-apps (file)
68 | ;; "Test that the mylang FILE is fontifies as the .faceup file describes."
69 | ;; (faceup-test-font-lock-file 'mylang-mode
70 | ;; (concat mylang-font-lock-test-dir file)))
71 | ;; (faceup-defexplainer mylang-font-lock-test-apps)
72 | ;;
73 | ;; (ert-deftest mylang-font-lock-file-test ()
74 | ;; (should (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
75 | ;; ;; ... Add more test files here ...
76 | ;; )
77 | ;;
78 | ;; To execute the tests, run something like `M-x ert RET t RET'.
79 | ;;
80 | ;;
81 | ;; Source snippets:
82 | ;;
83 | ;; To test smaller snippets of code, you can use the
84 | ;; `faceup-test-font-lock-string'. It takes a major mode and a string
85 | ;; written using the Faceup markup language. The functions strips away
86 | ;; the Faceup markup, inserts the plain text into a temporary buffer,
87 | ;; highlights it, converts the result back into the Faceup markup
88 | ;; language, and finally compares the result with the original Faceup
89 | ;; string.
90 | ;;
91 | ;; For example:
92 | ;;
93 | ;; (defun mylang-font-lock-test (faceup)
94 | ;; (faceup-test-font-lock-string 'mylang-mode faceup))
95 | ;; (faceup-defexplainer mylang-font-lock-test)
96 | ;;
97 | ;; (ert-deftest mylang-font-lock-test-simple ()
98 | ;; "Simple MyLang font-lock tests."
99 | ;; (should (mylang-font-lock-test "«k:this» is a keyword"))
100 | ;; (should (mylang-font-lock-test "«k:function» «f:myfunc» («v:var»)")))
101 | ;;
102 |
103 | ;; Executing the tests:
104 | ;;
105 | ;; Once the tests have been defined, you can use `M-x ert RET t RET'
106 | ;; to execute them. Hopefully, you will be given the "all clear".
107 | ;; However, if there is a problem, you will be presented with
108 | ;; something like:
109 | ;;
110 | ;; F mylang-font-lock-file-test
111 | ;; (ert-test-failed
112 | ;; ((should
113 | ;; (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
114 | ;; :form
115 | ;; (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang")
116 | ;; :value nil :explanation
117 | ;; ((on-line 2
118 | ;; ("but_«k:this»_is_not_a_keyword")
119 | ;; ("but_this_is_not_a_keyword")))))
120 | ;;
121 | ;; You should read this that on line 2, the old font-lock rules
122 | ;; highlighted `this' inside `but_this_is_not_a_keyword' (which is
123 | ;; clearly wrong), whereas the new doesn't. Of course, if this is the
124 | ;; desired result (for example, the result of a recent change) you can
125 | ;; simply regenerate the .faceup file and store it as the reference
126 | ;; file for the future.
127 |
128 | ;; The Faceup markup language:
129 | ;;
130 | ;; The Faceup markup language is designed to be human-readable and
131 | ;; minimalistic.
132 | ;;
133 | ;; The two special characters `«' and `»' marks the start and end of a
134 | ;; range of a face.
135 | ;;
136 | ;;
137 | ;; Compact format for special faces:
138 | ;;
139 | ;; The compact format `«:text»' is used for a number of common
140 | ;; faces. For example, `«U:abc»' means that the text `abc' is
141 | ;; underlined.
142 | ;;
143 | ;; See `faceup-face-short-alist' for the known faces and the
144 | ;; corresponding letter.
145 | ;;
146 | ;;
147 | ;; Full format:
148 | ;;
149 | ;; The format `«::text»' is used use to encode other
150 | ;; faces.
151 | ;;
152 | ;; For example `«:my-special-face:abc»' meanst that `abc' has the face
153 | ;; `my-special-face'.
154 | ;;
155 | ;;
156 | ;; Anonymous faces:
157 | ;;
158 | ;; An "anonymous face" is when the `face' property contains a property
159 | ;; list (plist) on the form `(:key value)'. This is represented using
160 | ;; a variant of the full format: `«:(:key value):text»'.
161 | ;;
162 | ;; For example, `«:(:background "red"):abc»' represent the text `abc'
163 | ;; with a red background.
164 | ;;
165 | ;;
166 | ;; Multiple properties:
167 | ;;
168 | ;; In case a text contains more than one face property, they are
169 | ;; represented using nested sections.
170 | ;;
171 | ;; For example:
172 | ;;
173 | ;; * `«B:abc«U:def»»' represent the text `abcdef' that is both *bold*
174 | ;; and *underlined*.
175 | ;;
176 | ;; * `«W:abc«U:def»ghi»' represent the text `abcdefghi' where the
177 | ;; entire text is in *warning* face and `def' is *underlined*.
178 | ;;
179 | ;; In case two faces partially overlap, the ranges will be split when
180 | ;; represented in Faceup. For example:
181 | ;;
182 | ;; * `«B:abc«U:def»»«U:ghi»' represent the text `abcdefghi' where
183 | ;; `abcdef' is bold and `defghi' is underlined.
184 | ;;
185 | ;;
186 | ;; Escaping start and end markers:
187 | ;;
188 | ;; Any occurrence of the start or end markers in the original text
189 | ;; will be escaped using the start marker in the Faceup
190 | ;; representation. In other words, the sequences `««' and `«»'
191 | ;; represent a start and end marker, respectively.
192 | ;;
193 | ;;
194 | ;; Other properties:
195 | ;;
196 | ;; In addition to representing the `face' property (or, more
197 | ;; correctly, the value of `faceup-default-property') other properties
198 | ;; can be encoded. The variable `faceup-properties' contains a list of
199 | ;; properties to track. If a property behaves like the `face'
200 | ;; property, it is encoded as described above, with the addition of
201 | ;; the property name placed in parentheses, for example:
202 | ;; `«(my-face)U:abd»'.
203 | ;;
204 | ;; The variable `faceup-face-like-properties' contains a list of
205 | ;; properties considered face-like.
206 | ;;
207 | ;; Properties that are not considered face-like are always encoded
208 | ;; using the full format and the don't nest. For example:
209 | ;; `«(my-fibonacci-property):(1 1 2 3 5 8):abd»'.
210 | ;;
211 | ;; Examples of properties that could be tracked are:
212 | ;;
213 | ;; * `font-lock-face' -- an alias to `face' when `font-lock-mode' is
214 | ;; enabled.
215 | ;;
216 | ;; * `syntax-table' -- used by a custom `syntax-propertize' to
217 | ;; override the default syntax table.
218 | ;;
219 | ;; * `help-echo' -- provides tooltip text displayed when the mouse is
220 | ;; held over a text.
221 |
222 | ;; Reference section:
223 | ;;
224 | ;; Faceup commands and functions:
225 | ;;
226 | ;; `M-x faceup-write-file RET' - generate a Faceup file based on the
227 | ;; current buffer.
228 | ;;
229 | ;; `M-x faceup-view-file RET' - view the current buffer converted to
230 | ;; Faceup.
231 | ;;
232 | ;; `faceup-markup-{string,buffer}' - convert text with properties to
233 | ;; the Faceup markup language.
234 | ;;
235 | ;; `faceup-render-view-buffer' - convert buffer with Faceup markup to
236 | ;; a buffer with real text properties and display it.
237 | ;;
238 | ;; `faceup-render-string' - return string with real text properties
239 | ;; from a string with Faceup markup.
240 | ;;
241 | ;; `faceup-render-to-{buffer,string}' - convert buffer with Faceup
242 | ;; markup to a buffer/string with real text properties.
243 | ;;
244 | ;; `faceup-clean-{buffer,string}' - remove Faceup markup from buffer
245 | ;; or string.
246 | ;;
247 | ;;
248 | ;; Regression test support:
249 | ;;
250 | ;; The following functions can be used as Ert test functions, or can
251 | ;; be used to implement new Ert test functions.
252 | ;;
253 | ;; `faceup-test-equal' - Test function, work like Ert:s `equal', but
254 | ;; more ergonomically when reporting multi-line string errors.
255 | ;; Concretely, it breaks down multi-line strings into lines and
256 | ;; reports which line number the error occurred on and the content of
257 | ;; that line.
258 | ;;
259 | ;; `faceup-test-font-lock-buffer' - Test that a buffer is highlighted
260 | ;; according to a reference Faceup text, for a specific major mode.
261 | ;;
262 | ;; `faceup-test-font-lock-string' - Test that a text with Faceup
263 | ;; markup is refontified to match the original Faceup markup.
264 | ;;
265 | ;; `faceup-test-font-lock-file' - Test that a file is highlighted
266 | ;; according to a reference .faceup file.
267 | ;;
268 | ;; `faceup-defexplainer' - Macro, define an explainer function and set
269 | ;; the `ert-explainer' property on the original function, for
270 | ;; functions based on the above test functions.
271 | ;;
272 | ;; `faceup-this-file-directory' - Macro, the directory of the current
273 | ;; file.
274 |
275 | ;; Real-world examples:
276 | ;;
277 | ;; The following are examples of real-world package that use faceup to
278 | ;; test their font-lock keywords.
279 | ;;
280 | ;; * [cmake-font-lock](https://github.com/Lindydancer/cmake-font-lock)
281 | ;; an advanced set of font-lock keywords for the CMake language
282 | ;;
283 | ;; * [objc-font-lock](https://github.com/Lindydancer/objc-font-lock)
284 | ;; highlight Objective-C function calls.
285 | ;;
286 |
287 | ;; Other Font Lock Tools:
288 | ;;
289 | ;; This package is part of a suite of font-lock tools. The other
290 | ;; tools in the suite are:
291 | ;;
292 | ;;
293 | ;; Font Lock Studio:
294 | ;;
295 | ;; Interactive debugger for font-lock keywords (Emacs syntax
296 | ;; highlighting rules).
297 | ;;
298 | ;; Font Lock Studio lets you *single-step* Font Lock keywords --
299 | ;; matchers, highlights, and anchored rules, so that you can see what
300 | ;; happens when a buffer is fontified. You can set *breakpoints* on
301 | ;; or inside rules and *run* until one has been hit. When inside a
302 | ;; rule, matches are *visualized* using a palette of background
303 | ;; colors. The *explainer* can describe a rule in plain-text English.
304 | ;; Tight integration with *Edebug* allows you to step into Lisp
305 | ;; expressions that are part of the Font Lock keywords.
306 | ;;
307 | ;;
308 | ;; Font Lock Profiler:
309 | ;;
310 | ;; A profiler for font-lock keywords. This package measures time and
311 | ;; counts the number of times each part of a font-lock keyword is
312 | ;; used. For matchers, it counts the total number and the number of
313 | ;; successful matches.
314 | ;;
315 | ;; The result is presented in table that can be sorted by count or
316 | ;; time. The table can be expanded to include each part of the
317 | ;; font-lock keyword.
318 | ;;
319 | ;; In addition, this package can generate a log of all font-lock
320 | ;; events. This can be used to verify font-lock implementations,
321 | ;; concretely, this is used for back-to-back tests of the real
322 | ;; font-lock engine and Font Lock Studio, an interactive debugger for
323 | ;; font-lock keywords.
324 | ;;
325 | ;;
326 | ;; Highlight Refontification:
327 | ;;
328 | ;; Minor mode that visualizes how font-lock refontifies a buffer.
329 | ;; This is useful when developing or debugging font-lock keywords,
330 | ;; especially for keywords that span multiple lines.
331 | ;;
332 | ;; The background of the buffer is painted in a rainbow of colors,
333 | ;; where each band in the rainbow represent a region of the buffer
334 | ;; that has been refontified. When the buffer is modified, the
335 | ;; rainbow is updated.
336 | ;;
337 | ;;
338 | ;; Face Explorer:
339 | ;;
340 | ;; Library and tools for faces and text properties.
341 | ;;
342 | ;; This library is useful for packages that convert syntax highlighted
343 | ;; buffers to other formats. The functions can be used to determine
344 | ;; how a face or a face text property looks, in terms of primitive
345 | ;; face attributes (e.g. foreground and background colors). Two sets
346 | ;; of functions are provided, one for existing frames and one for
347 | ;; fictitious displays, like 8 color tty.
348 | ;;
349 | ;; In addition, the following tools are provided:
350 | ;;
351 | ;; - `face-explorer-list-faces' -- list all available faces. Like
352 | ;; `list-faces-display' but with information on how a face is
353 | ;; defined. In addition, a sample for the selected frame and for a
354 | ;; fictitious display is shown.
355 | ;;
356 | ;; - `face-explorer-describe-face' -- Print detailed information on
357 | ;; how a face is defined, and list all underlying definitions.
358 | ;;
359 | ;; - `face-explorer-describe-face-prop' -- Describe the `face' text
360 | ;; property at the point in terms of primitive face attributes.
361 | ;; Also show how it would look on a fictitious display.
362 | ;;
363 | ;; - `face-explorer-list-display-features' -- Show which features a
364 | ;; display supports. Most graphical displays support all, or most,
365 | ;; features. However, many tty:s don't support, for example,
366 | ;; strike-through. Using specially constructed faces, the resulting
367 | ;; buffer will render differently in different displays, e.g. a
368 | ;; graphical frame and a tty connected using `emacsclient -nw'.
369 | ;;
370 | ;; - `face-explorer-list-face-prop-examples' -- Show a buffer with an
371 | ;; assortment of `face' text properties. A sample text is shown in
372 | ;; four variants: Native, a manually maintained reference vector,
373 | ;; the result of `face-explorer-face-prop-attributes' and
374 | ;; `face-explorer-face-prop-attributes-for-fictitious-display'. Any
375 | ;; package that convert a buffer to another format (like HTML, ANSI,
376 | ;; or LaTeX) could use this buffer to ensure that everything work as
377 | ;; intended.
378 | ;;
379 | ;; - `face-explorer-list-overlay-examples' -- Show a buffer with a
380 | ;; number of examples of overlays, some are mixed with `face' text
381 | ;; properties. Any package that convert a buffer to another format
382 | ;; (like HTML, ANSI, or LaTeX) could use this buffer to ensure that
383 | ;; everything work as intended.
384 | ;;
385 | ;; - `face-explorer-tooltip-mode' -- Minor mode that shows tooltips
386 | ;; containing text properties and overlays at the mouse pointer.
387 | ;;
388 | ;; - `face-explorer-simulate-display-mode' -- Minor mode for make a
389 | ;; buffer look like it would on a fictitious display. Using this
390 | ;; you can, for example, see how a theme would look in using dark or
391 | ;; light background, a 8 color tty, or on a grayscale graphical
392 | ;; monitor.
393 | ;;
394 | ;;
395 | ;; Font Lock Regression Suite:
396 | ;;
397 | ;; A collection of example source files for a large number of
398 | ;; programming languages, with ERT tests to ensure that syntax
399 | ;; highlighting does not accidentally change.
400 | ;;
401 | ;; For each source file, font-lock reference files are provided for
402 | ;; various Emacs versions. The reference files contains a plain-text
403 | ;; representation of source file with syntax highlighting, using the
404 | ;; format "faceup".
405 | ;;
406 | ;; Of course, the collection source file can be used for other kinds
407 | ;; of testing, not limited to font-lock regression testing.
408 |
409 | ;;; Code:
410 |
411 | (eval-when-compile
412 | (require 'cl))
413 |
414 |
415 | (defvar faceup-default-property 'face
416 | "The property that should be represented in Faceup without the (prop) part.")
417 |
418 | (defvar faceup-properties '(face)
419 | "List of properties that should be converted to the Faceup format.
420 |
421 | Only face-like property use the short format. All other use the
422 | non-nesting full format. (See `faceup-face-like-properties'.)" )
423 |
424 |
425 | (defvar faceup-face-like-properties '(face font-lock-face)
426 | "List of properties that behave like `face'.
427 |
428 | The following properties are assumed about face-like properties:
429 |
430 | * Elements are either symbols or property lists, or lists thereof.
431 |
432 | * A plain element and a list containing the same element are
433 | treated as equal
434 |
435 | * Property lists and sequences of property lists are considered
436 | equal. For example:
437 |
438 | ((:underline t :foreground \"red\"))
439 |
440 | and
441 |
442 | ((:underline t) (:foreground \"red\"))
443 |
444 | Face-like properties are converted to faceup in a nesting fashion.
445 |
446 | For example, the string AAAXXXAAA (where the property `prop' has
447 | the value `(a)' on the A:s and `(a b)' on the X:s) is converted
448 | as follows, when treated as a face-like property:
449 |
450 | «(prop):a:AAA«(prop):b:XXX»AAAA»
451 |
452 | When treated as a non-face-like property:
453 |
454 | «(prop):(a):AAA»«(prop):(a b):XXX»«(prop):(a):AAA»")
455 |
456 |
457 | (defvar faceup-markup-start-char 171) ;; «
458 | (defvar faceup-markup-end-char 187) ;; »
459 |
460 | (defvar faceup-face-short-alist
461 | '(;; Generic faces (uppercase letters)
462 | (bold . "B")
463 | (bold-italic . "Q")
464 | (default . "D")
465 | (error . "E")
466 | (highlight . "H")
467 | (italic . "I")
468 | (underline . "U")
469 | (warning . "W")
470 | ;; font-lock-specific faces (lowercase letters)
471 | (font-lock-builtin-face . "b")
472 | (font-lock-comment-delimiter-face . "m")
473 | (font-lock-comment-face . "x")
474 | (font-lock-constant-face . "c")
475 | (font-lock-doc-face . "d")
476 | (font-lock-function-name-face . "f")
477 | (font-lock-keyword-face . "k")
478 | (font-lock-negation-char-face . "n")
479 | (font-lock-preprocessor-face . "p")
480 | (font-lock-regexp-grouping-backslash . "h")
481 | (font-lock-regexp-grouping-construct . "o")
482 | (font-lock-string-face . "s")
483 | (font-lock-type-face . "t")
484 | (font-lock-variable-name-face . "v")
485 | (font-lock-warning-face . "w"))
486 | "Alist from faces to one-character representation.")
487 |
488 |
489 | ;; Plain: «W....»
490 | ;; Nested: «W...«W...»»
491 |
492 | ;; Overlapping: xxxxxxxxxx
493 | ;; yyyyyyyyyyyy
494 | ;; «X..«Y..»»«Y...»
495 |
496 |
497 | (defun faceup-markup-string (s)
498 | "Return the faceup version of the string S."
499 | (with-temp-buffer
500 | (insert s)
501 | (faceup-markup-buffer)))
502 |
503 |
504 | ;;;###autoload
505 | (defun faceup-view-buffer ()
506 | "Display the faceup representation of the current buffer."
507 | (interactive)
508 | (let ((buffer (get-buffer-create "*FaceUp*")))
509 | (with-current-buffer buffer
510 | (delete-region (point-min) (point-max)))
511 | (faceup-markup-to-buffer buffer)
512 | (display-buffer buffer)))
513 |
514 |
515 | ;;;###autoload
516 | (defun faceup-write-file (&optional file-name confirm)
517 | "Save the faceup representation of the current buffer to the file FILE-NAME.
518 |
519 | Unless a name is given, the file will be named xxx.faceup, where
520 | xxx is the file name associated with the buffer.
521 |
522 | If optional second arg CONFIRM is non-nil, this function
523 | asks for confirmation before overwriting an existing file.
524 | Interactively, confirmation is required unless you supply a prefix argument."
525 | (interactive
526 | (let ((suggested-name (and (buffer-file-name)
527 | (concat (buffer-file-name)
528 | ".faceup"))))
529 | (list (read-file-name "Write faceup file: "
530 | default-directory
531 | suggested-name
532 | nil
533 | (file-name-nondirectory suggested-name))
534 | (not current-prefix-arg))))
535 | (unless file-name
536 | (setq file-name (concat (buffer-file-name) ".faceup")))
537 | (let ((buffer (current-buffer)))
538 | (with-temp-buffer
539 | (faceup-markup-to-buffer (current-buffer) buffer)
540 | ;; Note: Must set `require-final-newline' inside
541 | ;; `with-temp-buffer', otherwise the value will be overridden by
542 | ;; the buffers local value.
543 | ;;
544 | ;; Clear `window-size-change-functions' as a workaround for
545 | ;; Emacs bug#19576 (`write-file' saves the wrong buffer if a
546 | ;; function in the list change current buffer).
547 | (let ((require-final-newline nil)
548 | (window-size-change-functions '()))
549 | (write-file file-name confirm)))))
550 |
551 |
552 | (defun faceup-markup-buffer ()
553 | "Return a string with the content of the buffer using faceup markup."
554 | (let ((buf (current-buffer)))
555 | (with-temp-buffer
556 | (faceup-markup-to-buffer (current-buffer) buf)
557 | (buffer-substring-no-properties (point-min) (point-max)))))
558 |
559 |
560 | ;; Idea:
561 | ;;
562 | ;; Typically, only one face is used. However, when two faces are used,
563 | ;; the one of top is typically shorter. Hence, the faceup variant
564 | ;; should treat the inner group of nested ranges the upper (i.e. the
565 | ;; one towards the front.) For example:
566 | ;;
567 | ;; «f:aaaaaaa«U:xxxx»aaaaaa»
568 |
569 | (defun faceup-copy-and-quote (start end to-buffer)
570 | "Quote and insert the text between START and END into TO-BUFFER."
571 | (let ((not-markup (concat "^"
572 | (make-string 1 faceup-markup-start-char)
573 | (make-string 1 faceup-markup-end-char))))
574 | (save-excursion
575 | (goto-char start)
576 | (while (< (point) end)
577 | (let ((old (point)))
578 | (skip-chars-forward not-markup end)
579 | (let ((s (buffer-substring-no-properties old (point))))
580 | (with-current-buffer to-buffer
581 | (insert s))))
582 | ;; Quote stray markup characters.
583 | (unless (= (point) end)
584 | (let ((next-char (following-char)))
585 | (with-current-buffer to-buffer
586 | (insert faceup-markup-start-char)
587 | (insert next-char)))
588 | (forward-char))))))
589 |
590 |
591 | ;; A face (string or symbol) can be on the top level.
592 | ;;
593 | ;; A face text property can be a arbitrary deep lisp structure. Each
594 | ;; list in the tree structure contains faces (symbols or strings) up
595 | ;; to the first keyword, e.g. :foreground, thereafter the list is
596 | ;; considered a property list, regardless of the content. A special
597 | ;; case are `(foreground-color . COLOR)' and `(background-color
598 | ;; . COLOR)', old forms used to represent the foreground and
599 | ;; background colors, respectively.
600 | ;;
601 | ;; Some of this is undocumented, and took some effort to reverse
602 | ;; engineer.
603 | (defun faceup-normalize-face-property (value)
604 | "Normalize VALUES into a list of faces and (KEY VALUE) entries."
605 | (cond ((null value)
606 | '())
607 | ((symbolp value)
608 | (list value))
609 | ((stringp value)
610 | (list (intern value)))
611 | ((consp value)
612 | (cond ((eq (car value) 'foreground-color)
613 | (list (list :foreground (cdr value))))
614 | ((eq (car value) 'background-color)
615 | (list (list :background (cdr value))))
616 | (t
617 | ;; A list
618 | (if (keywordp (car value))
619 | ;; Once a keyword has been seen, the rest of the
620 | ;; list is treated as a property list, regardless
621 | ;; of what it contains.
622 | (let ((res '()))
623 | (while value
624 | (let ((key (pop value))
625 | (val (pop value)))
626 | (when (keywordp key)
627 | (push (list key val) res))))
628 | res)
629 | (append
630 | (faceup-normalize-face-property (car value))
631 | (faceup-normalize-face-property (cdr value)))))))
632 | (t
633 | (error "Unexpected text property %s" value))))
634 |
635 |
636 | (defun faceup-get-text-properties (pos)
637 | "Alist of properties and values at POS.
638 |
639 | Face-like properties are normalized -- value is a list of
640 | faces (symbols) and short (KEY VALUE) lists. The list is
641 | reversed to that later elements take precedence over earlier."
642 | (let ((res '()))
643 | (dolist (prop faceup-properties)
644 | (let ((value (get-text-property pos prop)))
645 | (when value
646 | (when (memq prop faceup-face-like-properties)
647 | ;; Normalize face-like properties.
648 | (setq value (reverse (faceup-normalize-face-property value))))
649 | (push (cons prop value) res))))
650 | res))
651 |
652 |
653 | (defun faceup-markup-to-buffer (to-buffer &optional buffer)
654 | "Convert content of BUFFER to faceup form and insert in TO-BUFFER."
655 | (save-excursion
656 | (if buffer
657 | (set-buffer buffer))
658 | ;; Font-lock often only fontifies the visible sections. This
659 | ;; ensures that the entire buffer is fontified before converting
660 | ;; it.
661 | (if (and font-lock-mode
662 | ;; Prevent clearing out face attributes explicitly
663 | ;; inserted by functions like `list-faces-display'.
664 | ;; (Font-lock mode is enabled, for some reason, in those
665 | ;; buffers.)
666 | (not (and (eq major-mode 'help-mode)
667 | (not font-lock-defaults))))
668 | (font-lock-fontify-region (point-min) (point-max)))
669 | (let ((last-pos (point-min))
670 | (pos nil)
671 | ;; List of (prop . value), representing open faceup blocks.
672 | (state '()))
673 | (while (setq pos (faceup-next-property-change pos))
674 | ;; Insert content.
675 | (faceup-copy-and-quote last-pos pos to-buffer)
676 | (setq last-pos pos)
677 | (let ((prop-values (faceup-get-text-properties pos)))
678 | (let ((next-state '()))
679 | (setq state (reverse state))
680 | ;; Find all existing sequences that should continue.
681 | (let ((cont t))
682 | (while (and state
683 | prop-values
684 | cont)
685 | (let* ((prop (car (car state)))
686 | (value (cdr (car state)))
687 | (pair (assq prop prop-values)))
688 | (if (memq prop faceup-face-like-properties)
689 | ;; Element by element.
690 | (if (equal value (car (cdr pair)))
691 | (setcdr pair (cdr (cdr pair)))
692 | (setq cont nil))
693 | ;; Full value.
694 | ;;
695 | ;; Note: Comparison is done by `eq', since (at
696 | ;; least) the `display' property treats
697 | ;; eq-identical values differently than when
698 | ;; comparing using `equal'. See "Display Specs
699 | ;; That Replace The Text" in the elisp manual.
700 | (if (eq value (cdr pair))
701 | (setq prop-values (delq pair prop-values))
702 | (setq cont nil))))
703 | (when cont
704 | (push (pop state) next-state))))
705 | ;; End values that should not be included in the next state.
706 | (while state
707 | (with-current-buffer to-buffer
708 | (insert (make-string 1 faceup-markup-end-char)))
709 | (pop state))
710 | ;; Start new ranges.
711 | (with-current-buffer to-buffer
712 | (while prop-values
713 | (let ((pair (pop prop-values)))
714 | (if (memq (car pair) faceup-face-like-properties)
715 | ;; Face-like.
716 | (dolist (element (cdr pair))
717 | (insert (make-string 1 faceup-markup-start-char))
718 | (unless (eq (car pair) faceup-default-property)
719 | (insert "(")
720 | (insert (symbol-name (car pair)))
721 | (insert "):"))
722 | (if (symbolp element)
723 | (let ((short
724 | (assq element faceup-face-short-alist)))
725 | (if short
726 | (insert (cdr short) ":")
727 | (insert ":" (symbol-name element) ":")))
728 | (insert ":")
729 | (prin1 element (current-buffer))
730 | (insert ":"))
731 | (push (cons (car pair) element) next-state))
732 | ;; Not face-like.
733 | (insert (make-string 1 faceup-markup-start-char))
734 | (insert "(")
735 | (insert (symbol-name (car pair)))
736 | (insert "):")
737 | (prin1 (cdr pair) (current-buffer))
738 | (insert ":")
739 | (push pair next-state)))))
740 | ;; Insert content.
741 | (setq state next-state))))
742 | ;; Insert whatever is left after the last face change.
743 | (faceup-copy-and-quote last-pos (point-max) to-buffer))))
744 |
745 |
746 |
747 | ;; Some basic facts:
748 | ;;
749 | ;; (get-text-property (point-max) ...) always return nil. To check the
750 | ;; last character in the buffer, use (- (point-max) 1).
751 | ;;
752 | ;; If a text has more than one face, the first one in the list
753 | ;; takes precedence, when being viewed in Emacs.
754 | ;;
755 | ;; (let ((s "ABCDEF"))
756 | ;; (set-text-properties 1 4
757 | ;; '(face (font-lock-warning-face font-lock-variable-name-face)) s)
758 | ;; (insert s))
759 | ;;
760 | ;; => ABCDEF
761 | ;;
762 | ;; Where DEF is drawn in "warning" face.
763 |
764 |
765 | (defun faceup-has-any-text-property (pos)
766 | "True if any properties in `faceup-properties' are defined at POS."
767 | (let ((res nil))
768 | (dolist (prop faceup-properties)
769 | (when (get-text-property pos prop)
770 | (setq res t)))
771 | res))
772 |
773 |
774 | (defun faceup-next-single-property-change (pos)
775 | "Next position a property in `faceup-properties' changes after POS, or nil."
776 | (let ((res nil))
777 | (dolist (prop faceup-properties)
778 | (let ((next (next-single-property-change pos prop)))
779 | (when next
780 | (setq res (if res
781 | (min res next)
782 | next)))))
783 | res))
784 |
785 |
786 | (defun faceup-next-property-change (pos)
787 | "Next position after POS where one of the tracked properties change.
788 |
789 | If POS is nil, also include `point-min' in the search.
790 | If last character contains a tracked property, return `point-max'.
791 |
792 | See `faceup-properties' for a list of tracked properties."
793 | (if (eq pos (point-max))
794 | ;; Last search returned `point-max'. There is no more to search
795 | ;; for.
796 | nil
797 | (if (and (null pos)
798 | (faceup-has-any-text-property (point-min)))
799 | ;; `pos' is `nil' and the character at `point-min' contains a
800 | ;; tracked property, return `point-min'.
801 | (point-min)
802 | (unless pos
803 | ;; Start from the beginning.
804 | (setq pos (point-min)))
805 | ;; Do a normal search. Compensate for that
806 | ;; `next-single-property-change' does not include the end of the
807 | ;; buffer, even when a property reach it.
808 | (let ((res (faceup-next-single-property-change pos)))
809 | (if (and (not res) ; No more found.
810 | (not (eq pos (point-max))) ; Not already at the end.
811 | (not (eq (point-min) (point-max))) ; Not an empty buffer.
812 | (faceup-has-any-text-property (- (point-max) 1)))
813 | ;; If a property goes all the way to the end of the
814 | ;; buffer, return `point-max'.
815 | (point-max)
816 | res)))))
817 |
818 |
819 | ;; ----------------------------------------------------------------------
820 | ;; Renderer
821 | ;;
822 |
823 | ;; Functions to convert from the faceup textual representation to text
824 | ;; with real properties.
825 |
826 | (defun faceup-render-string (faceup)
827 | "Return string with properties from FACEUP written with Faceup markup."
828 | (with-temp-buffer
829 | (insert faceup)
830 | (faceup-render-to-string)))
831 |
832 |
833 | ;;;###autoload
834 | (defun faceup-render-view-buffer (&optional buffer)
835 | "Convert BUFFER containing Faceup markup to a new buffer and display it."
836 | (interactive)
837 | (with-current-buffer (or buffer (current-buffer))
838 | (let ((dest-buffer (get-buffer-create "*FaceUp rendering*")))
839 | (with-current-buffer dest-buffer
840 | (delete-region (point-min) (point-max)))
841 | (faceup-render-to-buffer dest-buffer)
842 | (display-buffer dest-buffer))))
843 |
844 |
845 | (defun faceup-render-to-string (&optional buffer)
846 | "Convert BUFFER containing faceup markup to a string with faces."
847 | (unless buffer
848 | (setq buffer (current-buffer)))
849 | (with-temp-buffer
850 | (faceup-render-to-buffer (current-buffer) buffer)
851 | (buffer-substring (point-min) (point-max))))
852 |
853 |
854 | (defun faceup-render-to-buffer (to-buffer &optional buffer)
855 | "Convert BUFFER containing faceup markup into text with faces in TO-BUFFER."
856 | (with-current-buffer (or buffer (current-buffer))
857 | (goto-char (point-min))
858 | (let ((last-point (point))
859 | (state '()) ; List of (prop . element)
860 | (not-markup (concat
861 | "^"
862 | (make-string 1 faceup-markup-start-char)
863 | (make-string 1 faceup-markup-end-char))))
864 | (while (progn
865 | (skip-chars-forward not-markup)
866 | (if (not (eq last-point (point)))
867 | (let ((text (buffer-substring-no-properties
868 | last-point (point)))
869 | (prop-elements-alist '()))
870 | ;; Accumulate all values for each property.
871 | (dolist (prop-element state)
872 | (let ((property (car prop-element))
873 | (element (cdr prop-element)))
874 | (let ((pair (assq property prop-elements-alist)))
875 | (unless pair
876 | (setq pair (cons property '()))
877 | (push pair prop-elements-alist))
878 | (push element (cdr pair)))))
879 | ;; Apply all properties.
880 | (dolist (pair prop-elements-alist)
881 | (let ((property (car pair))
882 | (elements (reverse (cdr pair))))
883 | ;; Create one of:
884 | ;; (property element) or
885 | ;; (property (element element ...))
886 | (when (eq (length elements) 1)
887 | ;; This ensures that non-face-like
888 | ;; properties are restored to their
889 | ;; original state.
890 | (setq elements (car elements)))
891 | (add-text-properties 0 (length text)
892 | (list property elements)
893 | text)))
894 | (with-current-buffer to-buffer
895 | (insert text))
896 | (setq last-point (point))))
897 | (not (eobp)))
898 | (if (eq (following-char) faceup-markup-start-char)
899 | ;; Start marker.
900 | (progn
901 | (forward-char)
902 | (if (or (eq (following-char) faceup-markup-start-char)
903 | (eq (following-char) faceup-markup-end-char))
904 | ;; Escaped markup character.
905 | (progn
906 | (setq last-point (point))
907 | (forward-char))
908 | ;; Markup sequence.
909 | (let ((property faceup-default-property))
910 | (when (eq (following-char) ?\( )
911 | (forward-char) ; "("
912 | (let ((p (point)))
913 | (forward-sexp)
914 | (setq property (intern (buffer-substring p (point)))))
915 | (forward-char)) ; ")"
916 | (let ((element
917 | (if (eq (following-char) ?:)
918 | ;; :element:
919 | (progn
920 | (forward-char)
921 | (prog1
922 | (let ((p (point)))
923 | (forward-sexp)
924 | ;; Note: (read (current-buffer))
925 | ;; doesn't work, as it reads more
926 | ;; than a sexp.
927 | (read (buffer-substring p (point))))
928 | (forward-char)))
929 | ;; X:
930 | (prog1
931 | (car (rassoc (buffer-substring-no-properties
932 | (point) (+ (point) 1))
933 | faceup-face-short-alist))
934 | (forward-char 2)))))
935 | (push (cons property element) state)))
936 | (setq last-point (point))))
937 | ;; End marker.
938 | (pop state)
939 | (forward-char)
940 | (setq last-point (point)))))))
941 |
942 | ;; ----------------------------------------------------------------------
943 |
944 | ;;;###autoload
945 | (defun faceup-clean-buffer ()
946 | "Remove faceup markup from buffer."
947 | (interactive)
948 | (goto-char (point-min))
949 | (let ((not-markup (concat
950 | "^"
951 | (make-string 1 faceup-markup-start-char)
952 | (make-string 1 faceup-markup-end-char))))
953 | (while (progn (skip-chars-forward not-markup)
954 | (not (eobp)))
955 | (if (eq (following-char) faceup-markup-end-char)
956 | ;; End markers are always on their own.
957 | (delete-char 1)
958 | ;; Start marker.
959 | (delete-char 1)
960 | (if (or (eq (following-char) faceup-markup-start-char)
961 | (eq (following-char) faceup-markup-end-char))
962 | ;; Escaped markup character, delete the escape and skip
963 | ;; the original character.
964 | (forward-char)
965 | ;; Property name (if present)
966 | (if (eq (following-char) ?\( )
967 | (let ((p (point)))
968 | (forward-sexp)
969 | (delete-region p (point))))
970 | ;; Markup sequence.
971 | (if (eq (following-char) ?:)
972 | ;; :value:
973 | (let ((p (point)))
974 | (forward-char)
975 | (forward-sexp)
976 | (unless (eobp)
977 | (forward-char))
978 | (delete-region p (point)))
979 | ;; X:
980 | (delete-char 1) ; The one-letter form.
981 | (delete-char 1))))))) ; The colon.
982 |
983 |
984 | (defun faceup-clean-string (s)
985 | "Remove faceup markup from string S."
986 | (with-temp-buffer
987 | (insert s)
988 | (faceup-clean-buffer)
989 | (buffer-substring (point-min) (point-max))))
990 |
991 |
992 | ;; ----------------------------------------------------------------------
993 | ;; Regression test support
994 | ;;
995 |
996 | (defvar faceup-test-explain nil
997 | "When non-nil, tester functions returns a text description on failure.
998 |
999 | Of course, this only work for test functions aware of this
1000 | variable, like `faceup-test-equal' and functions based on this
1001 | function.
1002 |
1003 | This is intended to be used to simplify `ert' explain functions,
1004 | which could be defined as:
1005 |
1006 | (defun my-test (args...) ...)
1007 | (defun my-test-explain (args...)
1008 | (let ((faceup-test-explain t))
1009 | (the-test args...)))
1010 | (put 'my-test 'ert-explainer 'my-test-explain)
1011 |
1012 | Alternative, you can use the macro `faceup-defexplainer' as follows:
1013 |
1014 | (defun my-test (args...) ...)
1015 | (faceup-defexplainer my-test)
1016 |
1017 | Test functions, like `faceup-test-font-lock-buffer', built on top
1018 | of `faceup-test-equal', and other functions that adhere to this
1019 | variable, can easily define their own explainer functions.")
1020 |
1021 | ;;;###autoload
1022 | (defmacro faceup-defexplainer (function)
1023 | "Defines an Ert explainer function for FUNCTION.
1024 |
1025 | FUNCTION must return an explanation when the test fails and
1026 | `faceup-test-explain' is set."
1027 | (let ((name (intern (concat (symbol-name function) "-explainer"))))
1028 | `(progn
1029 | (defun ,name (&rest args)
1030 | (let ((faceup-test-explain t))
1031 | (apply (quote ,function) args)))
1032 | (put (quote ,function) 'ert-explainer (quote ,name)))))
1033 |
1034 |
1035 | ;; ------------------------------
1036 | ;; Multi-line string support.
1037 | ;;
1038 |
1039 | (defun faceup-test-equal (lhs rhs)
1040 | "Compares two (multi-line) strings, LHS and RHS, for equality.
1041 |
1042 | This is intended to be used in Ert regression test rules.
1043 |
1044 | When `faceup-test-explain' is non-nil, instead of returning nil
1045 | on inequality, a list is returned with a explanation what
1046 | differs. Currently, this function reports 1) if the number of
1047 | lines in the strings differ. 2) the lines and the line numbers on
1048 | which the string differed.
1049 |
1050 | For example:
1051 | (let ((a \"ABC\\nDEF\\nGHI\")
1052 | (b \"ABC\\nXXX\\nGHI\\nZZZ\")
1053 | (faceup-test-explain t))
1054 | (message \"%s\" (faceup-test-equal a b)))
1055 |
1056 | ==> (4 3 number-of-lines-differ (on-line 2 (DEF) (XXX)))
1057 |
1058 | When used in an `ert' rule, the output is as below:
1059 |
1060 | (ert-deftest faceup-test-equal-example ()
1061 | (let ((a \"ABC\\nDEF\\nGHI\")
1062 | (b \"ABC\\nXXX\\nGHI\\nZZZ\"))
1063 | (should (faceup-test-equal a b))))
1064 |
1065 | F faceup-test-equal-example
1066 | (ert-test-failed
1067 | ((should
1068 | (faceup-test-equal a b))
1069 | :form
1070 | (faceup-test-equal \"ABC\\nDEF\\nGHI\" \"ABC\\nXXX\\nGHI\\nZZZ\")
1071 | :value nil :explanation
1072 | (4 3 number-of-lines-differ
1073 | (on-line 2
1074 | (\"DEF\")
1075 | (\"XXX\")))))"
1076 | (if (equal lhs rhs)
1077 | t
1078 | (if faceup-test-explain
1079 | (let ((lhs-lines (split-string lhs "\n"))
1080 | (rhs-lines (split-string rhs "\n"))
1081 | (explanation '())
1082 | (line 1))
1083 | (unless (= (length lhs-lines) (length rhs-lines))
1084 | (setq explanation (list 'number-of-lines-differ
1085 | (length lhs-lines) (length rhs-lines))))
1086 | (while lhs-lines
1087 | (let ((one (pop lhs-lines))
1088 | (two (pop rhs-lines)))
1089 | (unless (equal one two)
1090 | (setq explanation
1091 | (cons (list 'on-line line (list one) (list two))
1092 | explanation)))
1093 | (setq line (+ line 1))))
1094 | (nreverse explanation))
1095 | nil)))
1096 |
1097 | (faceup-defexplainer faceup-test-equal)
1098 |
1099 |
1100 | ;; ------------------------------
1101 | ;; Font-lock regression test support.
1102 | ;;
1103 |
1104 | (defun faceup-test-font-lock-buffer (mode faceup &optional buffer)
1105 | "Verify that BUFFER is fontified as FACEUP for major mode MODE.
1106 |
1107 | If BUFFER is not specified the current buffer is used.
1108 |
1109 | Note that the major mode of the buffer is set to MODE and that
1110 | the buffer is fontified.
1111 |
1112 | If MODE is a list, the first element is the major mode, the
1113 | remaining are additional functions to call, e.g. minor modes."
1114 | (save-excursion
1115 | (if buffer
1116 | (set-buffer buffer))
1117 | (if (listp mode)
1118 | (dolist (m mode)
1119 | (funcall m))
1120 | (funcall mode))
1121 | (font-lock-fontify-region (point-min) (point-max))
1122 | (let ((result (faceup-markup-buffer)))
1123 | (faceup-test-equal faceup result))))
1124 |
1125 | (faceup-defexplainer faceup-test-font-lock-buffer)
1126 |
1127 |
1128 | (defun faceup-test-font-lock-string (mode faceup)
1129 | "True if FACEUP is re-fontified as the faceup markup for major mode MODE.
1130 |
1131 | The string FACEUP is stripped from markup, inserted into a
1132 | buffer, the requested major mode activated, the buffer is
1133 | fontified, the result is again converted to the faceup form, and
1134 | compared with the original string."
1135 | (with-temp-buffer
1136 | (insert faceup)
1137 | (faceup-clean-buffer)
1138 | (faceup-test-font-lock-buffer mode faceup)))
1139 |
1140 | (faceup-defexplainer faceup-test-font-lock-string)
1141 |
1142 |
1143 | (defun faceup-test-font-lock-file (mode file &optional faceup-file)
1144 | "Verify that FILE is fontified as FACEUP-FILE for major mode MODE.
1145 |
1146 | If FACEUP-FILE is omitted, FILE.faceup is used."
1147 | (unless faceup-file
1148 | (setq faceup-file (concat file ".faceup")))
1149 | (let ((faceup (with-temp-buffer
1150 | (insert-file-contents faceup-file)
1151 | (buffer-substring-no-properties (point-min) (point-max)))))
1152 | (with-temp-buffer
1153 | (insert-file-contents file)
1154 | (faceup-test-font-lock-buffer mode faceup))))
1155 |
1156 | (faceup-defexplainer faceup-test-font-lock-file)
1157 |
1158 |
1159 | ;; ------------------------------
1160 | ;; Get current file directory. Test cases can use this to locate test
1161 | ;; files.
1162 | ;;
1163 |
1164 | (defun faceup-this-file-directory ()
1165 | "The directory of the file where the call to this function is located in.
1166 | Intended to be called when a file is loaded."
1167 | (expand-file-name
1168 | (if load-file-name
1169 | ;; File is being loaded.
1170 | (file-name-directory load-file-name)
1171 | ;; File is being evaluated using, for example, `eval-buffer'.
1172 | default-directory)))
1173 |
1174 |
1175 | ;; ----------------------------------------------------------------------
1176 | ;; The end
1177 | ;;
1178 |
1179 | (provide 'faceup)
1180 |
1181 | ;;; faceup.el ends here
1182 |
--------------------------------------------------------------------------------
/test/faceup-test-basics.el:
--------------------------------------------------------------------------------
1 | ;;; faceup-test-basics.el --- Tests for the `faceup' package.
2 |
3 | ;; Copyright (C) 2014 Anders Lindgren
4 |
5 | ;; Author: Anders Lindgren
6 | ;; Keywords: languages, faces
7 | ;; URL: https://github.com/Lindydancer/char-font-lock
8 |
9 | ;;; Commentary:
10 |
11 | ;;; Code:
12 |
13 | ;; Note: In the diagrams below, the face drawn over the other
14 | ;; represent a face earlier in the list, in other words, one that take
15 | ;; precedence.
16 |
17 | (add-to-list 'load-path (concat
18 | (if load-file-name
19 | (file-name-directory load-file-name)
20 | default-directory)
21 | ".."))
22 |
23 | (require 'faceup)
24 |
25 | (ert-deftest faceup-functions ()
26 | "Test primitive functions."
27 | (should (equal (faceup-reverse-list-and-split-property-lists '()) '()))
28 | (should (equal (faceup-reverse-list-and-split-property-lists '(a)) '(a)))
29 | (should (equal (faceup-reverse-list-and-split-property-lists '(a b)) '(b a)))
30 |
31 | (should (equal (faceup-reverse-list-and-split-property-lists '((:foo t)))
32 | '((:foo t))))
33 | (should (equal (faceup-reverse-list-and-split-property-lists
34 | '((:foo t) (:bar nil)))
35 | '((:bar nil) (:foo t))))
36 | (should (equal (faceup-reverse-list-and-split-property-lists
37 | '((:foo t :bar nil)))
38 | '((:bar nil) (:foo t))))
39 | (should (equal (faceup-reverse-list-and-split-property-lists
40 | '(alpha (:foo t :bar nil) gamma))
41 | '(gamma (:bar nil) (:foo t) alpha)))
42 | )
43 |
44 |
45 | (ert-deftest faceup-markup ()
46 | "Test basic `faceup' features."
47 | ;; ----------
48 | ;; Basics
49 | (should (equal (faceup-markup-string "") ""))
50 | (should (equal (faceup-markup-string "test") "test"))
51 | ;; ----------
52 | ;; Escaping
53 | (should (equal (faceup-markup-string "«") "««"))
54 | (should (equal (faceup-markup-string "«A«B«C«") "««A««B««C««"))
55 | (should (equal (faceup-markup-string "»") "«»"))
56 | (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»"))
57 | ;; ----------
58 | ;; Plain property.
59 | ;;
60 | ;; UU
61 | ;; ABCDEF
62 | (let ((s "ABCDEF"))
63 | (set-text-properties 2 4 '(face underline) s)
64 | (should (equal (faceup-markup-string s) "AB«U:CD»EF")))
65 | ;; ----------
66 | ;; Plain property, full text
67 | ;;
68 | ;; UUUUUU
69 | ;; ABCDEF
70 | (let ((s "ABCDEF"))
71 | (set-text-properties 0 6 '(face underline) s)
72 | (should (equal (faceup-markup-string s) "«U:ABCDEF»")))
73 | ;; ----------
74 | ;; Anonymous face.
75 | ;;
76 | ;; AA
77 | ;; ABCDEF
78 | (let ((s "ABCDEF"))
79 | (set-text-properties 2 4 '(face (:underline t)) s)
80 | (should (equal (faceup-markup-string s) "AB«:(:underline t):CD»EF")))
81 | ;; ----------
82 | ;; Anonymous face -- plist with two keys.
83 | ;;
84 | ;; AA
85 | ;; ABCDEF
86 | (let ((s "ABCDEF"))
87 | (set-text-properties 2 4 '(face (:foo t :bar nil)) s)
88 | (should (equal (faceup-markup-string s)
89 | "AB«:(:bar nil):«:(:foo t):CD»»EF")))
90 | ;; Ditto, with plist in list.
91 | (let ((s "ABCDEF"))
92 | (set-text-properties 2 4 '(face ((:foo t :bar nil))) s)
93 | (should (equal (faceup-markup-string s)
94 | "AB«:(:bar nil):«:(:foo t):CD»»EF")))
95 | ;; ----------
96 | ;; Anonymous face -- Two plists.
97 | ;;
98 | ;; AA
99 | ;; ABCDEF
100 | (let ((s "ABCDEF"))
101 | (set-text-properties 2 4 '(face ((:foo t) (:bar nil))) s)
102 | (should (equal (faceup-markup-string s)
103 | "AB«:(:bar nil):«:(:foo t):CD»»EF")))
104 | ;; ----------
105 | ;; Anonymous face -- Nested.
106 | ;;
107 | ;; AA
108 | ;; IIII
109 | ;; ABCDEF
110 | (let ((s "ABCDEF"))
111 | (set-text-properties 1 2 '(face ((:foo t))) s)
112 | (set-text-properties 2 4 '(face ((:bar t) (:foo t))) s)
113 | (set-text-properties 4 5 '(face ((:foo t))) s)
114 | (should (equal (faceup-markup-string s)
115 | "A«:(:foo t):B«:(:bar t):CD»E»F")))
116 | ;; ----------
117 | ;; Nested properties.
118 | ;;
119 | ;; UU
120 | ;; IIII
121 | ;; ABCDEF
122 | (let ((s "ABCDEF"))
123 | (set-text-properties 1 2 '(face italic) s)
124 | (set-text-properties 2 4 '(face (underline italic)) s)
125 | (set-text-properties 4 5 '(face italic) s)
126 | (should (equal (faceup-markup-string s) "A«I:B«U:CD»E»F")))
127 | ;; ----------
128 | ;; Overlapping, but not nesting, properties.
129 | ;;
130 | ;; UUU
131 | ;; III
132 | ;; ABCDEF
133 | (let ((s "ABCDEF"))
134 | (set-text-properties 1 2 '(face italic) s)
135 | (set-text-properties 2 4 '(face (underline italic)) s)
136 | (set-text-properties 4 5 '(face underline) s)
137 | (should (equal (faceup-markup-string s) "A«I:B«U:CD»»«U:E»F")))
138 | ;; ----------
139 | ;; Overlapping, but not nesting, properties.
140 | ;;
141 | ;; III
142 | ;; UUU
143 | ;; ABCDEF
144 | (let ((s "ABCDEF"))
145 | (set-text-properties 1 2 '(face italic) s)
146 | (set-text-properties 2 4 '(face (italic underline)) s)
147 | (set-text-properties 4 5 '(face underline) s)
148 | (should (equal (faceup-markup-string s) "A«I:B»«U:«I:CD»E»F")))
149 | ;; ----------
150 | ;; More than one face at the same location.
151 | ;;
152 | ;; The property to the front takes precedence, it is rendered as the
153 | ;; innermost parenthesis pair.
154 | (let ((s "ABCDEF"))
155 | (set-text-properties 2 4 '(face (underline italic)) s)
156 | (should (equal (faceup-markup-string s) "AB«I:«U:CD»»EF")))
157 | (let ((s "ABCDEF"))
158 | (set-text-properties 2 4 '(face (italic underline)) s)
159 | (should (equal (faceup-markup-string s) "AB«U:«I:CD»»EF")))
160 | ;; ----------
161 | ;; Equal ranges, full text.
162 | (let ((s "ABCDEF"))
163 | (set-text-properties 0 6 '(face (underline italic)) s)
164 | (should (equal (faceup-markup-string s) "«I:«U:ABCDEF»»")))
165 | ;; Ditto, with stray markup characters.
166 | (let ((s "AB«CD»EF"))
167 | (set-text-properties 0 8 '(face (underline italic)) s)
168 | (should (equal (faceup-markup-string s) "«I:«U:AB««CD«»EF»»")))
169 |
170 | ;; ----------
171 | ;; Multiple properties
172 | (let ((faceup-properties '(alpha beta gamma)))
173 | ;; One property.
174 | (let ((s "ABCDEF"))
175 | (set-text-properties 2 4 '(alpha (a l p h a)) s)
176 | (should (equal (faceup-markup-string s) "AB«(alpha):(a l p h a):CD»EF")))
177 |
178 | ;; Two properties, inner enclosed.
179 | (let ((s "ABCDEFGHIJ"))
180 | (set-text-properties 2 8 '(alpha (a l p h a)) s)
181 | (font-lock-append-text-property 4 6 'beta '(b e t a) s)
182 | (should (equal (faceup-markup-string s)
183 | "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ")))
184 |
185 | ;; Two properties, same end
186 | (let ((s "ABCDEFGH"))
187 | (set-text-properties 2 6 '(alpha (a)) s)
188 | (add-text-properties 4 6 '(beta (b)) s)
189 | (should
190 | (equal
191 | (faceup-markup-string s)
192 | "AB«(alpha):(a):CD«(beta):(b):EF»»GH")))
193 |
194 | ;; Two properties, overlap.
195 | (let ((s "ABCDEFGHIJ"))
196 | (set-text-properties 2 6 '(alpha (a)) s)
197 | (add-text-properties 4 8 '(beta (b)) s)
198 | (should
199 | (equal
200 | (faceup-markup-string s)
201 | "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ")))
202 | ))
203 |
204 |
205 | (ert-deftest faceup-clean ()
206 | "Test the clean features of `faceup'."
207 | (should (equal (faceup-clean-string "") ""))
208 | (should (equal (faceup-clean-string "test") "test"))
209 | (should (equal (faceup-clean-string "AB«U:CD»EF") "ABCDEF"))
210 | (should (equal (faceup-clean-string "«U:ABCDEF»") "ABCDEF"))
211 | (should (equal (faceup-clean-string "A«I:B«U:CD»E»F") "ABCDEF"))
212 | (should (equal (faceup-clean-string "A«I:B«U:CD»»«U:E»F") "ABCDEF"))
213 | (should (equal (faceup-clean-string "AB«I:«U:CD»»EF") "ABCDEF"))
214 | (should (equal (faceup-clean-string "«I:«U:ABCDEF»»") "ABCDEF"))
215 | (should (equal (faceup-clean-string "«(foo)I:ABC»DEF") "ABCDEF"))
216 | (should (equal (faceup-clean-string "«:(:foo t):ABC»DEF") "ABCDEF"))
217 | ;; Escaped markup characters.
218 | (should (equal (faceup-clean-string "««") "«"))
219 | (should (equal (faceup-clean-string "«»") "»"))
220 | (should (equal (faceup-clean-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF")))
221 |
222 |
223 | (ert-deftest faceup-render ()
224 | "Test the render features of `faceup'."
225 | (should (equal (faceup-render-string "") ""))
226 | (should (equal (faceup-render-string "««") "«"))
227 | (should (equal (faceup-render-string "«»") "»"))
228 | (should (equal (faceup-render-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF")))
229 |
230 | (defvar faceup-test-dummy)
231 |
232 | (ert-deftest faceup-directory ()
233 | "Test `faceup-this-file-directory'."
234 | (let* ((dir (concat (file-name-directory
235 | (symbol-file 'faceup-this-file-directory))
236 | "test/"))
237 | (file (concat dir "faceup-test-this-file-directory.el")))
238 | ;; Test normal load.
239 | (makunbound 'faceup-test-this-file-directory)
240 | (load-file file)
241 | (should (equal faceup-test-this-file-directory dir))
242 | ;; Test `eval-buffer'.
243 | (makunbound 'faceup-test-this-file-directory)
244 | (save-excursion
245 | (find-file file)
246 | (eval-buffer))
247 | (should (equal faceup-test-this-file-directory dir))
248 | ;; Test `eval-defun'.
249 | (makunbound 'faceup-test-this-file-directory)
250 | (save-excursion
251 | (find-file file)
252 | (eval-defun nil))
253 | (should (equal faceup-test-this-file-directory dir))))
254 |
255 | (provide 'faceup-test-basics)
256 |
257 | ;;; faceup-test-basics.el ends here
258 |
--------------------------------------------------------------------------------
/test/faceup-test-files.el:
--------------------------------------------------------------------------------
1 | ;;; faceup-test-files.el --- Self test of `faceup' using.
2 |
3 | ;; Copyright (C) 2015 Anders Lindgren
4 |
5 | ;; Author: Anders Lindgren
6 | ;; Keywords: faces languages
7 | ;; Created: 2015-02-14
8 |
9 | ;; This program is free software: you can redistribute it and/or modify
10 | ;; it under the terms of the GNU General Public License as published by
11 | ;; the Free Software Foundation, either version 3 of the License, or
12 | ;; (at your option) any later version.
13 |
14 | ;; This program is distributed in the hope that it will be useful,
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 | ;; GNU General Public License for more details.
18 |
19 | ;; You should have received a copy of the GNU General Public License
20 | ;; along with this program. If not, see .
21 |
22 | ;;; Commentary:
23 |
24 | ;; Self test of `faceup' with a major mode that sets both the
25 | ;; `syntax-table' and the `echo-help' property.
26 | ;;
27 | ;; This file can also be seen as a blueprint of test cases for real
28 | ;; major modes.
29 |
30 | ;;; Code:
31 |
32 | (require 'faceup)
33 | (require 'faceup-test-mode)
34 |
35 | (defvar faceup-test-files-dir (faceup-this-file-directory)
36 | "The directory of this file.")
37 |
38 | (defun faceup-test-file (file)
39 | "Test that FILE is fontified as the .faceup file describes.
40 |
41 | FILE is interpreted as relative to this source directory."
42 | (let ((faceup-properties '(face syntax-table help-echo)))
43 | (faceup-test-font-lock-file 'faceup-test-mode
44 | (concat
45 | faceup-test-files-dir
46 | file))))
47 | (faceup-defexplainer faceup-test-file)
48 |
49 | (ert-deftest faceup-files ()
50 | (should (faceup-test-file "files/test1.txt")))
51 |
52 | (provide 'faceup-test-files)
53 |
54 | ;; faceup-test-files.el ends here.
55 |
--------------------------------------------------------------------------------
/test/faceup-test-mode.el:
--------------------------------------------------------------------------------
1 | ;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'.
2 |
3 | ;; Copyright (C) 2015 Anders Lindgren
4 |
5 | ;; Author: Anders Lindgren
6 | ;; Created: 2015-02-14
7 | ;; URL: https://github.com/Lindydancer/faceup
8 |
9 | ;; This program is free software: you can redistribute it and/or modify
10 | ;; it under the terms of the GNU General Public License as published by
11 | ;; the Free Software Foundation, either version 3 of the License, or
12 | ;; (at your option) any later version.
13 | ;;
14 | ;; This program is distributed in the hope that it will be useful,
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 | ;; GNU General Public License for more details.
18 | ;;
19 | ;; You should have received a copy of the GNU General Public License
20 | ;; along with this program. If not, see .
21 |
22 | ;;; Commentary:
23 |
24 | ;; Dummy major-mode for testing `faceup', a regression test system for
25 | ;; font-lock keywords (syntax highlighting rules for Emacs).
26 | ;;
27 | ;; This mode use `syntax-propertize' to set the `syntax-table'
28 | ;; property on "<" and ">" in "" to make them act like
29 | ;; parentheses.
30 | ;;
31 | ;; This mode also sets the `help-echo' property on the text WARNING,
32 | ;; the effect is that Emacs displays a tooltip when you move your
33 | ;; mouse on to the text.
34 |
35 | ;;; Code:
36 |
37 | (defvar faceup-test-mode-syntax-table
38 | (make-syntax-table)
39 | "Syntax table for `faceup-test-mode'.")
40 |
41 | (defvar faceup-test-font-lock-keywords
42 | '(("\\_"
43 | (0 (progn
44 | (add-text-properties (match-beginning 0)
45 | (match-end 0)
46 | '(help-echo "Baloon tip: Fly smoothly!"))
47 | font-lock-warning-face))))
48 | "Highlight rules for `faceup-test-mode'.")
49 |
50 | (defun faceup-test-syntax-propertize (start end)
51 | (goto-char start)
52 | (funcall
53 | (syntax-propertize-rules
54 | ("\\(<\\)\\([^<>\n]*\\)\\(>\\)"
55 | (1 "() ")
56 | (3 ")( ")))
57 | start end))
58 |
59 | (defmacro faceup-test-define-prog-mode (mode name &rest args)
60 | "Define a major mode for a programming language.
61 | If `prog-mode' is defined, inherit from it."
62 | (declare (indent defun))
63 | `(define-derived-mode
64 | ,mode ,(and (fboundp 'prog-mode) 'prog-mode)
65 | ,name ,@args))
66 |
67 | ;;;###autoload
68 | (faceup-test-define-prog-mode faceup-test-mode "faceup-test"
69 | "Dummy major mode for testing `faceup', a test system for font-lock."
70 | (set (make-local-variable 'syntax-propertize-function)
71 | #'faceup-test-syntax-propertize)
72 | (setq font-lock-defaults '(faceup-test-font-lock-keywords nil)))
73 |
74 | (provide 'faceup-test-mode)
75 |
76 | ;;; faceup-test-mode.el ends here
77 |
--------------------------------------------------------------------------------
/test/faceup-test-setup.el:
--------------------------------------------------------------------------------
1 | ;;; faceup-test-setup.el --- Setup and execute all tests.
2 |
3 | ;;; Commentary:
4 |
5 | ;; This package sets up a suitable environment for testing
6 | ;; faceup, and executes the tests.
7 | ;;
8 | ;; Usage:
9 | ;;
10 | ;; emacs -q -l faceup-test-setup.el
11 | ;;
12 | ;; Note that this package assumes that some packages are located in
13 | ;; specific locations.
14 | ;;
15 | ;; Note that different Emacs versions highlight Objective-C slightly
16 | ;; differently. The corresponding .faceup file was generated using
17 | ;; Emacs 24.3.
18 |
19 | ;;; Code:
20 |
21 | (setq inhibit-startup-screen t)
22 | (prefer-coding-system 'utf-8)
23 |
24 | (defvar faceup-test-setup-directory
25 | (if load-file-name
26 | (file-name-directory load-file-name)
27 | default-directory))
28 |
29 | (dolist (dir '("." ".." "../../faceup"))
30 | (add-to-list 'load-path (concat faceup-test-setup-directory dir)))
31 |
32 | (require 'faceup)
33 | (require 'faceup-test-basics)
34 | (require 'faceup-test-files)
35 |
36 | (if noninteractive
37 | (ert-run-tests-batch-and-exit)
38 | (ert t))
39 |
40 | ;;; faceup-test-setup.el ends here
41 |
--------------------------------------------------------------------------------
/test/faceup-test-this-file-directory.el:
--------------------------------------------------------------------------------
1 | (defvar faceup-test-this-file-directory (faceup-this-file-directory))
2 |
--------------------------------------------------------------------------------
/test/files/test1.txt:
--------------------------------------------------------------------------------
1 | This is a test of `faceup', a regression test system for font-lock
2 | keywords. It should use major mode `faceup-test-mode'.
3 |
4 | WARNING: The first word on this line should use
5 | `font-lock-warning-face', and a tooltip should be displayed if the
6 | mouse is move over it.
7 |
8 | In this mode "<" and ">" are parentheses, but only when on the same
9 | line without any other "<" and ">" characters between them.
10 | >
11 | <
12 | NOT OK
13 | >
14 |
15 | test1.txt ends here.
16 |
--------------------------------------------------------------------------------
/test/files/test1.txt.faceup:
--------------------------------------------------------------------------------
1 | This is a test of `faceup', a regression test system for font-lock
2 | keywords. It should use major mode `faceup-test-mode'.
3 |
4 | «(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use
5 | `font-lock-warning-face', and a tooltip should be displayed if the
6 | mouse is move over it.
7 |
8 | In this mode «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» are parentheses, but only when on the same
9 | line without any other «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» characters between them.
10 | «(syntax-table):(4 . 41):<»OK«(syntax-table):(5 . 40):>» » >
11 | <
12 | NOT OK
13 | >
14 |
15 | test1.txt ends here.
16 |
--------------------------------------------------------------------------------