├── .ert-runner ├── .gitignore ├── .travis.yml ├── Cask ├── LICENSE ├── Makefile ├── README-concurrent.ja.markdown ├── README-concurrent.markdown ├── README.ja.markdown ├── README.markdown ├── concurrent.el ├── deferred.el ├── sample ├── concurrent-sample.el └── deferred-samples.el └── test ├── concurrent-test.el └── deferred-test.el /.ert-runner: -------------------------------------------------------------------------------- 1 | -L . 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled and temporary files 2 | *.elc 3 | *~ 4 | 5 | # Cask 6 | /.cask 7 | dist 8 | 9 | # Ecukes 10 | /features/project/.cask 11 | /features/project/test/*.el 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | sudo: false 3 | before_install: 4 | - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh 5 | - evm install $EVM_EMACS --use --skip 6 | - cask 7 | env: 8 | - EVM_EMACS=emacs-24.4-travis 9 | - EVM_EMACS=emacs-24.5-travis 10 | - EVM_EMACS=emacs-25.1-travis 11 | 12 | script: 13 | - emacs --version 14 | - make travis-ci 15 | after_script: 16 | - cat /tmp/undercover-report.json 17 | - curl -v -include --form json_file=@/tmp/undercover-report.json https://coveralls.io/api/v1/jobs 18 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa) 3 | 4 | (package-file "deferred.el") 5 | 6 | (development 7 | (depends-on "f") 8 | (depends-on "ecukes") 9 | (depends-on "ert-runner") 10 | (depends-on "el-mock") 11 | (depends-on "cask-package-toolset") 12 | (depends-on "undercover")) 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | CASK ?= cask 3 | 4 | .PHONY: test test-deferred test-concurrent compile clean print-deps travis-ci 5 | 6 | test: test-deferred test-deferred-compiled test-concurrent 7 | # test-concurrent-compiled 8 | 9 | test-deferred: 10 | $(CASK) exec ert-runner test/deferred-test.el 11 | 12 | test-deferred-compiled: deferred.elc 13 | $(CASK) exec ert-runner test/deferred-test.el -l deferred.elc 14 | 15 | test-concurrent: 16 | $(CASK) exec ert-runner test/concurrent-test.el 17 | 18 | test-concurrent-compiled: concurrent.elc 19 | $(CASK) exec ert-runner test/concurrent-test.el -l concurrent.elc 20 | 21 | compile: deferred.elc concurrent.elc 22 | 23 | %.elc: %.el 24 | $(EMACS) -batch -L . -f batch-byte-compile $< 25 | 26 | clean: 27 | rm -rfv *.elc 28 | 29 | print-deps: 30 | @echo "----------------------- Dependencies -----------------------" 31 | $(EMACS) --version 32 | @echo "------------------------------------------------------------" 33 | 34 | travis-ci: print-deps 35 | $(MAKE) clean test 36 | $(MAKE) compile test 37 | -------------------------------------------------------------------------------- /README-concurrent.ja.markdown: -------------------------------------------------------------------------------- 1 | # concurrent.el # 2 | 3 | [![Build Status](https://travis-ci.org/kiwanami/emacs-deferred.svg)](https://travis-ci.org/kiwanami/emacs-deferred) 4 | [![Coverage Status](https://coveralls.io/repos/kiwanami/emacs-deferred/badge.svg)](https://coveralls.io/r/kiwanami/emacs-deferred) 5 | [![MELPA](http://melpa.org/packages/concurrent-badge.svg)](http://melpa.org/#/concurrent) 6 | [![MELPA stable](http://stable.melpa.org/packages/concurrent-badge.svg)](http://stable.melpa.org/#/concurrent) 7 | [![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags) 8 | [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html) 9 | 10 | concurrent.elは、良くある非同期処理を抽象化したライブラリです。スレッド、セマフォ、イベント管理などがあります。他の環境のライブラリや並行プログラミングのアイデアを参考にしました。 11 | 12 | ## インストール ## 13 | 14 | concurrent.elは package.elを使って, [MELPA](http://melpa.org)からインストールすることができます. 15 | 16 | ## 使い方例 ## 17 | 18 | 以下のサンプルで例示したソースは concurrent-samples.el の中にあります。 19 | eval-last-sexp (C-x C-e) などで実行してみてください。 20 | 21 | ### Threadの例 22 | 23 | letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。 24 | 25 | Thread: 26 | 27 | ```el 28 | (let ((count 0) (anm "-/|\\-") 29 | (end 50) (pos (point))) 30 | (cc:thread 31 | 60 32 | (message "Animation started.") 33 | (while (> end (cl-incf count)) 34 | (save-excursion 35 | (when (< 1 count) 36 | (goto-char pos) (delete-char 1)) 37 | (insert (char-to-string 38 | (aref anm (% count (length anm))))))) 39 | (save-excursion 40 | (goto-char pos) (delete-char 1)) 41 | (message "Animation finished."))) 42 | ``` 43 | 44 | whileを使うことでスレッドをループさせることが出来ます。whileの中身は一気に実行されます。 45 | 46 | 無限ループや重い処理でEmacsが固まらないように注意してください。もし無限ループに突入してしまったり、固まってしまったら deferred:clear-queue コマンドで回復できる可能性があります。 47 | 48 | 49 | ### Generatorの例 50 | 51 | fib-genにジェネレーターを作ります。ジェネレーター生成body内のyield関数で値を返します。値はコールバックで値を受け取ります。 52 | 53 | Generator: 54 | 55 | ```el 56 | (setq fib-list nil) 57 | (setq fib-gen 58 | (let ((a1 0) (a2 1)) 59 | (cc:generator 60 | (lambda (x) (push x fib-list)) ; コールバックで結果受け取り 61 | (yield a1) 62 | (yield a2) 63 | (while t 64 | (let ((next (+ a1 a2))) 65 | (setq a1 a2 66 | a2 next) 67 | (yield next)))))) 68 | 69 | (funcall fib-gen) ; 何度か呼んでみる 70 | (funcall fib-gen) (funcall fib-gen) 71 | (funcall fib-gen) (funcall fib-gen) 72 | 73 | fib-list ; => (3 2 1 1 0) 74 | ``` 75 | 76 | ### Semaphoreの例 77 | 78 | cc:semaphore-acquire 関数が deferred を返すので、それに続けて実行させたいタスクをつなげていきます。時系列で挙動が変わっていくのでコード中に簡単な説明を書いてみました。 79 | 80 | Semaphore: 81 | 82 | ```el 83 | ;; permit=1のセマフォ作成 84 | (setq smp (cc:semaphore-create 1)) 85 | 86 | ;; 続けて3つ実行しようとする 87 | (deferred:nextc (cc:semaphore-acquire smp) 88 | (lambda(x) 89 | (message "go1"))) 90 | (deferred:nextc (cc:semaphore-acquire smp) 91 | (lambda(x) 92 | (message "go2"))) 93 | (deferred:nextc (cc:semaphore-acquire smp) 94 | (lambda(x) 95 | (message "go3"))) 96 | 97 | ;; => 1つ目だけ実行されて go1 が表示される 98 | 99 | (cc:semaphore-release smp) ; permitを返す 100 | 101 | ;; => 2つ目が実行されて go2 が表示される 102 | 103 | (cc:semaphore-waiting-deferreds smp) ; go3 を表示するdeferred 104 | 105 | (cc:semaphore-release-all smp) ; => permitを初期化して go3 を表示するdeferredを返す 106 | 107 | (cc:semaphore-waiting-deferreds smp) ; => nil 108 | ``` 109 | 110 | ### Dataflowの例： 111 | 112 | cc:dataflow-environment 関数で変数を格納する「環境」を作ります。 cc:dataflow-get は値の取得とそれに続くタスクをつなげる deferred を返します。 cc:dataflow-set で値をバインドします。例ではキーに文字列を使っていますが、キーには任意のオブジェクトを指定できます。 113 | 114 | Dataflow: 115 | 116 | ```el 117 | (setq dfenv (cc:dataflow-environment)) 118 | 119 | ;; ○基本の使い方 120 | 121 | ;; ↓同期的に値を取得。ブロックしない。 122 | (cc:dataflow-get-sync dfenv "abc") ; => nil まだ値が無い。 123 | 124 | (deferred:$ ; abc という値を取ってきて表示する処理 125 | (cc:dataflow-get dfenv "abc") 126 | (deferred:nextc it 127 | (lambda (x) (message "Got abc : %s" x)))) 128 | ;; => 値がないので処理はブロックしたまま 129 | 130 | (cc:dataflow-set dfenv "abc" 256) ; 値をセット 131 | ;; => ここで先ほどブロックしていた処理が再開し、 "Got abc : 256" が表示される 132 | 133 | (cc:dataflow-get-sync dfenv "abc") ; => 256 134 | 135 | (cc:dataflow-clear dfenv "abc") ; 値を未バインドに戻す 136 | 137 | (cc:dataflow-get-sync dfenv "abc") ; => nil 138 | 139 | ;; ○リストをキーにする 140 | 141 | (deferred:$ 142 | (cc:dataflow-get dfenv '("http://example.com/a.jpg" 300)) 143 | (deferred:nextc it 144 | (lambda (x) (message "a.jpg:300 OK %s" x)))) 145 | 146 | (cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg) 147 | 148 | ;; => a.jpg:300 OK jpeg 149 | 150 | ;; ○2つの値を待ち受ける 151 | 152 | (deferred:$ ; abc, def の2つの値を使う 153 | (deferred:parallel 154 | (cc:dataflow-get dfenv "abc") 155 | (cc:dataflow-get dfenv "def")) 156 | (deferred:nextc it 157 | (lambda (values) 158 | (apply 'message "Got values : %s, %s" values) 159 | (apply '+ values))) 160 | (deferred:nextc it 161 | (lambda (x) (insert (format ">> %s" x))))) 162 | ;; => もちろんブロックする 163 | 164 | (cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc") 165 | (cc:dataflow-get-avalable-pairs dfenv) ; => ((("http://example.com/a.jpg" 300) . jpeg)) 166 | 167 | (cc:dataflow-set dfenv "abc" 128) ; ここではまだブロックしたまま 168 | (cc:dataflow-set dfenv "def" 256) ; ここでやっと動く 169 | ;; => Got values : 128, 256 170 | ``` 171 | 172 | ### Signalの例： 173 | 174 | cc:signal-channel でシグナルを流すチャンネルを作成します。その後、signalに応答する処理を接続していきます。 175 | 176 | ```el 177 | ;; シグナルのチャンネルを作成 178 | (setq channel (cc:signal-channel)) 179 | 180 | (cc:signal-connect ; foo というシグナルを拾う 181 | channel 'foo 182 | (lambda (event) (message "Signal : %S" event))) 183 | 184 | (cc:signal-connect 185 | channel t ; t にするとすべてのシグナルを拾う 186 | (lambda (event) 187 | (cl-destructuring-bind (event-name (args)) event 188 | (message "Listener : %S / %S" event-name args)))) 189 | 190 | (deferred:$ ; deferred で非同期タスクを接続できる 191 | (cc:signal-connect channel 'foo) 192 | (deferred:nextc it 193 | (lambda (x) (message "Deferred Signal : %S" x)))) 194 | 195 | (cc:signal-send channel 'foo "hello signal!") 196 | ;; => 197 | ;; Listener : foo / "hello signal!" 198 | ;; Signal : (foo ("hello signal!")) 199 | ;; Deferred Signal : (foo ("hello signal!")) 200 | 201 | (cc:signal-send channel 'some "some signal!") 202 | ;; => 203 | ;; Listener : some / "some signal!" 204 | ``` 205 | 206 | dataflowの内部には、変数へのアクセスやバインドのシグナルを発信するchannelがあります。これを使って、未バインドの変数に値を作成してセットするようなことが出来ます。 207 | 208 | signalやdataflowは、カスケード接続して親子関係を構築できます。例えば、親dataflowにデフォルト値（フォールバックの値）を入れておくとか、channelで親子関係を構築してローカルなイベントとグローバルなイベントを分けて効率的にイベントを管理するなどが出来ます。 209 | 210 | ## インタフェース解説 ## 211 | 212 | ### Thread 213 | 214 | * cc:thread (wait-time-msec &rest body) 215 | * 引数： 216 | * wait-time-msec: タスク間の間隔（ミリ秒） 217 | * 返値：Threadオブジェクト（今のところ使い道無し） 218 | * スレッドを作成して開始します 219 | * bodyのS式が一つずつ非同期で実行されます。その間隔が wait-time-msec で指定された時間です。 220 | * bodyの中に while があった場合は、特別にループとして処理します。 221 | * 無限ループや重い処理でEmacsが固まらないように注意してください。もし無限ループに突入してしまったり、固まってしまったら deferred:clear-queue コマンドで回復できる可能性があります。 222 | 223 | ### Generator 224 | 225 | * cc:generator (callback &rest body) 226 | * 引数： 227 | * callback: yieldした値を受け取る関数 228 | * body: Generatorの中身 229 | * 返値：Generatorを実行する関数 230 | * Threadと同様に、bodyのS式が一つずつ非同期で実行されます。 231 | * bodyの中に while があった場合は、特別にループとして処理します。 232 | * bodyの内で yield 関数を使う（実際にはマクロで置換されます）と、callbackで指定した関数に値が渡って処理が停止します。 233 | * 再度 Generator 関数を実行すると停止した位置から開始します。 234 | 235 | ### Semaphore 236 | 237 | * cc:semaphore-create (permits-num) 238 | * 引数： 239 | * permits-num: 許可数 240 | * 返値：Semaphoreオブジェクト 241 | * セマフォオブジェクトを作成します。 242 | 243 | * cc:semaphore-acquire (semaphore) 244 | * 引数： 245 | * semaphore: Semaphoreオブジェクト 246 | * 返値：Deferredオブジェクト 247 | * 返したDeferredオブジェクトに、実行数を制限したいタスクをつなげます。 248 | * 実行する際、許可数を1つ消費します。許可数が0になったら、以降のタスクは待たされます。 249 | * 実行可能なら、返したDeferredタスクがすぐに実行されます。 250 | * 実行可能でなければ、許可数が戻るまで返したDeferredタスクは待たされます。 251 | 252 | * cc:semaphore-release (semaphore) 253 | * 引数： 254 | * semaphore: Semaphoreオブジェクト 255 | * 返値：Semaphoreオブジェクト 256 | * 許可数を一つ戻します。その際、待っているタスクがあれば実行されます。 257 | * 許可数は自動では戻りませんので、 cc:semaphore-release を呼ぶのはプログラマの責任です。 258 | 259 | * cc:semaphore-with (semaphore body-func &optional error-func) 260 | * 引数： 261 | * semaphore: Semaphoreオブジェクト 262 | * body-func: 実行数を制御したいタスクの関数 263 | * error-func: 発生したエラーを処理する関数（deferred:errorで接続される） 264 | * 返値：Deferredオブジェクト 265 | * acquireとreleaseを前後で行う関数です。特に理由がない限りは、acquireとreleaseを自分で書くよりも、こちらを使う方が安全で楽です。 266 | 267 | 268 | * cc:semaphore-release-all (semaphore) 269 | * 引数： 270 | * semaphore: Semaphoreオブジェクト 271 | * 返値：実行待ちだったDeferredオブジェクト 272 | * 許可数を強制的に初期値に戻します。デバッグ時や状態をリセットしたいときに使います。 273 | 274 | * cc:semaphore-interrupt-all (semaphore) 275 | * 引数： 276 | * semaphore: Semaphoreオブジェクト 277 | * 返値：Deferredオブジェクト 278 | * 実行待ちのタスクがなければ、すぐに実行するDeferredオブジェクトを返します。 279 | * 現在実行待ちのタスクがあれば取り除いて、現在実行中のタスクの次に実行されるDeferredオブジェクトを返します。 280 | * 割り込みしたいときに使います。 281 | 282 | ### Signal 283 | 284 | * cc:signal-channel (&optional name parent-channel) 285 | * 引数： 286 | * name: このチャンネルの名前。主にデバッグ用。 287 | * parent-channel: 上流のチャンネルオブジェクト。 288 | * 返値：チャンネルオブジェクト 289 | * 新しいチャンネルを作成します。 290 | * 上流のシグナルは下流に流れてきますが、下流から上流には cc:signal-send-global を使わない限り流れません。 291 | 292 | * cc:signal-connect (channel event-sym &optional callback) 293 | * 引数： 294 | * channel: チャンネルオブジェクト 295 | * event-sym: イベント識別シンボル 296 | * callback: 受け取り関数 297 | * 返値：Deferredオブジェクト 298 | * シグナルを受信するタスクを追加します。 299 | * event-sym が t の場合は、すべてのシグナルを受信します。 300 | * 通常はこの関数の返値にシグナルを受信する非同期タスクを接続します。 301 | 302 | * cc:signal-send (channel event-sym &rest args) 303 | * 引数： 304 | * channel: チャンネルオブジェクト 305 | * event-sym: イベント識別シンボル 306 | * args: イベント引数 307 | * 返値：なし 308 | * シグナルを発信します。 309 | * args は、受信側で (lambda (event) (cl-destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。 310 | 311 | 312 | * cc:signal-send-global (channel event-sym &rest args) 313 | * 引数： 314 | * channel: チャンネルオブジェクト 315 | * event-sym: イベント識別シンボル 316 | * args: イベント引数 317 | * 返値：なし 318 | * 上流のチャンネルにシグナルを送信します。 319 | 320 | * cc:signal-disconnect (channel deferred) 321 | * 引数： 322 | * channel: チャンネルオブジェクト 323 | * deferred: チャンネルから取り除きたいDeferredオブジェクト 324 | * 返値：削除されたDeferredオブジェクト 325 | * チャンネルから受信タスクを取り除きます。 326 | 327 | * cc:signal-disconnect-all (channel) 328 | * 引数： 329 | * channel: チャンネルオブジェクト 330 | * 返値：なし 331 | * すべての受信タスクを取り除きます。 332 | 333 | ### Dataflow 334 | 335 | * cc:dataflow-environment (&optional parent-env test-func channel) 336 | * 引数： 337 | * parent-env: デフォルト値として使うDataflowオブジェクト 338 | * test-func: keyの比較関数 339 | * channel: チャンネルオブジェクト 340 | * 返値：Dataflowオブジェクト 341 | * 新しくDataflowオブジェクトを作成して返します。 342 | * channelは引数で与えなかった場合は、内部新しいチャンネルオブジェクトを作成します。 343 | * 以下のシグナルがチャンネルに送信されます 344 | * get-first : 初回未バインド変数を参照したとき 345 | * get-waiting : 2回目以降の未バインド変数を参照したとき 346 | * set : 値をバインドしたとき 347 | * get : バインドされた値を参照したとき 348 | * clear : バインド解除されたとき 349 | * clear-all : すべてのバインドが解除されたとき 350 | 351 | * cc:dataflow-get (df key) 352 | * 引数： 353 | * df: Dataflowオブジェクト 354 | * key: 変数キー 355 | * 返値：変数の値を受け取るDeferredオブジェクト 356 | * 変数の値を受け取るDeferredタスクを返すので、変数の値を使う処理を接続します。 357 | * 変数の値がバインドされていれば、直ちに実行されます。 358 | * 変数の値がバインドされていなければ、返されたDeferredタスクはバインドされるまで実行されません。 359 | 360 | * cc:dataflow-get-sync (df key) 361 | * 引数： 362 | * df: Dataflowオブジェクト 363 | * key: 変数キー 364 | * 返値：nil か値 365 | * 変数の値を同期的に参照します。 366 | * 値がバインドされていなければ nil を返します。 367 | 368 | * cc:dataflow-set (df key value) 369 | * 引数： 370 | * df: Dataflowオブジェクト 371 | * key: 変数キー 372 | * value: 値 373 | * 返値：なし 374 | * 変数に値をバインドします。 375 | * もし、すでにバインドされている変数にバインドしようとした場合はエラーが発生します。 376 | 377 | * cc:dataflow-clear (df key) 378 | * 引数： 379 | * df: Dataflowオブジェクト 380 | * key: 変数キー 381 | * 返値：なし 382 | * 変数を未バインドに戻します。 383 | 384 | * cc:dataflow-get-avalable-pairs (df) 385 | * 引数： 386 | * df: Dataflowオブジェクト 387 | * 返値：バインドされている変数キーと値の alist 388 | 389 | * cc:dataflow-get-waiting-keys (df) 390 | * 引数： 391 | * df: Dataflowオブジェクト 392 | * 返値：未バインドで、受け取り待ちのタスクが存在する変数キーのリスト 393 | 394 | * cc:dataflow-clear-all (df) 395 | * 引数： 396 | * df: Dataflowオブジェクト 397 | * 返値：なし 398 | * 指定されたDataflowオブジェクトを空にします。 399 | * 受け取り待ちのタスクについては何もしません。 400 | 401 | * cc:dataflow-connect (df event-sym &optional callback) 402 | * 引数： 403 | * df: Dataflowオブジェクト 404 | * event-sym: イベント識別シンボル 405 | * callback: 受け取り関数 406 | * 返値：Deferredオブジェクト 407 | * このDataflowオブジェクトのチャンネルにシグナル受け取りタスクを追加します。 408 | * 内部で cc:signal-connect を呼びます。 409 | * 受け取れるイベント識別シンボルについては、 cc:dataflow-environment を参照してください。 410 | 411 | 412 | * * * * * 413 | 414 | (C) 2011-2016 SAKURAI Masashi All rights reserved. 415 | m.sakurai at kiwanami.net 416 | -------------------------------------------------------------------------------- /README-concurrent.markdown: -------------------------------------------------------------------------------- 1 | # concurrent.el 2 | 3 | [![Build Status](https://travis-ci.org/kiwanami/emacs-deferred.svg)](https://travis-ci.org/kiwanami/emacs-deferred) 4 | [![Coverage Status](https://coveralls.io/repos/kiwanami/emacs-deferred/badge.svg)](https://coveralls.io/r/kiwanami/emacs-deferred) 5 | [![MELPA](http://melpa.org/packages/concurrent-badge.svg)](http://melpa.org/#/concurrent) 6 | [![MELPA stable](http://stable.melpa.org/packages/concurrent-badge.svg)](http://stable.melpa.org/#/concurrent) 7 | [![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags) 8 | [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html) 9 | 10 | `concurrent.el` is a higher level library for asynchronous tasks, based on `deferred.el`. 11 | 12 | It is inspired by libraries of other environments and concurrent programing models. 13 | It has following facilities: *pseud-thread*, *generator*, *semaphore*, *dataflow variables* and 14 | *event management*. 15 | 16 | ## Installation ## 17 | 18 | You can install `concurrent.el` from [MELPA](http://melpa.org) by `package.el`. 19 | 20 | ## Sample codes ## 21 | 22 | You can find following sample codes in `concurrent-sample.el`. 23 | Executing `eval-last-sexp` (C-x C-e), you can try those codes. 24 | 25 | ### Pseud-thread 26 | 27 | Evaluating the let in the blow code, the animation starts. After few seconds, the animation will stop. 28 | 29 | Thread: 30 | 31 | ```el 32 | (let ((count 0) (anm "-/|\\-") 33 | (end 50) (pos (point))) 34 | (cc:thread 35 | 60 36 | (message "Animation started.") 37 | (while (> end (cl-incf count)) 38 | (save-excursion 39 | (when (< 1 count) 40 | (goto-char pos) (delete-char 1)) 41 | (insert (char-to-string 42 | (aref anm (% count (length anm))))))) 43 | (save-excursion 44 | (goto-char pos) (delete-char 1)) 45 | (message "Animation finished."))) 46 | ``` 47 | 48 | Using `while` clause in the body content, one can make a loop in the thread. 49 | 50 | Be careful not to make an infinite loop or heavy loop accidentally. If you find that the Emacs enters infinite loop, you may be able to stop the loop with executing the command `deferred:clear-queue`. 51 | 52 | ### Generator 53 | 54 | The following code creates a generator object and binds it to the variable `fib-gen`. 55 | One can receive values, using `yield` function in the generator body code. 56 | When the generator returns a value, the evaluation process stops. 57 | Calling generator object as a function, the evaluation process resumes. 58 | 59 | Generator: 60 | 61 | ```el 62 | (setq fib-list nil) 63 | (setq fib-gen 64 | (let ((a1 0) (a2 1)) 65 | (cc:generator 66 | (lambda (x) (push x fib-list)) ; Receiving values as a callback function 67 | (yield a1) 68 | (yield a2) 69 | (while t 70 | (let ((next (+ a1 a2))) 71 | (setq a1 a2 72 | a2 next) 73 | (yield next)))))) 74 | 75 | (funcall fib-gen) ; calling 5 times 76 | (funcall fib-gen) (funcall fib-gen) 77 | (funcall fib-gen) (funcall fib-gen) 78 | 79 | fib-list ; => (3 2 1 1 0) 80 | ``` 81 | 82 | ### Semaphore 83 | 84 | The semaphore restricts the number of concurrent tasks. 85 | The following code creates a semaphore object with one permit, and binds it to the variable `smp`. 86 | The subsequent codes and comments show how the semaphore object works. 87 | 88 | Semaphore: 89 | 90 | ```el 91 | ;; Create a semaphore with permit=1. 92 | (setq smp (cc:semaphore-create 1)) 93 | 94 | ;; Start three tasks with acquiring permit. 95 | (deferred:nextc (cc:semaphore-acquire smp) 96 | (lambda(x) 97 | (message "go1"))) 98 | (deferred:nextc (cc:semaphore-acquire smp) 99 | (lambda(x) 100 | (message "go2"))) 101 | (deferred:nextc (cc:semaphore-acquire smp) 102 | (lambda(x) 103 | (message "go3"))) 104 | 105 | ;; => Only the first task is executed and displays "go1". 106 | ;; Rest ones are blocked. 107 | 108 | (cc:semaphore-release smp) ; Releasing one permit 109 | 110 | ;; => The second task is executed, then, displays "go2". 111 | 112 | (cc:semaphore-waiting-deferreds smp) ; => The third task object 113 | 114 | (cc:semaphore-release-all smp) ; => Reset permits and return the third task object 115 | 116 | (cc:semaphore-waiting-deferreds smp) ; => nil 117 | ``` 118 | 119 | ### Dataflow 120 | 121 | The function `cc:dataflow-environment` creates an environment for dataflow variables. 122 | The function `cc:dataflow-get` returns a deferred object that can refer the value. 123 | The function `cc:dataflow-set` binds a value to a dataflow variable. 124 | Any objects can be variable keys in the environment. This sample code uses strings as keys. 125 | 126 | Dataflow: 127 | 128 | ```el 129 | ;; Create an environment. 130 | (setq dfenv (cc:dataflow-environment)) 131 | 132 | ;;## Basic usage 133 | 134 | ;; Referring a variable synchronously. This function doesn't block. 135 | (cc:dataflow-get-sync dfenv "abc") ; => nil 136 | 137 | (deferred:$ ; Start the task that gets the value of `abc` and that displays the value. 138 | (cc:dataflow-get dfenv "abc") 139 | (deferred:nextc it 140 | (lambda (x) (message "Got abc : %s" x)))) 141 | ;; => This task is blocked because no value is bound to the variable `abc`. 142 | 143 | (cc:dataflow-set dfenv "abc" 256) ; Binding a value to the variable `abc`. 144 | ;; => The blocked task resumes and displays "Got abc : 256". 145 | 146 | (cc:dataflow-get-sync dfenv "abc") ; => 256 147 | 148 | (cc:dataflow-clear dfenv "abc") ; unbind the variable `abc` 149 | 150 | (cc:dataflow-get-sync dfenv "abc") ; => nil 151 | 152 | ;;## Complex key 153 | 154 | (deferred:$ 155 | (cc:dataflow-get dfenv '("http://example.com/a.jpg" 300)) 156 | (deferred:nextc it 157 | (lambda (x) (message "a.jpg:300 OK %s" x)))) 158 | 159 | (cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg) 160 | 161 | ;; => a.jpg:300 OK jpeg 162 | 163 | ;;## Waiting for two variables 164 | 165 | (deferred:$ ; Start the task that refers two variables, `abc` and `def`. 166 | (deferred:parallel 167 | (cc:dataflow-get dfenv "abc") 168 | (cc:dataflow-get dfenv "def")) 169 | (deferred:nextc it 170 | (lambda (values) 171 | (apply 'message "Got values : %s, %s" values) 172 | (apply '+ values))) 173 | (deferred:nextc it 174 | (lambda (x) (insert (format ">> %s" x))))) 175 | ;; => This task is blocked. 176 | 177 | (cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc") 178 | (cc:dataflow-get-avalable-pairs dfenv) ; => ((("http://example.com/a.jpg" 300) . jpeg)) 179 | 180 | (cc:dataflow-set dfenv "abc" 128) ; Binding one value. The task is still blocked. 181 | (cc:dataflow-set dfenv "def" 256) ; Binding the next value. Then, the task resumes. 182 | ;; => Got values : 128, 256 183 | ``` 184 | 185 | ### Signal 186 | 187 | The function `cc:signal-channel` creates a channel for signals. 188 | Then, one can connect receivers and send signals. 189 | 190 | Signal: 191 | 192 | ```el 193 | ;; Create a channel. 194 | (setq channel (cc:signal-channel)) 195 | 196 | (cc:signal-connect ; Connect the receiver for the signal 'foo. 197 | channel 'foo 198 | (lambda (event) (message "Signal : %S" event))) 199 | 200 | (cc:signal-connect 201 | channel t ; The signal symbol 't' means any signals. 202 | (lambda (event) 203 | (cl-destructuring-bind (event-name (args)) event 204 | (message "Listener : %S / %S" event-name args)))) 205 | 206 | (deferred:$ ; Connect the deferred task. 207 | (cc:signal-connect channel 'foo) 208 | (deferred:nextc it 209 | (lambda (x) (message "Deferred Signal : %S" x)))) 210 | 211 | (cc:signal-send channel 'foo "hello signal!") 212 | ;; => 213 | ;; Listener : foo / "hello signal!" 214 | ;; Signal : (foo ("hello signal!")) 215 | ;; Deferred Signal : (foo ("hello signal!")) 216 | 217 | (cc:signal-send channel 'some "some signal!") 218 | ;; => 219 | ;; Listener : some / "some signal!" 220 | ``` 221 | 222 | Dataflow objects have the own channel to notify accessing to the variables. 223 | Receiving the signals for referring unbound variables, one can create values on demand. 224 | 225 | The signal and dataflow objects can be cascades, creating objects with the parent ones. 226 | It enables that the dataflow object can have the default values, and that 227 | one can use the different scope signals in the tree structure of the channel objects, such as global signals and local signals. 228 | 229 | ## API Details 230 | 231 | ### Thread 232 | 233 | * cc:thread (wait-time-msec &rest body) 234 | * Arguments 235 | * wait-time-msec: The interval time between tasks (millisecond). 236 | * Return 237 | * A thread object. 238 | * This function creates a thread and start it. 239 | * The `thread` means that each s-exps in the body part are executed as asynchronous tasks. Then, the interval between tasks is `wait-time-msec`. 240 | * The `while` form in the body part acts as a loop. 241 | * Note that the infinite loops or the heavy loop tasks may make the Emacs freeze. The command `deferred:clear-queue` may recover such freeze situation. 242 | 243 | ### Generator 244 | 245 | * cc:generator (callback &rest body) 246 | * Arguments 247 | * callback: A function to receive the value passed by `yield` form. 248 | * body: Generator forms. 249 | * Return 250 | * A generating function. 251 | * Similar to `cc:thread`, each s-exps in the body part are executed as asynchronous tasks and the `while` form in the body part acts as a loop. 252 | * The `yield` form in the body part passes the value to the `callback` function and pause the asynchronous tasks. 253 | * Calling the generating function, the asynchronous tasks resume. 254 | 255 | ### Semaphore 256 | 257 | * cc:semaphore-create (permits-num) 258 | * Arguments 259 | * permits-num: The number of permits. 260 | * Return 261 | * A semaphore object. 262 | * This function creates a semaphore object. 263 | 264 | * cc:semaphore-acquire (semaphore) 265 | * Argument 266 | * semaphore: A semaphore object. 267 | * Return 268 | * A deferred object. 269 | * Acquire an execution permission and return deferred object to chain. 270 | * If this semaphore object has permissions, the subsequent deferred task is executed immediately. 271 | * If this semaphore object has no permissions, the subsequent deferred task is blocked. After the permission is returned, the task is executed. 272 | 273 | * cc:semaphore-release (semaphore) 274 | * Arguments 275 | * semaphore: A semaphore object 276 | * Return 277 | * The given semaphore object 278 | * Release an execution permission. 279 | * The programmer is responsible to return the permissions. 280 | 281 | * cc:semaphore-with (semaphore body-func &optional error-func) 282 | * Arguments 283 | * semaphore: A semaphore object 284 | * body-func: A task function 285 | * error-func: An error handling function (which is connected by `deferred:error`.) 286 | * Return 287 | * A deferred object 288 | * Execute the task function asynchronously with the semaphore block. 289 | * Using this function is bit safer than using a pair of `cc:semaphore-acquire` and `cc:semaphore-release`. 290 | 291 | * cc:semaphore-release-all (semaphore) 292 | * Arguments 293 | * semaphore: A semaphore object 294 | * Return 295 | * Deferred objects those were waiting for permission. 296 | * Release all permissions for resetting the semaphore object. 297 | * If the semaphore object has some blocked tasks, this function return a list of the tasks and clear the list of the blocked tasks in the semaphore object. 298 | 299 | * cc:semaphore-interrupt-all (semaphore) 300 | * Arguments 301 | * semaphore: A semaphore object 302 | * Return 303 | * A deferred object 304 | * Clear the list of the blocked tasks in the semaphore and return a deferred object to chain. 305 | * This function is used for the interruption cases. 306 | 307 | ### Signal 308 | 309 | * cc:signal-channel (&optional name parent-channel) 310 | * Arguments 311 | * name: A channel name for debug. 312 | * parent-channel: An upstream channel object. 313 | * Return 314 | * A channel object. 315 | * Create a new channel object. 316 | * The observers of this channel can receive the upstream signals. 317 | * In the case of using the function `cc:signal-send`, the observers of the upstream channel can not receive the signals of this channel. 318 | * The function `cc:signal-send-global` can send a signal to the upstream channels from the downstream channels. 319 | 320 | * cc:signal-connect (channel event-sym &optional callback) 321 | * Arguments 322 | * channel: A channel object 323 | * event-sym: A signal symbol 324 | * callback: A receiver function 325 | * Return 326 | * A deferred object 327 | * Append an observer for the symbol of the channel and return a deferred object. 328 | * If `event-sym` is `t`, the observer receives all signals of the channel. 329 | * If the callback function is given, the deferred object executes the callback function asynchronously. 330 | * One can connect subsequent tasks to the returned deferred object. 331 | 332 | * cc:signal-send (channel event-sym &rest args) 333 | * Arguments 334 | * channel: A channel object 335 | * event-sym: A signal symbol 336 | * args: Signal arguments 337 | * Return 338 | * None 339 | * Send a signal to the channel. 340 | * If the `args` are given, observers can get the values by following code: 341 | * `(lambda (event) (cl-destructuring-bind (event-sym (args)) event ... ))` 342 | 343 | * cc:signal-send-global (channel event-sym &rest args) 344 | * Arguments 345 | * channel: A channel object 346 | * event-sym: A signal symbol 347 | * args: Signal arguments 348 | * Return 349 | * None 350 | * Send a signal to the most upstream channel. 351 | 352 | * cc:signal-disconnect (channel deferred) 353 | * Arguments 354 | * channel: A channel object 355 | * deferred: The deferred object to delete 356 | * Return 357 | * The deleted deferred object 358 | * Remove the observer object from the channel and return the removed deferred object. 359 | 360 | * cc:signal-disconnect-all (channel) 361 | * Arguments 362 | * channel: A channel object 363 | * Return 364 | * None 365 | * Remove all observers. 366 | 367 | ### Dataflow 368 | 369 | * cc:dataflow-environment (&optional parent-env test-func channel) 370 | * Arguments 371 | * parent-env: A dataflow object as the default value. 372 | * test-func: A test function that compares the entry keys. 373 | * channel: A channel object that sends signals of variable events. 374 | * Return 375 | * A dataflow object 376 | * Create a dataflow environment. 377 | * The parent environment 378 | * If this environment doesn't have the entry A and the parent one has the entry A, this environment can return the entry A. 379 | * One can override the entry, setting another entry A to this environment. 380 | * If no channel is given, this function creates a new channel object internally. 381 | * Observers can receive following signals: 382 | * `get-first` : the fist referrer is waiting for binding, 383 | * `get-waiting` : another referrer is waiting for binding, 384 | * `set` : a value is bound, 385 | * `get` : returned a bound value, 386 | * `clear` : cleared one entry, 387 | * `clear-all` : cleared all entries. 388 | 389 | * cc:dataflow-get (df key) 390 | * Arguments 391 | * df: A dataflow object 392 | * key: A key object 393 | * Return 394 | * A deferred object 395 | * Return a deferred object that can refer the value which is indicated by the key. 396 | * If the dataflow object has the entry that bound value, the subsequent deferred task is executed immediately. 397 | * If not, the task is deferred till a value is bound. 398 | 399 | * cc:dataflow-get-sync (df key) 400 | * Arguments 401 | * df: A dataflow object 402 | * key: A key object 403 | * Return 404 | * Nil or a value 405 | * Return the value which is indicated by the key synchronously. 406 | * If the environment doesn't have an entry of the key, this function returns nil. 407 | 408 | * cc:dataflow-set (df key value) 409 | * Arguments 410 | * df: A dataflow object 411 | * key: A key object 412 | * value: A value 413 | * Return 414 | * None 415 | * Bind the value to the key in the environment. 416 | * If the dataflow already has the bound entry of the key, this function throws an error signal. 417 | * The value can be nil as a value. 418 | 419 | * cc:dataflow-clear (df key) 420 | * Arguments 421 | * df: A dataflow object 422 | * key: A key object 423 | * Return 424 | * None 425 | * Clear the entry which is indicated by the key. 426 | * This function does nothing for the waiting deferred objects. 427 | 428 | * cc:dataflow-get-avalable-pairs (df) 429 | * Arguments 430 | * df: A dataflow object 431 | * Return 432 | * An available key-value alist in the environment and the parent ones. 433 | 434 | * cc:dataflow-get-waiting-keys (df) 435 | * Arguments 436 | * df: A dataflow object 437 | * Return 438 | * A list of keys which have waiting deferred objects in the environment and the parent ones. 439 | 440 | * cc:dataflow-clear-all (df) 441 | * Arguments 442 | * df: A dataflow object 443 | * Return 444 | * None 445 | * Clear all entries in the environment. 446 | * This function does nothing for the waiting deferred objects. 447 | 448 | * cc:dataflow-connect (df event-sym &optional callback) 449 | * Arguments 450 | * df: A dataflow object 451 | * event-sym: A signal symbol 452 | * callback: A receiver function 453 | * Return 454 | * A deferred object 455 | * Append an observer for the symbol of the channel of the environment and return a deferred object. 456 | * See the document of `cc:dataflow-environment` for details of signals. 457 | 458 | 459 | * * * * * 460 | 461 | (C) 2011-2016 SAKURAI Masashi All rights reserved. 462 | m.sakurai at kiwanami.net 463 | -------------------------------------------------------------------------------- /README.ja.markdown: -------------------------------------------------------------------------------- 1 | # deferred.el # 2 | 3 | [![Build Status](https://travis-ci.org/kiwanami/emacs-deferred.svg)](https://travis-ci.org/kiwanami/emacs-deferred) 4 | [![Coverage Status](https://coveralls.io/repos/kiwanami/emacs-deferred/badge.svg)](https://coveralls.io/r/kiwanami/emacs-deferred) 5 | [![MELPA](http://melpa.org/packages/deferred-badge.svg)](http://melpa.org/#/deferred) 6 | [![MELPA stable](http://stable.melpa.org/packages/deferred-badge.svg)](http://stable.melpa.org/#/deferred) 7 | [![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags) 8 | [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html) 9 | 10 | deferred.el は非同期処理を抽象化して書きやすくするためのライブラリです。 11 | APIや実装については 12 | [JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45さん)と 13 | [Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html 14 | "Mochikit.Async") (by Bob Ippolitoさん)を参考にしています。 15 | 16 | ## インストール ## 17 | 18 | deferred.elは package.elを使って, [MELPA](http://melpa.org)からインストールすることができます. 19 | 20 | ## 使い方例 ## 21 | 22 | 以下のサンプルで例示したソースは deferred-samples.el の中にあります。 23 | eval-last-sexp (C-x C-e) などで実行してみてください。 24 | 25 | ### 基本 ### 26 | 27 | 基本的な deferred の連結です。messageにいくつか表示し、ミニバッファから 28 | 入力を受け付けます。 29 | 30 | Chain: 31 | 32 | ```el 33 | (deferred:$ 34 | (deferred:next 35 | (lambda () (message "deferred start"))) 36 | (deferred:nextc it 37 | (lambda () 38 | (message "chain 1") 39 | 1)) 40 | (deferred:nextc it 41 | (lambda (x) 42 | (message "chain 2 : %s" x))) 43 | (deferred:nextc it 44 | (lambda () 45 | (read-minibuffer "Input a number: "))) 46 | (deferred:nextc it 47 | (lambda (x) 48 | (message "Got the number : %i" x))) 49 | (deferred:error it 50 | (lambda (err) 51 | (message "Wrong input : %s" err)))) 52 | ``` 53 | 54 | 55 | * この式を実行すると、直ちに結果が帰ってきます。 56 | * 実際の処理自体はすぐ後に非同期で実行されます。 57 | * deferred:$ は deferred を連結するためのマクロです。 58 | * itには前の式(deferred:nextなど)の返値が入っています。 59 | * 前の deferred 処理の返値が、次の処理の引数になっています。 60 | * 数字以外を入力するとエラーになりますが、 deferred:error でエラーを拾っています。 61 | 62 | 63 | ### タイマーで一定時間後 ### 64 | 65 | 1秒待ってメッセージを表示します。 66 | 67 | Timer: 68 | 69 | ```el 70 | (deferred:$ 71 | (deferred:wait 1000) ; 1000msec 72 | (deferred:nextc it 73 | (lambda (x) 74 | (message "Timer sample! : %s msec" x)))) 75 | ``` 76 | 77 | * deferred:wait の次の処理には、実際に経過した時間が渡ってきます。 78 | 79 | ### 外部プロセス・コマンド実行 ### 80 | 81 | 外部プロセスで「ls -la」を実行して結果を現在のバッファに表示します。（素のWindowsで動かす場合は、dirなどに変更してみてください。） 82 | 83 | Command process: 84 | 85 | ```el 86 | (deferred:$ 87 | (deferred:process "ls" "-la") 88 | (deferred:nextc it 89 | (lambda (x) (insert x)))) 90 | ``` 91 | 92 | * 非同期で実行するため、処理がブロックしたりしません。 93 | 94 | 95 | ### HTTP GET ### 96 | 97 | GNUのトップページのHTMLを取ってきて、現在のバッファに貼り付けます（大量のHTMLが張り付きますが、undoで戻せます）。 98 | 99 | HTTP GET: 100 | 101 | ```el 102 | (require 'url) 103 | 104 | (deferred:$ 105 | (deferred:url-retrieve "http://www.gnu.org") 106 | (deferred:nextc it 107 | (lambda (buf) 108 | (insert (with-current-buffer buf (buffer-string))) 109 | (kill-buffer buf)))) 110 | ``` 111 | 112 | ### 画像 ### 113 | 114 | googleの画像を取ってきてそのままバッファに貼り付けます。 115 | 116 | Get an image: 117 | 118 | ```el 119 | (deferred:$ 120 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png") 121 | (deferred:nextc it 122 | (lambda (buf) 123 | (insert-image 124 | (create-image 125 | (let ((data (with-current-buffer buf (buffer-string)))) 126 | (substring data (+ (string-match "\n\n" data) 2))) 127 | 'png t)) 128 | (kill-buffer buf)))) 129 | ``` 130 | 131 | ### 並列 ### 132 | 133 | 2つの画像を取ってきて、結果がそろったところで各画像のファイルサイズを現在のバッファに表示します。 134 | 135 | Parallel deferred: 136 | 137 | ```el 138 | (deferred:$ 139 | (deferred:parallel 140 | (lambda () 141 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")) 142 | (lambda () 143 | (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png"))) 144 | (deferred:nextc it 145 | (lambda (buffers) 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))))) 153 | ``` 154 | 155 | * deferred:parallel 内部で、並列に実行できるものは並列に動作します。 156 | * 各処理が完了するかエラーが発生して、すべての処理が完了したところで次の処理が開始されます。 157 | * 次の処理には結果がリストで渡されます。 158 | * 順番は保持されます 159 | * alistを渡して名前で結果を選ぶことも出来ます 160 | 161 | ### deferred組み合わせ、try-catch-finally ### 162 | 163 | 外部プロセスの wget で画像を取ってきて、ImageMagic の convert コマンドでリサイズし、バッファに画像を表示します。（wget, convertが無いと動きません） 164 | deferred を組み合わせて、非同期処理の try-catch のような構造を作ることが出来ます。 165 | 166 | Get an image by wget and resize by ImageMagick: 167 | 168 | ```el 169 | (deferred:$ 170 | 171 | ;; try 172 | (deferred:$ 173 | (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") 174 | (deferred:nextc it 175 | (lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) 176 | (deferred:nextc it 177 | (lambda () 178 | (clear-image-cache) 179 | (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) 180 | 181 | ;; catch 182 | (deferred:error it ; 183 | (lambda (err) 184 | (insert "Can not get a image! : " err))) 185 | 186 | ;; finally 187 | (deferred:nextc it 188 | (lambda () 189 | (deferred:parallel 190 | (lambda () (delete-file "a.jpg")) 191 | (lambda () (delete-file "b.jpg"))))) 192 | (deferred:nextc it 193 | (lambda (x) (message ">> %s" x)))) 194 | ``` 195 | 196 | * deferred を静的につなげることで、自由に組み合わせることが出来ます。 197 | * 関数などで個別の deferred 処理を作って、後で一つにまとめるなど。 198 | 199 | なお、この例は以下のようにも書けます。（注意：完全に同じ動作ではありません。また、非同期の仕組み上、finallyタスクは必ず実行することを保証するものではありません。） 200 | 201 | Try-catch-finally: 202 | 203 | ```el 204 | (deferred:$ 205 | (deferred:try 206 | (deferred:$ 207 | (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") 208 | (deferred:nextc it 209 | (lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) 210 | (deferred:nextc it 211 | (lambda () 212 | (clear-image-cache) 213 | (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) 214 | :catch 215 | (lambda (err) (insert "Can not get a image! : " err)) 216 | :finally 217 | (lambda () 218 | (delete-file "a.jpg") 219 | (delete-file "b.jpg"))) 220 | (deferred:nextc it 221 | (lambda (x) (message ">> %s" x)))) 222 | ``` 223 | 224 | ### earlierでtimeout ### 225 | 226 | 外部プロセスで3秒待つコマンドを実行しますが、途中でキャンセルします。 227 | 228 | deferred:earlier は parallel と同様に、引数の処理を並列に実行しますが、一番早く完了した処理の結果を次の処理に渡します。他の処理はその時点でキャンセルされます。 229 | 230 | Timeout Process: 231 | 232 | ```el 233 | (deferred:$ 234 | (deferred:earlier 235 | (deferred:process "sh" "-c" "sleep 3 | echo 'hello!'") 236 | (deferred:$ 237 | (deferred:wait 1000) ; timeout msec 238 | (deferred:nextc it (lambda () "canceled!")))) 239 | (deferred:nextc it 240 | (lambda (x) (insert x)))) 241 | ``` 242 | 243 | * deferred:wait の待つ時間を5秒などにすると、コマンドの結果が渡ってきます。 244 | * エラーは完了と見なされません。すべての処理がエラーになった場合は nil が次に渡ります。 245 | * deferred:parallel と deferred:earlier は lisp の and や or のようなイメージです。 246 | 247 | なお、この例は deferred:timeout マクロを使って以下のようにも書けます。 248 | 249 | Timeout macro: 250 | 251 | ```el 252 | (deferred:$ 253 | (deferred:timeout 254 | 1000 "canceled!" 255 | (deferred:process "sh" "-c" "sleep 3 | echo 'hello!'")) 256 | (deferred:nextc it 257 | (lambda (x) (insert x)))) 258 | ``` 259 | 260 | ### ループとアニメーション・スレッド ### 261 | 262 | 数秒間カーソールのある位置に文字でアニメーションを表示します。その間、カーソールを自由に動かして普通にEmacsを操作できます。 263 | 264 | deferredの処理の中でdeferredオブジェクトを返すと、ソースコードで（静的に）繋がっている次のdeferred処理へ移る前に、返した方のdeferredオブジェクトを実行します（動的なdeferredの接続）。再帰的な構造にしてwaitを入れて負荷を調節することで、マルチスレッドのような処理を実現することが出来ます。 265 | 266 | Loop and animation: 267 | 268 | ```el 269 | (let ((count 0) (anm "-/|\\-") 270 | (end 50) (pos (point)) 271 | (wait-time 50)) 272 | (deferred:$ 273 | (deferred:next 274 | (lambda (x) (message "Animation started."))) 275 | 276 | (deferred:nextc it 277 | (deferred:lambda (x) 278 | (save-excursion 279 | (when (< 0 count) 280 | (goto-char pos) (delete-char 1)) 281 | (insert (char-to-string 282 | (aref anm (% count (length anm)))))) 283 | (if (> end (cl-incf count)) ; 止める場合はdeferredでないものを返す（この場合はnil） 284 | (deferred:nextc (deferred:wait wait-time) self)))) ; 続けるときはdeferredを返す 285 | 286 | (deferred:nextc it 287 | (lambda (x) 288 | (save-excursion 289 | (goto-char pos) (delete-char 1)) 290 | (message "Animation finished."))))) 291 | ``` 292 | 293 | * deferred:lambda は自分自身をselfとして使えるマクロです。再帰的構造を作るのに便利です。 294 | 295 | ## インタフェース解説 ## 296 | 297 | 「関数」の章では各関数の簡単な説明を行います。「実行・接続」の章では、deferredオブジェクトの接続（実行順序）などの説明を行います。 298 | 299 | ### 関数 ### 300 | 301 | #### 基本 #### 302 | 303 | 良く使用する基本的な関数やマクロです。 304 | 305 | * deferred:next (callback) 306 | * 引数： 307 | * callback: 引数1つか0個の関数 308 | * 返値：deferredオブジェクト 309 | * 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成して返します。また実行キューに入れて非同期実行をスケジュールします。 310 | * →関数を非同期で実行します。 311 | 312 | 313 | * deferred:nextc (d callback) 314 | * 引数： 315 | * d: deferredオブジェクト 316 | * callback: 引数1つか0個の関数 317 | * 返値：deferredオブジェクト 318 | * 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。 319 | * →前のdeferredの後に関数を実行するように連結します。 320 | 321 | * deferred:error (d errorback) 322 | * 引数： 323 | * d: deferredオブジェクト 324 | * errorback: 引数1つか0個の関数 325 | * 返値：deferredオブジェクト 326 | * 引数の関数をエラー処理コールバックとしてラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。 327 | * →前のdeferredでエラーが起きたときに、この関数で処理するようにします。 328 | * この関数内で例外を発生しなければ、後続のdeferredのコールバック関数が実行されます。 329 | 330 | * deferred:cancel (d) 331 | * 引数： 332 | * d: deferredオブジェクト 333 | * 返値：引数のdeferredオブジェクト（無効になっている） 334 | * 引数のdeferredオブジェクトを無効にして、コールバックやエラーバック関数が実行されないようにします。 335 | * この関数は引数のdeferredオブジェクトを破壊的に変更します。 336 | 337 | * deferred:watch (d callback) 338 | * 引数： 339 | * d: deferredオブジェクト 340 | * callback: 引数1つか0個の関数 341 | * 返値：deferredオブジェクト 342 | * 引数の関数をコールバックとエラーバックの両方でラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。 343 | * 次のdeferredタスクへの値は前のタスクの結果をそのまま渡します。 344 | * callbackが何を返しても、callback内部でエラーが発生しても、deferredの流れに影響を与えません。 345 | * callback内部の非同期タスクは後続のdeferredタスクと非同期に実行されます。 346 | * →deferred処理の流れに割り込んだり、実行状況を監視したいときに使います。 347 | 348 | * deferred:wait (msec) 349 | * 引数： 350 | * msec: 数値 351 | * 返値：deferredオブジェクト 352 | * この関数が実行された時点から引数で指定されたミリ秒待って、後続のdeferredオブジェクトを実行します。 353 | * 後続のdeferredオブジェクトのコールバック関数の引数には、実際に経過した時間がミリ秒で渡ってきます。 354 | 355 | * deferred:$ (forms...) 356 | * 引数：1つ以上のdeferredフォーム 357 | * 返値：一番最後のdeferredオブジェクト 358 | * deferredオブジェクトのチェインを書きやすくするためのアナフォリックマクロです。 359 | * 一つ前のdeferredオブジェクトが「it」で渡ってきます。 360 | 361 | #### ユーティリティ #### 362 | 363 | 複数のdeferredを扱う関数です。 364 | 365 | * deferred:loop (number-or-list callback) 366 | * 引数： 367 | * number-or-list: 1以上の整数もしくはリスト 368 | * callback: 引数1つか0個の関数 369 | * 返値：deferredオブジェクト 370 | * 引数の数値で指定された数だけループするようなdeferredオブジェクトを生成して返します。関数には0から始まるカウンタが渡ってきます。 371 | * 整数ではなくリストが渡ってきた場合は、mapcのようにループします。 372 | 373 | * deferred:parallel (list-or-alist) 374 | * 引数：以下のどちらか 375 | * 1つ以上のdeferredオブジェクトか引数1つか0個の関数のリスト 376 | * 1つ以上のシンボルとdeferredオブジェクトか引数1つか0個の関数によるconsセルのリスト（つまりalist） 377 | * 返値：deferredオブジェクト 378 | * 引数に与えられたdeferredオブジェクトを並列に実行し、結果を待ち合わせます。 379 | * 後続のdeferredには結果が順番の保持されたリストとして渡ります。 380 | * 引数にalistが渡した場合は、結果もalistで渡ります。この場合は順番は保持されません。 381 | * deferred処理の中でエラーが発生した場合は、結果のリストの中にエラーオブジェクトが入ります。 382 | 383 | * deferred:earlier (list-or-alist) 384 | * 引数：以下のどちらか 385 | * 1つ以上のdeferredオブジェクトか引数1つか0個の関数のリスト 386 | * 1つ以上のシンボルとdeferredオブジェクトか引数1つか0個の関数によるconsセルのリスト（つまりalist） 387 | * 返値：deferredオブジェクト 388 | * 引数に与えられたdeferredオブジェクトを並列に実行し、最初に帰ってきた結果を後続のdeferredに渡します。 389 | * 2番目以降の処理はキャンセルされ、結果が帰ってきても無視されます。 390 | * 引数にalistを渡した場合は、結果はconsセルで渡ります。 391 | * deferred処理の中でエラーが発生した場合は、結果が帰ってこなかったものとして扱われます。 392 | * すべての処理がエラーになった場合は、後続のdeferredにnilが渡ります。つまり、エラーバックで処理されません。 393 | 394 | #### ラッパー #### 395 | 396 | 元からある処理をdeferredでラップする関数です。 397 | 398 | * deferred:call (function args...) 399 | * 引数： 400 | * function: 関数のシンボル 401 | * args: 引数（可変長） 402 | * 返値：deferredオブジェクト 403 | * オリジナルのfuncallを非同期にした関数です 404 | 405 | * deferred:apply (function args) 406 | * 引数： 407 | * function: 関数のシンボル 408 | * args: 引数（リスト） 409 | * 返値：deferredオブジェクト 410 | * オリジナルのapplyを非同期にした関数です 411 | 412 | * deferred:process (command args...) / deferred:process-shell (command args...) 413 | * 引数： 414 | * command: 外部実行コマンド 415 | * args: コマンドの引数(可変長) 416 | * 返値：deferredオブジェクト 417 | * 外部コマンドを非同期で実行します。（start-process, start-process-shell-command のラッパー） 418 | * 外部コマンドのstdoutとstderrの結果が文字列として後続のdeferredに渡ります。 419 | 420 | * deferred:process-buffer (command args...) / deferred:process-shell-buffer (command args...) 421 | * 引数： 422 | * command: 外部実行コマンド 423 | * args: コマンドの引数(可変長) 424 | * 返値：deferredオブジェクト 425 | * 外部コマンドを非同期で実行します。（start-process, start-process-shell-command のラッパー） 426 | * 外部コマンドのstdoutとstderrの結果がバッファとして後続のdeferredに渡ります。 427 | * バッファの処分は後続のdeferredに任されます。 428 | 429 | * deferred:wait-idle (msec) 430 | * 引数： 431 | * msec: 数値 432 | * 返値：deferredオブジェクト 433 | * 引数で指定されたミリ秒間Emacsがアイドル状態だったときに、後続のdeferredオブジェクトを実行します。 434 | * 後続のdeferredオブジェクトのコールバック関数の引数には、この関数が呼ばれてから経過した時間がミリ秒で渡ってきます。 435 | 436 | * deferred:url-retrieve (url [cbargs]) 437 | * 引数： 438 | * url: 取ってきたいURL 439 | * cbargs: コールバック引数（オリジナル関数のもの。省略可。） 440 | * 返値：deferredオブジェクト 441 | * urlパッケージにある、オリジナルのurl-retrieveをdeferredでラップした関数です。 442 | * HTTPで取得した結果が、後続のdeferredにバッファで渡ります。 443 | * バッファの処分は後続のdeferredに任されます。 444 | 445 | * （仮）deferred:url-get (url params) 446 | * 引数： 447 | * url: 取ってきたいURL 448 | * params: パラメーターのalist 449 | * 返値：deferredオブジェクト 450 | * パラメーターを指定しやすくした関数です。仮実装ですので今後仕様が変わる可能性があります。 451 | 452 | * （仮）deferred:url-post (url params) 453 | * 引数： 454 | * url: 取ってきたいURL 455 | * params: パラメーターのalist 456 | * 返値：deferredオブジェクト 457 | * パラメーターを指定しやすくして、POSTでアクセスする関数です。仮実装ですので今後仕様が変わる可能性があります。 458 | 459 | #### インスタンスメソッド #### 460 | 461 | プリミティブな操作を行う関数です。典型的でないdeferred処理を行いたい場合に、組み合わせて使います。 462 | 463 | * deferred:new (callback) 464 | * 引数：引数1つか0個の関数 465 | * 返値：deferredオブジェクト 466 | * 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成して返します。 467 | * 実行キューに入れないため、deferred:callbackやdeferred:errorbackが呼ばれない限り実行されません。 468 | * 一時停止して他のイベントを待つような、deferredチェインを作りたいときに使います。 → deferred:wait のソースなどを参考。 469 | 470 | * deferred:succeed ([value]) 471 | * 引数：値（省略可） 472 | * 返値：deferredオブジェクト 473 | * 引数の値を使って、既にコールバックが呼ばれた状態のdeferredを返します。 474 | * 後続のdeferredは接続されたら直ちに（同期的に）実行されます。 475 | 476 | * deferred:fail ([error]) 477 | * 引数：値（省略可） 478 | * 返値：deferredオブジェクト 479 | * 引数の値を使って、既にエラーバックが呼ばれた状態のdeferredを返します。 480 | * 後続のdeferredは接続されたら直ちに（同期的に）実行されます。 481 | 482 | * deferred:callback (d [value]) 483 | * 引数： 484 | * d: deferredオブジェクト 485 | * value: 値（省略可） 486 | * 返値：deferredオブジェクトか、結果値 487 | * 引数のdeferredオブジェクトを同期的に開始します。 488 | * ただし、同期的な実行は初回のみで、引数のdeferred以降のdeferredオブジェクトは非同期に実行されます。 489 | 490 | * deferred:callback-post (d [value]) 491 | * 引数： 492 | * d: deferredオブジェクト 493 | * value: 値（省略可） 494 | * 返値：deferredオブジェクトか、結果値 495 | * 引数のdeferredオブジェクトを非同期に開始します。 496 | 497 | * deferred:errorback (d [error]) 498 | * 引数： 499 | * d: deferredオブジェクト 500 | * error: 値（省略可） 501 | * 返値：deferredオブジェクトか、結果値 502 | * 引数のdeferredオブジェクトからエラーバックを同期的に開始します。 503 | 504 | * deferred:errorback-post (d [error]) 505 | * 引数： 506 | * d: deferredオブジェクト 507 | * error: 値（省略可） 508 | * 返値：deferredオブジェクトか、結果値 509 | * 引数のdeferredオブジェクトからエラーバックを非同期に開始します。 510 | 511 | 512 | ### ユーティリティマクロ ### 513 | 514 | いくつかの便利なマクロを用意しています。マクロですので、スコープや評価順序などに注意して予想外の動作に気をつけてください。 515 | 516 | * deferred:try (d &key catch finally) 517 | * 引数： 518 | * d: deferredオブジェクト 519 | * catch: [キーワード引数] dのタスクを実行中にエラーが起きたときに実行される関数。（マクロ展開によって deferred:error の引数に入る） 520 | * finally: [キーワード引数] dのタスクが正常・エラーに関わらず終了したあとに実行する関数（マクロ展開によって deferred:watch の引数に入る） 521 | * 返値：deferredオブジェクト 522 | * 非同期処理で try-catch-finally のような処理を実現するマクロです。所詮非同期なので、メインのdeferredタスクの内容によっては、finallyタスクに処理が回ってこない可能性もあります。 523 | * deferred:error と deferred:watch を使って実装しています。 524 | 525 | * deferred:timeout (msec timeout-form d) 526 | * 引数： 527 | * msec: 数値 528 | * timeout-form: キャンセル時に評価する sexp-form 529 | * d: deferredオブジェクト 530 | * 返値：deferredオブジェクト 531 | * dのタスクを開始してmsecミリ秒経過した場合、dのタスクをキャンセルして、timeout-formの結果を後続のdeferredに渡します。 532 | * deferred:earlierとdeferred:waitを使って実装しています。 533 | 534 | * deferred:process〜 535 | * deferred:processc (d command args...) 536 | * deferred:process-bufferc (d command args...) 537 | * deferred:process-shellc (d command args...) 538 | * deferred:process-shell-bufferc (d command args...) 539 | * 引数： 540 | * d: deferredオブジェクト 541 | * command: 外部実行コマンド 542 | * args: コマンドの引数(可変長) 543 | * 返値：deferredオブジェクト 544 | * 外部コマンドを非同期で実行するdeferredオブジェクトをdに接続します。 545 | * deferred:nextc の lambda の中に元の関数を埋め込んで実装しています。 546 | 547 | ### 実行・接続 ### 548 | 549 | #### 処理開始について #### 550 | 551 | 関数の中には処理を自動的に開始するものとしないものがあります。 552 | 553 | 以下の関数は、非同期実行用のキューにdeferredオブジェクトを登録します。つまり、自動的に実行を開始します。 554 | 555 | * next 556 | * wait 557 | * loop 558 | * parallel 559 | * earlier 560 | * call, apply 561 | * process 562 | * url-retrieve, url-get, url-post 563 | 564 | new は callback や errorback を呼ぶまで実行が開始されません。他のイベントを待って実行を開始するような用途で使います。 565 | 566 | deferredオブジェクトは先にコールバックを実行しておいて、後で後続のdeferredオブジェクトをつなげることも出来ます。つまり、一番最後のdeferredオブジェクトは、続きのdeferredオブジェクトが接続されるまで結果を保持し続けます。succeed と fail は、そのような既に実行された状態の deferred を生成します。 567 | 568 | #### ソースコード上のでの接続 #### 569 | 570 | deferredオブジェクトを$などを使ってソースコード上で連結することを、静的な接続と呼びます。 571 | 572 | これはdeferredの基本的な使い方で、コールバック処理の書き方を変えたものだと言えます。 573 | 574 | 処理がコード上に並びますので読みやすく、流れも理解しやすいです。通常、このパターンを使います。 575 | 576 | #### 実行時に接続 #### 577 | 578 | deferred処理の中でdeferredオブジェクトを返すと、静的に接続された（ソースコード上の）後続のdeferredオブジェクトの前に、そのdeferredを割り込ませます。 579 | 580 | この動作により、ループや分岐などの高度な非同期処理を行うことができます。 581 | 582 | ## ポイント ## 583 | 584 | ここでは、いくつかの実装上のポイントを示します。 585 | 586 | ### レキシカルスコープ ### 587 | 588 | deferredの処理に値を持って行く場合、let などを用いてレキシカルスコープを使うと大変便利です。 589 | 590 | 特に、一連のdeferred処理の中で共通に使う値にレキシカルスコープを使うと、ローカル変数のようにアクセスすること出来るため、非同期処理のために値をグローバルに保持しておく必要が無くなります。 591 | 592 | let 例: 593 | 594 | ```el 595 | (let ((a (point))) 596 | (deferred:$ 597 | (deferred:wait 1000) 598 | (deferred:nextc it 599 | (lambda (x) 600 | (goto-char a) 601 | (insert "here!"))))) 602 | ``` 603 | 604 | 逆に、letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。 605 | 606 | ### カレント状態 ### 607 | 608 | save-execursion や with-current-buffer など、S式の範囲で状態を保持する関数がありますが、deferred関数を囲っていても非同期で処理される時点では無効になっています。 609 | 610 | ダメな例: 611 | 612 | ```el 613 | (with-current-buffer (get-buffer "*Message*") 614 | (deferred:$ 615 | (deferred:wait 1000) 616 | (deferred:nextc it 617 | (lambda (x) 618 | (insert "Time: %s " x) ; ここは *Message* バッファとは限らない！ 619 | )))) 620 | ``` 621 | 622 | このような場合は、レキシカルスコープなどでdeferredの中にバッファオブジェクトを持って行き、その中でバッファを切り替える必要があります。 623 | 624 | 改善例: 625 | 626 | ```el 627 | (let ((buf (get-buffer "*Message*"))) 628 | (deferred:$ 629 | (deferred:wait 1000) 630 | (deferred:nextc it 631 | (lambda (x) 632 | (with-current-buffer buf ; 非同期処理の中で設定する 633 | (insert "Time: %s " x)))))) 634 | ``` 635 | 636 | ### lambdaの返り値に気を使う ### 637 | 638 | 先に述べたとおり、deferredの処理の中でdeferredオブジェクトを返すと、動的な接続によりdeferred処理が割り込まれます。しかしながら、意図せずdeferredオブジェクトを返してしまい、実行順序がおかしくなり、バグに繋がるケースがあります。 639 | 640 | そのため、deferredのコールバックで返す値には気をつける必要があります。特に値を返さない場合は、予防として明示的にnilを返すようにするといいと思います。 641 | 642 | ### デバッグ ### 643 | 644 | 通常の処理に比べて、非同期の処理はデバッグが難しいことが多いです。デバッガが使える場面も多いですが、デバッガで停止中に他の非同期処理が行われたりすることがあるため、正しくデバッグできないこともあります。その場合は、message文をちりばめるとか、独自のログバッファに出力するなどしてデバッグすることが確実だと思います。 645 | 646 | 意図せず無限ループに陥って、非同期処理が延々と走り続けてしまうことがあります。その場合は、 deferred:clear-queue 関数を呼ぶ（M-xからも呼べます）ことで、実行キューを空にして止めることが出来ます。 647 | 648 | 非同期のタスクで発生したエラーは、エラーバックで拾わないと最終的にはmessageに表示されます。deferredの実装内部は condition-case で囲っていますので、デバッガでエラーを拾いたい場合は toggle-debug-on-error でデバッガを有効にすると同時に、 deferred:debug-on-signal を t に設定して発生したエラー取得するようにしてください。 649 | 650 | deferred:sync! 関数を使うことによって、deferred タスクを待ち合わせて同期的にすることができます。ただし、待ち合わせは完全ではないため、テストやデバッグ目的にのみ使うようにして、実アプリでは使わないようにしてください。 651 | 652 | ### マクロ ### 653 | 654 | deferred.elを使うと、nextcやlambdaをたくさん書くことになると思います。これらをマクロでラップすることで短く書くことが可能になります。deferred.elのテストコードのtest-deferred.elでは、マクロを使ってとにかく短く書いています。 655 | 656 | 一方、マクロでlambdaを隠蔽することで、フォームを実行した値を渡したいのか、あるいは非同期に実行される関数が引数なのか、分かりづらくなるおそれがあります。そういった理由からdeferred.elでは積極的に便利なマクロを提供していません。マクロで短く書く場合には、実行されるタイミングに気をつける必要があります。 657 | 658 | ### deferred入門 ### 659 | 660 | deferredによってどのようなことが可能になるかなどについては、JavaScriptの例ではありますが、以下のドキュメントが大変参考になると思います。 661 | 662 | * [JSDeferred紹介](http://cho45.stfuawsc.com/jsdeferred/doc/intro.html "JSDeferred紹介") 663 | * [特集：JSDeferredで，面倒な非同期処理とサヨナラ｜gihyo.jp … 技術評論社](http://gihyo.jp/dev/feature/01/jsdeferred "特集：JSDeferredで，面倒な非同期処理とサヨナラ｜gihyo.jp … 技術評論社") 664 | 665 | 666 | * * * * * 667 | 668 | (C) 2010-2016 SAKURAI Masashi All rights reserved. 669 | m.sakurai at kiwanami.net 670 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # deferred.el # 2 | 3 | [![Build Status](https://travis-ci.org/kiwanami/emacs-deferred.svg)](https://travis-ci.org/kiwanami/emacs-deferred) 4 | [![Coverage Status](https://coveralls.io/repos/kiwanami/emacs-deferred/badge.svg)](https://coveralls.io/r/kiwanami/emacs-deferred) 5 | [![MELPA](http://melpa.org/packages/deferred-badge.svg)](http://melpa.org/#/deferred) 6 | [![MELPA stable](http://stable.melpa.org/packages/deferred-badge.svg)](http://stable.melpa.org/#/deferred) 7 | [![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags) 8 | [![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html) 9 | 10 | `deferred.el` provides facilities to manage asynchronous tasks. 11 | 12 | The API and implementations were translated from 13 | [JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45) and 14 | [Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html 15 | "Mochikit.Async") (by Bob Ippolito) in JavaScript. 16 | 17 | *(note the README for `concurrent` is [here in the same repo](./README-concurrent.markdown))* 18 | 19 | ## Installation ## 20 | 21 | You can install deferred.el from [MELPA](http://melpa.org) by package.el. 22 | 23 | ## Sample codes ## 24 | 25 | You can find following sample codes in `deferred-sample.el`. 26 | Executing `eval-last-sexp` (C-x C-e), you can try those codes. 27 | 28 | ### Basic usage ### 29 | 30 | This is a basic deferred chain. This code puts some outputs into 31 | message buffer, and then require a number from minibuffer. 32 | 33 | Chain: 34 | 35 | ```el 36 | (deferred:$ 37 | (deferred:next 38 | (lambda () (message "deferred start"))) 39 | (deferred:nextc it 40 | (lambda () 41 | (message "chain 1") 42 | 1)) 43 | (deferred:nextc it 44 | (lambda (x) 45 | (message "chain 2 : %s" x))) 46 | (deferred:nextc it 47 | (lambda () 48 | (read-minibuffer "Input a number: "))) 49 | (deferred:nextc it 50 | (lambda (x) 51 | (message "Got the number : %i" x))) 52 | (deferred:error it 53 | (lambda (err) 54 | (message "Wrong input : %s" err)))) 55 | ``` 56 | 57 | * This s-exp returns immediately. 58 | * Asynchronous tasks start subsequently. 59 | * The macro `deferred:$` chains deferred objects. 60 | * The anaphoric variable `it` holds a deferred object in the previous line. 61 | * The next deferred task receives the value that is returned by the previous deferred one. 62 | * Inputting a wrong value, such as alphabets, this s-exp raises an error. The error is caught by the errorback function defined by `deferred:error`. 63 | 64 | ### Timer ### 65 | 66 | After evaluating this s-exp and waiting for 1 second, a message is shown in the minibuffer. 67 | 68 | Timer: 69 | 70 | ```el 71 | (deferred:$ 72 | (deferred:wait 1000) ; 1000msec 73 | (deferred:nextc it 74 | (lambda (x) 75 | (message "Timer sample! : %s msec" x)))) 76 | ``` 77 | 78 | * The next deferred task subsequent to deferred:wait receives the actual elapse time in millisecond. 79 | 80 | ### Commands and Sub-process ### 81 | 82 | This s-exp inserts the result that is performed by the command `ls -la`. (This s-exp may not run in windows. Try `dir` command.) 83 | 84 | Command process: 85 | 86 | ```el 87 | (deferred:$ 88 | (deferred:process "ls" "-la") 89 | (deferred:nextc it 90 | (lambda (x) (insert x)))) 91 | ``` 92 | 93 | * This s-exp hardly blocks Emacs because of asynchronous mechanisms. 94 | 95 | 96 | ### HTTP GET : Text ### 97 | 98 | This s-exp inserts a text from http://www.gnu.org asynchronously. (You can clear the result with undo command.) 99 | 100 | HTTP GET: 101 | 102 | ```el 103 | (require 'url) 104 | 105 | (deferred:$ 106 | (deferred:url-retrieve "http://www.gnu.org") 107 | (deferred:nextc it 108 | (lambda (buf) 109 | (insert (with-current-buffer buf (buffer-string))) 110 | (kill-buffer buf)))) 111 | ``` 112 | 113 | ### HTTP Get : Image ### 114 | 115 | This s-exp inserts an image from google asynchronously. 116 | 117 | Get an image: 118 | 119 | ```el 120 | (deferred:$ 121 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png") 122 | (deferred:nextc it 123 | (lambda (buf) 124 | (insert-image 125 | (create-image 126 | (let ((data (with-current-buffer buf (buffer-string)))) 127 | (substring data (+ (string-match "\n\n" data) 2))) 128 | 'png t)) 129 | (kill-buffer buf)))) 130 | ``` 131 | 132 | ### Parallel ### 133 | 134 | This s-exp retrieves two images from google concurrently and wait for the both results. Then, the file sizes of the images are inserted the current buffer. 135 | 136 | Parallel deferred: 137 | 138 | ```el 139 | (deferred:$ 140 | (deferred:parallel 141 | (lambda () 142 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")) 143 | (lambda () 144 | (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png"))) 145 | (deferred:nextc it 146 | (lambda (buffers) 147 | (cl-loop for i in buffers 148 | do 149 | (insert 150 | (format 151 | "size: %s\n" 152 | (with-current-buffer i (length (buffer-string))))) 153 | (kill-buffer i))))) 154 | ``` 155 | 156 | * The function `deferred:parallel` runs asynchronous tasks concurrently. 157 | * The function wait for all results, regardless normal or abnormal. Then, the subsequent tasks are executed. 158 | * The next task receives a list of the results. 159 | * The order of the results is corresponding to one of the argument. 160 | * Giving an alist of tasks as the argument, the results alist is returned. 161 | 162 | ### Deferred Combination : try-catch-finally ### 163 | 164 | This s-exp executes following tasks: 165 | * Getting an image by wget command, 166 | * Resizing the image by convert command in ImageMagick, 167 | * Insert the re-sized image into the current buffer. 168 | You can construct the control structure of deferred tasks, like try-catch-finally in Java. 169 | 170 | Get an image by wget and resize by ImageMagick: 171 | 172 | ```el 173 | (deferred:$ 174 | 175 | ;; try 176 | (deferred:$ 177 | (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") 178 | (deferred:nextc it 179 | (lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) 180 | (deferred:nextc it 181 | (lambda () 182 | (clear-image-cache) 183 | (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) 184 | 185 | ;; catch 186 | (deferred:error it ; 187 | (lambda (err) 188 | (insert "Can not get a image! : " err))) 189 | 190 | ;; finally 191 | (deferred:nextc it 192 | (lambda () 193 | (deferred:parallel 194 | (lambda () (delete-file "a.jpg")) 195 | (lambda () (delete-file "b.jpg"))))) 196 | (deferred:nextc it 197 | (lambda (x) (message ">> %s" x)))) 198 | ``` 199 | 200 | * In this case, the deferred tasks are statically connected. 201 | 202 | Here is an another sample code for try-catch-finally blocks. This is simpler than above code because of the `deferred:try' macro. (Note: They bring the same results practically, but are not perfectly identical. The `finally` task may not be called because of asynchrony.) 203 | 204 | Try-catch-finally: 205 | 206 | ```el 207 | (deferred:$ 208 | (deferred:try 209 | (deferred:$ 210 | (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") 211 | (deferred:nextc it 212 | (lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) 213 | (deferred:nextc it 214 | (lambda () 215 | (clear-image-cache) 216 | (insert-image (create-image (expand-file-name "b.jpg") `jpeg nil))))) 217 | :catch 218 | (lambda (err) (insert "Can not get a image! : " err)) 219 | :finally 220 | (lambda () 221 | (delete-file "a.jpg") 222 | (delete-file "b.jpg"))) 223 | (deferred:nextc it 224 | (lambda (x) (message ">> %s" x)))) 225 | ``` 226 | 227 | ### Timeout ### 228 | 229 | Although a long time command is executed (3 second sleeping), the task is rejected by timeout for 1 second. 230 | 231 | The function `deferred:earlier` also runs asynchronous tasks concurrently, however, the next deferred task receives the first result. The other results and tasks will be rejected (canceled or ignored). 232 | 233 | Timeout Process: 234 | 235 | ```el 236 | (deferred:$ 237 | (deferred:earlier 238 | (deferred:process "sh" "-c" "sleep 3 | echo 'hello!'") 239 | (deferred:$ 240 | (deferred:wait 1000) ; timeout msec 241 | (deferred:nextc it (lambda () "canceled!")))) 242 | (deferred:nextc it 243 | (lambda (x) (insert x)))) 244 | ``` 245 | 246 | * Changing longer timeout for `deferred:wait`, the next task receives a result of the command. 247 | * When a task finishes abnormally, the task is ignored. 248 | * When all tasks finishes abnormally, the next task receives nil. 249 | * The functions `deferred:parallel` and `deferred:earlier` may be corresponding to `and` and `or`, respectively. 250 | 251 | Here is an another sample code for timeout, employing `deferred:timeout` macro. 252 | 253 | Timeout macro: 254 | 255 | ```el 256 | (deferred:$ 257 | (deferred:timeout 258 | 1000 "canceled!" 259 | (deferred:process "sh" "-c" "sleep 3 | echo 'hello!'")) 260 | (deferred:nextc it 261 | (lambda (x) (insert x)))) 262 | ``` 263 | 264 | Note that the `deferred:timeout` and `deferred:earlier` just rejects the task result and does not stop the running task chains. Please see the document for `deferred:cancel`. 265 | 266 | ### Loop and Animation ### 267 | 268 | This s-exp plays an animation at the cursor position for few seconds. Then, you can move cursor freely, because the animation does not block Emacs. 269 | 270 | Returning a deferred object in the deferred tasks, the returned task is executed before the next deferred one that is statically connected on the source code. (In this case, the interrupt task is dynamically connected.) 271 | 272 | Employing a recursive structure of deferred tasks, you can construct a deferred loop. 273 | It may seem the multi-thread in Emacs Lisp. 274 | 275 | Loop and animation: 276 | 277 | ```el 278 | (let ((count 0) (anm "-/|\\-") 279 | (end 50) (pos (point)) 280 | (wait-time 50)) 281 | (deferred:$ 282 | (deferred:next 283 | (lambda (x) (message "Animation started."))) 284 | 285 | (deferred:nextc it 286 | (deferred:lambda (x) 287 | (save-excursion 288 | (when (< 0 count) 289 | (goto-char pos) (delete-char 1)) 290 | (insert (char-to-string 291 | (aref anm (% count (length anm)))))) 292 | (if (> end (cl-incf count)) ; return nil to stop this loop 293 | (deferred:nextc (deferred:wait wait-time) self)))) ; return the deferred 294 | 295 | (deferred:nextc it 296 | (lambda (x) 297 | (save-excursion 298 | (goto-char pos) (delete-char 1)) 299 | (message "Animation finished."))))) 300 | ``` 301 | 302 | * `deferred:lambda` is an anaphoric macro in which `self` refers itself. It is convenient to construct a recursive structure. 303 | 304 | ### Wrapping asynchronous function ### 305 | 306 | Let's say you have an asynchronous function which takes a callback. For example, dbus.el, xml-rpc.el and websocket.el has such kind of asynchronous APIs. To use such libraries with deferred.el, you can make an unregistered deferred object using `deferred:new` and then start the deferred callback queue using `deferred:callback-post` in the callback given to the asynchronous function. If the asynchronous function supports "errorback", you can use `deferred:errorback-post` to pass the error information to the following callback queue. 307 | 308 | In the following example, `run-at-time` is used as an example for the asynchronous function. Deferred.el already has `deferred:wait` for this purpose so that you don't need the following code if you want to use `run-at-time`. 309 | 310 | ```el 311 | (deferred:$ 312 | (deferred:next 313 | (lambda () 314 | (message "1") 315 | 1)) 316 | (deferred:nextc it 317 | (lambda (x) 318 | (let ((d (deferred:new #'identity))) 319 | (run-at-time 0 nil (lambda (x) 320 | ;; Start the following callback queue now. 321 | (deferred:callback-post d x)) 322 | x) 323 | ;; Return the unregistered (not yet started) callback 324 | ;; queue, so that the following queue will wait until it 325 | ;; is started. 326 | d))) 327 | ;; You can connect deferred callback queues 328 | (deferred:nextc it 329 | (lambda (x) 330 | (message "%s" (1+ x))))) 331 | ``` 332 | 333 | ## API ## 334 | 335 | ### Functions ### 336 | 337 | #### Basic functions #### 338 | 339 | * deferred:next (callback) 340 | * Arguments 341 | * callback: a function with zero or one argument 342 | * Return 343 | * a deferred object 344 | * Return a deferred object that wrap the given callback function. Then, put the deferred object into the execution queue to run asynchronously. 345 | * Namely, run the given function asynchronously. 346 | 347 | 348 | * deferred:nextc (d callback) 349 | * Arguments 350 | * d: a deferred object 351 | * callback: a function with zero or one argument 352 | * Return 353 | * a deferred object 354 | * Return a deferred object that wrap the given callback function. Then, connect the created deferred object with the given deferred object. 355 | * Namely, add the given function to the previous deferred object. 356 | 357 | * deferred:error (d errorback) 358 | * Arguments 359 | * d: a deferred object 360 | * errorback: a function with zero or one argument 361 | * Return 362 | * a deferred object 363 | * Return a deferred object that wrap the given function as errorback. Then, connect the created deferred object with the given deferred object. 364 | * Namely, the given function catches the error occurred in the previous task. 365 | * If this function does not throw an error, the subsequent callback functions are executed. 366 | 367 | * deferred:cancel (d) 368 | * Arguments 369 | * d: a deferred object 370 | * Return 371 | * the given deferred object (invalidated) 372 | * Invalidate the given deferred object. 373 | * Because this function modifies the deferred object, one can not used the given deferred instance again. 374 | * This function just cancels the given deferred instance, not the whole deferred chain. In the current deferred implementation, a message of cancellation can not propagate to chained deferred objects because the chain is built by the singly linked list. If the deferred chains may be canceled on your code, you should care the side-effect tasks. 375 | 376 | * deferred:watch (d callback) 377 | * Arguments 378 | * d: deferred object 379 | * callback: a function with zero or one argument 380 | * Return 381 | * a deferred object 382 | * Create a deferred object with watch task and connect it to the given deferred object. 383 | * The watch task CALLBACK can not affect deferred chains with return values. 384 | * This function is used in following purposes, simulation of try-finally block in asynchronous tasks, monitoring of progress of deferred tasks. 385 | 386 | * deferred:wait (msec) 387 | * Arguments 388 | * msec: a number (millisecond) 389 | * Return 390 | * a deferred object 391 | * Return a deferred object that will be called after the specified millisecond. 392 | * The subsequent deferred task receives the actual elapse time in millisecond. 393 | 394 | * deferred:$ 395 | * Arguments / more than one deferred forms 396 | * Return / the last deferred object 397 | * An anaphoric macro chains deferred objects. 398 | * The anaphoric variable `it` holds a deferred object in the previous line. 399 | 400 | #### Utility functions #### 401 | 402 | * deferred:loop (number-or-list callback) 403 | * Arguments 404 | * number-or-list: an integer or a list 405 | * callback: a function with zero or one argument 406 | * Return 407 | * a deferred object 408 | * Return a deferred object that iterates the function for the specified times. 409 | * The function receives the count number that begins zero. 410 | * If a list is given, not a number, the function visits each elements in the list like `mapc`. 411 | 412 | * deferred:parallel (list-or-alist) 413 | * Arguments 414 | * list-or-alist: 415 | * more than one deferred objects or a list of functions 416 | * an alist consist of cons cells with a symbol and a deferred object or a function 417 | * Return 418 | * a deferred object 419 | * Return a deferred object that executes given functions in parallel and wait for all callback values. 420 | * The subsequent deferred task receives a list of the results. The order of the results is corresponding to one of the argument. 421 | * Giving an alist of tasks as the argument, the results alist is returned. 422 | * If the parallel task throws an error, the error object is passed as a result. 423 | 424 | * deferred:earlier (list-or-alist) 425 | * Arguments 426 | * list-or-alist: 427 | * more than one deferred objects or a list of functions 428 | * an alist consist of cons cells with a symbol and a deferred object or a function 429 | * Return 430 | * a deferred object 431 | * Return a deferred object that executes given functions in parallel and wait for the first callback value. 432 | * The other tasks are rejected. (See the document for `deferred:cancel`) 433 | * Giving an alist of tasks as the argument, a cons cell is returned as a result. 434 | * When a task finishes abnormally, the task is ignored. 435 | * When all tasks finishes abnormally, the next task receives nil. That is, no errorback function is called. 436 | 437 | #### Wrapper functions #### 438 | 439 | * deferred:call (function args...) 440 | * Arguments 441 | * function: a function 442 | * args: arguments (variable length) 443 | * Return 444 | * a deferred object 445 | * a wrapper of the function `funcall` 446 | 447 | * deferred:apply (function args) 448 | * Arguments 449 | * function: a function 450 | * args: a list of arguments 451 | * Return 452 | * a deferred object 453 | * a wrapper of the function `apply` 454 | 455 | * deferred:process (command args...) / deferred:process-shell (command args...) 456 | * Arguments 457 | * command: command to execute 458 | * args: command arguments (variable length) 459 | * Return 460 | * a deferred object 461 | * Execute a command asynchronously. These functions are wrappers of `start-process` and `start-process-shell-command`. 462 | * The subsequent deferred task receives the stdout and stderr from the command as a string. 463 | 464 | * deferred:process-buffer (command args...) / deferred:process-shell-buffer (command args...) 465 | * Arguments 466 | * command: command to execute 467 | * args: command arguments (variable length) 468 | * Return 469 | * a deferred object 470 | * Execute a command asynchronously. These functions are wrappers of `start-process` and `start-process-shell-command`. 471 | * The subsequent deferred task receives the stdout and stderr from the command as a buffer. 472 | * The following tasks are responsible to kill the buffer. 473 | 474 | * deferred:wait-idle (msec) 475 | * Arguments 476 | * msec: a number (millisecond) 477 | * Return 478 | * a deferred object 479 | * Return a deferred object that will be called when Emacs has been idle for the specified millisecond. 480 | * The subsequent deferred task receives the elapse time in millisecond. 481 | 482 | * deferred:url-retrieve (url [cbargs]) 483 | * Arguments 484 | * url: URL to get 485 | * cbargs: callback argument (optional) 486 | * Return 487 | * a deferred object 488 | * A wrapper function of `url-retrieve` in the `url` package. 489 | * The subsequent deferred task receives the content as a buffer. 490 | * The following tasks are responsible to kill the buffer. 491 | 492 | * [experimental] deferred:url-get (url [params]) 493 | * Arguments 494 | * url: URL to get 495 | * params: alist of parameters 496 | * Return 497 | * a deferred object 498 | 499 | * [experimental] deferred:url-post (url [params]) 500 | * Arguments 501 | * url: URL to get 502 | * params: alist of parameters 503 | * Return 504 | * a deferred object 505 | 506 | #### Primitive functions #### 507 | 508 | * deferred:new ([callback]) 509 | * Arguments 510 | * callback: a function with zero or one argument (optional) 511 | * Return 512 | * a deferred object 513 | * Create a deferred object 514 | * The created deferred object is never called until someone call the function `deferred:callback` or `deferred:errorback`. 515 | * Using this object, a deferred chain can pause to wait for other events. (See the source for `deferred:wait`.) 516 | 517 | * deferred:succeed ([value]) 518 | * Arguments 519 | * value: a value (optional) 520 | * Return 521 | * a deferred object 522 | * Create a deferred object that has been called the callback function. 523 | * When a deferred task is connected, the subsequent task will be executed immediately (synchronously). 524 | 525 | * deferred:fail ([error]) 526 | * Arguments 527 | * error: an error value (optional) 528 | * Return 529 | * a deferred object 530 | * Create a deferred object that has been called the errorback function. 531 | * When a deferred task is connected, the subsequent task will be executed immediately (synchronously). 532 | 533 | * deferred:callback (d [value]) 534 | * Arguments 535 | * d: a deferred object 536 | * value: a value (optional) 537 | * Return 538 | * a deferred object or a result value 539 | * Start executing the deferred tasks. The first task is executed synchronously. 540 | 541 | * deferred:callback-post (d [value]) 542 | * Arguments 543 | * d: a deferred object 544 | * value: a value (optional) 545 | * Return 546 | * a deferred object or a result value 547 | * Start executing the deferred tasks. The first task is executed asynchronously. 548 | 549 | * deferred:errorback (d [error]) 550 | * Arguments 551 | * d: a deferred object 552 | * error: an error value (optional) 553 | * Return 554 | * a deferred object or a result value 555 | * Start executing the deferred tasks from errorback. The first task is executed synchronously. 556 | 557 | * deferred:errorback-post (d [error]) 558 | * Arguments 559 | * d: a deferred object 560 | * error: an error value (optional) 561 | * Return 562 | * a deferred object or a result value 563 | * Start executing the deferred tasks from errorback. The first task is executed asynchronously. 564 | 565 | ### Utility Macros ### 566 | 567 | * deferred:try (d &key catch finally) 568 | * Arguments 569 | * d: deferred object 570 | * catch: [keyword argument] A function that is called when an error is occurred during tasks `d`. (This function is expanded as an argument of `deferred:error`.) 571 | * finally: [keyword argument] A function that is called when tasks `d` finishes whether in success or failure. (This function is expanded as an argument of deferred:watch.) 572 | * Return 573 | * a deferred object 574 | * Try-catch-finally macro. This macro simulates the try-catch-finally block asynchronously. 575 | * Because of asynchrony, this macro does not ensure that the `finally` task should be called. 576 | * This macro is implemented by `deferred:error` and `deferred:watch`. 577 | 578 | * deferred:timeout (msec timeout-form d) 579 | * Arguments 580 | * msec: a number 581 | * timeout-form: sexp-form 582 | * d: a deferred object 583 | * Return 584 | * a deferred object 585 | * Time out macro on a deferred task `d`. 586 | * If the deferred task `d` does not complete within `timeout-msec`, this macro rejects the deferred task and return the `timeout-form`. (See the document for `deferred:cancel`) 587 | * This macro is implemented by `deferred:earlier` and `deferred:wait`. 588 | 589 | * deferred:process... 590 | * deferred:processc (d command args...) 591 | * deferred:process-bufferc (d command args...) 592 | * deferred:process-shellc (d command args...) 593 | * deferred:process-shell-bufferc (d command args...) 594 | * Arguments 595 | * d: a deferred object 596 | * command: command to execute 597 | * args: command arguments (variable length) 598 | * Return 599 | * a deferred object 600 | * This macro wraps the deferred:process function in deferred:nextc and connect the given deferred task. 601 | 602 | ### Execution and Connection ### 603 | 604 | #### Firing #### 605 | 606 | Some deferred functions can fire a deferred chain implicitly. Following functions register a deferred object with the execution queue to run asynchronously. 607 | 608 | * next 609 | * wait 610 | * loop 611 | * parallel 612 | * earlier 613 | * call, apply 614 | * process 615 | * url-retrieve, url-get, url-post 616 | 617 | 618 | The deferred tasks those are created by `deferred:new` are never called. Using this object, a deferred chain can pause to wait for other events. (See the source for `deferred:wait`.) 619 | 620 | 621 | One can fire the chain before connecting. That is, deferred objects wait for connecting the subsequent task holding the result value. The functions `deferred:succeed` and `deferred:fail` create those waiting objects. 622 | 623 | #### Static connection #### 624 | 625 | The `static connection (statically connected)` is a connection between deferred tasks on the source code. 626 | This is a basic usage for the deferred chain. 627 | 628 | The static connection is almost equivalent to ordinary callback notation as an argument in the function declarations. The deferred notation is easy to read and write better than the callback one, because the sequence of asynchronous tasks can be written by the deferred notation straightforward. 629 | 630 | #### Dynamic Connection #### 631 | 632 | Returning a deferred object in the deferred tasks, the returned task is executed before the next deferred one that is statically connected on the source code. This is the `dynamic connection (dynamically connected)`. 633 | 634 | Employing a recursive structure of deferred tasks, you can construct higher level control structures, such as loop. 635 | 636 | ## Discussion ## 637 | 638 | Some discussions of writing deferred codes. 639 | 640 | ### Using lexical scope ### 641 | 642 | Using the lexical scope macro, such as `let`, the deferred tasks defined by lambdas can access local variables. 643 | 644 | `let` Ex.: 645 | 646 | ```el 647 | (let ((a (point))) 648 | (deferred:$ 649 | (deferred:wait 1000) 650 | (deferred:nextc it 651 | (lambda (x) 652 | (goto-char a) 653 | (insert "here!"))))) 654 | ``` 655 | 656 | If you write a code of deferred tasks without lexical scope macros, you should be careful with the scopes of each variables. 657 | 658 | ### Excursion (Current status) ### 659 | 660 | The `excursion` functions those hold the current status with the s-exp form, such as `save-execursion` or `with-current-buffer`, are not valid in the deferred tasks, because of execution asynchronously. 661 | 662 | Wrong Ex.: 663 | 664 | ```el 665 | (with-current-buffer (get-buffer "*Message*") 666 | (deferred:$ 667 | (deferred:wait 1000) 668 | (deferred:nextc it 669 | (lambda (x) 670 | (insert "Time: %s " x) ; `insert` may not be in the *Message* buffer! 671 | )))) 672 | ``` 673 | 674 | In this case, using lexical scope macros to access the buffer variable, you can change the buffer in the deferred task. 675 | 676 | Corrected: 677 | 678 | ```el 679 | (let ((buf (get-buffer "*Message*"))) 680 | (deferred:$ 681 | (deferred:wait 1000) 682 | (deferred:nextc it 683 | (lambda (x) 684 | (with-current-buffer buf ; Set buffer in the asynchronous task. 685 | (insert "Time: %s " x)))))) 686 | ``` 687 | 688 | 689 | ### Be aware of return values ### 690 | 691 | However the dynamic connection is a powerful feature, sometimes it causes bugs of the wrong execution order, because of returning not intended deferred objects. 692 | 693 | Then, you should watch the return values of the deferred tasks not to cause an unexpected dynamic connection. 694 | 695 | ### Debugging ### 696 | 697 | The debugging of asynchronous tasks is difficult. Of course, you can use debugger for deferred tasks, but asynchronous tasks cause some troubles, such as interruptions of your debugging and timing gap of simultaneous deferred tasks. Therefore, logging is a safe debugging to observe the tasks correctly, for example, using the `message` function and making custom application log buffer. 698 | 699 | If deferred tasks fall into an infinite loop unexpectedly (but Emacs may not freeze), calling the command `deferred:clear-queue`, you can stop the deferred tasks immediately. 700 | 701 | If the errors occurred in deferred tasks are caught by no errorback functions, finally the deferred framework catches it and reports to the message buffer. Because the implementation of the framework uses a `condition-case` form, the debugger can not catch the signals normally. If you want to debug the errors in the deferred tasks with the debug-on-error mechanism, set the variable `deferred:debug-on-signal` non-nil. 702 | 703 | Wrapping a deferred task in the function `deferred:sync!`, you can wait for the result of the task synchronously. However, the wrapper function should be used for test or debug purpose, because the synchronous waiting is not exact. 704 | 705 | ### Using macros ### 706 | 707 | Writing deferred tasks with `deferred.el`, you may write a lot of `deferred:nextc` and `lambda` to define tasks. Defining a macro, you may write codes shortly. The test code `test-deferred.el` uses many macros to shorten test codes. 708 | 709 | On the other hand, using macros to hide `lambda`, it is difficult to realize when the deferred codes are evaluated. That is why `deferred.el` does not provide lot of convenient macros. If you use macros, be careful evaluation timing of deferred forms. 710 | 711 | ### Introduction for deferred ### 712 | 713 | Following documents are good introduction to deferred. 714 | 715 | * [Introduction to JSDeferred](http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html "Introduction to JSDeferred") 716 | * [JSDeferred site](http://cho45.stfuawsc.com/jsdeferred/ "JSDeferred site") 717 | 718 | * * * * * 719 | 720 | (C) 2010-2016 SAKURAI Masashi All rights reserved. 721 | m.sakurai at kiwanami.net 722 | -------------------------------------------------------------------------------- /concurrent.el: -------------------------------------------------------------------------------- 1 | ;;; concurrent.el --- Concurrent utility functions for emacs lisp -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2010-2016 SAKURAI Masashi 4 | 5 | ;; Author: SAKURAI Masashi 6 | ;; Version: 0.5.0 7 | ;; Keywords: deferred, async, concurrent 8 | ;; Package-Requires: ((emacs "24.3") (deferred "0.5.0")) 9 | ;; URL: https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; 'concurrent.el' is a higher level library for concurrent tasks 27 | ;; based on 'deferred.el'. This library has following features: 28 | ;; 29 | ;; - Generator 30 | ;; - Green thread 31 | ;; - Semaphore 32 | ;; - Dataflow 33 | ;; - Signal/Channel 34 | 35 | (require 'cl-lib) 36 | 37 | (require 'deferred) 38 | 39 | (defvar cc:version nil "version number") 40 | (setq cc:version "0.3") 41 | 42 | ;;; Code: 43 | 44 | 45 | 46 | (defmacro cc:aif (test-form then-form &rest else-forms) 47 | (declare (debug (form form &rest form))) 48 | `(let ((it ,test-form)) 49 | (if it ,then-form ,@else-forms))) 50 | (put 'cc:aif 'lisp-indent-function 2) 51 | 52 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 53 | ;; Generator 54 | 55 | (defun cc:generator-replace-yield (tree) 56 | "[internal] Replace `yield' symbols to calling a function in TREE." 57 | (let (ret) 58 | (cl-loop for i in tree 59 | do (cond 60 | ((eq i 'yield) 61 | (push 'funcall ret) 62 | (push i ret)) 63 | ((listp i) 64 | (push (cc:generator-replace-yield i) ret)) 65 | (t 66 | (push i ret)))) 67 | (nreverse ret))) 68 | 69 | (defun cc:generator-line (chain line) 70 | "[internal] Return a macro expansion to execute the sexp LINE 71 | asynchronously." 72 | (cond 73 | ;; function object 74 | ((functionp line) 75 | `(setq ,chain (deferred:nextc ,chain ,line))) 76 | ;; while loop form 77 | ((eq 'while (car line)) 78 | (let ((condition (cadr line)) 79 | (body (cddr line))) 80 | `(setq ,chain 81 | (deferred:nextc ,chain 82 | (deferred:lambda (x) 83 | (if ,condition 84 | (deferred:nextc 85 | (progn 86 | ,@(cc:generator-replace-yield body)) self))))))) 87 | ;; statement 88 | (t 89 | `(setq ,chain 90 | (deferred:nextc ,chain 91 | (deferred:lambda (x) ,(cc:generator-replace-yield line))))))) 92 | 93 | (defmacro cc:generator (callback &rest body) 94 | "Create a generator object. If BODY has `yield' symbols, it 95 | means calling callback function CALLBACK." 96 | (let ((chain (cl-gensym)) 97 | (cc (cl-gensym)) 98 | (waiter (cl-gensym))) 99 | `(let* (,chain 100 | (,cc ,callback) 101 | (,waiter (deferred:new)) 102 | (yield (lambda (x) (funcall ,cc x) ,waiter))) 103 | (setq ,chain ,waiter) 104 | ,@(cl-loop for i in body 105 | collect 106 | (cc:generator-line chain i)) 107 | (lambda () (deferred:callback ,waiter))))) 108 | 109 | 110 | 111 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 112 | ;; Thread 113 | 114 | (defun cc:thread-line (wait-time chain line) 115 | "[internal] Return a macro expansion to execute the sexp LINE asynchronously. 116 | WAIT-TIME is an interval time between tasks. 117 | CHAIN is the previous deferred task." 118 | (cond 119 | ;; function object 120 | ((functionp line) 121 | `(setq ,chain (deferred:nextc ,chain ,line))) 122 | ;; while loop form 123 | ((eq 'while (car line)) 124 | (let ((condition (cadr line)) 125 | (body (cddr line)) 126 | (retsym (cl-gensym))) 127 | `(setq ,chain 128 | (deferred:nextc ,chain 129 | (deferred:lambda (x) 130 | (if ,condition 131 | (deferred:nextc 132 | (let ((,retsym (progn ,@body))) 133 | (if (deferred-p ,retsym) ,retsym 134 | (deferred:wait ,wait-time))) 135 | self))))))) 136 | ;; statement 137 | (t 138 | `(setq ,chain 139 | (deferred:nextc ,chain 140 | (lambda (x) ,line)))))) 141 | 142 | (defmacro cc:thread (wait-time-msec &rest body) 143 | "Return a thread object." 144 | (let ((chain (cl-gensym)) 145 | (dstart (cl-gensym))) 146 | `(let* (,chain 147 | (,dstart (deferred:new))) 148 | (setq ,chain ,dstart) 149 | ,@(cl-loop for i in body 150 | collect 151 | (cc:thread-line wait-time-msec chain i)) 152 | (deferred:callback ,dstart)))) 153 | (put 'cc:thread 'lisp-indent-function 1) 154 | 155 | 156 | 157 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 158 | ;; Semaphore 159 | 160 | (cl-defstruct cc:semaphore max-permits permits waiting-deferreds) 161 | 162 | (defun cc:semaphore-create(permits-num) 163 | "Return a semaphore object with PERMITS-NUM permissions." 164 | (make-cc:semaphore :max-permits permits-num :permits permits-num)) 165 | 166 | (defun cc:semaphore-acquire(semaphore) 167 | "Acquire an execution permission and return deferred object to chain. 168 | If this semaphore object has permissions, the subsequent deferred 169 | task is executed immediately. If this semaphore object has no 170 | permissions, the subsequent deferred task is blocked. After the 171 | permission is returned, the task is executed." 172 | (cond 173 | ((< 0 (cc:semaphore-permits semaphore)) 174 | (cl-decf (cc:semaphore-permits semaphore)) 175 | (deferred:succeed)) 176 | (t 177 | (let ((d (deferred:new))) 178 | (push d (cc:semaphore-waiting-deferreds semaphore)) 179 | d)))) 180 | 181 | (defun cc:semaphore-release(semaphore) 182 | "Release an execution permission. The programmer is responsible to return the permissions." 183 | (when (<= (cc:semaphore-max-permits semaphore) 184 | (cc:semaphore-permits semaphore)) 185 | (error "Too many calling semaphore-release. [max:%s <= permits:%s]" 186 | (cc:semaphore-max-permits semaphore) 187 | (cc:semaphore-permits semaphore))) 188 | (let ((waiting-deferreds 189 | (cc:semaphore-waiting-deferreds semaphore))) 190 | (cond 191 | (waiting-deferreds 192 | (let* ((d (car (last waiting-deferreds)))) 193 | (setf (cc:semaphore-waiting-deferreds semaphore) 194 | (nbutlast waiting-deferreds)) 195 | (deferred:callback-post d))) 196 | (t 197 | (cl-incf (cc:semaphore-permits semaphore))))) 198 | semaphore) 199 | 200 | (defun cc:semaphore-with (semaphore body-func &optional error-func) 201 | "Execute the task BODY-FUNC asynchronously with the semaphore block." 202 | (deferred:try 203 | (deferred:nextc (cc:semaphore-acquire semaphore) body-func) 204 | :catch 205 | error-func 206 | :finally 207 | (lambda (_x) (cc:semaphore-release semaphore)))) 208 | (put 'cc:semaphore-with 'lisp-indent-function 1) 209 | 210 | (defun cc:semaphore-release-all (semaphore) 211 | "Release all permissions for resetting the semaphore object. 212 | If the semaphore object has some blocked tasks, this function 213 | return a list of the tasks and clear the list of the blocked 214 | tasks in the semaphore object." 215 | (setf (cc:semaphore-permits semaphore) 216 | (cc:semaphore-max-permits semaphore)) 217 | (let ((ds (cc:semaphore-waiting-deferreds semaphore))) 218 | (when ds 219 | (setf (cc:semaphore-waiting-deferreds semaphore) nil)) 220 | ds)) 221 | 222 | (defun cc:semaphore-interrupt-all (semaphore) 223 | "Clear the list of the blocked tasks in the semaphore and return a deferred object to chain. 224 | This function is used for the interruption cases." 225 | (when (cc:semaphore-waiting-deferreds semaphore) 226 | (setf (cc:semaphore-waiting-deferreds semaphore) nil) 227 | (setf (cc:semaphore-permits semaphore) 0)) 228 | (cc:semaphore-acquire semaphore)) 229 | 230 | 231 | 232 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 233 | ;; Signal / Channel 234 | 235 | (defun cc:signal-channel (&optional name parent-channel) 236 | "Create a channel. 237 | NAME is a channel name for debug. 238 | PARENT-CHANNEL is an upstream channel. The observers of this channel can receive the upstream signals. 239 | 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." 240 | (let ((ch (cons 241 | (or name (format "signal%s" (deferred:uid))) ; name for debug 242 | (cons 243 | parent-channel ; parent-channel 244 | nil)))) ; observers 245 | (when parent-channel 246 | (cc:signal-connect 247 | parent-channel 248 | t (lambda (event) 249 | (cl-destructuring-bind 250 | (event-name event-args) event 251 | (apply 'cc:signal-send 252 | ch event-name event-args))))) 253 | ch)) 254 | 255 | (defmacro cc:signal-name (ch) 256 | "[internal] Return signal name." 257 | `(car ,ch)) 258 | 259 | (defmacro cc:signal-parent-channel (ch) 260 | "[internal] Return parent channel object." 261 | `(cadr ,ch)) 262 | 263 | (defmacro cc:signal-observers (ch) 264 | "[internal] Return observers." 265 | `(cddr ,ch)) 266 | 267 | (defun cc:signal-connect (channel event-sym &optional callback) 268 | "Append an observer for EVENT-SYM of CHANNEL and return a deferred object. 269 | If EVENT-SYM is `t', the observer receives all signals of the channel. 270 | If CALLBACK function is given, the deferred object executes the 271 | CALLBACK function asynchronously. One can connect subsequent 272 | tasks to the returned deferred object." 273 | (let ((d (if callback 274 | (deferred:new callback) 275 | (deferred:new)))) 276 | (push (cons event-sym d) 277 | (cc:signal-observers channel)) 278 | d)) 279 | 280 | (defun cc:signal-send (channel event-sym &rest args) 281 | "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 ... )). " 282 | (let ((observers (cc:signal-observers channel)) 283 | (event (list event-sym args))) 284 | (cl-loop for i in observers 285 | for name = (car i) 286 | for d = (cdr i) 287 | if (or (eq event-sym name) (eq t name)) 288 | do (deferred:callback-post d event)))) 289 | 290 | (defun cc:signal-send-global (channel event-sym &rest args) 291 | "Send a signal to the most upstream channel. " 292 | (cc:aif (cc:signal-parent-channel channel) 293 | (apply 'cc:signal-send-global it event-sym args) 294 | (apply 'cc:signal-send channel event-sym args))) 295 | 296 | 297 | (defun cc:signal-disconnect (channel deferred) 298 | "Remove the observer object DEFERRED from CHANNEL and return 299 | the removed deferred object. " 300 | (let ((observers (cc:signal-observers channel)) deleted) 301 | (setf 302 | (cc:signal-observers channel) ; place 303 | (cl-loop for i in observers 304 | for d = (cdr i) 305 | unless (eq d deferred) 306 | collect i 307 | else 308 | do (push i deleted))) 309 | deleted)) 310 | 311 | (defun cc:signal-disconnect-all (channel) 312 | "Remove all observers." 313 | (setf 314 | (cc:signal-observers channel) ; place 315 | nil)) 316 | 317 | 318 | 319 | 320 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 321 | ;; Dataflow 322 | 323 | ;; Dataflow variable entry 324 | (cl-defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list) 325 | 326 | (defun cc:dataflow-undefine-p (obj) 327 | "[internal] If the variable entry is not bound, return `t'." 328 | (eq 'cc:dataflow-undefine (cc:dataflow-value obj))) 329 | 330 | (defmacro cc:dataflow-parent-environment (df) 331 | "[internal] Return the parent environment." 332 | `(car ,df)) 333 | 334 | (defmacro cc:dataflow-test (df) 335 | "[internal] Return the test function." 336 | `(cadr ,df)) 337 | 338 | (defmacro cc:dataflow-channel (df) 339 | "[internal] Return the channel object." 340 | `(cl-caddr ,df)) 341 | 342 | (defmacro cc:dataflow-list (df) 343 | "[internal] Return the list of deferred object which are waiting for value binding." 344 | `(cl-cdddr ,df)) 345 | 346 | (defun cc:dataflow-environment (&optional parent-env test-func channel) 347 | "Create a dataflow environment. 348 | PARENT-ENV is the default environment. If this environment doesn't have the entry A and the parent one has the entry A, this environment can return the entry A. One can override the entry, setting another entry A to this environment. 349 | TEST-FUNC is a test function that compares the entry keys. The default function is `equal'. 350 | CHANNEL is a channel object that sends signals of variable events. Observers can receive following signals: 351 | -get-first : the fist referrer is waiting for binding, 352 | -get-waiting : another referrer is waiting for binding, 353 | -set : a value is bound, 354 | -get : returned a bound value, 355 | -clear : cleared one entry, 356 | -clear-all : cleared all entries. 357 | " 358 | (let ((this (list parent-env 359 | (or test-func 'equal) 360 | (or channel 361 | (cc:signal-channel 362 | 'dataflow 363 | (and parent-env 364 | (cc:dataflow-channel parent-env))))))) 365 | (cc:dataflow-init-connect this) 366 | this)) 367 | 368 | (defun cc:dataflow-init-connect (df) 369 | "[internal] Initialize the channel object." 370 | (cc:dataflow-connect 371 | df 'set 372 | (lambda (args) 373 | (cl-destructuring-bind (_event (key)) args 374 | (let* ((obj (cc:dataflow-get-object-for-value df key)) 375 | (value (and obj (cc:dataflow-value obj)))) 376 | (when obj 377 | (cl-loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key) 378 | (cc:dataflow-deferred-list it) nil) 379 | do (deferred:callback-post i value)) 380 | (setf (cc:dataflow-deferred-list obj) nil))))))) 381 | 382 | (defun cc:dataflow-get-object-for-value (df key) 383 | "[internal] Return an entry object that is indicated by KEY. 384 | 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." 385 | (or 386 | (cl-loop for i in (cc:dataflow-list df) 387 | with test = (cc:dataflow-test df) 388 | if (and (funcall test key (cc:dataflow-key i)) 389 | (not (cc:dataflow-undefine-p i))) 390 | return i) 391 | (deferred:aand 392 | (cc:dataflow-parent-environment df) 393 | (cc:dataflow-get-object-for-value it key)))) 394 | 395 | (defun cc:dataflow-get-object-for-deferreds (df key) 396 | "[internal] Return a list of the deferred objects those are waiting for value binding. 397 | This function doesn't affect the waiting list and doesn't refer the parent environment." 398 | (cl-loop for i in (cc:dataflow-list df) 399 | with test = (cc:dataflow-test df) 400 | if (funcall test key (cc:dataflow-key i)) 401 | return i)) 402 | 403 | (defun cc:dataflow-connect (df event-sym &optional callback) 404 | "Append an observer for EVENT-SYM of the channel of DF and return a deferred object. 405 | See the docstring of `cc:dataflow-environment' for details." 406 | (cc:signal-connect (cc:dataflow-channel df) event-sym callback)) 407 | 408 | (defun cc:dataflow-signal (df event &optional arg) 409 | "[internal] Send a signal to the channel of DF." 410 | (cc:signal-send (cc:dataflow-channel df) event arg)) 411 | 412 | (defun cc:dataflow-get (df key) 413 | "Return a deferred object that can refer the value which is indicated by KEY. 414 | If DF has the entry that bound value, the subsequent deferred task is executed immediately. 415 | If not, the task is deferred till a value is bound." 416 | (let ((obj (cc:dataflow-get-object-for-value df key))) 417 | (cond 418 | ((and obj (cc:dataflow-value obj)) 419 | (cc:dataflow-signal df 'get key) 420 | (deferred:succeed (cc:dataflow-value obj))) 421 | (t 422 | (setq obj (cc:dataflow-get-object-for-deferreds df key)) 423 | (unless obj 424 | (setq obj (make-cc:dataflow :key key)) 425 | (push obj (cc:dataflow-list df)) 426 | (cc:dataflow-signal df 'get-first key)) 427 | (let ((d (deferred:new))) 428 | (push d (cc:dataflow-deferred-list obj)) 429 | (cc:dataflow-signal df 'get-waiting key) 430 | d))))) 431 | 432 | (defun cc:dataflow-get-sync (df key) 433 | "Return the value which is indicated by KEY synchronously. 434 | If the environment DF doesn't have an entry of KEY, this function returns nil." 435 | (let ((obj (cc:dataflow-get-object-for-value df key))) 436 | (and obj (cc:dataflow-value obj)))) 437 | 438 | (defun cc:dataflow-set (df key value) 439 | "Bind the VALUE to KEY in the environment DF. 440 | If DF already has the bound entry of KEY, this function throws an error signal. 441 | VALUE can be nil as a value." 442 | (let ((obj (cc:dataflow-get-object-for-deferreds df key))) 443 | (cond 444 | ((and obj (not (cc:dataflow-undefine-p obj))) 445 | ;; overwrite! 446 | (error "Can not set a dataflow value. The key [%s] has already had a value. NEW:[%s] OLD:[%s]" key value (cc:dataflow-value obj))) 447 | (obj 448 | (setf (cc:dataflow-value obj) value)) 449 | (t 450 | ;; just value arrived 451 | (push (make-cc:dataflow :key key :value value) 452 | (cc:dataflow-list df)))) 453 | ;; value arrived and start deferred objects 454 | (cc:dataflow-signal df 'set key) 455 | value)) 456 | 457 | (defun cc:dataflow-clear (df key) 458 | "Clear the entry which is indicated by KEY. 459 | This function does nothing for the waiting deferred objects." 460 | (cc:dataflow-signal df 'clear key) 461 | (setf (cc:dataflow-list df) 462 | (cl-loop for i in (cc:dataflow-list df) 463 | with test = (cc:dataflow-test df) 464 | unless (funcall test key (cc:dataflow-key i)) 465 | collect i))) 466 | 467 | (defun cc:dataflow-get-avalable-pairs (df) 468 | "Return an available key-value alist in the environment DF and the parent ones." 469 | (append 470 | (cl-loop for i in (cc:dataflow-list df) 471 | for key = (cc:dataflow-key i) 472 | for val = (cc:dataflow-value i) 473 | unless (cc:dataflow-undefine-p i) collect (cons key val)) 474 | (deferred:aand 475 | (cc:dataflow-parent-environment df) 476 | (cc:dataflow-get-avalable-pairs it)))) 477 | 478 | (defun cc:dataflow-get-waiting-keys (df) 479 | "Return a list of keys which have waiting deferred objects in the environment DF and the parent ones." 480 | (append 481 | (cl-loop for i in (cc:dataflow-list df) 482 | for key = (cc:dataflow-key i) 483 | if (cc:dataflow-undefine-p i) collect key) 484 | (deferred:aand 485 | (cc:dataflow-parent-environment df) 486 | (cc:dataflow-get-waiting-keys it)))) 487 | 488 | (defun cc:dataflow-clear-all (df) 489 | "Clear all entries in the environment DF. 490 | This function does nothing for the waiting deferred objects." 491 | (cc:dataflow-signal df 'clear-all) 492 | (setf (cc:dataflow-list df) nil)) 493 | 494 | 495 | (provide 'concurrent) 496 | 497 | ;; Local Variables: 498 | ;; byte-compile-warnings: (not cl-functions) 499 | ;; End: 500 | 501 | ;;; concurrent.el ends here 502 | -------------------------------------------------------------------------------- /sample/concurrent-sample.el: -------------------------------------------------------------------------------- 1 | ;;; Sample code for concurrent.el -*- lexical-binding: t; -*- 2 | 3 | ;; Evaluate following code in the scratch buffer. 4 | 5 | (require 'cl-lib) 6 | (require 'concurrent) 7 | 8 | ;;================================================== 9 | ;;; generator 10 | 11 | (defvar fib-list nil) 12 | 13 | (defvar fib-gen ; Create a generator object. 14 | (let ((a1 0) (a2 1)) 15 | (cc:generator 16 | (lambda (x) (push x fib-list)) ; receiving values 17 | (yield a1) 18 | (yield a2) 19 | (while t 20 | (let ((next (+ a1 a2))) 21 | (setq a1 a2 22 | a2 next) 23 | (yield next)))))) 24 | 25 | (funcall fib-gen) ; Generate 5 times 26 | (funcall fib-gen) (funcall fib-gen) 27 | (funcall fib-gen) (funcall fib-gen) 28 | 29 | fib-list ;=> (3 2 1 1 0) 30 | 31 | 32 | ;;================================================== 33 | ;;; thread 34 | 35 | (let ((count 0) (anm "-/|\\-") 36 | (end 50) (pos (point))) 37 | (cc:thread 38 | 60 39 | (message "Animation started.") 40 | (while (> end (cl-incf count)) 41 | (save-excursion 42 | (when (< 1 count) 43 | (goto-char pos) (delete-char 1)) 44 | (insert (char-to-string 45 | (aref anm (% count (length anm))))))) 46 | (save-excursion 47 | (goto-char pos) (delete-char 1)) 48 | (message "Animation finished."))) 49 | 50 | ;; Play the simple character animation here. 51 | 52 | 53 | ;;================================================== 54 | ;;; semaphore 55 | 56 | ;; create a semaphore object with permit=1. 57 | (defvar smp (cc:semaphore-create 1)) 58 | 59 | ;; executing three tasks... 60 | (deferred:nextc (cc:semaphore-acquire smp) 61 | (lambda (_) 62 | (message "go1"))) 63 | (deferred:nextc (cc:semaphore-acquire smp) 64 | (lambda (_) 65 | (message "go2"))) 66 | (deferred:nextc (cc:semaphore-acquire smp) 67 | (lambda (_) 68 | (message "go3"))) 69 | 70 | ;; => Only the fist task is executed and displays "go1". 71 | 72 | (cc:semaphore-release smp) 73 | 74 | ;; => The second task is executed and displays "go2". 75 | 76 | (cc:semaphore-waiting-deferreds smp) ; return the deferred object that displays "go3". 77 | 78 | (cc:semaphore-release-all smp) ; => reset permit count and return the deferred object that displays "go3". 79 | 80 | (cc:semaphore-waiting-deferreds smp) ; => nil 81 | 82 | 83 | ;;================================================== 84 | ;; Dataflow 85 | 86 | ;; create a parent environment and bind "aaa" to 256. 87 | (defvar dfenv-parent (cc:dataflow-environment)) 88 | (cc:dataflow-set dfenv-parent "aaa" 256) 89 | 90 | ;; create an environment with the parent one. 91 | (defvar dfenv (cc:dataflow-environment dfenv-parent)) 92 | 93 | ;; Return the parent value. 94 | (cc:dataflow-get-sync dfenv "aaa") ; => 256 95 | 96 | (deferred:$ 97 | (cc:dataflow-get dfenv "abc") 98 | (deferred:nextc it 99 | (lambda (x) (message "Got abc : %s" x)))) 100 | ;; => This task is blocked 101 | 102 | (cc:dataflow-set dfenv "abc" 256) ; bind 256 to "abc" 103 | 104 | ;; => The blocked task is executed and displays "Got abc : 256". 105 | 106 | (cc:dataflow-get-sync dfenv "abc") ; => 256 107 | 108 | ;; unbind the variable "abc" 109 | (cc:dataflow-clear dfenv "abc") 110 | 111 | (cc:dataflow-get-sync dfenv "abc") ; => nil 112 | 113 | 114 | ;; complicated key (`equal' can compare nested lists.) 115 | 116 | (deferred:$ 117 | (cc:dataflow-get dfenv '("http://example.com/a.jpg" 300)) 118 | (deferred:nextc it 119 | (lambda (x) (message "a.jpg:300 OK %s" x)))) 120 | 121 | (cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg) 122 | 123 | ;; waiting for two variables 124 | 125 | (deferred:$ 126 | (deferred:parallel 127 | (cc:dataflow-get dfenv "abc") 128 | (cc:dataflow-get dfenv "def")) 129 | (deferred:nextc it 130 | (lambda (values) 131 | (apply 'message "Got values : %s, %s" values) 132 | (apply '+ values))) 133 | (deferred:nextc it 134 | (lambda (x) (insert (format ">> %s" x))))) 135 | 136 | (cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc") 137 | (cc:dataflow-get-avalable-pairs dfenv) ; => (("aaa" . 256)) 138 | 139 | (cc:dataflow-set dfenv "abc" 128) 140 | (cc:dataflow-set dfenv "def" 256) 141 | 142 | ;; => "Got values : 128, 256" 143 | ;; inserted ">> 384" 144 | 145 | (cc:dataflow-get-avalable-pairs dfenv) 146 | 147 | (cc:dataflow-clear-all dfenv) 148 | 149 | (cc:dataflow-get-avalable-pairs dfenv) 150 | 151 | 152 | ;;================================================== 153 | ;; Signal 154 | 155 | (progn 156 | (defvar parent-channel (cc:signal-channel "parent")) 157 | (cc:signal-connect 158 | parent-channel 'parent-load 159 | (lambda (event) (message "Parent Signal : %s" event))) 160 | (cc:signal-connect 161 | parent-channel t 162 | (lambda (event) (message "Parent Listener : %s" event))) 163 | 164 | (defvar channel (cc:signal-channel "child" parent-channel)) 165 | (cc:signal-connect 166 | channel 'window-load 167 | (lambda (event) (message "Signal : %s" event))) 168 | (cc:signal-connect 169 | channel t 170 | (lambda (event) (message "Listener : %s" event))) 171 | (deferred:$ 172 | (cc:signal-connect channel 'window-load) 173 | (deferred:nextc it 174 | (lambda (x) (message "Deferred Signal : %s" x)))) 175 | ) 176 | 177 | (cc:signal-send channel 'window-load "hello signal!") 178 | (cc:signal-send channel 'some "some signal!") 179 | 180 | (cc:signal-send parent-channel 'parent-load "parent hello!") 181 | (cc:signal-send parent-channel 'window-load "parent hello!") 182 | (cc:signal-send parent-channel 'some "parent some hello!") 183 | (cc:signal-send-global channel 'some "parent some hello!") 184 | 185 | (cc:signal-disconnect-all channel) 186 | -------------------------------------------------------------------------------- /sample/deferred-samples.el: -------------------------------------------------------------------------------- 1 | ;; deferred.el samples -*- lexical-binding: t; -*- 2 | 3 | (require 'cl-lib) 4 | (require 'deferred) 5 | 6 | ;;; Basic Chain 7 | 8 | (deferred:$ 9 | (deferred:next 10 | (lambda () (message "deferred start"))) 11 | (deferred:nextc it 12 | (lambda () 13 | (message "chain 1") 14 | 1)) 15 | (deferred:nextc it 16 | (lambda (x) 17 | (message "chain 2 : %s" x))) 18 | (deferred:nextc it 19 | (lambda () 20 | (read-minibuffer "Input a number: "))) 21 | (deferred:nextc it 22 | (lambda (x) 23 | (message "Got the number : %i" x))) 24 | (deferred:error it 25 | (lambda (err) 26 | (message "Wrong input : %s" err)))) 27 | 28 | 29 | ;;; Timer 30 | 31 | (deferred:$ 32 | (deferred:wait 1000) ; 1000msec 33 | (deferred:nextc it 34 | (lambda (x) 35 | (message "Timer sample! : %s msec" x)))) 36 | 37 | 38 | ;;; Command process 39 | 40 | (deferred:$ 41 | (deferred:process "ls" "-la") 42 | (deferred:nextc it 43 | (lambda (x) (insert x)))) 44 | 45 | 46 | ;;; Web Access 47 | 48 | ;; Simple web access 49 | 50 | (require 'url) 51 | 52 | (deferred:$ 53 | (deferred:url-retrieve "http://www.gnu.org") 54 | (deferred:nextc it 55 | (lambda (buf) 56 | (insert (with-current-buffer buf (buffer-string))) 57 | (kill-buffer buf)))) 58 | 59 | ;; Get an image 60 | 61 | (deferred:$ 62 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png") 63 | (deferred:nextc it 64 | (lambda (buf) 65 | (insert-image 66 | (create-image 67 | (let ((data (with-current-buffer buf (buffer-string)))) 68 | (substring data (+ (string-match "\n\n" data) 2))) 69 | 'png t)) 70 | (kill-buffer buf)))) 71 | 72 | ;; HTTP POST 73 | 74 | (deferred:$ 75 | (deferred:url-post 76 | "http://127.0.0.1:8080/post-test.cgi" 77 | '(('a . "test") ('param . "OK"))) 78 | (deferred:nextc it 79 | (lambda (buf) 80 | (insert (with-current-buffer buf (buffer-string))) 81 | (kill-buffer buf)))) 82 | 83 | 84 | ;; Parallel deferred 85 | 86 | (deferred:$ 87 | (deferred:parallel 88 | (lambda () 89 | (deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")) 90 | (lambda () 91 | (deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png"))) 92 | (deferred:nextc it 93 | (lambda (buffers) 94 | (cl-loop for i in buffers 95 | do 96 | (insert 97 | (format 98 | "size: %s\n" 99 | (with-current-buffer i (length (buffer-string))))) 100 | (kill-buffer i))))) 101 | 102 | ;; Get an image by wget and resize by ImageMagick 103 | 104 | (deferred:$ 105 | 106 | ;; try 107 | (deferred:$ 108 | (deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png") 109 | (deferred:nextc it 110 | (lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg"))) 111 | (deferred:nextc it 112 | (lambda () 113 | (clear-image-cache) 114 | (insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil))))) 115 | 116 | ;; catch 117 | (deferred:error it ; 118 | (lambda (err) 119 | (insert "Can not get a image! : " err))) 120 | 121 | ;; finally 122 | (deferred:nextc it 123 | (lambda () 124 | (deferred:parallel 125 | (lambda () (delete-file "a.jpg")) 126 | (lambda () (delete-file "b.jpg"))))) 127 | (deferred:nextc it 128 | (lambda (x) (message ">> %s" x)))) 129 | 130 | 131 | ;; Timeout Process 132 | 133 | (deferred:$ 134 | (deferred:earlier 135 | (deferred:process "sh" "-c" "sleep 3 | echo 'hello!'") 136 | (deferred:$ 137 | (deferred:wait 1000) ; timeout msec 138 | (deferred:nextc it (lambda () "canceled!")))) 139 | (deferred:nextc it 140 | (lambda (x) (insert x)))) 141 | 142 | 143 | ;; Loop and animation 144 | 145 | (let ((count 0) (anm "-/|\\-") 146 | (end 50) (pos (point)) 147 | (wait-time 50)) 148 | (deferred:$ 149 | (deferred:next 150 | (lambda (_) (message "Animation started."))) 151 | 152 | (deferred:nextc it 153 | (deferred:lambda (_) 154 | (save-excursion 155 | (when (< 0 count) 156 | (goto-char pos) (delete-char 1)) 157 | (insert (char-to-string 158 | (aref anm (% count (length anm)))))) 159 | (if (> end (cl-incf count)) 160 | (deferred:nextc (deferred:wait wait-time) self)))) 161 | 162 | (deferred:nextc it 163 | (lambda (_) 164 | (save-excursion 165 | (goto-char pos) (delete-char 1)) 166 | (message "Animation finished."))))) 167 | -------------------------------------------------------------------------------- /test/concurrent-test.el: -------------------------------------------------------------------------------- 1 | ;;; test code for concurrent.el -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2010 SAKURAI Masashi 4 | ;; Author: SAKURAI Masashi 5 | 6 | ;; This program is free software; you can redistribute it and/or modify 7 | ;; it under the terms of the GNU General Public License as published by 8 | ;; the Free Software Foundation, either version 3 of the License, or 9 | ;; (at your option) any later version. 10 | 11 | ;; This program is distributed in the hope that it will be useful, 12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ;; GNU General Public License for more details. 15 | 16 | ;; You should have received a copy of the GNU General Public License 17 | ;; along with this program. If not, see . 18 | 19 | ;; How to run this test ? 20 | ;; $ emacs -L . -L $HOME/.emacs.d/elisp -batch -l deferred -l concurrent -l test-concurrent -f cc:test-all 21 | 22 | (require 'undercover) 23 | (undercover "concurrent.el" 24 | (:send-report nil) 25 | (:report-file "/tmp/undercover-report.json")) 26 | (require 'concurrent) 27 | (require 'cl-lib) 28 | (require 'pp) 29 | (require 'ert) 30 | 31 | (defmacro cc:debug (d msg &rest args) 32 | `(deferred:nextc ,d 33 | (lambda (x) (funcall 'message ,msg ,@args) x))) 34 | 35 | ;; generator 36 | 37 | (defun cc:fib-gen (callback) 38 | (let ((a1 0) (a2 1) 39 | (callback callback)) 40 | (cc:generator 41 | callback 42 | (yield a1) 43 | (yield a2) 44 | (while t 45 | (let ((next (+ a1 a2))) 46 | (setq a1 a2 47 | a2 next) 48 | (yield next)))))) 49 | 50 | (defun cc:test-fib-gen () 51 | (let* ((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 | (cl-incf count) 63 | (deferred:call gen)))))) 64 | (setq gen (cc:fib-gen cc)) 65 | (deferred:call gen) 66 | dfinish)) 67 | 68 | ;; (cc:debug (cc:test-fib-gen) "Fib10 : %s" x) 69 | 70 | ;; thread 71 | 72 | (defun cc:test-thread () 73 | (let ((dfinish (deferred:new)) 74 | (result nil) (start-time (float-time)) 75 | (count 0) (end 20)) 76 | (push 1 result) 77 | (cc:thread 78 | 60 79 | (push 2 result) 80 | (while (> end (cl-incf count)) 81 | (when (= 0 (% count 10)) 82 | (push count result))) 83 | (push 99 result) 84 | (setq result (reverse result)) 85 | (deferred:callback dfinish 86 | (and (or (equal '(1 2 10 99) result) result) 87 | (let ((elapsed-time (- (float-time) start-time))) 88 | (or (and (< 1.0 elapsed-time) (< elapsed-time 6)) elapsed-time))))) 89 | dfinish)) 90 | 91 | ;; (cc:debug (cc:test-thread) "Thread : %s" x) 92 | 93 | ;; semaphore 94 | 95 | (defun cc:test-semaphore1 () 96 | (let* ((result nil) 97 | (dfinish (deferred:new 98 | (lambda (_) 99 | (setq result (reverse result)) 100 | (or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result) 101 | result)))) 102 | (smp (cc:semaphore-create 1))) 103 | 104 | (push 1 result) 105 | 106 | (deferred:nextc (cc:semaphore-acquire smp) 107 | (lambda(_) (push 2 result))) 108 | (deferred:nextc (cc:semaphore-acquire smp) 109 | (lambda(_) (push 3 result))) 110 | (deferred:nextc (cc:semaphore-acquire smp) 111 | (lambda(x) (push x result))) 112 | 113 | (deferred:$ 114 | (deferred:next 115 | (lambda (_) 116 | (push 5 result) 117 | (cc:semaphore-release smp) 118 | (push 6 result))) 119 | (deferred:nextc it 120 | (lambda (_) 121 | (push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result))) 122 | (deferred:nextc it 123 | (lambda (_) 124 | (push 7 result) 125 | (cl-loop for i in (cc:semaphore-release-all smp) 126 | do (deferred:callback i 'canceled)) 127 | (push 8 result))) 128 | (deferred:nextc it 129 | (lambda (_) 130 | (push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result))) 131 | (deferred:nextc it 132 | (lambda (_) (deferred:callback dfinish)))) 133 | 134 | dfinish)) 135 | 136 | ;; (cc:debug (cc:test-semaphore1) "Semaphore1 : %s" x) 137 | 138 | (defun cc:test-semaphore2 () 139 | (let* ((result nil) 140 | (dfinish (deferred:new 141 | (lambda (_) 142 | (setq result (reverse result)) 143 | (or (equal '(0 a b c d e f g) result) 144 | result)))) 145 | (smp (cc:semaphore-create 1))) 146 | 147 | (push 0 result) 148 | 149 | (cc:semaphore-with 150 | smp (lambda (_) 151 | (deferred:nextc (cc:semaphore-acquire smp) 152 | (lambda (_) 153 | (push 'c result) 154 | (cc:semaphore-release smp))) 155 | (push 'a result) 156 | (deferred:nextc 157 | (deferred:wait 100) 158 | (lambda (_) (push 'b result))))) 159 | 160 | (cc:semaphore-with 161 | smp (lambda (_) 162 | (deferred:nextc (cc:semaphore-acquire smp) 163 | (lambda (_) 164 | (push 'g result) 165 | (cc:semaphore-release smp) 166 | (deferred:callback dfinish))) 167 | (push 'd result) 168 | (deferred:nextc 169 | (deferred:wait 100) 170 | (lambda (_) 171 | (push 'e result) 172 | (error "SMP CC ERR")))) 173 | (lambda (e) 174 | (cl-destructuring-bind (sym msg) e 175 | (when (and (eq 'error sym) (equal "SMP CC ERR" msg)) 176 | (push 'f result))))) 177 | 178 | dfinish)) 179 | 180 | ;; (cc:debug (cc:test-semaphore2) "Semaphore2 : %s" x) 181 | 182 | ;; Dataflow 183 | 184 | (defun cc:test-dataflow-simple1 () 185 | (let* ((result '(1)) 186 | (dfinish (deferred:new 187 | (lambda (_) 188 | (setq result (reverse result)) 189 | (or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result) 190 | result)))) 191 | (dfenv (cc:dataflow-environment))) 192 | 193 | (push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result) 194 | 195 | (deferred:$ 196 | (deferred:parallel 197 | (deferred:$ 198 | (cc:dataflow-get dfenv "abc") 199 | (deferred:nextc it 200 | (lambda (x) (push (cons 3 x) result)))) 201 | (deferred:$ 202 | (deferred:next 203 | (lambda (_) 204 | (push 4 result) 205 | (cc:dataflow-set dfenv "abc" 256) 206 | (push 5 result))))) 207 | (deferred:nextc it 208 | (lambda (_) 209 | (push (cons 6 (cc:dataflow-get-sync dfenv "abc")) result) 210 | (cc:dataflow-clear dfenv "abc") 211 | (push (cons 7 (cc:dataflow-get-sync dfenv "abc")) result))) 212 | (deferred:nextc it 213 | (lambda (_) 214 | (deferred:callback dfinish)))) 215 | 216 | dfinish)) 217 | 218 | ;; (cc:debug (cc:test-dataflow-simple1) "Dataflow1 : %s" x) 219 | 220 | (defun cc:test-dataflow-simple2 () 221 | (let* ((result nil) 222 | (dfinish (deferred:new 223 | (lambda (_) 224 | (or (equal '("a.jpg:300 OK jpeg") result) 225 | result)))) 226 | (dfenv (cc:dataflow-environment))) 227 | 228 | (deferred:$ 229 | (cc:dataflow-get dfenv '("http://example.com/a.jpg" 300)) 230 | (deferred:nextc it 231 | (lambda (x) (push (format "a.jpg:300 OK %s" x) result))) 232 | (deferred:nextc it 233 | (lambda (_) 234 | (deferred:callback dfinish)))) 235 | 236 | (cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg) 237 | 238 | dfinish)) 239 | 240 | ;; (cc:debug (cc:test-dataflow-simple2) "Dataflow2 : %s" x) 241 | 242 | (defun cc:test-dataflow-simple3 () 243 | (let* ((result nil) 244 | (dfinish (deferred:new 245 | (lambda (_) 246 | (or (equal '(">> 384") result) 247 | result)))) 248 | (dfenv (cc:dataflow-environment))) 249 | 250 | (deferred:$ 251 | (deferred:parallel 252 | (cc:dataflow-get dfenv "def") 253 | (cc:dataflow-get dfenv "abc")) 254 | (deferred:nextc it 255 | (lambda (values) 256 | (apply '+ values))) 257 | (deferred:nextc it 258 | (lambda (x) (push (format ">> %s" x) result))) 259 | (deferred:nextc it 260 | (lambda (_) 261 | (deferred:callback dfinish)))) 262 | 263 | (deferred:nextc (deferred:wait 0.2) 264 | (lambda (_) 265 | (cc:dataflow-set dfenv "def" 128) 266 | (cc:dataflow-set dfenv "abc" 256) 267 | (cc:dataflow-set dfenv "aaa" 512) 268 | )) 269 | 270 | dfinish)) 271 | 272 | ;; (cc:debug (cc:test-dataflow-simple3) "Dataflow3 : %s" x) 273 | 274 | (defun cc:test-dataflow-simple4 () 275 | (let* ((result nil) 276 | (dfinish (deferred:new 277 | (lambda (_) 278 | (or (equal '(">> 3") result) 279 | result)))) 280 | (dfenv (cc:dataflow-environment))) 281 | 282 | (deferred:$ 283 | (deferred:parallel 284 | (cc:dataflow-get dfenv "abc") 285 | (cc:dataflow-get dfenv "abc") 286 | (cc:dataflow-get dfenv "abc")) 287 | (deferred:nextc it 288 | (lambda (values) 289 | (apply '+ values))) 290 | (deferred:nextc it 291 | (lambda (x) (push (format ">> %s" x) result))) 292 | (deferred:nextc it 293 | (lambda (_) 294 | (deferred:callback dfinish)))) 295 | 296 | (deferred:nextc (deferred:wait 0.2) 297 | (lambda (_) 298 | (cc:dataflow-set dfenv "abc" 1) 299 | )) 300 | 301 | dfinish)) 302 | 303 | ;; (cc:debug (cc:test-dataflow-simple4) "Dataflow4 : %s" x) 304 | 305 | (defun cc:test-dataflow-signal () 306 | (let* ((result '(1)) 307 | (dfinish (deferred:new 308 | (lambda (_) 309 | (setq result (reverse result)) 310 | (or (equal 311 | '(1 312 | (2 . nil) 313 | (get-first ("abc")) 314 | (get-waiting ("abc")) 315 | 4 5 316 | (set ("abc")) 317 | (3 . 256) 318 | 6 7 319 | (get ("abc")) 320 | (8 . 256) 321 | (9 . nil) 322 | (clear ("abc")) 323 | (clear-all (nil)) 324 | ) 325 | result) 326 | result)))) 327 | (dfenv (cc:dataflow-environment))) 328 | 329 | (cl-loop for i in '(get get-first get-waiting set clear clear-all) 330 | do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result)))) 331 | 332 | (push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result) 333 | 334 | (deferred:$ 335 | (deferred:parallel 336 | (deferred:$ 337 | (cc:dataflow-get dfenv "abc") 338 | (deferred:nextc it 339 | (lambda (x) (push (cons 3 x) result)))) 340 | (deferred:$ 341 | (deferred:next 342 | (lambda (_) 343 | (push 4 result) 344 | (cc:dataflow-set dfenv "abc" 256) 345 | (push 5 result))))) 346 | (deferred:nextc it 347 | (lambda (_) 348 | (push 6 result) 349 | (cc:dataflow-get dfenv "abc") 350 | (push 7 result))) 351 | (deferred:nextc it 352 | (lambda (_) 353 | (push (cons 8 (cc:dataflow-get-sync dfenv "abc")) result) 354 | (cc:dataflow-clear dfenv "abc") 355 | (push (cons 9 (cc:dataflow-get-sync dfenv "abc")) result))) 356 | (deferred:nextc it 357 | (lambda (_) 358 | (cc:dataflow-clear-all dfenv))) 359 | (deferred:nextc it 360 | (lambda (_) 361 | (deferred:callback dfinish)))) 362 | 363 | dfinish)) 364 | 365 | ;; (cc:debug (cc:test-dataflow-signal) "Dataflow Signal : %s" x) 366 | 367 | 368 | (defun cc:test-dataflow-parent1 () 369 | (let* ((result '(1)) 370 | (dfinish (deferred:new 371 | (lambda (_) 372 | (setq result (reverse result)) 373 | (or (equal 374 | '(1 375 | (available-parent . (("abc" . 128))) 376 | (available-child . (("abc" . 128))) 377 | (waiting-parent . nil) 378 | (waiting-child . ("aaa")) 379 | (get-sync . 256) 380 | (get . 256) 381 | ) 382 | result) 383 | result)))) 384 | (dfenv-parent (cc:dataflow-environment)) 385 | (dfenv (cc:dataflow-environment dfenv-parent))) 386 | 387 | (cc:dataflow-set dfenv-parent "abc" 128) 388 | 389 | (deferred:$ 390 | (deferred:parallel 391 | (deferred:$ 392 | (cc:dataflow-get dfenv "aaa") 393 | (deferred:nextc it 394 | (lambda (x) (push (cons 'get x) result)))) 395 | (deferred:$ 396 | (deferred:next 397 | (lambda (_) 398 | (push (cons 'available-parent (cc:dataflow-get-avalable-pairs dfenv-parent)) result) 399 | (push (cons 'available-child (cc:dataflow-get-avalable-pairs dfenv)) result) 400 | (push (cons 'waiting-parent (cc:dataflow-get-waiting-keys dfenv-parent)) result) 401 | (push (cons 'waiting-child (cc:dataflow-get-waiting-keys dfenv)) result))) 402 | (deferred:next 403 | (lambda (_) 404 | (cc:dataflow-set dfenv-parent "aaa" 256) 405 | (push (cons 'get-sync (cc:dataflow-get-sync dfenv "aaa")) result))))) 406 | (deferred:nextc it 407 | (lambda (_) (deferred:callback dfinish)))) 408 | 409 | dfinish)) 410 | 411 | ;; (cc:debug (cc:test-dataflow-parent1) "Dataflow Parent1 : %s" x) 412 | 413 | (defun cc:test-dataflow-parent2 () 414 | (let* ((result '()) 415 | (dfinish (deferred:new 416 | (lambda (_) 417 | (setq result (reverse result)) 418 | (or (equal 419 | '("parent get 256" "child get 256") result) 420 | result)))) 421 | (dfenv-parent (cc:dataflow-environment)) 422 | (dfenv (cc:dataflow-environment dfenv-parent))) 423 | 424 | (deferred:$ 425 | (deferred:parallel 426 | (deferred:$ 427 | (cc:dataflow-get dfenv-parent "abc") 428 | (deferred:nextc it 429 | (lambda (x) (push (format "parent get %s" x) result)))) 430 | (deferred:$ 431 | (cc:dataflow-get dfenv "abc") 432 | (deferred:nextc it 433 | (lambda (x) (push (format "child get %s" x) result)))) 434 | (deferred:nextc (deferred:wait 0.2) 435 | (lambda (_) (cc:dataflow-set dfenv-parent "abc" 256)))) 436 | (deferred:nextc it 437 | (lambda (_) (deferred:callback dfinish)))) 438 | 439 | dfinish)) 440 | 441 | ;; (cc:debug (cc:test-dataflow-parent2) "Dataflow Parent : %s" x) 442 | 443 | 444 | ;; Signal 445 | 446 | (defun cc:test-signal1 () 447 | (let* ((result '()) 448 | (dfinish (deferred:new 449 | (lambda (_) 450 | (setq result (reverse result)) 451 | (or (equal 452 | '( 453 | (ls ev1 (1)) 454 | (sig ev1 (1)) 455 | (ls ev2 (2)) 456 | (def ev1 (1)) 457 | ) 458 | result) 459 | result)))) 460 | (channel (cc:signal-channel "child"))) 461 | 462 | (cc:signal-connect channel 'ev1 463 | (lambda (event) 464 | (push (cons 'sig event) result))) 465 | (cc:signal-connect channel t 466 | (lambda (event) 467 | (push (cons 'ls event) result))) 468 | (deferred:$ 469 | (cc:signal-connect channel 'ev1) 470 | (deferred:nextc it 471 | (lambda (x) (push (cons 'def x) result)))) 472 | 473 | (deferred:$ 474 | (deferred:next 475 | (lambda (_) 476 | (cc:signal-send channel 'ev1 1) 477 | (cc:signal-send channel 'ev2 2))) 478 | (deferred:nextc it 479 | (lambda (_) (deferred:wait 300))) 480 | (deferred:nextc it 481 | (lambda (_) 482 | (deferred:callback dfinish)))) 483 | 484 | dfinish)) 485 | 486 | ;; (cc:debug (cc:test-signal1) "Signal1 : %s" x) 487 | 488 | ;; (cc:debug (cc:test-signal2) "Signal2 : %s" x) 489 | 490 | (defun cc:test-signal2 () 491 | (let* ((result nil) 492 | (dfinish (deferred:new 493 | (lambda (_) 494 | (setq result (reverse result)) 495 | (or (equal 496 | '( 497 | (pls pev1 (1)) 498 | (psig pev1 (1)) 499 | (pls ev1 (2)) 500 | (ls ev1 (3)) 501 | (sig ev1 (3)) 502 | (pls ev2 (4)) 503 | (pls ev2 (5)) 504 | 505 | (ls pev1 (1)) 506 | (ls ev1 (2)) 507 | 508 | (sig ev1 (2)) 509 | (def ev1 (3)) 510 | (ls ev2 (4)) 511 | (ls ev2 (5)) 512 | 513 | (def ev1 (2)) 514 | ) 515 | result) 516 | result)))) 517 | (parent-channel (cc:signal-channel "parent")) 518 | (channel (cc:signal-channel "child" parent-channel))) 519 | 520 | (cc:signal-connect parent-channel 'pev1 521 | (lambda (event) 522 | (push (cons 'psig event) result))) 523 | (cc:signal-connect parent-channel t 524 | (lambda (event) 525 | (push (cons 'pls event) result))) 526 | (cc:signal-connect channel 'ev1 527 | (lambda (event) 528 | (push (cons 'sig event) result))) 529 | (cc:signal-connect channel t 530 | (lambda (event) 531 | (push (cons 'ls event) result))) 532 | (deferred:$ 533 | (cc:signal-connect channel 'ev1) 534 | (deferred:nextc it 535 | (lambda (x) 536 | (push (cons 'def x) result)))) 537 | 538 | (deferred:$ 539 | (deferred:next 540 | (lambda (_) 541 | (cc:signal-send parent-channel 'pev1 1) 542 | (cc:signal-send parent-channel 'ev1 2) 543 | (cc:signal-send channel 'ev1 3) 544 | (cc:signal-send parent-channel 'ev2 4) 545 | (cc:signal-send-global channel 'ev2 5))) 546 | (deferred:nextc it 547 | (lambda (_) (deferred:wait 300))) 548 | (deferred:nextc it 549 | (lambda (_) 550 | (deferred:callback-post dfinish)))) 551 | 552 | dfinish)) 553 | 554 | ;; (cc:debug (cc:test-signal2) "Signal2 : %s" x) 555 | 556 | (defvar cc:test-finished-flag nil) 557 | (defvar cc:test-fails 0) 558 | 559 | (defun cc:test-all () 560 | (interactive) 561 | (setq cc:test-finished-flag nil) 562 | (setq cc:test-fails 0) 563 | (deferred:$ 564 | (deferred:parallel 565 | (cl-loop for i in '(cc:test-fib-gen 566 | cc:test-thread 567 | cc:test-semaphore1 568 | cc:test-semaphore2 569 | cc:test-dataflow-simple1 570 | cc:test-dataflow-simple2 571 | cc:test-dataflow-simple3 572 | cc:test-dataflow-simple4 573 | cc:test-dataflow-signal 574 | cc:test-dataflow-parent1 575 | cc:test-dataflow-parent2 576 | cc:test-signal1 577 | cc:test-signal2 578 | ) 579 | collect (cons i (deferred:timeout 5000 "timeout" (funcall i))))) 580 | (deferred:nextc it 581 | (lambda (results) 582 | (pop-to-buffer 583 | (with-current-buffer (get-buffer-create "*cc:test*") 584 | (erase-buffer) 585 | (cl-loop for i in results 586 | for name = (car i) 587 | for result = (cdr i) 588 | with fails = 0 589 | do (insert (format "%s : %s\n" name 590 | (if (eq t result) "OK" 591 | (format "FAIL > %s" result)))) 592 | (unless (eq t result) (cl-incf fails)) 593 | finally 594 | (goto-char (point-min)) 595 | (insert (format "Test Finished : %s\nTests Fails: %s / %s\n" 596 | (format-time-string "%Y/%m/%d %H:%M:%S" (current-time)) 597 | fails (length results))) 598 | (setq cc:test-fails fails)) 599 | (message (buffer-string)) 600 | (current-buffer))) 601 | (setq cc:test-finished-flag t)))) 602 | 603 | (while (null cc:test-finished-flag) 604 | (sleep-for 0 100) (sit-for 0 100)) 605 | (when (and noninteractive 606 | (> cc:test-fails 0)) 607 | (error "Test failed"))) 608 | 609 | (ert-deftest concurrent-all-the-thing () 610 | (should-not (cc:test-all))) 611 | -------------------------------------------------------------------------------- /test/deferred-test.el: -------------------------------------------------------------------------------- 1 | ;;; test code for deferred.el -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2010, 2011 SAKURAI Masashi 4 | ;; Author: SAKURAI Masashi 5 | 6 | ;; This program is free software; you can redistribute it and/or modify 7 | ;; it under the terms of the GNU General Public License as published by 8 | ;; the Free Software Foundation, either version 3 of the License, or 9 | ;; (at your option) any later version. 10 | 11 | ;; This program is distributed in the hope that it will be useful, 12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ;; GNU General Public License for more details. 15 | 16 | ;; You should have received a copy of the GNU General Public License 17 | ;; along with this program. If not, see . 18 | 19 | ;;; Commentary: 20 | 21 | ;; Run tests: 22 | ;; $ emacs -batch -l test-deferred.el -f ert-run-tests-batch-and-exit 23 | 24 | 25 | (require 'ert) 26 | (require 'undercover) 27 | (undercover "deferred.el" 28 | (:send-report nil) 29 | (:report-file "/tmp/undercover-report.json")) 30 | (require 'deferred) 31 | (require 'cl-lib) 32 | (require 'pp) 33 | 34 | (defmacro should= (a &rest b) 35 | `(should (equal ,a (progn ,@b))) 36 | ) 37 | 38 | (defmacro aand (test &rest rest) 39 | `(let ((it ,test)) 40 | (if it ,(if rest (macroexpand-all `(aand ,@rest)) 'it)))) 41 | 42 | (defmacro $ (&rest elements) 43 | `(let (it) 44 | ,@(cl-loop for i in elements 45 | with it = nil 46 | collect 47 | `(setq it ,i)) 48 | it)) 49 | 50 | (defmacro dnew(&rest aforms) 51 | (if aforms 52 | `(deferred:new (lambda (x) ,@aforms)) 53 | `(deferred:new))) 54 | 55 | (defmacro next(&rest aforms) 56 | `(deferred:next (lambda (x) ,@aforms))) 57 | 58 | (defmacro nextc(d &rest aforms) 59 | `(deferred:nextc ,d (lambda (x) ,@aforms))) 60 | 61 | (defmacro errorc(d &rest aforms) 62 | `(deferred:error ,d (lambda (e) ,@aforms))) 63 | 64 | (defmacro errorf(d formatstr) 65 | `(deferred:error ,d (lambda (e) (error ,formatstr e)))) 66 | 67 | (defmacro cancelc(d) 68 | `(deferred:cancel ,d)) 69 | 70 | (defmacro wait(msec) 71 | `(deferred:wait ,msec)) 72 | 73 | (defmacro dloop(&rest body) 74 | `(deferred:loop ,@body)) 75 | 76 | (defmacro parallel(&rest args) 77 | `(deferred:parallel ,@args)) 78 | 79 | (defmacro earlier(&rest args) 80 | `(deferred:earlier ,@args)) 81 | 82 | (defmacro flush () 83 | `(deferred:flush-queue!)) 84 | 85 | (defmacro clear () 86 | `(setq deferred:queue nil)) 87 | 88 | (defmacro dtest (&rest form) 89 | `(progn 90 | (clear) 91 | (let (last-value) 92 | (nextc 93 | ($ 94 | ,@form) 95 | (setq last-value x)) 96 | (flush) 97 | last-value))) 98 | 99 | (defmacro wtest (time &rest form) 100 | `(progn 101 | (clear) 102 | (let (last-value) 103 | (nextc 104 | ($ 105 | ,@form) 106 | (setq last-value x)) 107 | (while (null last-value) 108 | (sit-for ,time)) 109 | (flush) 110 | last-value))) 111 | 112 | (defun deferred:setTimeout (f _msec) 113 | "overrided for test" 114 | (deferred:call f)) 115 | 116 | (defun deferred:cancelTimeout (id) 117 | "overrided for test" 118 | (when (deferred-p id) 119 | (deferred:cancel id))) 120 | 121 | (defun deferred:run-with-idle-timer (_sec f) 122 | "overrided for test" 123 | (deferred:call f)) 124 | 125 | (defun deferred:not-called-func (&optional m) 126 | (error "Must not be called!! %s" m)) 127 | 128 | 129 | 130 | (ert-deftest deferred-primitive-simple () 131 | "> call-lambda simple" 132 | (should= 1 (deferred:call-lambda (lambda () 1))) 133 | (should= 1 (deferred:call-lambda (lambda () 1) 1)) 134 | (should= 1 (deferred:call-lambda (lambda (_) 1))) 135 | (should= 1 (deferred:call-lambda (lambda (_) 1) 1)) 136 | (should= 1 (deferred:call-lambda (deferred:lambda () 1))) 137 | (should= 1 (deferred:call-lambda (deferred:lambda () 1) 1)) 138 | (should= nil (deferred:call-lambda 'car)) 139 | (should= 2 (deferred:call-lambda 'car '(2 1))) 140 | (should= nil (deferred:call-lambda (symbol-function 'car))) 141 | (should= 2 (deferred:call-lambda (symbol-function 'car) '(2 1)))) 142 | 143 | (ert-deftest deferred-primitive-scope () 144 | "> call-lambda lexical-scope" 145 | (should= 3 (let ((st 1)) 146 | (deferred:call-lambda 147 | (lambda () (+ st 2))))) 148 | (should= 3 (let ((st 1)) 149 | (deferred:call-lambda 150 | (lambda () (+ st 2)) 0))) 151 | (should= 3 (let ((st 1)) 152 | (deferred:call-lambda 153 | (lambda (_) (+ st 2))))) 154 | (should= 3 (let ((st 1)) 155 | (deferred:call-lambda 156 | (lambda (_) (+ st 2)) 0)))) 157 | 158 | (when (version<= "25.0" emacs-version) 159 | ;; Emacs 24 doesn’t know how to byte-compile closures, so run this test only 160 | ;; under Emacs 25. 161 | (ert-deftest deferred-primitive-compile () 162 | "> call-lambda byte-compile" 163 | (should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1)))) 164 | (should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1)) 1)) 165 | (should= 1 (deferred:call-lambda (byte-compile (lambda () 1)))) 166 | (should= 1 (deferred:call-lambda (byte-compile (lambda () 1)) 1)) 167 | 168 | (should= 3 (let ((st 1)) 169 | (deferred:call-lambda 170 | (byte-compile (lambda () (+ st 2)))))) 171 | (should= 3 (let ((st 1)) ;ng 172 | (deferred:call-lambda 173 | (byte-compile (lambda () (+ st 2))) 0))) 174 | (should= 3 (let ((st 1)) 175 | (deferred:call-lambda 176 | (byte-compile (lambda (_) (+ st 2)))))) 177 | (should= 3 (let ((st 1)) ;ng 178 | (deferred:call-lambda 179 | (byte-compile (lambda (_) (+ st 2))) 0))) 180 | 181 | (should-error 182 | (deferred:call-lambda 183 | (lambda (x) (signal 'wrong-number-of-arguments '("org")))) 184 | :type 'wrong-number-of-arguments))) 185 | 186 | (ert-deftest deferred-basic () 187 | "Basic test for deferred functions." 188 | (should (deferred-p 189 | ;; function test 190 | (deferred:new))) 191 | (should (null 192 | ;; basic cancel test 193 | (let ((d (deferred:next 'deferred:not-called-func))) 194 | (cancelc d) 195 | (flush)))) 196 | (should (deferred-p 197 | ;; basic post function test 198 | (progn 199 | (clear) 200 | (let ((d (dnew))) 201 | (nextc d x) 202 | (deferred:exec-task d 'ok "ok!"))))) 203 | (should (deferred-p 204 | ;; basic error post function test 205 | (progn 206 | (clear) 207 | (let ((d (dnew))) 208 | (deferred:error d (lambda (e) e)) 209 | (deferred:exec-task d 'ng "error")))))) 210 | 211 | (ert-deftest deferred-basic-result-propagation () 212 | "> result propagation" 213 | (should= 'ok 214 | ;; value saving test 215 | (let ((d (deferred:succeed 1))) 216 | (deferred:status d))) 217 | 218 | (should= 1 219 | ;; value saving test 220 | (let ((d (deferred:succeed 1))) 221 | (deferred-value d))) 222 | 223 | (should= nil 224 | ;; value clearing test 225 | (let ((d (deferred:succeed 1))) 226 | (deferred:set-next d (dnew)) 227 | (deferred:status d))) 228 | 229 | (should= 1 230 | ;; value propagating test 231 | (let ((d (deferred:succeed 1)) 232 | (nd (dnew))) 233 | (deferred:set-next d nd) 234 | (deferred-value nd)))) 235 | 236 | (ert-deftest deferred-basic-error-propagation () 237 | "> error propagation" 238 | (should= 'ok 239 | ;; value saving test 240 | (let ((d (deferred:succeed 1))) 241 | (deferred:status d))) 242 | 243 | (should= 1 244 | ;; value saving test 245 | (let ((d (deferred:succeed 1))) 246 | (deferred-value d))) 247 | 248 | (should= nil 249 | ;; value clearing test 250 | (let ((d (deferred:succeed 1))) 251 | (deferred:set-next d (dnew)) 252 | (deferred:status d))) 253 | 254 | (should= 1 255 | ;; value propagating test 256 | (let ((d (deferred:succeed 1)) 257 | (nd (dnew))) 258 | (deferred:set-next d nd) 259 | (deferred-value nd)))) 260 | 261 | (ert-deftest deferred-main-chain () 262 | ">>> Main Test / Chaining" 263 | 264 | (should= '(2 1 0) 265 | ;; basic deferred chain test 266 | (clear) 267 | (let (vs) 268 | ($ (next (push 1 vs)) 269 | (nextc it (push 2 vs))) 270 | (push 0 vs) 271 | (flush) 272 | vs)) 273 | 274 | (should= "errorback called" 275 | ;; basic errorback test 276 | (dtest (next (error "errorback")) 277 | (errorc it (concat (cadr e) " called")))) 278 | 279 | (should= "next callback called" 280 | ;; error recovery test 281 | (dtest 282 | (next (error "callback called")) 283 | (errorc it (cadr e)) 284 | (nextc it (concat "next " x)))) 285 | 286 | (should= '(error "second errorback called") 287 | ;; error recovery test 2 288 | (dtest 289 | (next (error "callback called")) 290 | (nextc it (deferred:not-called-func "second errorback1")) 291 | (errorc it e) 292 | (errorc it (deferred:not-called-func "second errorback2")) 293 | (nextc it (error "second errorback called")) 294 | (nextc it "skipped") 295 | (errorc it e))) 296 | 297 | (should= "start errorback ok1" 298 | ;; start errorback test1 299 | (let (message-log-max) 300 | (cl-letf (((symbol-function 'message) (lambda (&rest args) args))) 301 | (let ((d (dnew))) 302 | (dtest 303 | (progn 304 | (deferred:errorback d "start errorback") d) 305 | (nextc it (deferred:not-called-func "ERROR : start errorback")) 306 | (errorc it (cadr e)) 307 | (nextc it (concat x " ok1"))))))) 308 | 309 | (should= "post errorback ok2" 310 | ;; start errorback test1 311 | (let ((d (dnew))) 312 | (dtest 313 | (progn (deferred:errorback-post d "post errorback") d) 314 | (nextc it (deferred:not-called-func "ERROR : post errorback")) 315 | (errorc it (cadr e)) 316 | (nextc it (concat x " ok2"))))) 317 | 318 | (should= "Child deferred chain" 319 | ;; child deferred chain test 320 | (dtest 321 | (next 322 | (next "Child deferred chain")) 323 | (errorf it "Error on simple chain : %s"))) 324 | 325 | (should= "chain watch ok" 326 | ;; watch chain: normal 327 | (let ((val "><")) 328 | (dtest 329 | (next "chain") 330 | (deferred:watch it 331 | (lambda (_) (setq val " watch") nil)) 332 | (nextc it (concat x val " ok"))))) 333 | 334 | (should= "error!! watch ok" 335 | ;; watch chain: error 336 | (let ((val "><")) 337 | (dtest 338 | (next "chain") 339 | (nextc it (error "error!!")) 340 | (deferred:watch it (lambda (x) (setq val " watch") nil)) 341 | (errorc it (concat (cadr e) val " ok"))))) 342 | 343 | (should= "chain watch ok2" 344 | ;; watch chain: normal 345 | (let ((val "><")) 346 | (dtest 347 | (next "chain") 348 | (deferred:watch it 349 | (lambda (_) (error "ERROR"))) 350 | (nextc it (concat x " watch ok2")))))) 351 | 352 | (ert-deftest deferred-async-connect () 353 | "> async connect" 354 | (should= "saved result!" 355 | ;; asynchronously connect deferred and propagate a value 356 | (let (d ret) 357 | (clear) 358 | (setq d (next "saved ")) 359 | (deferred:callback d) 360 | (flush) 361 | (setq d (nextc d (concat x "result"))) 362 | (nextc d (setq ret (concat x "!"))) 363 | ret))) 364 | 365 | (ert-deftest deferred-global-onerror () 366 | "> global onerror" 367 | (should= "ONERROR" 368 | ;; default onerror handler test 369 | (let (ret) 370 | (let ((deferred:onerror 371 | (lambda (e) (setq ret (concat "ON" (error-message-string e)))))) 372 | (dtest 373 | (next (error "ERROR"))) 374 | ret)))) 375 | 376 | (ert-deftest deferred-async-call () 377 | "> async call" 378 | (should= "ASYNC CALL" 379 | ;; basic async 'call' test 380 | (dtest 381 | (deferred:call 'concat "ASYNC" " " "CALL"))) 382 | 383 | (should= "ASYNC APPLY" 384 | ;; basic async 'apply' test 385 | (dtest 386 | (deferred:apply 'concat '("ASYNC" " " "APPLY"))))) 387 | 388 | (ert-deftest deferred-wait () 389 | "> wait" 390 | (should= "wait ok" 391 | ;; basic wait test 392 | (dtest 393 | (wait 1) 394 | (nextc it (if (< x 300) "wait ok" x)) 395 | (errorf it "Error on simple wait : %s"))) 396 | 397 | (should= "waitc ok" 398 | ;; wait chain test 399 | (dtest 400 | (wait 1) 401 | (nextc it "wait") 402 | (nextc it (wait 1)) 403 | (nextc it (if (< x 300) "waitc ok" x)) 404 | (errorf it "Error on simple wait chain : %s"))) 405 | 406 | (should= nil 407 | ;; wait cancel test 408 | (dtest 409 | (wait 1000) 410 | (cancelc it) 411 | (nextc it (deferred:not-called-func "wait cancel")))) 412 | 413 | (should= "wait-idle ok" 414 | ;; basic wait test 415 | (dtest 416 | (deferred:wait-idle 1) 417 | (nextc it (if (< x 300) "wait-idle ok" x)) 418 | (errorf it "Error on simple wait-idle : %s"))) 419 | 420 | (should= "wait-idlec ok" 421 | ;; wait chain test 422 | (dtest 423 | (deferred:wait-idle 1) 424 | (nextc it "wait") 425 | (nextc it (deferred:wait-idle 1)) 426 | (nextc it (if (< x 300) "wait-idlec ok" x)) 427 | (errorf it "Error on simple wait-idle chain : %s"))) 428 | 429 | (should= nil 430 | ;; wait cancel test 431 | (dtest 432 | (deferred:wait-idle 1000) 433 | (cancelc it) 434 | (nextc it (deferred:not-called-func "wait-idle cancel"))))) 435 | 436 | (ert-deftest deferred-sync-connect () 437 | "> synchronized connection and wait a value" 438 | (should= "sync connect1" 439 | ;; real time connection1 440 | (dtest 441 | (deferred:succeed "sync ") 442 | (nextc it 443 | (concat x "connect1")))) 444 | 445 | (should= "sync connect11" 446 | ;; real time connection11 447 | (dtest 448 | (deferred:succeed "sync ") 449 | (nextc it 450 | (concat x "connect1")) 451 | (nextc it 452 | (concat x "1")))) 453 | 454 | (should= "connect2" 455 | ;; real time connection1 456 | (dtest 457 | (deferred:succeed "sync ") 458 | (nextc it 459 | (next "connect")) 460 | (nextc it 461 | (concat x "2")))) 462 | 463 | (should= "connect!! GO" 464 | ;; real time connection2 465 | (dtest 466 | (deferred:succeed "sync ") 467 | (nextc it 468 | ($ 469 | (next "connect") 470 | (nextc it (concat x "!!")))) 471 | (nextc it 472 | (concat x " GO"))))) 473 | 474 | (ert-deftest deferred-try () 475 | "> try-catch-finally" 476 | 477 | (should= "try" 478 | ;; try block 479 | (dtest 480 | (deferred:try 481 | (next "try")))) 482 | 483 | (should= "try" 484 | ;; try catch block 485 | (dtest 486 | (deferred:try 487 | (next "try") 488 | :catch 489 | (lambda (e) (concat "CATCH:" e))))) 490 | 491 | (should= "try-finally" 492 | ;; try catch finally block 493 | (let (val) 494 | (dtest 495 | (deferred:try 496 | (next "try") 497 | :finally 498 | (lambda (x) (setq val "finally"))) 499 | (nextc it (concat x "-" val))))) 500 | 501 | (should= "try-finally2" 502 | ;; try catch finally block 503 | (let (val) 504 | (dtest 505 | (deferred:try 506 | (next "try") 507 | :catch 508 | (lambda (e) (concat "CATCH:" e)) 509 | :finally 510 | (lambda (x) (setq val "finally2"))) 511 | (nextc it (concat x "-" val))))) 512 | 513 | (should= "try-catch:err" 514 | ;; try block 515 | (dtest 516 | (deferred:try 517 | ($ (next "start") 518 | (nextc it (error "err")) 519 | (nextc it (deferred:not-called-func x))) 520 | :catch 521 | (lambda (e) (concat "catch:" (cadr e)))) 522 | (nextc it (concat "try-" x)))) 523 | 524 | (should= "try-catch:err-finally" 525 | ;; try catch finally block 526 | (let (val) 527 | (dtest 528 | (deferred:try 529 | ($ (next "start") 530 | (nextc it (error "err")) 531 | (nextc it (deferred:not-called-func x))) 532 | :catch 533 | (lambda (e) (concat "catch:" (cadr e))) 534 | :finally 535 | (lambda (x) (setq val "finally"))) 536 | (nextc it (concat "try-" x "-" val)))))) 537 | 538 | 539 | 540 | (ert-deftest deferred-loop () 541 | "> loop" 542 | (should= 10 543 | ;; basic loop test 544 | (let ((v 0)) 545 | (dtest 546 | (dloop 5 (lambda (i) (setq v (+ v i)))) 547 | (errorf it "Error on simple loop calling : %s")) 548 | v)) 549 | 550 | (should= "loop ok 4" 551 | ;; return value for a loop 552 | (dtest 553 | (dloop 5 (lambda (i) i)) 554 | (nextc it (format "loop ok %i" x)) 555 | (errorf it "Error on simple loop calling : %s"))) 556 | 557 | (should= "nested loop ok (4 nil 3 2 1 0)" 558 | ;; nested deferred task in a loop 559 | (let (count) 560 | (dtest 561 | (dloop 5 (lambda (i) 562 | (push i count) 563 | (if (eql i 3) (next (push x count))))) 564 | (nextc it (format "nested loop ok %s" count)) 565 | (errorf it "Error on simple loop calling : %s")) 566 | ) 567 | ) 568 | 569 | (should= '(6 4 2) 570 | ;; do-loop test 571 | (let (count) 572 | (dtest 573 | (dloop '(1 2 3) 574 | (lambda (x) (push (* 2 x) count))) 575 | (errorf it "Error on do-loop calling : %s")))) 576 | 577 | (should= nil 578 | ;; zero times loop test 579 | (dtest 580 | (dloop 0 (lambda (i) (deferred:not-called-func "zero loop"))))) 581 | 582 | (should= nil 583 | ;; loop cancel test 584 | (dtest 585 | (dloop 3 (lambda (i) (deferred:not-called-func "loop cancel"))) 586 | (cancelc it))) 587 | 588 | (should= "loop error!" 589 | ;; loop error recover test 590 | (dtest 591 | (deferred:loop 5 592 | (lambda (i) (if (= 2 i) (error "loop error")))) 593 | (nextc it (deferred:not-called-func)) 594 | (errorc it (format "%s!" (cadr e))) 595 | (nextc it x))) 596 | 597 | (should= "loop error catch ok" 598 | ;; try catch finally test 599 | (let ((body (lambda () 600 | (deferred:loop 5 601 | (lambda (i) (if (= 2 i) (error "loop error"))))))) 602 | (dtest 603 | (next "try ") ; try 604 | (nextc it (funcall body)) ; body 605 | (errorc it (format "%s catch " (cadr e))) ; catch 606 | (nextc it (concat x "ok"))))) ; finally 607 | 608 | (should= "4 ok" 609 | ;; try catch finally test 610 | (let ((body (lambda () 611 | (deferred:loop 5 612 | (lambda (i) i))))) 613 | (dtest 614 | (next "try ") ; try 615 | (nextc it (funcall body)) ; body 616 | (errorc it (format "%s catch " e)) ; catch 617 | (nextc it (format "%s ok" x))))) ; finally 618 | ) 619 | 620 | 621 | 622 | (ert-deftest deferred-parallel () 623 | "> parallel" 624 | (should= nil 625 | ;; nil test 626 | (dtest 627 | (parallel '()))) 628 | 629 | (should= '(1) 630 | ;; single job test: argument 631 | (dtest 632 | (parallel 633 | (next 1)))) 634 | 635 | (should= '(1) 636 | ;; single job test: function 637 | (dtest 638 | (parallel 639 | (lambda () 1)))) 640 | 641 | (should= '(1) 642 | ;; single job test: list 643 | (dtest 644 | (parallel 645 | (list (next 1))))) 646 | 647 | (should= '((a . 1)) 648 | ;; single job test: alist 649 | (dtest 650 | (parallel 651 | (list (cons 'a (next 1)))))) 652 | 653 | (should= '(0 1) 654 | ;; simple parallel test: just return value 655 | (dtest 656 | (parallel 657 | (next 0) (next 1)))) 658 | 659 | (should= '(13 14) 660 | ;; simple parallel test: list 661 | (dtest 662 | (parallel 663 | (list (next 13) 664 | (next 14))))) 665 | 666 | (should= '((a . 20) (b . 30)) 667 | ;; simple parallel test: alist 668 | (dtest 669 | (parallel 670 | (list (cons 'a (next 20)) 671 | (cons 'b (next 30)))))) 672 | 673 | (should= '(0 1) 674 | ;; simple parallel test: function list 675 | (dtest 676 | (parallel 677 | (lambda () 0) (lambda () 1)))) 678 | 679 | (should= '(0 1) 680 | ;; nested deferred and order change test 681 | (dtest 682 | (parallel 683 | (lambda () (next 0)) 684 | (next 1)))) 685 | 686 | (should= "((error ERROR) OK (error ERROR2))" 687 | ;; error handling 688 | (dtest 689 | (parallel 690 | (next (error "ERROR")) (next "OK") (next (error "ERROR2"))) 691 | (nextc it (format "%s" x)))) 692 | 693 | (should= "((error ERROR) (error ERROR2))" 694 | ;; failed test 695 | (dtest 696 | (parallel 697 | (next (error "ERROR")) (next (error "ERROR2"))) 698 | (nextc it (format "%s" x)))) 699 | 700 | (should= "((b . OK) (a error ERROR) (c error ERROR2))" 701 | ;; error handling 702 | (dtest 703 | (parallel 704 | (cons 'a (next (error "ERROR"))) 705 | (cons 'b (next "OK")) 706 | (cons 'c (next (error "ERROR2")))) 707 | (nextc it (format "%s" x)))) 708 | 709 | (should= "((a error ERROR) (b error ERROR2))" 710 | ;; failed test 711 | (dtest 712 | (parallel 713 | (cons 'a (next (error "ERROR"))) 714 | (cons 'b (next (error "ERROR2")))) 715 | (nextc it (format "%s" x)))) 716 | 717 | (should= nil 718 | ;; parallel cancel test 719 | (dtest 720 | (parallel 721 | (list (next (deferred:not-called-func "parallel 1")) 722 | (next (deferred:not-called-func "parallel 2")))) 723 | (cancelc it))) 724 | 725 | (should= "nest parallel ok" 726 | ;; parallel next 727 | (let* ((flow (lambda (x) 728 | (parallel 729 | (next "nest ") 730 | (next "parallel "))))) 731 | (dtest 732 | (next "start ") 733 | (nextc it (funcall flow x)) 734 | (nextc it (apply 'concat x)) 735 | (nextc it (concat x "ok"))))) 736 | 737 | (should= "arrived (1) ok" 738 | ;; arrived one deferred 739 | (dtest 740 | (parallel (deferred:succeed 1)) 741 | (nextc it (format "arrived %s ok" x)))) 742 | 743 | (should= "arrived (1 2) ok" 744 | ;; arrived deferreds 745 | (dtest 746 | (parallel (deferred:succeed 1) (deferred:succeed 2)) 747 | (nextc it (format "arrived %s ok" x))))) 748 | 749 | 750 | 751 | (ert-deftest deferred-earlier () 752 | "> earlier" 753 | (should= nil 754 | ;; nil test 755 | (dtest 756 | (earlier '()))) 757 | 758 | (should= 1 759 | ;; single job test: argument 760 | (dtest 761 | (earlier 762 | (nextc (wait 10) 1)) 763 | (nextc it x))) 764 | 765 | (should= 1 766 | ;; single job test: function 767 | (dtest 768 | (earlier 769 | (lambda () 1)) 770 | (nextc it x))) 771 | 772 | (should= 1 773 | ;; single job test: list 774 | (dtest 775 | (earlier 776 | (list (next 1))) 777 | (nextc it x))) 778 | 779 | (should= '(a . 1) 780 | ;; single job test: alist 781 | (dtest 782 | (earlier 783 | (list (cons 'a (next 1)))) 784 | (nextc it x))) 785 | 786 | (should= '0 787 | ;; simple earlier test 788 | (dtest 789 | (earlier 790 | (next 0) (next 1)) 791 | (nextc it x))) 792 | 793 | (should= '11 794 | ;; simple earlier test: argument 795 | (dtest 796 | (earlier 797 | (next 11) (next 12)) 798 | (nextc it x))) 799 | 800 | (should= '13 801 | ;; simple earlier test: list 802 | (dtest 803 | (earlier 804 | (list (next 13) (next 14))) 805 | (nextc it x))) 806 | 807 | (should= '(a . 20) 808 | ;; simple earlier test: alist 809 | (dtest 810 | (earlier 811 | (list (cons 'a (next 20)) 812 | (cons 'b (next 30)))) 813 | (nextc it x))) 814 | 815 | (should= '0 816 | ;; simple earlier test: function list 817 | (dtest 818 | (earlier 819 | (lambda () 0) (lambda () 1)) 820 | (nextc it x))) 821 | 822 | (should= '1 823 | ;; nested deferred and order change test 824 | (dtest 825 | (earlier 826 | (lambda () (dnew 0)) 827 | (next 1)))) 828 | 829 | (should= "OK" 830 | ;; error handling 831 | (dtest 832 | (earlier 833 | (next (error "ERROR")) (next "OK") (next (error "ERROR2"))) 834 | (nextc it x))) 835 | 836 | (should= nil 837 | ;; failed test 838 | (dtest 839 | (earlier 840 | (next (error "ERROR")) (next (error "ERROR2"))) 841 | (nextc it x))) 842 | 843 | (should= '(b . "OK") 844 | ;; error handling 845 | (dtest 846 | (earlier 847 | (cons 'a (next (error "ERROR"))) 848 | (cons 'b (next "OK")) 849 | (cons 'c (next (error "ERROR2")))) 850 | (nextc it x))) 851 | 852 | (should= nil 853 | ;; failed test 854 | (dtest 855 | (earlier 856 | (cons 'a (next (error "ERROR"))) 857 | (cons 'b (next (error "ERROR2")))) 858 | (nextc it x))) 859 | 860 | (should= nil 861 | ;; cancel test 862 | (dtest 863 | (earlier 864 | (list (next (deferred:not-called-func "earlier 1")) 865 | (next (deferred:not-called-func "earlier 2")))) 866 | (cancelc it))) 867 | 868 | (should= "arrived 1 ok" 869 | ;; arrived one deferred 870 | (dtest 871 | (earlier (deferred:succeed 1)) 872 | (nextc it (format "arrived %s ok" x)))) 873 | 874 | (should= "arrived 1 ok" 875 | ;; arrived deferreds 876 | (dtest 877 | (earlier (deferred:succeed 1) (deferred:succeed 2)) 878 | (nextc it (format "arrived %s ok" x))))) 879 | 880 | (ert-deftest deferred-sync! () 881 | (should= "foo" 882 | (deferred:$ 883 | (deferred:next 884 | (lambda () 885 | "foo")) 886 | (deferred:sync! it)))) 887 | 888 | ;; process 889 | 890 | (ert-deftest deferred-process () 891 | "> Process" 892 | (should= 893 | (with-temp-buffer 894 | (call-process "pwd" nil t nil) 895 | (buffer-string)) 896 | (wtest 0.1 ;; maybe fail in some environments... 897 | (deferred:process "pwd"))) 898 | 899 | (should= 900 | (with-temp-buffer 901 | (call-process "pwd" nil t nil) 902 | (buffer-string)) 903 | (wtest 0.1 ;; maybe fail in some environments... 904 | (deferred:process "pwd" nil))) 905 | 906 | (should= 907 | (length (buffer-list)) 908 | (deferred:cancel (deferred:process "pwd" nil)) 909 | (length (buffer-list))) 910 | 911 | (should= 0 912 | (dtest 913 | (deferred:process "pwd---") 914 | (nextc it (deferred:not-called-func)) 915 | (errorc it (string-match "^Searching for program" (cadr e))))) 916 | 917 | (should= 918 | (with-temp-buffer (call-process "pwd" nil t nil) 919 | (buffer-string)) 920 | (wtest 0.1 921 | (wait 0.1) 922 | (deferred:processc it "pwd" nil))) 923 | 924 | (should= 925 | (with-temp-buffer 926 | (call-process "ls" nil t "-1") 927 | (buffer-string)) 928 | (wtest 0.1 ;; maybe fail in some environments... 929 | (deferred:process-buffer "ls" "-1") 930 | (nextc it 931 | (unless (buffer-live-p x) 932 | (error "Not live buffer : %s" x)) 933 | (with-current-buffer x (buffer-string))))) 934 | 935 | (should= 936 | (with-temp-buffer 937 | (call-process "ls" nil t "-1") 938 | (buffer-string)) 939 | (wtest 0.1 ;; maybe fail in some environments... 940 | (wait 0.1) 941 | (deferred:process-bufferc it "ls" "-1") 942 | (nextc it 943 | (unless (buffer-live-p x) 944 | (error "Not live buffer : %s" x)) 945 | (with-current-buffer x (buffer-string))))) 946 | 947 | (should= 948 | (length (buffer-list)) 949 | (deferred:cancel (deferred:process-buffer "ls" nil)) 950 | (length (buffer-list))) 951 | 952 | (should= 0 953 | (dtest 954 | (deferred:process-buffer "pwd---") 955 | (nextc it (deferred:not-called-func)) 956 | (errorc it (string-match "^Searching for program" (cadr e))))) 957 | 958 | ;;shell 959 | 960 | (should= 961 | (with-temp-buffer 962 | (call-process-shell-command "pwd" nil t nil) 963 | (buffer-string)) 964 | (wtest 0.1 ;; maybe fail in some environments... 965 | (deferred:process-shell "pwd"))) 966 | 967 | (should= 968 | (with-temp-buffer 969 | (call-process-shell-command "pwd" nil t nil) 970 | (buffer-string)) 971 | (wtest 0.1 ;; maybe fail in some environments... 972 | (deferred:process-shell "pwd" nil))) 973 | 974 | (should= 975 | (length (buffer-list)) 976 | (deferred:cancel (deferred:process-shell "pwd" nil)) 977 | (length (buffer-list))) 978 | 979 | (should= "ERROR" 980 | (wtest 0.1 981 | (deferred:process-shell "lsasfdsadf") 982 | (nextc it (deferred:not-called-func)) 983 | (errorc it "ERROR"))) 984 | 985 | (should= 986 | (with-temp-buffer (call-process-shell-command "pwd" nil t nil) 987 | (buffer-string)) 988 | (wtest 0.1 989 | (wait 0.1) 990 | (deferred:process-shellc it "pwd" nil))) 991 | 992 | (should= 993 | (with-temp-buffer 994 | (call-process-shell-command "ls" nil t "-1") 995 | (buffer-string)) 996 | (wtest 0.1 ;; maybe fail in some environments... 997 | (deferred:process-shell-buffer "ls" "-1") 998 | (nextc it 999 | (unless (buffer-live-p x) 1000 | (error "Not live buffer : %s" x)) 1001 | (with-current-buffer x (buffer-string))))) 1002 | 1003 | (should= 1004 | (with-temp-buffer 1005 | (call-process-shell-command "ls" nil t "-1") 1006 | (buffer-string)) 1007 | (wtest 0.1 ;; maybe fail in some environments... 1008 | (wait 0.1) 1009 | (deferred:process-shell-bufferc it "ls" "-1") 1010 | (nextc it 1011 | (unless (buffer-live-p x) 1012 | (error "Not live buffer : %s" x)) 1013 | (with-current-buffer x (buffer-string))))) 1014 | 1015 | (should= 1016 | (length (buffer-list)) 1017 | (deferred:cancel (deferred:process-shell-buffer "ls" nil)) 1018 | (length (buffer-list))) 1019 | 1020 | (should= "ERROR" 1021 | (wtest 0.1 1022 | (deferred:process-shell-buffer "lssaf") 1023 | (nextc it (deferred:not-called-func)) 1024 | (errorc it "ERROR")))) 1025 | --------------------------------------------------------------------------------