Package list emacs-deferred / b7736d7
New upstream version 0.5.0 Lev Lamberov 4 years ago
13 changed file(s) with 1323 addition(s) and 661 deletion(s). Raw diff Collapse all Expand all
77 - EVM_EMACS=emacs-24.3-travis
88 - EVM_EMACS=emacs-24.4-travis
99 - EVM_EMACS=emacs-24.5-travis
10 - EVM_EMACS=emacs-25.1-travis
1011
1112 script:
1213 - emacs --version
0 GNU GENERAL PUBLIC LICENSE
1 Version 3, 29 June 2007
2
3 Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
4 Everyone is permitted to copy and distribute verbatim copies
5 of this license document, but changing it is not allowed.
6
7 Preamble
8
9 The GNU General Public License is a free, copyleft license for
10 software and other kinds of works.
11
12 The licenses for most software and other practical works are designed
13 to take away your freedom to share and change the works. By contrast,
14 the GNU General Public License is intended to guarantee your freedom to
15 share and change all versions of a program--to make sure it remains free
16 software for all its users. We, the Free Software Foundation, use the
17 GNU General Public License for most of our software; it applies also to
18 any other work released this way by its authors. You can apply it to
19 your programs, too.
20
21 When we speak of free software, we are referring to freedom, not
22 price. Our General Public Licenses are designed to make sure that you
23 have the freedom to distribute copies of free software (and charge for
24 them if you wish), that you receive source code or can get it if you
25 want it, that you can change the software or use pieces of it in new
26 free programs, and that you know you can do these things.
27
28 To protect your rights, we need to prevent others from denying you
29 these rights or asking you to surrender the rights. Therefore, you have
30 certain responsibilities if you distribute copies of the software, or if
31 you modify it: responsibilities to respect the freedom of others.
32
33 For example, if you distribute copies of such a program, whether
34 gratis or for a fee, you must pass on to the recipients the same
35 freedoms that you received. You must make sure that they, too, receive
36 or can get the source code. And you must show them these terms so they
37 know their rights.
38
39 Developers that use the GNU GPL protect your rights with two steps:
40 (1) assert copyright on the software, and (2) offer you this License
41 giving you legal permission to copy, distribute and/or modify it.
42
43 For the developers' and authors' protection, the GPL clearly explains
44 that there is no warranty for this free software. For both users' and
45 authors' sake, the GPL requires that modified versions be marked as
46 changed, so that their problems will not be attributed erroneously to
47 authors of previous versions.
48
49 Some devices are designed to deny users access to install or run
50 modified versions of the software inside them, although the manufacturer
51 can do so. This is fundamentally incompatible with the aim of
52 protecting users' freedom to change the software. The systematic
53 pattern of such abuse occurs in the area of products for individuals to
54 use, which is precisely where it is most unacceptable. Therefore, we
55 have designed this version of the GPL to prohibit the practice for those
56 products. If such problems arise substantially in other domains, we
57 stand ready to extend this provision to those domains in future versions
58 of the GPL, as needed to protect the freedom of users.
59
60 Finally, every program is threatened constantly by software patents.
61 States should not allow patents to restrict development and use of
62 software on general-purpose computers, but in those that do, we wish to
63 avoid the special danger that patents applied to a free program could
64 make it effectively proprietary. To prevent this, the GPL assures that
65 patents cannot be used to render the program non-free.
66
67 The precise terms and conditions for copying, distribution and
68 modification follow.
69
70 TERMS AND CONDITIONS
71
72 0. Definitions.
73
74 "This License" refers to version 3 of the GNU General Public License.
75
76 "Copyright" also means copyright-like laws that apply to other kinds of
77 works, such as semiconductor masks.
78
79 "The Program" refers to any copyrightable work licensed under this
80 License. Each licensee is addressed as "you". "Licensees" and
81 "recipients" may be individuals or organizations.
82
83 To "modify" a work means to copy from or adapt all or part of the work
84 in a fashion requiring copyright permission, other than the making of an
85 exact copy. The resulting work is called a "modified version" of the
86 earlier work or a work "based on" the earlier work.
87
88 A "covered work" means either the unmodified Program or a work based
89 on the Program.
90
91 To "propagate" a work means to do anything with it that, without
92 permission, would make you directly or secondarily liable for
93 infringement under applicable copyright law, except executing it on a
94 computer or modifying a private copy. Propagation includes copying,
95 distribution (with or without modification), making available to the
96 public, and in some countries other activities as well.
97
98 To "convey" a work means any kind of propagation that enables other
99 parties to make or receive copies. Mere interaction with a user through
100 a computer network, with no transfer of a copy, is not conveying.
101
102 An interactive user interface displays "Appropriate Legal Notices"
103 to the extent that it includes a convenient and prominently visible
104 feature that (1) displays an appropriate copyright notice, and (2)
105 tells the user that there is no warranty for the work (except to the
106 extent that warranties are provided), that licensees may convey the
107 work under this License, and how to view a copy of this License. If
108 the interface presents a list of user commands or options, such as a
109 menu, a prominent item in the list meets this criterion.
110
111 1. Source Code.
112
113 The "source code" for a work means the preferred form of the work
114 for making modifications to it. "Object code" means any non-source
115 form of a work.
116
117 A "Standard Interface" means an interface that either is an official
118 standard defined by a recognized standards body, or, in the case of
119 interfaces specified for a particular programming language, one that
120 is widely used among developers working in that language.
121
122 The "System Libraries" of an executable work include anything, other
123 than the work as a whole, that (a) is included in the normal form of
124 packaging a Major Component, but which is not part of that Major
125 Component, and (b) serves only to enable use of the work with that
126 Major Component, or to implement a Standard Interface for which an
127 implementation is available to the public in source code form. A
128 "Major Component", in this context, means a major essential component
129 (kernel, window system, and so on) of the specific operating system
130 (if any) on which the executable work runs, or a compiler used to
131 produce the work, or an object code interpreter used to run it.
132
133 The "Corresponding Source" for a work in object code form means all
134 the source code needed to generate, install, and (for an executable
135 work) run the object code and to modify the work, including scripts to
136 control those activities. However, it does not include the work's
137 System Libraries, or general-purpose tools or generally available free
138 programs which are used unmodified in performing those activities but
139 which are not part of the work. For example, Corresponding Source
140 includes interface definition files associated with source files for
141 the work, and the source code for shared libraries and dynamically
142 linked subprograms that the work is specifically designed to require,
143 such as by intimate data communication or control flow between those
144 subprograms and other parts of the work.
145
146 The Corresponding Source need not include anything that users
147 can regenerate automatically from other parts of the Corresponding
148 Source.
149
150 The Corresponding Source for a work in source code form is that
151 same work.
152
153 2. Basic Permissions.
154
155 All rights granted under this License are granted for the term of
156 copyright on the Program, and are irrevocable provided the stated
157 conditions are met. This License explicitly affirms your unlimited
158 permission to run the unmodified Program. The output from running a
159 covered work is covered by this License only if the output, given its
160 content, constitutes a covered work. This License acknowledges your
161 rights of fair use or other equivalent, as provided by copyright law.
162
163 You may make, run and propagate covered works that you do not
164 convey, without conditions so long as your license otherwise remains
165 in force. You may convey covered works to others for the sole purpose
166 of having them make modifications exclusively for you, or provide you
167 with facilities for running those works, provided that you comply with
168 the terms of this License in conveying all material for which you do
169 not control copyright. Those thus making or running the covered works
170 for you must do so exclusively on your behalf, under your direction
171 and control, on terms that prohibit them from making any copies of
172 your copyrighted material outside their relationship with you.
173
174 Conveying under any other circumstances is permitted solely under
175 the conditions stated below. Sublicensing is not allowed; section 10
176 makes it unnecessary.
177
178 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
179
180 No covered work shall be deemed part of an effective technological
181 measure under any applicable law fulfilling obligations under article
182 11 of the WIPO copyright treaty adopted on 20 December 1996, or
183 similar laws prohibiting or restricting circumvention of such
184 measures.
185
186 When you convey a covered work, you waive any legal power to forbid
187 circumvention of technological measures to the extent such circumvention
188 is effected by exercising rights under this License with respect to
189 the covered work, and you disclaim any intention to limit operation or
190 modification of the work as a means of enforcing, against the work's
191 users, your or third parties' legal rights to forbid circumvention of
192 technological measures.
193
194 4. Conveying Verbatim Copies.
195
196 You may convey verbatim copies of the Program's source code as you
197 receive it, in any medium, provided that you conspicuously and
198 appropriately publish on each copy an appropriate copyright notice;
199 keep intact all notices stating that this License and any
200 non-permissive terms added in accord with section 7 apply to the code;
201 keep intact all notices of the absence of any warranty; and give all
202 recipients a copy of this License along with the Program.
203
204 You may charge any price or no price for each copy that you convey,
205 and you may offer support or warranty protection for a fee.
206
207 5. Conveying Modified Source Versions.
208
209 You may convey a work based on the Program, or the modifications to
210 produce it from the Program, in the form of source code under the
211 terms of section 4, provided that you also meet all of these conditions:
212
213 a) The work must carry prominent notices stating that you modified
214 it, and giving a relevant date.
215
216 b) The work must carry prominent notices stating that it is
217 released under this License and any conditions added under section
218 7. This requirement modifies the requirement in section 4 to
219 "keep intact all notices".
220
221 c) You must license the entire work, as a whole, under this
222 License to anyone who comes into possession of a copy. This
223 License will therefore apply, along with any applicable section 7
224 additional terms, to the whole of the work, and all its parts,
225 regardless of how they are packaged. This License gives no
226 permission to license the work in any other way, but it does not
227 invalidate such permission if you have separately received it.
228
229 d) If the work has interactive user interfaces, each must display
230 Appropriate Legal Notices; however, if the Program has interactive
231 interfaces that do not display Appropriate Legal Notices, your
232 work need not make them do so.
233
234 A compilation of a covered work with other separate and independent
235 works, which are not by their nature extensions of the covered work,
236 and which are not combined with it such as to form a larger program,
237 in or on a volume of a storage or distribution medium, is called an
238 "aggregate" if the compilation and its resulting copyright are not
239 used to limit the access or legal rights of the compilation's users
240 beyond what the individual works permit. Inclusion of a covered work
241 in an aggregate does not cause this License to apply to the other
242 parts of the aggregate.
243
244 6. Conveying Non-Source Forms.
245
246 You may convey a covered work in object code form under the terms
247 of sections 4 and 5, provided that you also convey the
248 machine-readable Corresponding Source under the terms of this License,
249 in one of these ways:
250
251 a) Convey the object code in, or embodied in, a physical product
252 (including a physical distribution medium), accompanied by the
253 Corresponding Source fixed on a durable physical medium
254 customarily used for software interchange.
255
256 b) Convey the object code in, or embodied in, a physical product
257 (including a physical distribution medium), accompanied by a
258 written offer, valid for at least three years and valid for as
259 long as you offer spare parts or customer support for that product
260 model, to give anyone who possesses the object code either (1) a
261 copy of the Corresponding Source for all the software in the
262 product that is covered by this License, on a durable physical
263 medium customarily used for software interchange, for a price no
264 more than your reasonable cost of physically performing this
265 conveying of source, or (2) access to copy the
266 Corresponding Source from a network server at no charge.
267
268 c) Convey individual copies of the object code with a copy of the
269 written offer to provide the Corresponding Source. This
270 alternative is allowed only occasionally and noncommercially, and
271 only if you received the object code with such an offer, in accord
272 with subsection 6b.
273
274 d) Convey the object code by offering access from a designated
275 place (gratis or for a charge), and offer equivalent access to the
276 Corresponding Source in the same way through the same place at no
277 further charge. You need not require recipients to copy the
278 Corresponding Source along with the object code. If the place to
279 copy the object code is a network server, the Corresponding Source
280 may be on a different server (operated by you or a third party)
281 that supports equivalent copying facilities, provided you maintain
282 clear directions next to the object code saying where to find the
283 Corresponding Source. Regardless of what server hosts the
284 Corresponding Source, you remain obligated to ensure that it is
285 available for as long as needed to satisfy these requirements.
286
287 e) Convey the object code using peer-to-peer transmission, provided
288 you inform other peers where the object code and Corresponding
289 Source of the work are being offered to the general public at no
290 charge under subsection 6d.
291
292 A separable portion of the object code, whose source code is excluded
293 from the Corresponding Source as a System Library, need not be
294 included in conveying the object code work.
295
296 A "User Product" is either (1) a "consumer product", which means any
297 tangible personal property which is normally used for personal, family,
298 or household purposes, or (2) anything designed or sold for incorporation
299 into a dwelling. In determining whether a product is a consumer product,
300 doubtful cases shall be resolved in favor of coverage. For a particular
301 product received by a particular user, "normally used" refers to a
302 typical or common use of that class of product, regardless of the status
303 of the particular user or of the way in which the particular user
304 actually uses, or expects or is expected to use, the product. A product
305 is a consumer product regardless of whether the product has substantial
306 commercial, industrial or non-consumer uses, unless such uses represent
307 the only significant mode of use of the product.
308
309 "Installation Information" for a User Product means any methods,
310 procedures, authorization keys, or other information required to install
311 and execute modified versions of a covered work in that User Product from
312 a modified version of its Corresponding Source. The information must
313 suffice to ensure that the continued functioning of the modified object
314 code is in no case prevented or interfered with solely because
315 modification has been made.
316
317 If you convey an object code work under this section in, or with, or
318 specifically for use in, a User Product, and the conveying occurs as
319 part of a transaction in which the right of possession and use of the
320 User Product is transferred to the recipient in perpetuity or for a
321 fixed term (regardless of how the transaction is characterized), the
322 Corresponding Source conveyed under this section must be accompanied
323 by the Installation Information. But this requirement does not apply
324 if neither you nor any third party retains the ability to install
325 modified object code on the User Product (for example, the work has
326 been installed in ROM).
327
328 The requirement to provide Installation Information does not include a
329 requirement to continue to provide support service, warranty, or updates
330 for a work that has been modified or installed by the recipient, or for
331 the User Product in which it has been modified or installed. Access to a
332 network may be denied when the modification itself materially and
333 adversely affects the operation of the network or violates the rules and
334 protocols for communication across the network.
335
336 Corresponding Source conveyed, and Installation Information provided,
337 in accord with this section must be in a format that is publicly
338 documented (and with an implementation available to the public in
339 source code form), and must require no special password or key for
340 unpacking, reading or copying.
341
342 7. Additional Terms.
343
344 "Additional permissions" are terms that supplement the terms of this
345 License by making exceptions from one or more of its conditions.
346 Additional permissions that are applicable to the entire Program shall
347 be treated as though they were included in this License, to the extent
348 that they are valid under applicable law. If additional permissions
349 apply only to part of the Program, that part may be used separately
350 under those permissions, but the entire Program remains governed by
351 this License without regard to the additional permissions.
352
353 When you convey a copy of a covered work, you may at your option
354 remove any additional permissions from that copy, or from any part of
355 it. (Additional permissions may be written to require their own
356 removal in certain cases when you modify the work.) You may place
357 additional permissions on material, added by you to a covered work,
358 for which you have or can give appropriate copyright permission.
359
360 Notwithstanding any other provision of this License, for material you
361 add to a covered work, you may (if authorized by the copyright holders of
362 that material) supplement the terms of this License with terms:
363
364 a) Disclaiming warranty or limiting liability differently from the
365 terms of sections 15 and 16 of this License; or
366
367 b) Requiring preservation of specified reasonable legal notices or
368 author attributions in that material or in the Appropriate Legal
369 Notices displayed by works containing it; or
370
371 c) Prohibiting misrepresentation of the origin of that material, or
372 requiring that modified versions of such material be marked in
373 reasonable ways as different from the original version; or
374
375 d) Limiting the use for publicity purposes of names of licensors or
376 authors of the material; or
377
378 e) Declining to grant rights under trademark law for use of some
379 trade names, trademarks, or service marks; or
380
381 f) Requiring indemnification of licensors and authors of that
382 material by anyone who conveys the material (or modified versions of
383 it) with contractual assumptions of liability to the recipient, for
384 any liability that these contractual assumptions directly impose on
385 those licensors and authors.
386
387 All other non-permissive additional terms are considered "further
388 restrictions" within the meaning of section 10. If the Program as you
389 received it, or any part of it, contains a notice stating that it is
390 governed by this License along with a term that is a further
391 restriction, you may remove that term. If a license document contains
392 a further restriction but permits relicensing or conveying under this
393 License, you may add to a covered work material governed by the terms
394 of that license document, provided that the further restriction does
395 not survive such relicensing or conveying.
396
397 If you add terms to a covered work in accord with this section, you
398 must place, in the relevant source files, a statement of the
399 additional terms that apply to those files, or a notice indicating
400 where to find the applicable terms.
401
402 Additional terms, permissive or non-permissive, may be stated in the
403 form of a separately written license, or stated as exceptions;
404 the above requirements apply either way.
405
406 8. Termination.
407
408 You may not propagate or modify a covered work except as expressly
409 provided under this License. Any attempt otherwise to propagate or
410 modify it is void, and will automatically terminate your rights under
411 this License (including any patent licenses granted under the third
412 paragraph of section 11).
413
414 However, if you cease all violation of this License, then your
415 license from a particular copyright holder is reinstated (a)
416 provisionally, unless and until the copyright holder explicitly and
417 finally terminates your license, and (b) permanently, if the copyright
418 holder fails to notify you of the violation by some reasonable means
419 prior to 60 days after the cessation.
420
421 Moreover, your license from a particular copyright holder is
422 reinstated permanently if the copyright holder notifies you of the
423 violation by some reasonable means, this is the first time you have
424 received notice of violation of this License (for any work) from that
425 copyright holder, and you cure the violation prior to 30 days after
426 your receipt of the notice.
427
428 Termination of your rights under this section does not terminate the
429 licenses of parties who have received copies or rights from you under
430 this License. If your rights have been terminated and not permanently
431 reinstated, you do not qualify to receive new licenses for the same
432 material under section 10.
433
434 9. Acceptance Not Required for Having Copies.
435
436 You are not required to accept this License in order to receive or
437 run a copy of the Program. Ancillary propagation of a covered work
438 occurring solely as a consequence of using peer-to-peer transmission
439 to receive a copy likewise does not require acceptance. However,
440 nothing other than this License grants you permission to propagate or
441 modify any covered work. These actions infringe copyright if you do
442 not accept this License. Therefore, by modifying or propagating a
443 covered work, you indicate your acceptance of this License to do so.
444
445 10. Automatic Licensing of Downstream Recipients.
446
447 Each time you convey a covered work, the recipient automatically
448 receives a license from the original licensors, to run, modify and
449 propagate that work, subject to this License. You are not responsible
450 for enforcing compliance by third parties with this License.
451
452 An "entity transaction" is a transaction transferring control of an
453 organization, or substantially all assets of one, or subdividing an
454 organization, or merging organizations. If propagation of a covered
455 work results from an entity transaction, each party to that
456 transaction who receives a copy of the work also receives whatever
457 licenses to the work the party's predecessor in interest had or could
458 give under the previous paragraph, plus a right to possession of the
459 Corresponding Source of the work from the predecessor in interest, if
460 the predecessor has it or can get it with reasonable efforts.
461
462 You may not impose any further restrictions on the exercise of the
463 rights granted or affirmed under this License. For example, you may
464 not impose a license fee, royalty, or other charge for exercise of
465 rights granted under this License, and you may not initiate litigation
466 (including a cross-claim or counterclaim in a lawsuit) alleging that
467 any patent claim is infringed by making, using, selling, offering for
468 sale, or importing the Program or any portion of it.
469
470 11. Patents.
471
472 A "contributor" is a copyright holder who authorizes use under this
473 License of the Program or a work on which the Program is based. The
474 work thus licensed is called the contributor's "contributor version".
475
476 A contributor's "essential patent claims" are all patent claims
477 owned or controlled by the contributor, whether already acquired or
478 hereafter acquired, that would be infringed by some manner, permitted
479 by this License, of making, using, or selling its contributor version,
480 but do not include claims that would be infringed only as a
481 consequence of further modification of the contributor version. For
482 purposes of this definition, "control" includes the right to grant
483 patent sublicenses in a manner consistent with the requirements of
484 this License.
485
486 Each contributor grants you a non-exclusive, worldwide, royalty-free
487 patent license under the contributor's essential patent claims, to
488 make, use, sell, offer for sale, import and otherwise run, modify and
489 propagate the contents of its contributor version.
490
491 In the following three paragraphs, a "patent license" is any express
492 agreement or commitment, however denominated, not to enforce a patent
493 (such as an express permission to practice a patent or covenant not to
494 sue for patent infringement). To "grant" such a patent license to a
495 party means to make such an agreement or commitment not to enforce a
496 patent against the party.
497
498 If you convey a covered work, knowingly relying on a patent license,
499 and the Corresponding Source of the work is not available for anyone
500 to copy, free of charge and under the terms of this License, through a
501 publicly available network server or other readily accessible means,
502 then you must either (1) cause the Corresponding Source to be so
503 available, or (2) arrange to deprive yourself of the benefit of the
504 patent license for this particular work, or (3) arrange, in a manner
505 consistent with the requirements of this License, to extend the patent
506 license to downstream recipients. "Knowingly relying" means you have
507 actual knowledge that, but for the patent license, your conveying the
508 covered work in a country, or your recipient's use of the covered work
509 in a country, would infringe one or more identifiable patents in that
510 country that you have reason to believe are valid.
511
512 If, pursuant to or in connection with a single transaction or
513 arrangement, you convey, or propagate by procuring conveyance of, a
514 covered work, and grant a patent license to some of the parties
515 receiving the covered work authorizing them to use, propagate, modify
516 or convey a specific copy of the covered work, then the patent license
517 you grant is automatically extended to all recipients of the covered
518 work and works based on it.
519
520 A patent license is "discriminatory" if it does not include within
521 the scope of its coverage, prohibits the exercise of, or is
522 conditioned on the non-exercise of one or more of the rights that are
523 specifically granted under this License. You may not convey a covered
524 work if you are a party to an arrangement with a third party that is
525 in the business of distributing software, under which you make payment
526 to the third party based on the extent of your activity of conveying
527 the work, and under which the third party grants, to any of the
528 parties who would receive the covered work from you, a discriminatory
529 patent license (a) in connection with copies of the covered work
530 conveyed by you (or copies made from those copies), or (b) primarily
531 for and in connection with specific products or compilations that
532 contain the covered work, unless you entered into that arrangement,
533 or that patent license was granted, prior to 28 March 2007.
534
535 Nothing in this License shall be construed as excluding or limiting
536 any implied license or other defenses to infringement that may
537 otherwise be available to you under applicable patent law.
538
539 12. No Surrender of Others' Freedom.
540
541 If conditions are imposed on you (whether by court order, agreement or
542 otherwise) that contradict the conditions of this License, they do not
543 excuse you from the conditions of this License. If you cannot convey a
544 covered work so as to satisfy simultaneously your obligations under this
545 License and any other pertinent obligations, then as a consequence you may
546 not convey it at all. For example, if you agree to terms that obligate you
547 to collect a royalty for further conveying from those to whom you convey
548 the Program, the only way you could satisfy both those terms and this
549 License would be to refrain entirely from conveying the Program.
550
551 13. Use with the GNU Affero General Public License.
552
553 Notwithstanding any other provision of this License, you have
554 permission to link or combine any covered work with a work licensed
555 under version 3 of the GNU Affero General Public License into a single
556 combined work, and to convey the resulting work. The terms of this
557 License will continue to apply to the part which is the covered work,
558 but the special requirements of the GNU Affero General Public License,
559 section 13, concerning interaction through a network will apply to the
560 combination as such.
561
562 14. Revised Versions of this License.
563
564 The Free Software Foundation may publish revised and/or new versions of
565 the GNU General Public License from time to time. Such new versions will
566 be similar in spirit to the present version, but may differ in detail to
567 address new problems or concerns.
568
569 Each version is given a distinguishing version number. If the
570 Program specifies that a certain numbered version of the GNU General
571 Public License "or any later version" applies to it, you have the
572 option of following the terms and conditions either of that numbered
573 version or of any later version published by the Free Software
574 Foundation. If the Program does not specify a version number of the
575 GNU General Public License, you may choose any version ever published
576 by the Free Software Foundation.
577
578 If the Program specifies that a proxy can decide which future
579 versions of the GNU General Public License can be used, that proxy's
580 public statement of acceptance of a version permanently authorizes you
581 to choose that version for the Program.
582
583 Later license versions may give you additional or different
584 permissions. However, no additional obligations are imposed on any
585 author or copyright holder as a result of your choosing to follow a
586 later version.
587
588 15. Disclaimer of Warranty.
589
590 THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
591 APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
592 HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
593 OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
594 THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
595 PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
596 IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
597 ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
598
599 16. Limitation of Liability.
600
601 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
602 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
603 THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
604 GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
605 USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
606 DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
607 PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
608 EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
609 SUCH DAMAGES.
610
611 17. Interpretation of Sections 15 and 16.
612
613 If the disclaimer of warranty and limitation of liability provided
614 above cannot be given local legal effect according to their terms,
615 reviewing courts shall apply local law that most closely approximates
616 an absolute waiver of all civil liability in connection with the
617 Program, unless a warranty or assumption of liability accompanies a
618 copy of the Program in return for a fee.
619
620 END OF TERMS AND CONDITIONS
621
622 How to Apply These Terms to Your New Programs
623
624 If you develop a new program, and you want it to be of the greatest
625 possible use to the public, the best way to achieve this is to make it
626 free software which everyone can redistribute and change under these terms.
627
628 To do so, attach the following notices to the program. It is safest
629 to attach them to the start of each source file to most effectively
630 state the exclusion of warranty; and each file should have at least
631 the "copyright" line and a pointer to where the full notice is found.
632
633 <one line to give the program's name and a brief idea of what it does.>
634 Copyright (C) <year> <name of author>
635
636 This program is free software: you can redistribute it and/or modify
637 it under the terms of the GNU General Public License as published by
638 the Free Software Foundation, either version 3 of the License, or
639 (at your option) any later version.
640
641 This program is distributed in the hope that it will be useful,
642 but WITHOUT ANY WARRANTY; without even the implied warranty of
643 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
644 GNU General Public License for more details.
645
646 You should have received a copy of the GNU General Public License
647 along with this program. If not, see <http://www.gnu.org/licenses/>.
648
649 Also add information on how to contact you by electronic and paper mail.
650
651 If the program does terminal interaction, make it output a short
652 notice like this when it starts in an interactive mode:
653
654 <program> Copyright (C) <year> <name of author>
655 This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
656 This is free software, and you are welcome to redistribute it
657 under certain conditions; type `show c' for details.
658
659 The hypothetical commands `show w' and `show c' should show the appropriate
660 parts of the General Public License. Of course, your program's commands
661 might be different; for a GUI interface, you would use an "about box".
662
663 You should also get your employer (if you work as a programmer) or school,
664 if any, to sign a "copyright disclaimer" for the program, if necessary.
665 For more information on this, and how to apply and follow the GNU GPL, see
666 <http://www.gnu.org/licenses/>.
667
668 The GNU General Public License does not permit incorporating your program
669 into proprietary programs. If your program is a subroutine library, you
670 may consider it more useful to permit linking proprietary applications with
671 the library. If this is what you want to do, use the GNU Lesser General
672 Public License instead of this License. But first, please read
673 <http://www.gnu.org/philosophy/why-not-lgpl.html>.
00 EMACS ?= emacs
11 CASK ?= cask
2
3 CURL=curl --silent -L
4 ERT_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24
5 ERT=ert
6 CL_URL=https://raw.githubusercontent.com/emacsmirror/cl-lib/master/cl-lib.el
7 CL=cl-lib
82
93 .PHONY: test test-deferred test-concurrent compile clean print-deps travis-ci
104
1919
2020 ### Threadの例
2121
22 lexical-letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。
22 letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。
2323
2424 Thread:
2525
2626 ```el
27 (lexical-let
28 ((count 0) (anm "-/|\\-")
29 (end 50) (pos (point)))
27 (let ((count 0) (anm "-/|\\-")
28 (end 50) (pos (point)))
3029 (cc:thread
3130 60
3231 (message "Animation started.")
33 (while (> end (incf count))
32 (while (> end (cl-incf count))
3433 (save-excursion
3534 (when (< 1 count)
3635 (goto-char pos) (delete-char 1))
5554 ```el
5655 (setq fib-list nil)
5756 (setq fib-gen
58 (lexical-let ((a1 0) (a2 1))
57 (let ((a1 0) (a2 1))
5958 (cc:generator
6059 (lambda (x) (push x fib-list)) ; コールバックで結果受け取り
6160 (yield a1)
184183 (cc:signal-connect
185184 channel t ; t にするとすべてのシグナルを拾う
186185 (lambda (event)
187 (destructuring-bind (event-name (args)) event
186 (cl-destructuring-bind (event-name (args)) event
188187 (message "Listener : %S / %S" event-name args))))
189188
190189 (deferred:$ ; deferred で非同期タスクを接続できる
306305 * args: イベント引数
307306 * 返値:なし
308307 * シグナルを発信します。
309 * args は、受信側で (lambda (event) (destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。
308 * args は、受信側で (lambda (event) (cl-destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。
310309
311310
312311 * cc:signal-send-global (channel event-sym &rest args)
2323
2424 ### Pseud-thread
2525
26 Evaluating the lexical-let in the blow code, the animation starts. After few seconds, the animation will stop.
26 Evaluating the let in the blow code, the animation starts. After few seconds, the animation will stop.
2727
2828 Thread:
2929
3030 ```el
31 (lexical-let
32 ((count 0) (anm "-/|\\-")
33 (end 50) (pos (point)))
31 (let ((count 0) (anm "-/|\\-")
32 (end 50) (pos (point)))
3433 (cc:thread
3534 60
3635 (message "Animation started.")
37 (while (> end (incf count))
36 (while (> end (cl-incf count))
3837 (save-excursion
3938 (when (< 1 count)
4039 (goto-char pos) (delete-char 1))
6160 ```el
6261 (setq fib-list nil)
6362 (setq fib-gen
64 (lexical-let ((a1 0) (a2 1))
63 (let ((a1 0) (a2 1))
6564 (cc:generator
6665 (lambda (x) (push x fib-list)) ; Receiving values as a callback function
6766 (yield a1)
200199 (cc:signal-connect
201200 channel t ; The signal symbol 't' means any signals.
202201 (lambda (event)
203 (destructuring-bind (event-name (args)) event
202 (cl-destructuring-bind (event-name (args)) event
204203 (message "Listener : %S / %S" event-name args))))
205204
206205 (deferred:$ ; Connect the deferred task.
338337 * None
339338 * Send a signal to the channel.
340339 * If the `args` are given, observers can get the values by following code:
341 * `(lambda (event) (destructuring-bind (event-sym (args)) event ... ))`
340 * `(lambda (event) (cl-destructuring-bind (event-sym (args)) event ... ))`
342341
343342 * cc:signal-send-global (channel event-sym &rest args)
344343 * Arguments
66 [![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags)
77 [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html)
88
9 deferred.elは非同期処理を抽象化して書きやすくするためのライブラリです。APIや
10 実装については
9 deferred.el は非同期処理を抽象化して書きやすくするためのライブラリです。
10 APIや実装については
1111 [JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45さん)と
1212 [Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html
1313 "Mochikit.Async") (by Bob Ippolitoさん)を参考にしています。
142142 (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
143143 (deferred:nextc it
144144 (lambda (buffers)
145 (loop for i in buffers
146 do
147 (insert
148 (format
149 "size: %s\n"
150 (with-current-buffer i (length (buffer-string)))))
151 (kill-buffer i)))))
145 (cl-loop for i in buffers
146 do
147 (insert
148 (format
149 "size: %s\n"
150 (with-current-buffer i (length (buffer-string)))))
151 (kill-buffer i)))))
152152 ```
153153
154154 * deferred:parallel 内部で、並列に実行できるものは並列に動作します。
265265 Loop and animation:
266266
267267 ```el
268 (lexical-let ((count 0) (anm "-/|\\-")
269 (end 50) (pos (point))
270 (wait-time 50))
268 (let ((count 0) (anm "-/|\\-")
269 (end 50) (pos (point))
270 (wait-time 50))
271271 (deferred:$
272272 (deferred:next
273273 (lambda (x) (message "Animation started.")))
279279 (goto-char pos) (delete-char 1))
280280 (insert (char-to-string
281281 (aref anm (% count (length anm))))))
282 (if (> end (incf count)) ; 止める場合はdeferredでないものを返す(この場合はnil)
282 (if (> end (cl-incf count)) ; 止める場合はdeferredでないものを返す(この場合はnil)
283283 (deferred:nextc (deferred:wait wait-time) self)))) ; 続けるときはdeferredを返す
284284
285285 (deferred:nextc it
584584
585585 ### レキシカルスコープ ###
586586
587 deferredの処理に値を持って行く場合、lexical-let などを用いてレキシカルスコープを使うと大変便利です。
587 deferredの処理に値を持って行く場合、let などを用いてレキシカルスコープを使うと大変便利です。
588588
589589 特に、一連のdeferred処理の中で共通に使う値にレキシカルスコープを使うと、ローカル変数のようにアクセスすること出来るため、非同期処理のために値をグローバルに保持しておく必要が無くなります。
590590
591 lexical-let 例:
592
593 ```el
594 (lexical-let ((a (point)))
591 let 例:
592
593 ```el
594 (let ((a (point)))
595595 (deferred:$
596596 (deferred:wait 1000)
597597 (deferred:nextc it
600600 (insert "here!")))))
601601 ```
602602
603 逆に、lexical-letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。
603 逆に、letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。
604604
605605 ### カレント状態 ###
606606
623623 改善例:
624624
625625 ```el
626 (lexical-let ((buf (get-buffer "*Message*")))
626 (let ((buf (get-buffer "*Message*")))
627627 (deferred:$
628628 (deferred:wait 1000)
629629 (deferred:nextc it
143143 (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
144144 (deferred:nextc it
145145 (lambda (buffers)
146 (loop for i in buffers
147 do
148 (insert
149 (format
150 "size: %s\n"
151 (with-current-buffer i (length (buffer-string)))))
152 (kill-buffer i)))))
146 (cl-loop for i in buffers
147 do
148 (insert
149 (format
150 "size: %s\n"
151 (with-current-buffer i (length (buffer-string)))))
152 (kill-buffer i)))))
153153 ```
154154
155155 * The function `deferred:parallel` runs asynchronous tasks concurrently.
274274 Loop and animation:
275275
276276 ```el
277 (lexical-let ((count 0) (anm "-/|\\-")
278 (end 50) (pos (point))
279 (wait-time 50))
277 (let ((count 0) (anm "-/|\\-")
278 (end 50) (pos (point))
279 (wait-time 50))
280280 (deferred:$
281281 (deferred:next
282282 (lambda (x) (message "Animation started.")))
288288 (goto-char pos) (delete-char 1))
289289 (insert (char-to-string
290290 (aref anm (% count (length anm))))))
291 (if (> end (incf count)) ; return nil to stop this loop
291 (if (> end (cl-incf count)) ; return nil to stop this loop
292292 (deferred:nextc (deferred:wait wait-time) self)))) ; return the deferred
293293
294294 (deferred:nextc it
314314 1))
315315 (deferred:nextc it
316316 (lambda (x)
317 (lexical-let ((d (deferred:new #'identity)))
317 (let ((d (deferred:new #'identity)))
318318 (run-at-time 0 nil (lambda (x)
319319 ;; Start the following callback queue now.
320320 (deferred:callback-post d x))
638638
639639 ### Using lexical scope ###
640640
641 Using the lexical scope macro, such as `lexical-let`, the deferred tasks defined by lambdas can access local variables.
642
643 `lexical-let` Ex.:
644
645 ```el
646 (lexical-let ((a (point)))
641 Using the lexical scope macro, such as `let`, the deferred tasks defined by lambdas can access local variables.
642
643 `let` Ex.:
644
645 ```el
646 (let ((a (point)))
647647 (deferred:$
648648 (deferred:wait 1000)
649649 (deferred:nextc it
675675 Corrected:
676676
677677 ```el
678 (lexical-let ((buf (get-buffer "*Message*")))
678 (let ((buf (get-buffer "*Message*")))
679679 (deferred:$
680680 (deferred:wait 1000)
681681 (deferred:nextc it
0 ;;; concurrent.el --- Concurrent utility functions for emacs lisp
0 ;;; concurrent.el --- Concurrent utility functions for emacs lisp -*- lexical-binding: t; -*-
11
22 ;; Copyright (C) 2010-2016 SAKURAI Masashi
33
44 ;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
5 ;; Version: 0.4.0
5 ;; Version: 0.5.0
66 ;; Keywords: deferred, async, concurrent
7 ;; Package-Requires: ((deferred "0.4.0"))
7 ;; Package-Requires: ((emacs "24.3") (deferred "0.5.0"))
88 ;; URL: https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown
99
1010 ;; This program is free software; you can redistribute it and/or modify
3131 ;; - Dataflow
3232 ;; - Signal/Channel
3333
34 (require 'cl)
34 (require 'cl-lib)
3535
3636 (require 'deferred)
3737
5454 (defun cc:generator-replace-yield (tree)
5555 "[internal] Replace `yield' symbols to calling a function in TREE."
5656 (let (ret)
57 (loop for i in tree
58 do (cond
59 ((eq i 'yield)
60 (push 'funcall ret)
61 (push i ret))
62 ((listp i)
63 (push (cc:generator-replace-yield i) ret))
64 (t
65 (push i ret))))
57 (cl-loop for i in tree
58 do (cond
59 ((eq i 'yield)
60 (push 'funcall ret)
61 (push i ret))
62 ((listp i)
63 (push (cc:generator-replace-yield i) ret))
64 (t
65 (push i ret))))
6666 (nreverse ret)))
6767
6868 (defun cc:generator-line (chain line)
9292 (defmacro cc:generator (callback &rest body)
9393 "Create a generator object. If BODY has `yield' symbols, it
9494 means calling callback function CALLBACK."
95 (let ((chain (gensym))
96 (cc (gensym))
97 (waiter (gensym)))
98 `(lexical-let*
99 (,chain
100 (,cc ,callback)
101 (,waiter (deferred:new))
102 (yield (lambda (x) (funcall ,cc x) ,waiter)))
95 (let ((chain (cl-gensym))
96 (cc (cl-gensym))
97 (waiter (cl-gensym)))
98 `(let* (,chain
99 (,cc ,callback)
100 (,waiter (deferred:new))
101 (yield (lambda (x) (funcall ,cc x) ,waiter)))
103102 (setq ,chain ,waiter)
104 ,@(loop for i in body
105 collect
106 (cc:generator-line chain i))
103 ,@(cl-loop for i in body
104 collect
105 (cc:generator-line chain i))
107106 (lambda () (deferred:callback ,waiter)))))
108107
109108
123122 ((eq 'while (car line))
124123 (let ((condition (cadr line))
125124 (body (cddr line))
126 (retsym (gensym)))
125 (retsym (cl-gensym)))
127126 `(setq ,chain
128127 (deferred:nextc ,chain
129128 (deferred:lambda (x)
141140
142141 (defmacro cc:thread (wait-time-msec &rest body)
143142 "Return a thread object."
144 (let ((chain (gensym))
145 (dstart (gensym)))
146 `(lexical-let*
147 (,chain
148 (,dstart (deferred:new)))
143 (let ((chain (cl-gensym))
144 (dstart (cl-gensym)))
145 `(let* (,chain
146 (,dstart (deferred:new)))
149147 (setq ,chain ,dstart)
150 ,@(loop for i in body
151 collect
152 (cc:thread-line wait-time-msec chain i))
148 ,@(cl-loop for i in body
149 collect
150 (cc:thread-line wait-time-msec chain i))
153151 (deferred:callback ,dstart))))
154152 (put 'cc:thread 'lisp-indent-function 1)
155153
158156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159157 ;; Semaphore
160158
161 (defstruct cc:semaphore max-permits permits waiting-deferreds)
159 (cl-defstruct cc:semaphore max-permits permits waiting-deferreds)
162160
163161 (defun cc:semaphore-create(permits-num)
164162 "Return a semaphore object with PERMITS-NUM permissions."
172170 permission is returned, the task is executed."
173171 (cond
174172 ((< 0 (cc:semaphore-permits semaphore))
175 (decf (cc:semaphore-permits semaphore))
173 (cl-decf (cc:semaphore-permits semaphore))
176174 (deferred:succeed))
177175 (t
178176 (let ((d (deferred:new)))
195193 (nbutlast waiting-deferreds))
196194 (deferred:callback-post d)))
197195 (t
198 (incf (cc:semaphore-permits semaphore)))))
196 (cl-incf (cc:semaphore-permits semaphore)))))
199197 semaphore)
200198
201199 (defun cc:semaphore-with (semaphore body-func &optional error-func)
202200 "Execute the task BODY-FUNC asynchronously with the semaphore block."
203 (lexical-let ((semaphore semaphore))
204 (deferred:try
205 (deferred:nextc (cc:semaphore-acquire semaphore) body-func)
206 :catch
207 error-func
208 :finally
209 (lambda (_x) (cc:semaphore-release semaphore)))))
201 (deferred:try
202 (deferred:nextc (cc:semaphore-acquire semaphore) body-func)
203 :catch
204 error-func
205 :finally
206 (lambda (_x) (cc:semaphore-release semaphore))))
210207 (put 'cc:semaphore-with 'lisp-indent-function 1)
211208
212209 (defun cc:semaphore-release-all (semaphore)
239236 NAME is a channel name for debug.
240237 PARENT-CHANNEL is an upstream channel. The observers of this channel can receive the upstream signals.
241238 In the case of using the function `cc:signal-send', the observers of the upstream channel can not receive the signals of this channel. The function `cc:signal-send-global' can send a signal to the upstream channels from the downstream channels."
242 (lexical-let
243 ((ch (cons
244 (or name (format "signal%s" (deferred:uid))) ; name for debug
245 (cons
246 parent-channel ; parent-channel
247 nil)))) ; observers
239 (let ((ch (cons
240 (or name (format "signal%s" (deferred:uid))) ; name for debug
241 (cons
242 parent-channel ; parent-channel
243 nil)))) ; observers
248244 (when parent-channel
249245 (cc:signal-connect
250246 parent-channel
251247 t (lambda (event)
252 (destructuring-bind
248 (cl-destructuring-bind
253249 (event-name event-args) event
254250 (apply 'cc:signal-send
255251 ch event-name event-args)))))
284280 "Send a signal to CHANNEL. If ARGS values are given, observers can get the values by following code: (lambda (event) (destructuring-bind (event-sym (args)) event ... )). "
285281 (let ((observers (cc:signal-observers channel))
286282 (event (list event-sym args)))
287 (loop for i in observers
288 for name = (car i)
289 for d = (cdr i)
290 if (or (eq event-sym name) (eq t name))
291 do (deferred:callback-post d event))))
283 (cl-loop for i in observers
284 for name = (car i)
285 for d = (cdr i)
286 if (or (eq event-sym name) (eq t name))
287 do (deferred:callback-post d event))))
292288
293289 (defun cc:signal-send-global (channel event-sym &rest args)
294290 "Send a signal to the most upstream channel. "
303299 (let ((observers (cc:signal-observers channel)) deleted)
304300 (setf
305301 (cc:signal-observers channel) ; place
306 (loop for i in observers
307 for d = (cdr i)
308 unless (eq d deferred)
309 collect i
310 else
311 do (push i deleted)))
302 (cl-loop for i in observers
303 for d = (cdr i)
304 unless (eq d deferred)
305 collect i
306 else
307 do (push i deleted)))
312308 deleted))
313309
314310 (defun cc:signal-disconnect-all (channel)
324320 ;; Dataflow
325321
326322 ;; Dataflow variable entry
327 (defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
323 (cl-defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
328324
329325 (defun cc:dataflow-undefine-p (obj)
330326 "[internal] If the variable entry is not bound, return `t'."
340336
341337 (defmacro cc:dataflow-channel (df)
342338 "[internal] Return the channel object."
343 `(caddr ,df))
339 `(cl-caddr ,df))
344340
345341 (defmacro cc:dataflow-list (df)
346342 "[internal] Return the list of deferred object which are waiting for value binding."
347 `(cdddr ,df))
343 `(cl-cdddr ,df))
348344
349345 (defun cc:dataflow-environment (&optional parent-env test-func channel)
350346 "Create a dataflow environment.
370366
371367 (defun cc:dataflow-init-connect (df)
372368 "[internal] Initialize the channel object."
373 (lexical-let ((df df))
374 (cc:dataflow-connect
375 df 'set
376 (lambda (args)
377 (destructuring-bind (_event (key)) args
378 (let* ((obj (cc:dataflow-get-object-for-value df key))
379 (value (and obj (cc:dataflow-value obj))))
380 (when obj
381 (loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
382 (cc:dataflow-deferred-list it) nil)
383 do (deferred:callback-post i value))
384 (setf (cc:dataflow-deferred-list obj) nil))))))))
369 (cc:dataflow-connect
370 df 'set
371 (lambda (args)
372 (cl-destructuring-bind (_event (key)) args
373 (let* ((obj (cc:dataflow-get-object-for-value df key))
374 (value (and obj (cc:dataflow-value obj))))
375 (when obj
376 (cl-loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
377 (cc:dataflow-deferred-list it) nil)
378 do (deferred:callback-post i value))
379 (setf (cc:dataflow-deferred-list obj) nil)))))))
385380
386381 (defun cc:dataflow-get-object-for-value (df key)
387382 "[internal] Return an entry object that is indicated by KEY.
388383 If the environment DF doesn't have the entry and the parent one has the entry, this function returns the entry of the parent environment. This function doesn't affect the waiting list."
389384 (or
390 (loop for i in (cc:dataflow-list df)
391 with test = (cc:dataflow-test df)
392 if (and (funcall test key (cc:dataflow-key i))
393 (not (cc:dataflow-undefine-p i)))
394 return i)
385 (cl-loop for i in (cc:dataflow-list df)
386 with test = (cc:dataflow-test df)
387 if (and (funcall test key (cc:dataflow-key i))
388 (not (cc:dataflow-undefine-p i)))
389 return i)
395390 (deferred:aand
396391 (cc:dataflow-parent-environment df)
397392 (cc:dataflow-get-object-for-value it key))))
399394 (defun cc:dataflow-get-object-for-deferreds (df key)
400395 "[internal] Return a list of the deferred objects those are waiting for value binding.
401396 This function doesn't affect the waiting list and doesn't refer the parent environment."
402 (loop for i in (cc:dataflow-list df)
403 with test = (cc:dataflow-test df)
404 if (funcall test key (cc:dataflow-key i))
405 return i))
397 (cl-loop for i in (cc:dataflow-list df)
398 with test = (cc:dataflow-test df)
399 if (funcall test key (cc:dataflow-key i))
400 return i))
406401
407402 (defun cc:dataflow-connect (df event-sym &optional callback)
408403 "Append an observer for EVENT-SYM of the channel of DF and return a deferred object.
463458 This function does nothing for the waiting deferred objects."
464459 (cc:dataflow-signal df 'clear key)
465460 (setf (cc:dataflow-list df)
466 (loop for i in (cc:dataflow-list df)
467 with test = (cc:dataflow-test df)
468 unless (funcall test key (cc:dataflow-key i))
469 collect i)))
461 (cl-loop for i in (cc:dataflow-list df)
462 with test = (cc:dataflow-test df)
463 unless (funcall test key (cc:dataflow-key i))
464 collect i)))
470465
471466 (defun cc:dataflow-get-avalable-pairs (df)
472467 "Return an available key-value alist in the environment DF and the parent ones."
473468 (append
474 (loop for i in (cc:dataflow-list df)
475 for key = (cc:dataflow-key i)
476 for val = (cc:dataflow-value i)
477 unless (cc:dataflow-undefine-p i) collect (cons key val))
469 (cl-loop for i in (cc:dataflow-list df)
470 for key = (cc:dataflow-key i)
471 for val = (cc:dataflow-value i)
472 unless (cc:dataflow-undefine-p i) collect (cons key val))
478473 (deferred:aand
479474 (cc:dataflow-parent-environment df)
480475 (cc:dataflow-get-avalable-pairs it))))
482477 (defun cc:dataflow-get-waiting-keys (df)
483478 "Return a list of keys which have waiting deferred objects in the environment DF and the parent ones."
484479 (append
485 (loop for i in (cc:dataflow-list df)
486 for key = (cc:dataflow-key i)
487 if (cc:dataflow-undefine-p i) collect key)
480 (cl-loop for i in (cc:dataflow-list df)
481 for key = (cc:dataflow-key i)
482 if (cc:dataflow-undefine-p i) collect key)
488483 (deferred:aand
489484 (cc:dataflow-parent-environment df)
490485 (cc:dataflow-get-waiting-keys it))))
0 ;;; deferred.el --- Simple asynchronous functions for emacs lisp
0 ;;; deferred.el --- Simple asynchronous functions for emacs lisp -*- lexical-binding: t; -*-
11
22 ;; Copyright (C) 2010-2016 SAKURAI Masashi
33
44 ;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
5 ;; Version: 0.4.0
5 ;; Version: 0.5.0
66 ;; Keywords: deferred, async
7 ;; Package-Requires: ((emacs "24.3"))
78 ;; URL: https://github.com/kiwanami/emacs-deferred
89
910 ;; This program is free software; you can redistribute it and/or modify
6465 ;; This program makes simple multi-thread function, using
6566 ;; deferred.el.
6667
67 (require 'cl)
68 (require 'cl-lib)
6869
6970 (declare-function pp-display-expression 'pp)
7071
8384 "Anaphoric function chain macro for deferred chains."
8485 (declare (debug (&rest form)))
8586 `(let (it)
86 ,@(loop for i in elements
87 collect
88 `(setq it ,i))
87 ,@(cl-loop for i in elements
88 collect
89 `(setq it ,i))
8990 it))
9091
9192 (defmacro deferred:lambda (args &rest body)
9293 "Anaphoric lambda macro for self recursion."
9394 (declare (debug ("args" form &rest form)))
94 (let ((argsyms (loop repeat (length args) collect (gensym))))
95 (let ((argsyms (cl-loop repeat (length args) collect (cl-gensym))))
9596 `(lambda (,@argsyms)
96 (lexical-let (self)
97 (let (self)
9798 (setq self (lambda( ,@args ) ,@body))
9899 (funcall self ,@argsyms)))))
99100
100 (defmacro* deferred:try (d &key catch finally)
101 (cl-defmacro deferred:try (d &key catch finally)
101102 "Try-catch-finally macro. This macro simulates the
102103 try-catch-finally block asynchronously. CATCH and FINALLY can be
103104 nil. Because of asynchrony, this macro does not ensure that the
150151 (save-excursion
151152 (goto-char (point-max))
152153 (insert (format "%5i %s\n" deferred:debug-count (format ,@args)))))
153 (incf deferred:debug-count))))
154 (cl-incf deferred:debug-count))))
154155
155156 (defun deferred:message-mark ()
156157 "[internal] Debug log function."
253254 "Wait for the given deferred task. For test and debugging.
254255 Error is raised if it is not processed within deferred chain D."
255256 (progn
256 (lexical-let ((last-value 'deferred:undefined*)
257 uncaught-error)
257 (let ((last-value 'deferred:undefined*)
258 uncaught-error)
258259 (deferred:try
259260 (deferred:nextc d
260261 (lambda (x) (setq last-value x)))
279280 ;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil)
280281 ;; value : saved value (default nil)
281282 ;;
282 (defstruct deferred
283 (cl-defstruct deferred
283284 (callback 'deferred:default-callback)
284285 (errorback 'deferred:default-errorback)
285286 (cancel 'deferred:default-cancel)
317318 (setf (deferred-errorback d) 'deferred:default-errorback)
318319 (setf (deferred-next d) nil)
319320 d)
321
322 (defvar deferred:onerror nil
323 "Default error handler. This value is nil or a function that
324 have one argument for the error message.")
320325
321326 (defun deferred:exec-task (d which &optional arg)
322327 "[internal] Executing deferred task. If the deferred object has
427432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428433 ;; Basic utility functions
429434
430 (defvar deferred:onerror nil
431 "Default error handler. This value is nil or a function that
432 have one argument for the error message.")
433
434435 (defun deferred:succeed (&optional arg)
435436 "Create a synchronous deferred object."
436437 (let ((d (deferred:new)))
469470 return values. This function is used in following purposes,
470471 simulation of try-finally block in asynchronous tasks, progress
471472 monitoring of tasks."
472 (lexical-let*
473 ((callback callback)
474 (normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x))
475 (err (lambda (e)
476 (ignore-errors (deferred:call-lambda callback e))
477 (deferred:resignal e))))
473 (let* ((callback callback)
474 (normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x))
475 (err (lambda (e)
476 (ignore-errors (deferred:call-lambda callback e))
477 (deferred:resignal e))))
478478 (let ((nd (make-deferred :callback normal :errorback err)))
479479 (deferred:set-next d nd))))
480480
481481 (defun deferred:wait (msec)
482482 "Return a deferred object scheduled at MSEC millisecond later."
483 (lexical-let
484 ((d (deferred:new)) (start-time (float-time)) timer)
483 (let ((d (deferred:new)) (start-time (float-time)) timer)
485484 (deferred:message "WAIT : %s" msec)
486485 (setq timer (deferred:setTimeout
487486 (lambda ()
497496 (defun deferred:wait-idle (msec)
498497 "Return a deferred object which will run when Emacs has been
499498 idle for MSEC millisecond."
500 (lexical-let
501 ((d (deferred:new)) (start-time (float-time)) timer)
499 (let ((d (deferred:new)) (start-time (float-time)) timer)
502500 (deferred:message "WAIT-IDLE : %s" msec)
503501 (setq timer
504502 (deferred:run-with-idle-timer
515513
516514 (defun deferred:call (f &rest args)
517515 "Call the given function asynchronously."
518 (lexical-let ((f f) (args args))
519 (deferred:next
520 (lambda (_x)
521 (apply f args)))))
516 (deferred:next
517 (lambda (_x)
518 (apply f args))))
522519
523520 (defun deferred:apply (f &optional args)
524521 "Call the given function asynchronously."
525 (lexical-let ((f f) (args args))
526 (deferred:next
527 (lambda (_x)
528 (apply f args)))))
522 (deferred:next
523 (lambda (_x)
524 (apply f args))))
529525
530526
531527
541537 "Return a iteration deferred object."
542538 (deferred:message "LOOP : %s" times-or-seq)
543539 (if (deferred:empty-p times-or-seq) (deferred:next)
544 (lexical-let*
545 (items (rd
546 (cond
547 ((numberp times-or-seq)
548 (loop for i from 0 below times-or-seq
549 with ld = (deferred:next)
550 do
551 (push ld items)
552 (setq ld
553 (lexical-let ((i i) (func func))
554 (deferred:nextc ld (lambda (_x) (deferred:call-lambda func i)))))
555 finally return ld))
556 ((sequencep times-or-seq)
557 (loop for i in (append times-or-seq nil) ; seq->list
558 with ld = (deferred:next)
559 do
560 (push ld items)
561 (setq ld
562 (lexical-let ((i i) (func func))
563 (deferred:nextc ld (lambda (_x) (deferred:call-lambda func i)))))
564 finally return ld)))))
540 (let* (items (rd
541 (cond
542 ((numberp times-or-seq)
543 (cl-loop for i from 0 below times-or-seq
544 with ld = (deferred:next)
545 do
546 (push ld items)
547 (setq ld
548 (let ((i i))
549 (deferred:nextc ld
550 (lambda (_x) (deferred:call-lambda func i)))))
551 finally return ld))
552 ((sequencep times-or-seq)
553 (cl-loop for i in (append times-or-seq nil) ; seq->list
554 with ld = (deferred:next)
555 do
556 (push ld items)
557 (setq ld
558 (let ((i i))
559 (deferred:nextc ld
560 (lambda (_x) (deferred:call-lambda func i)))))
561 finally return ld)))))
565562 (setf (deferred-cancel rd)
566563 (lambda (x) (deferred:default-cancel x)
567 (loop for i in items
568 do (deferred:cancel i))))
564 (cl-loop for i in items
565 do (deferred:cancel i))))
569566 rd)))
570567
571568 (defun deferred:trans-multi-args (args self-func list-func main-func)
587584
588585 (defun deferred:parallel-array-to-alist (lst)
589586 "[internal] Translation array to alist."
590 (loop for d in lst
591 for i from 0 below (length lst)
592 collect (cons i d)))
587 (cl-loop for d in lst
588 for i from 0 below (length lst)
589 collect (cons i d)))
593590
594591 (defun deferred:parallel-alist-to-array (alst)
595592 "[internal] Translation alist to array."
596 (loop for pair in
597 (sort alst (lambda (x y)
598 (< (car x) (car y))))
599 collect (cdr pair)))
593 (cl-loop for pair in
594 (sort alst (lambda (x y)
595 (< (car x) (car y))))
596 collect (cdr pair)))
600597
601598 (defun deferred:parallel-func-to-deferred (alst)
602599 "[internal] Normalization for parallel and earlier arguments."
603 (loop for pair in alst
604 for d = (cdr pair)
605 collect
606 (progn
607 (unless (deferred-p d)
608 (setf (cdr pair) (deferred:next d)))
609 pair)))
600 (cl-loop for pair in alst
601 for d = (cdr pair)
602 collect
603 (progn
604 (unless (deferred-p d)
605 (setf (cdr pair) (deferred:next d)))
606 pair)))
610607
611608 (defun deferred:parallel-main (alst)
612609 "[internal] Deferred alist implementation for `deferred:parallel'. "
613610 (deferred:message "PARALLEL<KEY . VALUE>" )
614 (lexical-let ((nd (deferred:new))
615 (len (length alst))
616 values)
617 (loop for pair in
618 (deferred:parallel-func-to-deferred alst)
619 with cd ; current child deferred
620 do
621 (lexical-let ((name (car pair)))
622 (setq cd
623 (deferred:nextc (cdr pair)
624 (lambda (x)
625 (push (cons name x) values)
626 (deferred:message "PARALLEL VALUE [%s/%s] %s"
627 (length values) len (cons name x))
628 (when (= len (length values))
629 (deferred:message "PARALLEL COLLECTED")
630 (deferred:post-task nd 'ok (nreverse values)))
631 nil)))
632 (deferred:error cd
633 (lambda (e)
634 (push (cons name e) values)
635 (deferred:message "PARALLEL ERROR [%s/%s] %s"
636 (length values) len (cons name e))
637 (when (= (length values) len)
638 (deferred:message "PARALLEL COLLECTED")
639 (deferred:post-task nd 'ok (nreverse values)))
640 nil))))
611 (let ((nd (deferred:new))
612 (len (length alst))
613 values)
614 (cl-loop for pair in
615 (deferred:parallel-func-to-deferred alst)
616 with cd ; current child deferred
617 do
618 (let ((name (car pair)))
619 (setq cd
620 (deferred:nextc (cdr pair)
621 (lambda (x)
622 (push (cons name x) values)
623 (deferred:message "PARALLEL VALUE [%s/%s] %s"
624 (length values) len (cons name x))
625 (when (= len (length values))
626 (deferred:message "PARALLEL COLLECTED")
627 (deferred:post-task nd 'ok (nreverse values)))
628 nil)))
629 (deferred:error cd
630 (lambda (e)
631 (push (cons name e) values)
632 (deferred:message "PARALLEL ERROR [%s/%s] %s"
633 (length values) len (cons name e))
634 (when (= (length values) len)
635 (deferred:message "PARALLEL COLLECTED")
636 (deferred:post-task nd 'ok (nreverse values)))
637 nil))))
641638 nd))
642639
643640 (defun deferred:parallel-list (lst)
644641 "[internal] Deferred list implementation for `deferred:parallel'. "
645642 (deferred:message "PARALLEL<LIST>" )
646 (lexical-let*
647 ((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst)))
648 (rd (deferred:nextc pd 'deferred:parallel-alist-to-array)))
643 (let* ((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst)))
644 (rd (deferred:nextc pd 'deferred:parallel-alist-to-array)))
649645 (setf (deferred-cancel rd)
650646 (lambda (x) (deferred:default-cancel x)
651647 (deferred:cancel pd)))
664660 (defun deferred:earlier-main (alst)
665661 "[internal] Deferred alist implementation for `deferred:earlier'. "
666662 (deferred:message "EARLIER<KEY . VALUE>" )
667 (lexical-let ((nd (deferred:new))
668 (len (length alst))
669 value results)
670 (loop for pair in
671 (deferred:parallel-func-to-deferred alst)
672 with cd ; current child deferred
673 do
674 (lexical-let ((name (car pair)))
675 (setq cd
676 (deferred:nextc (cdr pair)
677 (lambda (x)
678 (push (cons name x) results)
679 (cond
680 ((null value)
681 (setq value (cons name x))
682 (deferred:message "EARLIER VALUE %s" (cons name value))
683 (deferred:post-task nd 'ok value))
684 (t
685 (deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value))
686 (when (eql (length results) len)
687 (deferred:message "EARLIER COLLECTED"))))
688 nil)))
689 (deferred:error cd
690 (lambda (e)
691 (push (cons name e) results)
692 (deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e))
693 (when (and (eql (length results) len) (null value))
694 (deferred:message "EARLIER FAILED")
695 (deferred:post-task nd 'ok nil))
696 nil))))
663 (let ((nd (deferred:new))
664 (len (length alst))
665 value results)
666 (cl-loop for pair in
667 (deferred:parallel-func-to-deferred alst)
668 with cd ; current child deferred
669 do
670 (let ((name (car pair)))
671 (setq cd
672 (deferred:nextc (cdr pair)
673 (lambda (x)
674 (push (cons name x) results)
675 (cond
676 ((null value)
677 (setq value (cons name x))
678 (deferred:message "EARLIER VALUE %s" (cons name value))
679 (deferred:post-task nd 'ok value))
680 (t
681 (deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value))
682 (when (eql (length results) len)
683 (deferred:message "EARLIER COLLECTED"))))
684 nil)))
685 (deferred:error cd
686 (lambda (e)
687 (push (cons name e) results)
688 (deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e))
689 (when (and (eql (length results) len) (null value))
690 (deferred:message "EARLIER FAILED")
691 (deferred:post-task nd 'ok nil))
692 nil))))
697693 nd))
698694
699695 (defun deferred:earlier-list (lst)
700696 "[internal] Deferred list implementation for `deferred:earlier'. "
701697 (deferred:message "EARLIER<LIST>" )
702 (lexical-let*
703 ((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst)))
704 (rd (deferred:nextc pd (lambda (x) (cdr x)))))
698 (let* ((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst)))
699 (rd (deferred:nextc pd (lambda (x) (cdr x)))))
705700 (setf (deferred-cancel rd)
706701 (lambda (x) (deferred:default-cancel x)
707702 (deferred:cancel pd)))
736731
737732 (defun deferred:uid ()
738733 "[internal] Generate a sequence number."
739 (incf deferred:uid))
734 (cl-incf deferred:uid))
740735
741736 (defun deferred:buffer-string (strformat buf)
742737 "[internal] Return a string in the buffer with the given format."
777772
778773 (defun deferred:process-gen (f command args)
779774 "[internal]"
780 (lexical-let
781 ((pd (deferred:process-buffer-gen f command args)) d)
775 (let ((pd (deferred:process-buffer-gen f command args)) d)
782776 (setq d (deferred:nextc pd
783777 (lambda (buf)
784778 (prog1
793787 (defun deferred:process-buffer-gen (f command args)
794788 "[internal]"
795789 (let ((d (deferred:next)) (uid (deferred:uid)))
796 (lexical-let
797 ((f f) (command command) (args args)
798 (proc-name (format "*deferred:*%s*:%s" command uid))
799 (buf-name (format " *deferred:*%s*:%s" command uid))
800 (pwd default-directory)
801 (env process-environment)
802 (con-type process-connection-type)
803 (nd (deferred:new)) proc-buf proc)
790 (let ((proc-name (format "*deferred:*%s*:%s" command uid))
791 (buf-name (format " *deferred:*%s*:%s" command uid))
792 (pwd default-directory)
793 (env process-environment)
794 (con-type process-connection-type)
795 (nd (deferred:new)) proc-buf proc)
804796 (deferred:nextc d
805797 (lambda (_x)
806798 (setq proc-buf (get-buffer-create buf-name))
825817 (kill-buffer proc-buf)
826818 (deferred:post-task nd 'ng msg)))
827819 ((equal event "finished\n")
828 (deferred:post-task nd 'ok proc-buf)))))
820 (deferred:post-task nd 'ok proc-buf)))))
829821 (setf (deferred-cancel nd)
830822 (lambda (x) (deferred:default-cancel x)
831823 (when proc
838830 (defmacro deferred:processc (d command &rest args)
839831 "Process chain of `deferred:process'."
840832 `(deferred:nextc ,d
841 (lambda (,(gensym)) (deferred:process ,command ,@args))))
833 (lambda (,(cl-gensym)) (deferred:process ,command ,@args))))
842834
843835 (defmacro deferred:process-bufferc (d command &rest args)
844836 "Process chain of `deferred:process-buffer'."
845837 `(deferred:nextc ,d
846 (lambda (,(gensym)) (deferred:process-buffer ,command ,@args))))
838 (lambda (,(cl-gensym)) (deferred:process-buffer ,command ,@args))))
847839
848840 (defmacro deferred:process-shellc (d command &rest args)
849841 "Process chain of `deferred:process'."
850842 `(deferred:nextc ,d
851 (lambda (,(gensym)) (deferred:process-shell ,command ,@args))))
843 (lambda (,(cl-gensym)) (deferred:process-shell ,command ,@args))))
852844
853845 (defmacro deferred:process-shell-bufferc (d command &rest args)
854846 "Process chain of `deferred:process-buffer'."
855847 `(deferred:nextc ,d
856 (lambda (,(gensym)) (deferred:process-shell-buffer ,command ,@args))))
848 (lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args))))
849
850 ;; Special variables defined in url-vars.el.
851 (defvar url-request-data)
852 (defvar url-request-method)
853 (defvar url-request-extra-headers)
854
855 (declare-function url-http-symbol-value-in-buffer "url-http"
856 (symbol buffer &optional unbound-value))
857
858 (declare-function deferred:url-param-serialize "request" (params))
859
860 (declare-function deferred:url-escape "request" (val))
857861
858862 (eval-after-load "url"
859863 ;; for url package
860864 ;; TODO: proxy, charaset
861865 ;; List of gloabl variables to preserve and restore before url-retrieve call
862 '(lexical-let ((url-global-variables '(url-request-data
863 url-request-method
864 url-request-extra-headers)))
866 '(let ((url-global-variables '(url-request-data
867 url-request-method
868 url-request-extra-headers)))
865869
866870 (defun deferred:url-retrieve (url &optional cbargs silent inhibit-cookies)
867871 "A wrapper function for url-retrieve. The next deferred
868872 object receives the buffer object that URL will load
869873 into. Values of dynamically bound 'url-request-data', 'url-request-method' and
870874 'url-request-extra-headers' are passed to url-retrieve call."
871 (lexical-let ((nd (deferred:new)) (url url)
872 (cbargs cbargs) (silent silent) (inhibit-cookies inhibit-cookies) buf
873 (local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables)))
875 (let ((nd (deferred:new))
876 buf
877 (local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables)))
874878 (deferred:next
875879 (lambda (_x)
876 (progv url-global-variables local-values
880 (cl-progv url-global-variables local-values
877881 (condition-case err
878882 (setq buf
879883 (url-retrieve
945949 (when params
946950 (mapconcat
947951 'identity
948 (loop for p in params
949 collect
950 (cond
951 ((consp p)
952 (concat
953 (deferred:url-escape (car p)) "="
954 (deferred:url-escape (cdr p))))
955 (t
956 (deferred:url-escape p))))
952 (cl-loop for p in params
953 collect
954 (cond
955 ((consp p)
956 (concat
957 (deferred:url-escape (car p)) "="
958 (deferred:url-escape (cdr p))))
959 (t
960 (deferred:url-escape p))))
957961 "&")))
958962 ))
959963
0 ;;; Sample code for concurrent.el
0 ;;; Sample code for concurrent.el -*- lexical-binding: t; -*-
11
22 ;; Evaluate following code in the scratch buffer.
3
4 (require 'cl-lib)
5 (require 'concurrent)
36
47 ;;==================================================
58 ;;; generator
69
7 (setq fib-list nil)
10 (defvar fib-list nil)
811
9 (setq fib-gen ; Create a generator object.
10 (lexical-let ((a1 0) (a2 1))
11 (cc:generator
12 (lambda (x) (push x fib-list)) ; receiving values
13 (yield a1)
14 (yield a2)
15 (while t
16 (let ((next (+ a1 a2)))
17 (setq a1 a2
18 a2 next)
19 (yield next))))))
12 (defvar fib-gen ; Create a generator object.
13 (let ((a1 0) (a2 1))
14 (cc:generator
15 (lambda (x) (push x fib-list)) ; receiving values
16 (yield a1)
17 (yield a2)
18 (while t
19 (let ((next (+ a1 a2)))
20 (setq a1 a2
21 a2 next)
22 (yield next))))))
2023
2124 (funcall fib-gen) ; Generate 5 times
2225 (funcall fib-gen) (funcall fib-gen)
2831 ;;==================================================
2932 ;;; thread
3033
31 (lexical-let
32 ((count 0) (anm "-/|\\-")
33 (end 50) (pos (point)))
34 (let ((count 0) (anm "-/|\\-")
35 (end 50) (pos (point)))
3436 (cc:thread
3537 60
3638 (message "Animation started.")
37 (while (> end (incf count))
39 (while (> end (cl-incf count))
3840 (save-excursion
3941 (when (< 1 count)
4042 (goto-char pos) (delete-char 1))
5153 ;;; semaphore
5254
5355 ;; create a semaphore object with permit=1.
54 (setq smp (cc:semaphore-create 1))
56 (defvar smp (cc:semaphore-create 1))
5557
5658 ;; executing three tasks...
5759 (deferred:nextc (cc:semaphore-acquire smp)
58 (lambda(x)
60 (lambda (_)
5961 (message "go1")))
6062 (deferred:nextc (cc:semaphore-acquire smp)
61 (lambda(x)
63 (lambda (_)
6264 (message "go2")))
6365 (deferred:nextc (cc:semaphore-acquire smp)
64 (lambda(x)
66 (lambda (_)
6567 (message "go3")))
6668
6769 ;; => Only the fist task is executed and displays "go1".
8183 ;; Dataflow
8284
8385 ;; create a parent environment and bind "aaa" to 256.
84 (setq dfenv-parent (cc:dataflow-environment))
86 (defvar dfenv-parent (cc:dataflow-environment))
8587 (cc:dataflow-set dfenv-parent "aaa" 256)
8688
8789 ;; create an environment with the parent one.
88 (setq dfenv (cc:dataflow-environment dfenv-parent))
90 (defvar dfenv (cc:dataflow-environment dfenv-parent))
8991
9092 ;; Return the parent value.
9193 (cc:dataflow-get-sync dfenv "aaa") ; => 256
150152 ;; Signal
151153
152154 (progn
153 (setq parent-channel (cc:signal-channel "parent"))
155 (defvar parent-channel (cc:signal-channel "parent"))
154156 (cc:signal-connect
155157 parent-channel 'parent-load
156158 (lambda (event) (message "Parent Signal : %s" event)))
158160 parent-channel t
159161 (lambda (event) (message "Parent Listener : %s" event)))
160162
161 (setq channel (cc:signal-channel "child" parent-channel))
163 (defvar channel (cc:signal-channel "child" parent-channel))
162164 (cc:signal-connect
163165 channel 'window-load
164166 (lambda (event) (message "Signal : %s" event)))
0 ;; deferred.el samples
0 ;; deferred.el samples -*- lexical-binding: t; -*-
11
2 (require 'cl-lib)
23 (require 'deferred)
34
45 ;;; Basic Chain
8990 (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
9091 (deferred:nextc it
9192 (lambda (buffers)
92 (loop for i in buffers
93 do
94 (insert
95 (format
96 "size: %s\n"
97 (with-current-buffer i (length (buffer-string)))))
98 (kill-buffer i)))))
93 (cl-loop for i in buffers
94 do
95 (insert
96 (format
97 "size: %s\n"
98 (with-current-buffer i (length (buffer-string)))))
99 (kill-buffer i)))))
99100
100101 ;; Get an image by wget and resize by ImageMagick
101102
140141
141142 ;; Loop and animation
142143
143 (lexical-let ((count 0) (anm "-/|\\-")
144 (end 50) (pos (point))
145 (wait-time 50))
144 (let ((count 0) (anm "-/|\\-")
145 (end 50) (pos (point))
146 (wait-time 50))
146147 (deferred:$
147148 (deferred:next
148 (lambda (x) (message "Animation started.")))
149 (lambda (_) (message "Animation started.")))
149150
150151 (deferred:nextc it
151 (deferred:lambda (x)
152 (deferred:lambda (_)
152153 (save-excursion
153154 (when (< 0 count)
154155 (goto-char pos) (delete-char 1))
155156 (insert (char-to-string
156157 (aref anm (% count (length anm))))))
157 (if (> end (incf count))
158 (if (> end (cl-incf count))
158159 (deferred:nextc (deferred:wait wait-time) self))))
159160
160161 (deferred:nextc it
161 (lambda (x)
162 (lambda (_)
162163 (save-excursion
163164 (goto-char pos) (delete-char 1))
164165 (message "Animation finished.")))))
0 ;;; test code for concurrent.el
0 ;;; test code for concurrent.el -*- lexical-binding: t; -*-
11
22 ;; Copyright (C) 2010 SAKURAI Masashi
33 ;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
2323 (:send-report nil)
2424 (:report-file "/tmp/undercover-report.json"))
2525 (require 'concurrent)
26 (require 'cl)
26 (require 'cl-lib)
2727 (require 'pp)
2828 (require 'ert)
2929
3434 ;; generator
3535
3636 (defun cc:fib-gen (callback)
37 (lexical-let ((a1 0) (a2 1)
38 (callback callback))
37 (let ((a1 0) (a2 1)
38 (callback callback))
3939 (cc:generator
4040 callback
4141 (yield a1)
4747 (yield next))))))
4848
4949 (defun cc:test-fib-gen ()
50 (lexical-let*
51 ((count 0)
52 (dfinish (deferred:new))
53 gen
54 (cc (lambda (x)
55 (cond
56 ((= count 10)
57 (deferred:callback
58 dfinish
59 (if (= x 55) t
60 (format "Fib 10 = 55 -> %s" x))))
61 (t
62 (incf count)
63 (deferred:call gen))))))
50 (let* ((count 0)
51 (dfinish (deferred:new))
52 gen
53 (cc (lambda (x)
54 (cond
55 ((= count 10)
56 (deferred:callback
57 dfinish
58 (if (= x 55) t
59 (format "Fib 10 = 55 -> %s" x))))
60 (t
61 (cl-incf count)
62 (deferred:call gen))))))
6463 (setq gen (cc:fib-gen cc))
6564 (deferred:call gen)
6665 dfinish))
7069 ;; thread
7170
7271 (defun cc:test-thread ()
73 (lexical-let
74 ((dfinish (deferred:new))
75 (result nil) (start-time (float-time))
76 (count 0) (end 20))
72 (let ((dfinish (deferred:new))
73 (result nil) (start-time (float-time))
74 (count 0) (end 20))
7775 (push 1 result)
7876 (cc:thread
7977 60
8078 (push 2 result)
81 (while (> end (incf count))
79 (while (> end (cl-incf count))
8280 (when (= 0 (% count 10))
8381 (push count result)))
8482 (push 99 result)
9492 ;; semaphore
9593
9694 (defun cc:test-semaphore1 ()
97 (lexical-let*
98 ((result nil)
99 (dfinish (deferred:new
100 (lambda (x)
101 (setq result (reverse result))
102 (or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result)
103 result))))
104 (smp (cc:semaphore-create 1)))
95 (let* ((result nil)
96 (dfinish (deferred:new
97 (lambda (_)
98 (setq result (reverse result))
99 (or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result)
100 result))))
101 (smp (cc:semaphore-create 1)))
105102
106103 (push 1 result)
107104
108105 (deferred:nextc (cc:semaphore-acquire smp)
109 (lambda(x) (push 2 result)))
106 (lambda(_) (push 2 result)))
110107 (deferred:nextc (cc:semaphore-acquire smp)
111 (lambda(x) (push 3 result)))
108 (lambda(_) (push 3 result)))
112109 (deferred:nextc (cc:semaphore-acquire smp)
113110 (lambda(x) (push x result)))
114111
115112 (deferred:$
116113 (deferred:next
117 (lambda (x)
114 (lambda (_)
118115 (push 5 result)
119116 (cc:semaphore-release smp)
120117 (push 6 result)))
121118 (deferred:nextc it
122 (lambda (x)
119 (lambda (_)
123120 (push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
124121 (deferred:nextc it
125 (lambda (x)
122 (lambda (_)
126123 (push 7 result)
127 (loop for i in (cc:semaphore-release-all smp)
128 do (deferred:callback i 'canceled))
124 (cl-loop for i in (cc:semaphore-release-all smp)
125 do (deferred:callback i 'canceled))
129126 (push 8 result)))
130127 (deferred:nextc it
131 (lambda (x)
128 (lambda (_)
132129 (push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
133130 (deferred:nextc it
134 (lambda (x) (deferred:callback dfinish))))
131 (lambda (_) (deferred:callback dfinish))))
135132
136133 dfinish))
137134
138135 ;; (cc:debug (cc:test-semaphore1) "Semaphore1 : %s" x)
139136
140137 (defun cc:test-semaphore2 ()
141 (lexical-let*
142 ((result nil)
143 (dfinish (deferred:new
144 (lambda (x)
145 (setq result (reverse result))
146 (or (equal '(0 a b c d e f g) result)
147 result))))
148 (smp (cc:semaphore-create 1)))
138 (let* ((result nil)
139 (dfinish (deferred:new
140 (lambda (_)
141 (setq result (reverse result))
142 (or (equal '(0 a b c d e f g) result)
143 result))))
144 (smp (cc:semaphore-create 1)))
149145
150146 (push 0 result)
151147
152148 (cc:semaphore-with
153 smp (lambda (x)
149 smp (lambda (_)
154150 (deferred:nextc (cc:semaphore-acquire smp)
155 (lambda (x)
151 (lambda (_)
156152 (push 'c result)
157153 (cc:semaphore-release smp)))
158154 (push 'a result)
159155 (deferred:nextc
160156 (deferred:wait 100)
161 (lambda (x) (push 'b result)))))
157 (lambda (_) (push 'b result)))))
162158
163159 (cc:semaphore-with
164 smp (lambda (x)
160 smp (lambda (_)
165161 (deferred:nextc (cc:semaphore-acquire smp)
166 (lambda (x)
162 (lambda (_)
167163 (push 'g result)
168164 (cc:semaphore-release smp)
169165 (deferred:callback dfinish)))
170166 (push 'd result)
171167 (deferred:nextc
172168 (deferred:wait 100)
173 (lambda (x)
169 (lambda (_)
174170 (push 'e result)
175171 (error "SMP CC ERR"))))
176172 (lambda (e)
177 (destructuring-bind (sym msg) e
173 (cl-destructuring-bind (sym msg) e
178174 (when (and (eq 'error sym) (equal "SMP CC ERR" msg))
179175 (push 'f result)))))
180176
185181 ;; Dataflow
186182
187183 (defun cc:test-dataflow-simple1 ()
188 (lexical-let*
189 ((result '(1))
190 (dfinish (deferred:new
191 (lambda (x)
192 (setq result (reverse result))
193 (or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result)
194 result))))
195 (dfenv (cc:dataflow-environment)))
184 (let* ((result '(1))
185 (dfinish (deferred:new
186 (lambda (_)
187 (setq result (reverse result))
188 (or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result)
189 result))))
190 (dfenv (cc:dataflow-environment)))
196191
197192 (push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
198193
204199 (lambda (x) (push (cons 3 x) result))))
205200 (deferred:$
206201 (deferred:next
207 (lambda (x)
202 (lambda (_)
208203 (push 4 result)
209204 (cc:dataflow-set dfenv "abc" 256)
210205 (push 5 result)))))
211206 (deferred:nextc it
212 (lambda (x)
207 (lambda (_)
213208 (push (cons 6 (cc:dataflow-get-sync dfenv "abc")) result)
214209 (cc:dataflow-clear dfenv "abc")
215210 (push (cons 7 (cc:dataflow-get-sync dfenv "abc")) result)))
216211 (deferred:nextc it
217 (lambda (x)
212 (lambda (_)
218213 (deferred:callback dfinish))))
219214
220215 dfinish))
222217 ;; (cc:debug (cc:test-dataflow-simple1) "Dataflow1 : %s" x)
223218
224219 (defun cc:test-dataflow-simple2 ()
225 (lexical-let*
226 ((result nil)
227 (dfinish (deferred:new
228 (lambda (x)
229 (or (equal '("a.jpg:300 OK jpeg") result)
230 result))))
231 (dfenv (cc:dataflow-environment)))
220 (let* ((result nil)
221 (dfinish (deferred:new
222 (lambda (_)
223 (or (equal '("a.jpg:300 OK jpeg") result)
224 result))))
225 (dfenv (cc:dataflow-environment)))
232226
233227 (deferred:$
234228 (cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
235229 (deferred:nextc it
236230 (lambda (x) (push (format "a.jpg:300 OK %s" x) result)))
237231 (deferred:nextc it
238 (lambda (x)
232 (lambda (_)
239233 (deferred:callback dfinish))))
240234
241235 (cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)
245239 ;; (cc:debug (cc:test-dataflow-simple2) "Dataflow2 : %s" x)
246240
247241 (defun cc:test-dataflow-simple3 ()
248 (lexical-let*
249 ((result nil)
250 (dfinish (deferred:new
251 (lambda (x)
252 (or (equal '(">> 384") result)
253 result))))
254 (dfenv (cc:dataflow-environment)))
242 (let* ((result nil)
243 (dfinish (deferred:new
244 (lambda (_)
245 (or (equal '(">> 384") result)
246 result))))
247 (dfenv (cc:dataflow-environment)))
255248
256249 (deferred:$
257250 (deferred:parallel
263256 (deferred:nextc it
264257 (lambda (x) (push (format ">> %s" x) result)))
265258 (deferred:nextc it
266 (lambda (x)
259 (lambda (_)
267260 (deferred:callback dfinish))))
268261
269262 (deferred:nextc (deferred:wait 0.2)
270 (lambda (x)
263 (lambda (_)
271264 (cc:dataflow-set dfenv "def" 128)
272265 (cc:dataflow-set dfenv "abc" 256)
273266 (cc:dataflow-set dfenv "aaa" 512)
278271 ;; (cc:debug (cc:test-dataflow-simple3) "Dataflow3 : %s" x)
279272
280273 (defun cc:test-dataflow-simple4 ()
281 (lexical-let*
282 ((result nil)
283 (dfinish (deferred:new
284 (lambda (x)
285 (or (equal '(">> 3") result)
286 result))))
287 (dfenv (cc:dataflow-environment)))
274 (let* ((result nil)
275 (dfinish (deferred:new
276 (lambda (_)
277 (or (equal '(">> 3") result)
278 result))))
279 (dfenv (cc:dataflow-environment)))
288280
289281 (deferred:$
290282 (deferred:parallel
297289 (deferred:nextc it
298290 (lambda (x) (push (format ">> %s" x) result)))
299291 (deferred:nextc it
300 (lambda (x)
292 (lambda (_)
301293 (deferred:callback dfinish))))
302294
303295 (deferred:nextc (deferred:wait 0.2)
304 (lambda (x)
296 (lambda (_)
305297 (cc:dataflow-set dfenv "abc" 1)
306298 ))
307299
310302 ;; (cc:debug (cc:test-dataflow-simple4) "Dataflow4 : %s" x)
311303
312304 (defun cc:test-dataflow-signal ()
313 (lexical-let*
314 ((result '(1))
315 (dfinish (deferred:new
316 (lambda (x)
317 (setq result (reverse result))
318 (or (equal
319 '(1
320 (2 . nil)
321 (get-first ("abc"))
322 (get-waiting ("abc"))
323 4 5
324 (set ("abc"))
325 (3 . 256)
326 6 7
327 (get ("abc"))
328 (8 . 256)
329 (9 . nil)
330 (clear ("abc"))
331 (clear-all (nil))
332 ) result)
333 result))))
334 (dfenv (cc:dataflow-environment)))
335
336 (loop for i in '(get get-first get-waiting set clear clear-all)
337 do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result))))
305 (let* ((result '(1))
306 (dfinish (deferred:new
307 (lambda (_)
308 (setq result (reverse result))
309 (or (equal
310 '(1
311 (2 . nil)
312 (get-first ("abc"))
313 (get-waiting ("abc"))
314 4 5
315 (set ("abc"))
316 (3 . 256)
317 6 7
318 (get ("abc"))
319 (8 . 256)
320 (9 . nil)
321 (clear ("abc"))
322 (clear-all (nil))
323 )
324 result)
325 result))))
326 (dfenv (cc:dataflow-environment)))
327
328 (cl-loop for i in '(get get-first get-waiting set clear clear-all)
329 do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result))))
338330
339331 (push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
340332
346338 (lambda (x) (push (cons 3 x) result))))
347339 (deferred:$
348340 (deferred:next
349 (lambda (x)
341 (lambda (_)
350342 (push 4 result)
351343 (cc:dataflow-set dfenv "abc" 256)
352344 (push 5 result)))))
353345 (deferred:nextc it
354 (lambda (x)
346 (lambda (_)
355347 (push 6 result)
356348 (cc:dataflow-get dfenv "abc")
357349 (push 7 result)))
358350 (deferred:nextc it
359 (lambda (x)
351 (lambda (_)
360352 (push (cons 8 (cc:dataflow-get-sync dfenv "abc")) result)
361353 (cc:dataflow-clear dfenv "abc")
362354 (push (cons 9 (cc:dataflow-get-sync dfenv "abc")) result)))
363355 (deferred:nextc it
364 (lambda (x)
356 (lambda (_)
365357 (cc:dataflow-clear-all dfenv)))
366358 (deferred:nextc it
367 (lambda (x)
359 (lambda (_)
368360 (deferred:callback dfinish))))
369361
370362 dfinish))
373365
374366
375367 (defun cc:test-dataflow-parent1 ()
376 (lexical-let*
377 ((result '(1))
378 (dfinish (deferred:new
379 (lambda (x)
380 (setq result (reverse result))
381 (or (equal
382 '(1
383 (available-parent . (("abc" . 128)))
384 (available-child . (("abc" . 128)))
385 (waiting-parent . nil)
386 (waiting-child . ("aaa"))
387 (get-sync . 256)
388 (get . 256)
389 ) result)
390 result))))
391 (dfenv-parent (cc:dataflow-environment))
392 (dfenv (cc:dataflow-environment dfenv-parent)))
368 (let* ((result '(1))
369 (dfinish (deferred:new
370 (lambda (_)
371 (setq result (reverse result))
372 (or (equal
373 '(1
374 (available-parent . (("abc" . 128)))
375 (available-child . (("abc" . 128)))
376 (waiting-parent . nil)
377 (waiting-child . ("aaa"))
378 (get-sync . 256)
379 (get . 256)
380 )
381 result)
382 result))))
383 (dfenv-parent (cc:dataflow-environment))
384 (dfenv (cc:dataflow-environment dfenv-parent)))
393385
394386 (cc:dataflow-set dfenv-parent "abc" 128)
395387
401393 (lambda (x) (push (cons 'get x) result))))
402394 (deferred:$
403395 (deferred:next
404 (lambda (x)
396 (lambda (_)
405397 (push (cons 'available-parent (cc:dataflow-get-avalable-pairs dfenv-parent)) result)
406398 (push (cons 'available-child (cc:dataflow-get-avalable-pairs dfenv)) result)
407399 (push (cons 'waiting-parent (cc:dataflow-get-waiting-keys dfenv-parent)) result)
408400 (push (cons 'waiting-child (cc:dataflow-get-waiting-keys dfenv)) result)))
409401 (deferred:next
410 (lambda (x)
402 (lambda (_)
411403 (cc:dataflow-set dfenv-parent "aaa" 256)
412404 (push (cons 'get-sync (cc:dataflow-get-sync dfenv "aaa")) result)))))
413405 (deferred:nextc it
414 (lambda (x) (deferred:callback dfinish))))
406 (lambda (_) (deferred:callback dfinish))))
415407
416408 dfinish))
417409
418410 ;; (cc:debug (cc:test-dataflow-parent1) "Dataflow Parent1 : %s" x)
419411
420412 (defun cc:test-dataflow-parent2 ()
421 (lexical-let*
422 ((result '())
423 (dfinish (deferred:new
424 (lambda (x)
425 (setq result (reverse result))
426 (or (equal
427 '("parent get 256" "child get 256") result)
428 result))))
429 (dfenv-parent (cc:dataflow-environment))
430 (dfenv (cc:dataflow-environment dfenv-parent)))
413 (let* ((result '())
414 (dfinish (deferred:new
415 (lambda (_)
416 (setq result (reverse result))
417 (or (equal
418 '("parent get 256" "child get 256") result)
419 result))))
420 (dfenv-parent (cc:dataflow-environment))
421 (dfenv (cc:dataflow-environment dfenv-parent)))
431422
432423 (deferred:$
433424 (deferred:parallel
440431 (deferred:nextc it
441432 (lambda (x) (push (format "child get %s" x) result))))
442433 (deferred:nextc (deferred:wait 0.2)
443 (lambda (x) (cc:dataflow-set dfenv-parent "abc" 256))))
444 (deferred:nextc it
445 (lambda (x) (deferred:callback dfinish))))
434 (lambda (_) (cc:dataflow-set dfenv-parent "abc" 256))))
435 (deferred:nextc it
436 (lambda (_) (deferred:callback dfinish))))
446437
447438 dfinish))
448439
452443 ;; Signal
453444
454445 (defun cc:test-signal1 ()
455 (lexical-let*
456 ((result '())
457 (dfinish (deferred:new
458 (lambda (x)
459 (setq result (reverse result))
460 (or (equal
461 '(
462 (ls ev1 (1))
463 (sig ev1 (1))
464 (ls ev2 (2))
465 (def ev1 (1))
466 ) result)
467 result))))
468 (channel (cc:signal-channel "child")))
446 (let* ((result '())
447 (dfinish (deferred:new
448 (lambda (_)
449 (setq result (reverse result))
450 (or (equal
451 '(
452 (ls ev1 (1))
453 (sig ev1 (1))
454 (ls ev2 (2))
455 (def ev1 (1))
456 )
457 result)
458 result))))
459 (channel (cc:signal-channel "child")))
469460
470461 (cc:signal-connect channel 'ev1
471462 (lambda (event)
480471
481472 (deferred:$
482473 (deferred:next
483 (lambda (x)
474 (lambda (_)
484475 (cc:signal-send channel 'ev1 1)
485476 (cc:signal-send channel 'ev2 2)))
486477 (deferred:nextc it
487 (lambda (x) (deferred:wait 300)))
488 (deferred:nextc it
489 (lambda (x)
478 (lambda (_) (deferred:wait 300)))
479 (deferred:nextc it
480 (lambda (_)
490481 (deferred:callback dfinish))))
491482
492483 dfinish))
496487 ;; (cc:debug (cc:test-signal2) "Signal2 : %s" x)
497488
498489 (defun cc:test-signal2 ()
499 (lexical-let*
500 ((result nil)
501 (dfinish (deferred:new
502 (lambda (x)
503 (setq result (reverse result))
504 (or (equal
505 '(
506 (pls pev1 (1))
507 (psig pev1 (1))
508 (pls ev1 (2))
509 (ls ev1 (3))
510 (sig ev1 (3))
511 (pls ev2 (4))
512 (pls ev2 (5))
513
514 (ls pev1 (1))
515 (ls ev1 (2))
516
517 (sig ev1 (2))
518 (def ev1 (3))
519 (ls ev2 (4))
520 (ls ev2 (5))
521
522 (def ev1 (2))
523 )
524 result)
525 result))))
526 (parent-channel (cc:signal-channel "parent"))
527 (channel (cc:signal-channel "child" parent-channel)))
490 (let* ((result nil)
491 (dfinish (deferred:new
492 (lambda (_)
493 (setq result (reverse result))
494 (or (equal
495 '(
496 (pls pev1 (1))
497 (psig pev1 (1))
498 (pls ev1 (2))
499 (ls ev1 (3))
500 (sig ev1 (3))
501 (pls ev2 (4))
502 (pls ev2 (5))
503
504 (ls pev1 (1))
505 (ls ev1 (2))
506
507 (sig ev1 (2))
508 (def ev1 (3))
509 (ls ev2 (4))
510 (ls ev2 (5))
511
512 (def ev1 (2))
513 )
514 result)
515 result))))
516 (parent-channel (cc:signal-channel "parent"))
517 (channel (cc:signal-channel "child" parent-channel)))
528518
529519 (cc:signal-connect parent-channel 'pev1
530520 (lambda (event)
546536
547537 (deferred:$
548538 (deferred:next
549 (lambda (x)
539 (lambda (_)
550540 (cc:signal-send parent-channel 'pev1 1)
551541 (cc:signal-send parent-channel 'ev1 2)
552542 (cc:signal-send channel 'ev1 3)
553543 (cc:signal-send parent-channel 'ev2 4)
554544 (cc:signal-send-global channel 'ev2 5)))
555545 (deferred:nextc it
556 (lambda (x) (deferred:wait 300)))
557 (deferred:nextc it
558 (lambda (x)
546 (lambda (_) (deferred:wait 300)))
547 (deferred:nextc it
548 (lambda (_)
559549 (deferred:callback-post dfinish))))
560550
561551 dfinish))
571561 (setq cc:test-fails 0)
572562 (deferred:$
573563 (deferred:parallel
574 (loop for i in '(cc:test-fib-gen
575 cc:test-thread
576 cc:test-semaphore1
577 cc:test-semaphore2
578 cc:test-dataflow-simple1
579 cc:test-dataflow-simple2
580 cc:test-dataflow-simple3
581 cc:test-dataflow-simple4
582 cc:test-dataflow-signal
583 cc:test-dataflow-parent1
584 cc:test-dataflow-parent2
585 cc:test-signal1
586 cc:test-signal2
587 )
588 collect (cons i (deferred:timeout 5000 "timeout" (funcall i)))))
564 (cl-loop for i in '(cc:test-fib-gen
565 cc:test-thread
566 cc:test-semaphore1
567 cc:test-semaphore2
568 cc:test-dataflow-simple1
569 cc:test-dataflow-simple2
570 cc:test-dataflow-simple3
571 cc:test-dataflow-simple4
572 cc:test-dataflow-signal
573 cc:test-dataflow-parent1
574 cc:test-dataflow-parent2
575 cc:test-signal1
576 cc:test-signal2
577 )
578 collect (cons i (deferred:timeout 5000 "timeout" (funcall i)))))
589579 (deferred:nextc it
590580 (lambda (results)
591581 (pop-to-buffer
592582 (with-current-buffer (get-buffer-create "*cc:test*")
593583 (erase-buffer)
594 (loop for i in results
595 for name = (car i)
596 for result = (cdr i)
597 with fails = 0
598 do (insert (format "%s : %s\n" name
599 (if (eq t result) "OK"
600 (format "FAIL > %s" result))))
601 (unless (eq t result) (incf fails))
602 finally
603 (goto-char (point-min))
604 (insert (format "Test Finished : %s\nTests Fails: %s / %s\n"
605 (format-time-string "%Y/%m/%d %H:%M:%S" (current-time))
606 fails (length results)))
607 (setq cc:test-fails fails))
584 (cl-loop for i in results
585 for name = (car i)
586 for result = (cdr i)
587 with fails = 0
588 do (insert (format "%s : %s\n" name
589 (if (eq t result) "OK"
590 (format "FAIL > %s" result))))
591 (unless (eq t result) (cl-incf fails))
592 finally
593 (goto-char (point-min))
594 (insert (format "Test Finished : %s\nTests Fails: %s / %s\n"
595 (format-time-string "%Y/%m/%d %H:%M:%S" (current-time))
596 fails (length results)))
597 (setq cc:test-fails fails))
608598 (message (buffer-string))
609599 (current-buffer)))
610600 (setq cc:test-finished-flag t))))
0 ;;; test code for deferred.el
0 ;;; test code for deferred.el -*- lexical-binding: t; -*-
11
22 ;; Copyright (C) 2010, 2011 SAKURAI Masashi
33 ;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
2727 (:send-report nil)
2828 (:report-file "/tmp/undercover-report.json"))
2929 (require 'deferred)
30 (require 'cl)
30 (require 'cl-lib)
3131 (require 'pp)
3232
3333 (defmacro should= (a &rest b)
4040
4141 (defmacro $ (&rest elements)
4242 `(let (it)
43 ,@(loop for i in elements
44 with it = nil
45 collect
46 `(setq it ,i))
43 ,@(cl-loop for i in elements
44 with it = nil
45 collect
46 `(setq it ,i))
4747 it))
4848
4949 (defmacro dnew(&rest aforms)
8787 (defmacro dtest (&rest form)
8888 `(progn
8989 (clear)
90 (lexical-let (last-value)
90 (let (last-value)
9191 (nextc
9292 ($
9393 ,@form)
9898 (defmacro wtest (time &rest form)
9999 `(progn
100100 (clear)
101 (lexical-let (last-value)
101 (let (last-value)
102102 (nextc
103103 ($
104104 ,@form)
108108 (flush)
109109 last-value)))
110110
111 (defun deferred:setTimeout (f msec)
111 (defun deferred:setTimeout (f _msec)
112112 "overrided for test"
113113 (deferred:call f))
114114
117117 (when (deferred-p id)
118118 (deferred:cancel id)))
119119
120 (defun deferred:run-with-idle-timer (sec f)
120 (defun deferred:run-with-idle-timer (_sec f)
121121 "overrided for test"
122122 (deferred:call f))
123123
130130 "> call-lambda simple"
131131 (should= 1 (deferred:call-lambda (lambda () 1)))
132132 (should= 1 (deferred:call-lambda (lambda () 1) 1))
133 (should= 1 (deferred:call-lambda (lambda (x) 1)))
134 (should= 1 (deferred:call-lambda (lambda (x) 1) 1))
133 (should= 1 (deferred:call-lambda (lambda (_) 1)))
134 (should= 1 (deferred:call-lambda (lambda (_) 1) 1))
135135 (should= 1 (deferred:call-lambda (deferred:lambda () 1)))
136136 (should= 1 (deferred:call-lambda (deferred:lambda () 1) 1))
137137 (should= nil (deferred:call-lambda 'car))
141141
142142 (ert-deftest deferred-primitive-scope ()
143143 "> call-lambda lexical-scope"
144 (should= 3 (lexical-let ((st 1))
144 (should= 3 (let ((st 1))
145145 (deferred:call-lambda
146146 (lambda () (+ st 2)))))
147 (should= 3 (lexical-let ((st 1))
147 (should= 3 (let ((st 1))
148148 (deferred:call-lambda
149149 (lambda () (+ st 2)) 0)))
150 (should= 3 (lexical-let ((st 1))
150 (should= 3 (let ((st 1))
151151 (deferred:call-lambda
152 (lambda (x) (+ st 2)))))
153 (should= 3 (lexical-let ((st 1))
152 (lambda (_) (+ st 2)))))
153 (should= 3 (let ((st 1))
154154 (deferred:call-lambda
155 (lambda (x) (+ st 2)) 0))))
156
157 (ert-deftest deferred-primitive-compile ()
158 "> call-lambda byte-compile"
159 (should= 1 (deferred:call-lambda (byte-compile (lambda (x) 1))))
160 (should= 1 (deferred:call-lambda (byte-compile (lambda (x) 1)) 1))
161 (should= 1 (deferred:call-lambda (byte-compile (lambda () 1))))
162 (should= 1 (deferred:call-lambda (byte-compile (lambda () 1)) 1))
163
164 (should= 3 (lexical-let ((st 1))
165 (deferred:call-lambda
166 (byte-compile (lambda () (+ st 2))))))
167 (should= 3 (lexical-let ((st 1)) ;ng
168 (deferred:call-lambda
169 (byte-compile (lambda () (+ st 2))) 0)))
170 (should= 3 (lexical-let ((st 1))
171 (deferred:call-lambda
172 (byte-compile (lambda (x) (+ st 2))))))
173 (should= 3 (lexical-let ((st 1)) ;ng
174 (deferred:call-lambda
175 (byte-compile (lambda (x) (+ st 2))) 0)))
176
177 (should-error
178 (deferred:call-lambda
179 (lambda (x) (signal 'wrong-number-of-arguments '("org"))))
180 :type 'wrong-number-of-arguments))
155 (lambda (_) (+ st 2)) 0))))
156
157 (when (version<= "25.0" emacs-version)
158 ;; Emacs 24 doesn’t know how to byte-compile closures, so run this test only
159 ;; under Emacs 25.
160 (ert-deftest deferred-primitive-compile ()
161 "> call-lambda byte-compile"
162 (should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1))))
163 (should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1)) 1))
164 (should= 1 (deferred:call-lambda (byte-compile (lambda () 1))))
165 (should= 1 (deferred:call-lambda (byte-compile (lambda () 1)) 1))
166
167 (should= 3 (let ((st 1))
168 (deferred:call-lambda
169 (byte-compile (lambda () (+ st 2))))))
170 (should= 3 (let ((st 1)) ;ng
171 (deferred:call-lambda
172 (byte-compile (lambda () (+ st 2))) 0)))
173 (should= 3 (let ((st 1))
174 (deferred:call-lambda
175 (byte-compile (lambda (_) (+ st 2))))))
176 (should= 3 (let ((st 1)) ;ng
177 (deferred:call-lambda
178 (byte-compile (lambda (_) (+ st 2))) 0)))
179
180 (should-error
181 (deferred:call-lambda
182 (lambda (x) (signal 'wrong-number-of-arguments '("org"))))
183 :type 'wrong-number-of-arguments)))
181184
182185 (ert-deftest deferred-basic ()
183186 "Basic test for deferred functions."
193196 ;; basic post function test
194197 (progn
195198 (clear)
196 (lexical-let ((d (dnew)))
199 (let ((d (dnew)))
197200 (nextc d x)
198201 (deferred:exec-task d 'ok "ok!")))))
199202 (should (deferred-p
200203 ;; basic error post function test
201204 (progn
202205 (clear)
203 (lexical-let ((d (dnew)))
206 (let ((d (dnew)))
204207 (deferred:error d (lambda (e) e))
205208 (deferred:exec-task d 'ng "error"))))))
206209
260263 (should= '(2 1 0)
261264 ;; basic deferred chain test
262265 (clear)
263 (lexical-let (vs)
266 (let (vs)
264267 ($ (next (push 1 vs))
265268 (nextc it (push 2 vs)))
266269 (push 0 vs)
324327 (dtest
325328 (next "chain")
326329 (deferred:watch it
327 (lambda (x) (setq val " watch") nil))
330 (lambda (_) (setq val " watch") nil))
328331 (nextc it (concat x val " ok")))))
329332
330333 (should= "error!! watch ok"
342345 (dtest
343346 (next "chain")
344347 (deferred:watch it
345 (lambda (x) (error "ERROR")))
348 (lambda (_) (error "ERROR")))
346349 (nextc it (concat x " watch ok2"))))))
347350
348351 (ert-deftest deferred-async-connect ()
362365 "> global onerror"
363366 (should= "ONERROR"
364367 ;; default onerror handler test
365 (lexical-let (ret)
368 (let (ret)
366369 (let ((deferred:onerror
367370 (lambda (e) (setq ret (concat "ON" (error-message-string e))))))
368371 (dtest
537540 "> loop"
538541 (should= 10
539542 ;; basic loop test
540 (lexical-let ((v 0))
543 (let ((v 0))
541544 (dtest
542545 (dloop 5 (lambda (i) (setq v (+ v i))))
543546 (errorf it "Error on simple loop calling : %s"))
552555
553556 (should= "nested loop ok (4 nil 3 2 1 0)"
554557 ;; nested deferred task in a loop
555 (lexical-let (count)
558 (let (count)
556559 (dtest
557560 (dloop 5 (lambda (i)
558561 (push i count)
564567
565568 (should= '(6 4 2)
566569 ;; do-loop test
567 (lexical-let (count)
570 (let (count)
568571 (dtest
569572 (dloop '(1 2 3)
570573 (lambda (x) (push (* 2 x) count)))
592595
593596 (should= "loop error catch ok"
594597 ;; try catch finally test
595 (lexical-let ((body (lambda ()
596 (deferred:loop 5
597 (lambda (i) (if (= 2 i) (error "loop error")))))))
598 (let ((body (lambda ()
599 (deferred:loop 5
600 (lambda (i) (if (= 2 i) (error "loop error")))))))
598601 (dtest
599602 (next "try ") ; try
600603 (nextc it (funcall body)) ; body
603606
604607 (should= "4 ok"
605608 ;; try catch finally test
606 (lexical-let ((body (lambda ()
607 (deferred:loop 5
608 (lambda (i) i)))))
609 (let ((body (lambda ()
610 (deferred:loop 5
611 (lambda (i) i)))))
609612 (dtest
610613 (next "try ") ; try
611614 (nextc it (funcall body)) ; body
720723
721724 (should= "nest parallel ok"
722725 ;; parallel next
723 (lexical-let* ((flow (lambda (x)
724 (parallel
725 (next "nest ")
726 (next "parallel ")))))
726 (let* ((flow (lambda (x)
727 (parallel
728 (next "nest ")
729 (next "parallel ")))))
727730 (dtest
728731 (next "start ")
729732 (nextc it (funcall flow x))