remove emacs-deferred as subtree to add as submodule
This commit is contained in:
parent
292d8bf3ca
commit
9bf9bce9fd
@ -1 +0,0 @@
|
||||
-L .
|
||||
11
emacs-deferred/.gitignore
vendored
11
emacs-deferred/.gitignore
vendored
@ -1,11 +0,0 @@
|
||||
# Compiled and temporary files
|
||||
*.elc
|
||||
*~
|
||||
|
||||
# Cask
|
||||
/.cask
|
||||
dist
|
||||
|
||||
# Ecukes
|
||||
/features/project/.cask
|
||||
/features/project/test/*.el
|
||||
@ -1,17 +0,0 @@
|
||||
language: generic
|
||||
sudo: false
|
||||
before_install:
|
||||
- curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh
|
||||
- evm install $EVM_EMACS --use --skip
|
||||
- cask
|
||||
env:
|
||||
- EVM_EMACS=emacs-24.4-travis
|
||||
- EVM_EMACS=emacs-24.5-travis
|
||||
- EVM_EMACS=emacs-25.1-travis
|
||||
|
||||
script:
|
||||
- emacs --version
|
||||
- make travis-ci
|
||||
after_script:
|
||||
- cat /tmp/undercover-report.json
|
||||
- curl -v -include --form json_file=@/tmp/undercover-report.json https://coveralls.io/api/v1/jobs
|
||||
@ -1,12 +0,0 @@
|
||||
(source gnu)
|
||||
(source melpa)
|
||||
|
||||
(package-file "deferred.el")
|
||||
|
||||
(development
|
||||
(depends-on "f")
|
||||
(depends-on "ecukes")
|
||||
(depends-on "ert-runner")
|
||||
(depends-on "el-mock")
|
||||
(depends-on "cask-package-toolset")
|
||||
(depends-on "undercover"))
|
||||
@ -1,674 +0,0 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The GNU General Public License is a free, copyleft license for
|
||||
software and other kinds of works.
|
||||
|
||||
The licenses for most software and other practical works are designed
|
||||
to take away your freedom to share and change the works. By contrast,
|
||||
the GNU General Public License is intended to guarantee your freedom to
|
||||
share and change all versions of a program--to make sure it remains free
|
||||
software for all its users. We, the Free Software Foundation, use the
|
||||
GNU General Public License for most of our software; it applies also to
|
||||
any other work released this way by its authors. You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
them if you wish), that you receive source code or can get it if you
|
||||
want it, that you can change the software or use pieces of it in new
|
||||
free programs, and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to prevent others from denying you
|
||||
these rights or asking you to surrender the rights. Therefore, you have
|
||||
certain responsibilities if you distribute copies of the software, or if
|
||||
you modify it: responsibilities to respect the freedom of others.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must pass on to the recipients the same
|
||||
freedoms that you received. You must make sure that they, too, receive
|
||||
or can get the source code. And you must show them these terms so they
|
||||
know their rights.
|
||||
|
||||
Developers that use the GNU GPL protect your rights with two steps:
|
||||
(1) assert copyright on the software, and (2) offer you this License
|
||||
giving you legal permission to copy, distribute and/or modify it.
|
||||
|
||||
For the developers' and authors' protection, the GPL clearly explains
|
||||
that there is no warranty for this free software. For both users' and
|
||||
authors' sake, the GPL requires that modified versions be marked as
|
||||
changed, so that their problems will not be attributed erroneously to
|
||||
authors of previous versions.
|
||||
|
||||
Some devices are designed to deny users access to install or run
|
||||
modified versions of the software inside them, although the manufacturer
|
||||
can do so. This is fundamentally incompatible with the aim of
|
||||
protecting users' freedom to change the software. The systematic
|
||||
pattern of such abuse occurs in the area of products for individuals to
|
||||
use, which is precisely where it is most unacceptable. Therefore, we
|
||||
have designed this version of the GPL to prohibit the practice for those
|
||||
products. If such problems arise substantially in other domains, we
|
||||
stand ready to extend this provision to those domains in future versions
|
||||
of the GPL, as needed to protect the freedom of users.
|
||||
|
||||
Finally, every program is threatened constantly by software patents.
|
||||
States should not allow patents to restrict development and use of
|
||||
software on general-purpose computers, but in those that do, we wish to
|
||||
avoid the special danger that patents applied to a free program could
|
||||
make it effectively proprietary. To prevent this, the GPL assures that
|
||||
patents cannot be used to render the program non-free.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
TERMS AND CONDITIONS
|
||||
|
||||
0. Definitions.
|
||||
|
||||
"This License" refers to version 3 of the GNU General Public License.
|
||||
|
||||
"Copyright" also means copyright-like laws that apply to other kinds of
|
||||
works, such as semiconductor masks.
|
||||
|
||||
"The Program" refers to any copyrightable work licensed under this
|
||||
License. Each licensee is addressed as "you". "Licensees" and
|
||||
"recipients" may be individuals or organizations.
|
||||
|
||||
To "modify" a work means to copy from or adapt all or part of the work
|
||||
in a fashion requiring copyright permission, other than the making of an
|
||||
exact copy. The resulting work is called a "modified version" of the
|
||||
earlier work or a work "based on" the earlier work.
|
||||
|
||||
A "covered work" means either the unmodified Program or a work based
|
||||
on the Program.
|
||||
|
||||
To "propagate" a work means to do anything with it that, without
|
||||
permission, would make you directly or secondarily liable for
|
||||
infringement under applicable copyright law, except executing it on a
|
||||
computer or modifying a private copy. Propagation includes copying,
|
||||
distribution (with or without modification), making available to the
|
||||
public, and in some countries other activities as well.
|
||||
|
||||
To "convey" a work means any kind of propagation that enables other
|
||||
parties to make or receive copies. Mere interaction with a user through
|
||||
a computer network, with no transfer of a copy, is not conveying.
|
||||
|
||||
An interactive user interface displays "Appropriate Legal Notices"
|
||||
to the extent that it includes a convenient and prominently visible
|
||||
feature that (1) displays an appropriate copyright notice, and (2)
|
||||
tells the user that there is no warranty for the work (except to the
|
||||
extent that warranties are provided), that licensees may convey the
|
||||
work under this License, and how to view a copy of this License. If
|
||||
the interface presents a list of user commands or options, such as a
|
||||
menu, a prominent item in the list meets this criterion.
|
||||
|
||||
1. Source Code.
|
||||
|
||||
The "source code" for a work means the preferred form of the work
|
||||
for making modifications to it. "Object code" means any non-source
|
||||
form of a work.
|
||||
|
||||
A "Standard Interface" means an interface that either is an official
|
||||
standard defined by a recognized standards body, or, in the case of
|
||||
interfaces specified for a particular programming language, one that
|
||||
is widely used among developers working in that language.
|
||||
|
||||
The "System Libraries" of an executable work include anything, other
|
||||
than the work as a whole, that (a) is included in the normal form of
|
||||
packaging a Major Component, but which is not part of that Major
|
||||
Component, and (b) serves only to enable use of the work with that
|
||||
Major Component, or to implement a Standard Interface for which an
|
||||
implementation is available to the public in source code form. A
|
||||
"Major Component", in this context, means a major essential component
|
||||
(kernel, window system, and so on) of the specific operating system
|
||||
(if any) on which the executable work runs, or a compiler used to
|
||||
produce the work, or an object code interpreter used to run it.
|
||||
|
||||
The "Corresponding Source" for a work in object code form means all
|
||||
the source code needed to generate, install, and (for an executable
|
||||
work) run the object code and to modify the work, including scripts to
|
||||
control those activities. However, it does not include the work's
|
||||
System Libraries, or general-purpose tools or generally available free
|
||||
programs which are used unmodified in performing those activities but
|
||||
which are not part of the work. For example, Corresponding Source
|
||||
includes interface definition files associated with source files for
|
||||
the work, and the source code for shared libraries and dynamically
|
||||
linked subprograms that the work is specifically designed to require,
|
||||
such as by intimate data communication or control flow between those
|
||||
subprograms and other parts of the work.
|
||||
|
||||
The Corresponding Source need not include anything that users
|
||||
can regenerate automatically from other parts of the Corresponding
|
||||
Source.
|
||||
|
||||
The Corresponding Source for a work in source code form is that
|
||||
same work.
|
||||
|
||||
2. Basic Permissions.
|
||||
|
||||
All rights granted under this License are granted for the term of
|
||||
copyright on the Program, and are irrevocable provided the stated
|
||||
conditions are met. This License explicitly affirms your unlimited
|
||||
permission to run the unmodified Program. The output from running a
|
||||
covered work is covered by this License only if the output, given its
|
||||
content, constitutes a covered work. This License acknowledges your
|
||||
rights of fair use or other equivalent, as provided by copyright law.
|
||||
|
||||
You may make, run and propagate covered works that you do not
|
||||
convey, without conditions so long as your license otherwise remains
|
||||
in force. You may convey covered works to others for the sole purpose
|
||||
of having them make modifications exclusively for you, or provide you
|
||||
with facilities for running those works, provided that you comply with
|
||||
the terms of this License in conveying all material for which you do
|
||||
not control copyright. Those thus making or running the covered works
|
||||
for you must do so exclusively on your behalf, under your direction
|
||||
and control, on terms that prohibit them from making any copies of
|
||||
your copyrighted material outside their relationship with you.
|
||||
|
||||
Conveying under any other circumstances is permitted solely under
|
||||
the conditions stated below. Sublicensing is not allowed; section 10
|
||||
makes it unnecessary.
|
||||
|
||||
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
|
||||
|
||||
No covered work shall be deemed part of an effective technological
|
||||
measure under any applicable law fulfilling obligations under article
|
||||
11 of the WIPO copyright treaty adopted on 20 December 1996, or
|
||||
similar laws prohibiting or restricting circumvention of such
|
||||
measures.
|
||||
|
||||
When you convey a covered work, you waive any legal power to forbid
|
||||
circumvention of technological measures to the extent such circumvention
|
||||
is effected by exercising rights under this License with respect to
|
||||
the covered work, and you disclaim any intention to limit operation or
|
||||
modification of the work as a means of enforcing, against the work's
|
||||
users, your or third parties' legal rights to forbid circumvention of
|
||||
technological measures.
|
||||
|
||||
4. Conveying Verbatim Copies.
|
||||
|
||||
You may convey verbatim copies of the Program's source code as you
|
||||
receive it, in any medium, provided that you conspicuously and
|
||||
appropriately publish on each copy an appropriate copyright notice;
|
||||
keep intact all notices stating that this License and any
|
||||
non-permissive terms added in accord with section 7 apply to the code;
|
||||
keep intact all notices of the absence of any warranty; and give all
|
||||
recipients a copy of this License along with the Program.
|
||||
|
||||
You may charge any price or no price for each copy that you convey,
|
||||
and you may offer support or warranty protection for a fee.
|
||||
|
||||
5. Conveying Modified Source Versions.
|
||||
|
||||
You may convey a work based on the Program, or the modifications to
|
||||
produce it from the Program, in the form of source code under the
|
||||
terms of section 4, provided that you also meet all of these conditions:
|
||||
|
||||
a) The work must carry prominent notices stating that you modified
|
||||
it, and giving a relevant date.
|
||||
|
||||
b) The work must carry prominent notices stating that it is
|
||||
released under this License and any conditions added under section
|
||||
7. This requirement modifies the requirement in section 4 to
|
||||
"keep intact all notices".
|
||||
|
||||
c) You must license the entire work, as a whole, under this
|
||||
License to anyone who comes into possession of a copy. This
|
||||
License will therefore apply, along with any applicable section 7
|
||||
additional terms, to the whole of the work, and all its parts,
|
||||
regardless of how they are packaged. This License gives no
|
||||
permission to license the work in any other way, but it does not
|
||||
invalidate such permission if you have separately received it.
|
||||
|
||||
d) If the work has interactive user interfaces, each must display
|
||||
Appropriate Legal Notices; however, if the Program has interactive
|
||||
interfaces that do not display Appropriate Legal Notices, your
|
||||
work need not make them do so.
|
||||
|
||||
A compilation of a covered work with other separate and independent
|
||||
works, which are not by their nature extensions of the covered work,
|
||||
and which are not combined with it such as to form a larger program,
|
||||
in or on a volume of a storage or distribution medium, is called an
|
||||
"aggregate" if the compilation and its resulting copyright are not
|
||||
used to limit the access or legal rights of the compilation's users
|
||||
beyond what the individual works permit. Inclusion of a covered work
|
||||
in an aggregate does not cause this License to apply to the other
|
||||
parts of the aggregate.
|
||||
|
||||
6. Conveying Non-Source Forms.
|
||||
|
||||
You may convey a covered work in object code form under the terms
|
||||
of sections 4 and 5, provided that you also convey the
|
||||
machine-readable Corresponding Source under the terms of this License,
|
||||
in one of these ways:
|
||||
|
||||
a) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by the
|
||||
Corresponding Source fixed on a durable physical medium
|
||||
customarily used for software interchange.
|
||||
|
||||
b) Convey the object code in, or embodied in, a physical product
|
||||
(including a physical distribution medium), accompanied by a
|
||||
written offer, valid for at least three years and valid for as
|
||||
long as you offer spare parts or customer support for that product
|
||||
model, to give anyone who possesses the object code either (1) a
|
||||
copy of the Corresponding Source for all the software in the
|
||||
product that is covered by this License, on a durable physical
|
||||
medium customarily used for software interchange, for a price no
|
||||
more than your reasonable cost of physically performing this
|
||||
conveying of source, or (2) access to copy the
|
||||
Corresponding Source from a network server at no charge.
|
||||
|
||||
c) Convey individual copies of the object code with a copy of the
|
||||
written offer to provide the Corresponding Source. This
|
||||
alternative is allowed only occasionally and noncommercially, and
|
||||
only if you received the object code with such an offer, in accord
|
||||
with subsection 6b.
|
||||
|
||||
d) Convey the object code by offering access from a designated
|
||||
place (gratis or for a charge), and offer equivalent access to the
|
||||
Corresponding Source in the same way through the same place at no
|
||||
further charge. You need not require recipients to copy the
|
||||
Corresponding Source along with the object code. If the place to
|
||||
copy the object code is a network server, the Corresponding Source
|
||||
may be on a different server (operated by you or a third party)
|
||||
that supports equivalent copying facilities, provided you maintain
|
||||
clear directions next to the object code saying where to find the
|
||||
Corresponding Source. Regardless of what server hosts the
|
||||
Corresponding Source, you remain obligated to ensure that it is
|
||||
available for as long as needed to satisfy these requirements.
|
||||
|
||||
e) Convey the object code using peer-to-peer transmission, provided
|
||||
you inform other peers where the object code and Corresponding
|
||||
Source of the work are being offered to the general public at no
|
||||
charge under subsection 6d.
|
||||
|
||||
A separable portion of the object code, whose source code is excluded
|
||||
from the Corresponding Source as a System Library, need not be
|
||||
included in conveying the object code work.
|
||||
|
||||
A "User Product" is either (1) a "consumer product", which means any
|
||||
tangible personal property which is normally used for personal, family,
|
||||
or household purposes, or (2) anything designed or sold for incorporation
|
||||
into a dwelling. In determining whether a product is a consumer product,
|
||||
doubtful cases shall be resolved in favor of coverage. For a particular
|
||||
product received by a particular user, "normally used" refers to a
|
||||
typical or common use of that class of product, regardless of the status
|
||||
of the particular user or of the way in which the particular user
|
||||
actually uses, or expects or is expected to use, the product. A product
|
||||
is a consumer product regardless of whether the product has substantial
|
||||
commercial, industrial or non-consumer uses, unless such uses represent
|
||||
the only significant mode of use of the product.
|
||||
|
||||
"Installation Information" for a User Product means any methods,
|
||||
procedures, authorization keys, or other information required to install
|
||||
and execute modified versions of a covered work in that User Product from
|
||||
a modified version of its Corresponding Source. The information must
|
||||
suffice to ensure that the continued functioning of the modified object
|
||||
code is in no case prevented or interfered with solely because
|
||||
modification has been made.
|
||||
|
||||
If you convey an object code work under this section in, or with, or
|
||||
specifically for use in, a User Product, and the conveying occurs as
|
||||
part of a transaction in which the right of possession and use of the
|
||||
User Product is transferred to the recipient in perpetuity or for a
|
||||
fixed term (regardless of how the transaction is characterized), the
|
||||
Corresponding Source conveyed under this section must be accompanied
|
||||
by the Installation Information. But this requirement does not apply
|
||||
if neither you nor any third party retains the ability to install
|
||||
modified object code on the User Product (for example, the work has
|
||||
been installed in ROM).
|
||||
|
||||
The requirement to provide Installation Information does not include a
|
||||
requirement to continue to provide support service, warranty, or updates
|
||||
for a work that has been modified or installed by the recipient, or for
|
||||
the User Product in which it has been modified or installed. Access to a
|
||||
network may be denied when the modification itself materially and
|
||||
adversely affects the operation of the network or violates the rules and
|
||||
protocols for communication across the network.
|
||||
|
||||
Corresponding Source conveyed, and Installation Information provided,
|
||||
in accord with this section must be in a format that is publicly
|
||||
documented (and with an implementation available to the public in
|
||||
source code form), and must require no special password or key for
|
||||
unpacking, reading or copying.
|
||||
|
||||
7. Additional Terms.
|
||||
|
||||
"Additional permissions" are terms that supplement the terms of this
|
||||
License by making exceptions from one or more of its conditions.
|
||||
Additional permissions that are applicable to the entire Program shall
|
||||
be treated as though they were included in this License, to the extent
|
||||
that they are valid under applicable law. If additional permissions
|
||||
apply only to part of the Program, that part may be used separately
|
||||
under those permissions, but the entire Program remains governed by
|
||||
this License without regard to the additional permissions.
|
||||
|
||||
When you convey a copy of a covered work, you may at your option
|
||||
remove any additional permissions from that copy, or from any part of
|
||||
it. (Additional permissions may be written to require their own
|
||||
removal in certain cases when you modify the work.) You may place
|
||||
additional permissions on material, added by you to a covered work,
|
||||
for which you have or can give appropriate copyright permission.
|
||||
|
||||
Notwithstanding any other provision of this License, for material you
|
||||
add to a covered work, you may (if authorized by the copyright holders of
|
||||
that material) supplement the terms of this License with terms:
|
||||
|
||||
a) Disclaiming warranty or limiting liability differently from the
|
||||
terms of sections 15 and 16 of this License; or
|
||||
|
||||
b) Requiring preservation of specified reasonable legal notices or
|
||||
author attributions in that material or in the Appropriate Legal
|
||||
Notices displayed by works containing it; or
|
||||
|
||||
c) Prohibiting misrepresentation of the origin of that material, or
|
||||
requiring that modified versions of such material be marked in
|
||||
reasonable ways as different from the original version; or
|
||||
|
||||
d) Limiting the use for publicity purposes of names of licensors or
|
||||
authors of the material; or
|
||||
|
||||
e) Declining to grant rights under trademark law for use of some
|
||||
trade names, trademarks, or service marks; or
|
||||
|
||||
f) Requiring indemnification of licensors and authors of that
|
||||
material by anyone who conveys the material (or modified versions of
|
||||
it) with contractual assumptions of liability to the recipient, for
|
||||
any liability that these contractual assumptions directly impose on
|
||||
those licensors and authors.
|
||||
|
||||
All other non-permissive additional terms are considered "further
|
||||
restrictions" within the meaning of section 10. If the Program as you
|
||||
received it, or any part of it, contains a notice stating that it is
|
||||
governed by this License along with a term that is a further
|
||||
restriction, you may remove that term. If a license document contains
|
||||
a further restriction but permits relicensing or conveying under this
|
||||
License, you may add to a covered work material governed by the terms
|
||||
of that license document, provided that the further restriction does
|
||||
not survive such relicensing or conveying.
|
||||
|
||||
If you add terms to a covered work in accord with this section, you
|
||||
must place, in the relevant source files, a statement of the
|
||||
additional terms that apply to those files, or a notice indicating
|
||||
where to find the applicable terms.
|
||||
|
||||
Additional terms, permissive or non-permissive, may be stated in the
|
||||
form of a separately written license, or stated as exceptions;
|
||||
the above requirements apply either way.
|
||||
|
||||
8. Termination.
|
||||
|
||||
You may not propagate or modify a covered work except as expressly
|
||||
provided under this License. Any attempt otherwise to propagate or
|
||||
modify it is void, and will automatically terminate your rights under
|
||||
this License (including any patent licenses granted under the third
|
||||
paragraph of section 11).
|
||||
|
||||
However, if you cease all violation of this License, then your
|
||||
license from a particular copyright holder is reinstated (a)
|
||||
provisionally, unless and until the copyright holder explicitly and
|
||||
finally terminates your license, and (b) permanently, if the copyright
|
||||
holder fails to notify you of the violation by some reasonable means
|
||||
prior to 60 days after the cessation.
|
||||
|
||||
Moreover, your license from a particular copyright holder is
|
||||
reinstated permanently if the copyright holder notifies you of the
|
||||
violation by some reasonable means, this is the first time you have
|
||||
received notice of violation of this License (for any work) from that
|
||||
copyright holder, and you cure the violation prior to 30 days after
|
||||
your receipt of the notice.
|
||||
|
||||
Termination of your rights under this section does not terminate the
|
||||
licenses of parties who have received copies or rights from you under
|
||||
this License. If your rights have been terminated and not permanently
|
||||
reinstated, you do not qualify to receive new licenses for the same
|
||||
material under section 10.
|
||||
|
||||
9. Acceptance Not Required for Having Copies.
|
||||
|
||||
You are not required to accept this License in order to receive or
|
||||
run a copy of the Program. Ancillary propagation of a covered work
|
||||
occurring solely as a consequence of using peer-to-peer transmission
|
||||
to receive a copy likewise does not require acceptance. However,
|
||||
nothing other than this License grants you permission to propagate or
|
||||
modify any covered work. These actions infringe copyright if you do
|
||||
not accept this License. Therefore, by modifying or propagating a
|
||||
covered work, you indicate your acceptance of this License to do so.
|
||||
|
||||
10. Automatic Licensing of Downstream Recipients.
|
||||
|
||||
Each time you convey a covered work, the recipient automatically
|
||||
receives a license from the original licensors, to run, modify and
|
||||
propagate that work, subject to this License. You are not responsible
|
||||
for enforcing compliance by third parties with this License.
|
||||
|
||||
An "entity transaction" is a transaction transferring control of an
|
||||
organization, or substantially all assets of one, or subdividing an
|
||||
organization, or merging organizations. If propagation of a covered
|
||||
work results from an entity transaction, each party to that
|
||||
transaction who receives a copy of the work also receives whatever
|
||||
licenses to the work the party's predecessor in interest had or could
|
||||
give under the previous paragraph, plus a right to possession of the
|
||||
Corresponding Source of the work from the predecessor in interest, if
|
||||
the predecessor has it or can get it with reasonable efforts.
|
||||
|
||||
You may not impose any further restrictions on the exercise of the
|
||||
rights granted or affirmed under this License. For example, you may
|
||||
not impose a license fee, royalty, or other charge for exercise of
|
||||
rights granted under this License, and you may not initiate litigation
|
||||
(including a cross-claim or counterclaim in a lawsuit) alleging that
|
||||
any patent claim is infringed by making, using, selling, offering for
|
||||
sale, or importing the Program or any portion of it.
|
||||
|
||||
11. Patents.
|
||||
|
||||
A "contributor" is a copyright holder who authorizes use under this
|
||||
License of the Program or a work on which the Program is based. The
|
||||
work thus licensed is called the contributor's "contributor version".
|
||||
|
||||
A contributor's "essential patent claims" are all patent claims
|
||||
owned or controlled by the contributor, whether already acquired or
|
||||
hereafter acquired, that would be infringed by some manner, permitted
|
||||
by this License, of making, using, or selling its contributor version,
|
||||
but do not include claims that would be infringed only as a
|
||||
consequence of further modification of the contributor version. For
|
||||
purposes of this definition, "control" includes the right to grant
|
||||
patent sublicenses in a manner consistent with the requirements of
|
||||
this License.
|
||||
|
||||
Each contributor grants you a non-exclusive, worldwide, royalty-free
|
||||
patent license under the contributor's essential patent claims, to
|
||||
make, use, sell, offer for sale, import and otherwise run, modify and
|
||||
propagate the contents of its contributor version.
|
||||
|
||||
In the following three paragraphs, a "patent license" is any express
|
||||
agreement or commitment, however denominated, not to enforce a patent
|
||||
(such as an express permission to practice a patent or covenant not to
|
||||
sue for patent infringement). To "grant" such a patent license to a
|
||||
party means to make such an agreement or commitment not to enforce a
|
||||
patent against the party.
|
||||
|
||||
If you convey a covered work, knowingly relying on a patent license,
|
||||
and the Corresponding Source of the work is not available for anyone
|
||||
to copy, free of charge and under the terms of this License, through a
|
||||
publicly available network server or other readily accessible means,
|
||||
then you must either (1) cause the Corresponding Source to be so
|
||||
available, or (2) arrange to deprive yourself of the benefit of the
|
||||
patent license for this particular work, or (3) arrange, in a manner
|
||||
consistent with the requirements of this License, to extend the patent
|
||||
license to downstream recipients. "Knowingly relying" means you have
|
||||
actual knowledge that, but for the patent license, your conveying the
|
||||
covered work in a country, or your recipient's use of the covered work
|
||||
in a country, would infringe one or more identifiable patents in that
|
||||
country that you have reason to believe are valid.
|
||||
|
||||
If, pursuant to or in connection with a single transaction or
|
||||
arrangement, you convey, or propagate by procuring conveyance of, a
|
||||
covered work, and grant a patent license to some of the parties
|
||||
receiving the covered work authorizing them to use, propagate, modify
|
||||
or convey a specific copy of the covered work, then the patent license
|
||||
you grant is automatically extended to all recipients of the covered
|
||||
work and works based on it.
|
||||
|
||||
A patent license is "discriminatory" if it does not include within
|
||||
the scope of its coverage, prohibits the exercise of, or is
|
||||
conditioned on the non-exercise of one or more of the rights that are
|
||||
specifically granted under this License. You may not convey a covered
|
||||
work if you are a party to an arrangement with a third party that is
|
||||
in the business of distributing software, under which you make payment
|
||||
to the third party based on the extent of your activity of conveying
|
||||
the work, and under which the third party grants, to any of the
|
||||
parties who would receive the covered work from you, a discriminatory
|
||||
patent license (a) in connection with copies of the covered work
|
||||
conveyed by you (or copies made from those copies), or (b) primarily
|
||||
for and in connection with specific products or compilations that
|
||||
contain the covered work, unless you entered into that arrangement,
|
||||
or that patent license was granted, prior to 28 March 2007.
|
||||
|
||||
Nothing in this License shall be construed as excluding or limiting
|
||||
any implied license or other defenses to infringement that may
|
||||
otherwise be available to you under applicable patent law.
|
||||
|
||||
12. No Surrender of Others' Freedom.
|
||||
|
||||
If conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot convey a
|
||||
covered work so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you may
|
||||
not convey it at all. For example, if you agree to terms that obligate you
|
||||
to collect a royalty for further conveying from those to whom you convey
|
||||
the Program, the only way you could satisfy both those terms and this
|
||||
License would be to refrain entirely from conveying the Program.
|
||||
|
||||
13. Use with the GNU Affero General Public License.
|
||||
|
||||
Notwithstanding any other provision of this License, you have
|
||||
permission to link or combine any covered work with a work licensed
|
||||
under version 3 of the GNU Affero General Public License into a single
|
||||
combined work, and to convey the resulting work. The terms of this
|
||||
License will continue to apply to the part which is the covered work,
|
||||
but the special requirements of the GNU Affero General Public License,
|
||||
section 13, concerning interaction through a network will apply to the
|
||||
combination as such.
|
||||
|
||||
14. Revised Versions of this License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions of
|
||||
the GNU General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Program specifies that a certain numbered version of the GNU General
|
||||
Public License "or any later version" applies to it, you have the
|
||||
option of following the terms and conditions either of that numbered
|
||||
version or of any later version published by the Free Software
|
||||
Foundation. If the Program does not specify a version number of the
|
||||
GNU General Public License, you may choose any version ever published
|
||||
by the Free Software Foundation.
|
||||
|
||||
If the Program specifies that a proxy can decide which future
|
||||
versions of the GNU General Public License can be used, that proxy's
|
||||
public statement of acceptance of a version permanently authorizes you
|
||||
to choose that version for the Program.
|
||||
|
||||
Later license versions may give you additional or different
|
||||
permissions. However, no additional obligations are imposed on any
|
||||
author or copyright holder as a result of your choosing to follow a
|
||||
later version.
|
||||
|
||||
15. Disclaimer of Warranty.
|
||||
|
||||
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
|
||||
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
|
||||
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
|
||||
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
|
||||
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
|
||||
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||
|
||||
16. Limitation of Liability.
|
||||
|
||||
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
|
||||
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
|
||||
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
|
||||
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
|
||||
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
|
||||
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
|
||||
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGES.
|
||||
|
||||
17. Interpretation of Sections 15 and 16.
|
||||
|
||||
If the disclaimer of warranty and limitation of liability provided
|
||||
above cannot be given local legal effect according to their terms,
|
||||
reviewing courts shall apply local law that most closely approximates
|
||||
an absolute waiver of all civil liability in connection with the
|
||||
Program, unless a warranty or assumption of liability accompanies a
|
||||
copy of the Program in return for a fee.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
state the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program does terminal interaction, make it output a short
|
||||
notice like this when it starts in an interactive mode:
|
||||
|
||||
<program> Copyright (C) <year> <name of author>
|
||||
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, your program's commands
|
||||
might be different; for a GUI interface, you would use an "about box".
|
||||
|
||||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<http://www.gnu.org/licenses/>.
|
||||
|
||||
The GNU General Public License does not permit incorporating your program
|
||||
into proprietary programs. If your program is a subroutine library, you
|
||||
may consider it more useful to permit linking proprietary applications with
|
||||
the library. If this is what you want to do, use the GNU Lesser General
|
||||
Public License instead of this License. But first, please read
|
||||
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
@ -1,36 +0,0 @@
|
||||
EMACS ?= emacs
|
||||
CASK ?= cask
|
||||
|
||||
.PHONY: test test-deferred test-concurrent compile clean print-deps travis-ci
|
||||
|
||||
test: test-deferred test-deferred-compiled test-concurrent
|
||||
# test-concurrent-compiled
|
||||
|
||||
test-deferred:
|
||||
$(CASK) exec ert-runner test/deferred-test.el
|
||||
|
||||
test-deferred-compiled: deferred.elc
|
||||
$(CASK) exec ert-runner test/deferred-test.el -l deferred.elc
|
||||
|
||||
test-concurrent:
|
||||
$(CASK) exec ert-runner test/concurrent-test.el
|
||||
|
||||
test-concurrent-compiled: concurrent.elc
|
||||
$(CASK) exec ert-runner test/concurrent-test.el -l concurrent.elc
|
||||
|
||||
compile: deferred.elc concurrent.elc
|
||||
|
||||
%.elc: %.el
|
||||
$(EMACS) -batch -L . -f batch-byte-compile $<
|
||||
|
||||
clean:
|
||||
rm -rfv *.elc
|
||||
|
||||
print-deps:
|
||||
@echo "----------------------- Dependencies -----------------------"
|
||||
$(EMACS) --version
|
||||
@echo "------------------------------------------------------------"
|
||||
|
||||
travis-ci: print-deps
|
||||
$(MAKE) clean test
|
||||
$(MAKE) compile test
|
||||
@ -1,415 +0,0 @@
|
||||
# concurrent.el #
|
||||
|
||||
[](https://travis-ci.org/kiwanami/emacs-deferred)
|
||||
[](https://coveralls.io/r/kiwanami/emacs-deferred)
|
||||
[](http://melpa.org/#/concurrent)
|
||||
[](http://stable.melpa.org/#/concurrent)
|
||||
[](https://github.com/kiwanami/emacs-deferred/tags)
|
||||
[](http://www.gnu.org/licenses/gpl-3.0.html)
|
||||
|
||||
concurrent.elは、良くある非同期処理を抽象化したライブラリです。スレッド、セマフォ、イベント管理などがあります。他の環境のライブラリや並行プログラミングのアイデアを参考にしました。
|
||||
|
||||
## インストール ##
|
||||
|
||||
concurrent.elは package.elを使って, [MELPA](http://melpa.org)からインストールすることができます.
|
||||
|
||||
## 使い方例 ##
|
||||
|
||||
以下のサンプルで例示したソースは concurrent-samples.el の中にあります。
|
||||
eval-last-sexp (C-x C-e) などで実行してみてください。
|
||||
|
||||
### Threadの例
|
||||
|
||||
letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。
|
||||
|
||||
Thread:
|
||||
|
||||
```el
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point)))
|
||||
(cc:thread
|
||||
60
|
||||
(message "Animation started.")
|
||||
(while (> end (cl-incf count))
|
||||
(save-excursion
|
||||
(when (< 1 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm)))))))
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))
|
||||
```
|
||||
|
||||
whileを使うことでスレッドをループさせることが出来ます。whileの中身は一気に実行されます。
|
||||
|
||||
無限ループや重い処理でEmacsが固まらないように注意してください。もし無限ループに突入してしまったり、固まってしまったら deferred:clear-queue コマンドで回復できる可能性があります。
|
||||
|
||||
|
||||
### Generatorの例
|
||||
|
||||
fib-genにジェネレーターを作ります。ジェネレーター生成body内のyield関数で値を返します。値はコールバックで値を受け取ります。
|
||||
|
||||
Generator:
|
||||
|
||||
```el
|
||||
(setq fib-list nil)
|
||||
(setq fib-gen
|
||||
(let ((a1 0) (a2 1))
|
||||
(cc:generator
|
||||
(lambda (x) (push x fib-list)) ; コールバックで結果受け取り
|
||||
(yield a1)
|
||||
(yield a2)
|
||||
(while t
|
||||
(let ((next (+ a1 a2)))
|
||||
(setq a1 a2
|
||||
a2 next)
|
||||
(yield next))))))
|
||||
|
||||
(funcall fib-gen) ; 何度か呼んでみる
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
|
||||
fib-list ; => (3 2 1 1 0)
|
||||
```
|
||||
|
||||
### Semaphoreの例
|
||||
|
||||
cc:semaphore-acquire 関数が deferred を返すので、それに続けて実行させたいタスクをつなげていきます。時系列で挙動が変わっていくのでコード中に簡単な説明を書いてみました。
|
||||
|
||||
Semaphore:
|
||||
|
||||
```el
|
||||
;; permit=1のセマフォ作成
|
||||
(setq smp (cc:semaphore-create 1))
|
||||
|
||||
;; 続けて3つ実行しようとする
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go1")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go2")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go3")))
|
||||
|
||||
;; => 1つ目だけ実行されて go1 が表示される
|
||||
|
||||
(cc:semaphore-release smp) ; permitを返す
|
||||
|
||||
;; => 2つ目が実行されて go2 が表示される
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; go3 を表示するdeferred
|
||||
|
||||
(cc:semaphore-release-all smp) ; => permitを初期化して go3 を表示するdeferredを返す
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; => nil
|
||||
```
|
||||
|
||||
### Dataflowの例：
|
||||
|
||||
cc:dataflow-environment 関数で変数を格納する「環境」を作ります。 cc:dataflow-get は値の取得とそれに続くタスクをつなげる deferred を返します。 cc:dataflow-set で値をバインドします。例ではキーに文字列を使っていますが、キーには任意のオブジェクトを指定できます。
|
||||
|
||||
Dataflow:
|
||||
|
||||
```el
|
||||
(setq dfenv (cc:dataflow-environment))
|
||||
|
||||
;; ○基本の使い方
|
||||
|
||||
;; ↓同期的に値を取得。ブロックしない。
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => nil まだ値が無い。
|
||||
|
||||
(deferred:$ ; abc という値を取ってきて表示する処理
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Got abc : %s" x))))
|
||||
;; => 値がないので処理はブロックしたまま
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 256) ; 値をセット
|
||||
;; => ここで先ほどブロックしていた処理が再開し、 "Got abc : 256" が表示される
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => 256
|
||||
|
||||
(cc:dataflow-clear dfenv "abc") ; 値を未バインドに戻す
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => nil
|
||||
|
||||
;; ○リストをキーにする
|
||||
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "a.jpg:300 OK %s" x))))
|
||||
|
||||
(cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)
|
||||
|
||||
;; => a.jpg:300 OK jpeg
|
||||
|
||||
;; ○2つの値を待ち受ける
|
||||
|
||||
(deferred:$ ; abc, def の2つの値を使う
|
||||
(deferred:parallel
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(cc:dataflow-get dfenv "def"))
|
||||
(deferred:nextc it
|
||||
(lambda (values)
|
||||
(apply 'message "Got values : %s, %s" values)
|
||||
(apply '+ values)))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert (format ">> %s" x)))))
|
||||
;; => もちろんブロックする
|
||||
|
||||
(cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc")
|
||||
(cc:dataflow-get-avalable-pairs dfenv) ; => ((("http://example.com/a.jpg" 300) . jpeg))
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 128) ; ここではまだブロックしたまま
|
||||
(cc:dataflow-set dfenv "def" 256) ; ここでやっと動く
|
||||
;; => Got values : 128, 256
|
||||
```
|
||||
|
||||
### Signalの例：
|
||||
|
||||
cc:signal-channel でシグナルを流すチャンネルを作成します。その後、signalに応答する処理を接続していきます。
|
||||
|
||||
```el
|
||||
;; シグナルのチャンネルを作成
|
||||
(setq channel (cc:signal-channel))
|
||||
|
||||
(cc:signal-connect ; foo というシグナルを拾う
|
||||
channel 'foo
|
||||
(lambda (event) (message "Signal : %S" event)))
|
||||
|
||||
(cc:signal-connect
|
||||
channel t ; t にするとすべてのシグナルを拾う
|
||||
(lambda (event)
|
||||
(cl-destructuring-bind (event-name (args)) event
|
||||
(message "Listener : %S / %S" event-name args))))
|
||||
|
||||
(deferred:$ ; deferred で非同期タスクを接続できる
|
||||
(cc:signal-connect channel 'foo)
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Deferred Signal : %S" x))))
|
||||
|
||||
(cc:signal-send channel 'foo "hello signal!")
|
||||
;; =>
|
||||
;; Listener : foo / "hello signal!"
|
||||
;; Signal : (foo ("hello signal!"))
|
||||
;; Deferred Signal : (foo ("hello signal!"))
|
||||
|
||||
(cc:signal-send channel 'some "some signal!")
|
||||
;; =>
|
||||
;; Listener : some / "some signal!"
|
||||
```
|
||||
|
||||
dataflowの内部には、変数へのアクセスやバインドのシグナルを発信するchannelがあります。これを使って、未バインドの変数に値を作成してセットするようなことが出来ます。
|
||||
|
||||
signalやdataflowは、カスケード接続して親子関係を構築できます。例えば、親dataflowにデフォルト値（フォールバックの値）を入れておくとか、channelで親子関係を構築してローカルなイベントとグローバルなイベントを分けて効率的にイベントを管理するなどが出来ます。
|
||||
|
||||
## インタフェース解説 ##
|
||||
|
||||
### Thread
|
||||
|
||||
* cc:thread (wait-time-msec &rest body)
|
||||
* 引数：
|
||||
* wait-time-msec: タスク間の間隔（ミリ秒）
|
||||
* 返値：Threadオブジェクト（今のところ使い道無し）
|
||||
* スレッドを作成して開始します
|
||||
* bodyのS式が一つずつ非同期で実行されます。その間隔が wait-time-msec で指定された時間です。
|
||||
* bodyの中に while があった場合は、特別にループとして処理します。
|
||||
* 無限ループや重い処理でEmacsが固まらないように注意してください。もし無限ループに突入してしまったり、固まってしまったら deferred:clear-queue コマンドで回復できる可能性があります。
|
||||
|
||||
### Generator
|
||||
|
||||
* cc:generator (callback &rest body)
|
||||
* 引数：
|
||||
* callback: yieldした値を受け取る関数
|
||||
* body: Generatorの中身
|
||||
* 返値：Generatorを実行する関数
|
||||
* Threadと同様に、bodyのS式が一つずつ非同期で実行されます。
|
||||
* bodyの中に while があった場合は、特別にループとして処理します。
|
||||
* bodyの内で yield 関数を使う（実際にはマクロで置換されます）と、callbackで指定した関数に値が渡って処理が停止します。
|
||||
* 再度 Generator 関数を実行すると停止した位置から開始します。
|
||||
|
||||
### Semaphore
|
||||
|
||||
* cc:semaphore-create (permits-num)
|
||||
* 引数：
|
||||
* permits-num: 許可数
|
||||
* 返値：Semaphoreオブジェクト
|
||||
* セマフォオブジェクトを作成します。
|
||||
|
||||
* cc:semaphore-acquire (semaphore)
|
||||
* 引数：
|
||||
* semaphore: Semaphoreオブジェクト
|
||||
* 返値：Deferredオブジェクト
|
||||
* 返したDeferredオブジェクトに、実行数を制限したいタスクをつなげます。
|
||||
* 実行する際、許可数を1つ消費します。許可数が0になったら、以降のタスクは待たされます。
|
||||
* 実行可能なら、返したDeferredタスクがすぐに実行されます。
|
||||
* 実行可能でなければ、許可数が戻るまで返したDeferredタスクは待たされます。
|
||||
|
||||
* cc:semaphore-release (semaphore)
|
||||
* 引数：
|
||||
* semaphore: Semaphoreオブジェクト
|
||||
* 返値：Semaphoreオブジェクト
|
||||
* 許可数を一つ戻します。その際、待っているタスクがあれば実行されます。
|
||||
* 許可数は自動では戻りませんので、 cc:semaphore-release を呼ぶのはプログラマの責任です。
|
||||
|
||||
* cc:semaphore-with (semaphore body-func &optional error-func)
|
||||
* 引数：
|
||||
* semaphore: Semaphoreオブジェクト
|
||||
* body-func: 実行数を制御したいタスクの関数
|
||||
* error-func: 発生したエラーを処理する関数（deferred:errorで接続される）
|
||||
* 返値：Deferredオブジェクト
|
||||
* acquireとreleaseを前後で行う関数です。特に理由がない限りは、acquireとreleaseを自分で書くよりも、こちらを使う方が安全で楽です。
|
||||
|
||||
|
||||
* cc:semaphore-release-all (semaphore)
|
||||
* 引数：
|
||||
* semaphore: Semaphoreオブジェクト
|
||||
* 返値：実行待ちだったDeferredオブジェクト
|
||||
* 許可数を強制的に初期値に戻します。デバッグ時や状態をリセットしたいときに使います。
|
||||
|
||||
* cc:semaphore-interrupt-all (semaphore)
|
||||
* 引数：
|
||||
* semaphore: Semaphoreオブジェクト
|
||||
* 返値：Deferredオブジェクト
|
||||
* 実行待ちのタスクがなければ、すぐに実行するDeferredオブジェクトを返します。
|
||||
* 現在実行待ちのタスクがあれば取り除いて、現在実行中のタスクの次に実行されるDeferredオブジェクトを返します。
|
||||
* 割り込みしたいときに使います。
|
||||
|
||||
### Signal
|
||||
|
||||
* cc:signal-channel (&optional name parent-channel)
|
||||
* 引数：
|
||||
* name: このチャンネルの名前。主にデバッグ用。
|
||||
* parent-channel: 上流のチャンネルオブジェクト。
|
||||
* 返値：チャンネルオブジェクト
|
||||
* 新しいチャンネルを作成します。
|
||||
* 上流のシグナルは下流に流れてきますが、下流から上流には cc:signal-send-global を使わない限り流れません。
|
||||
|
||||
* cc:signal-connect (channel event-sym &optional callback)
|
||||
* 引数：
|
||||
* channel: チャンネルオブジェクト
|
||||
* event-sym: イベント識別シンボル
|
||||
* callback: 受け取り関数
|
||||
* 返値：Deferredオブジェクト
|
||||
* シグナルを受信するタスクを追加します。
|
||||
* event-sym が t の場合は、すべてのシグナルを受信します。
|
||||
* 通常はこの関数の返値にシグナルを受信する非同期タスクを接続します。
|
||||
|
||||
* cc:signal-send (channel event-sym &rest args)
|
||||
* 引数：
|
||||
* channel: チャンネルオブジェクト
|
||||
* event-sym: イベント識別シンボル
|
||||
* args: イベント引数
|
||||
* 返値：なし
|
||||
* シグナルを発信します。
|
||||
* args は、受信側で (lambda (event) (cl-destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。
|
||||
|
||||
|
||||
* cc:signal-send-global (channel event-sym &rest args)
|
||||
* 引数：
|
||||
* channel: チャンネルオブジェクト
|
||||
* event-sym: イベント識別シンボル
|
||||
* args: イベント引数
|
||||
* 返値：なし
|
||||
* 上流のチャンネルにシグナルを送信します。
|
||||
|
||||
* cc:signal-disconnect (channel deferred)
|
||||
* 引数：
|
||||
* channel: チャンネルオブジェクト
|
||||
* deferred: チャンネルから取り除きたいDeferredオブジェクト
|
||||
* 返値：削除されたDeferredオブジェクト
|
||||
* チャンネルから受信タスクを取り除きます。
|
||||
|
||||
* cc:signal-disconnect-all (channel)
|
||||
* 引数：
|
||||
* channel: チャンネルオブジェクト
|
||||
* 返値：なし
|
||||
* すべての受信タスクを取り除きます。
|
||||
|
||||
### Dataflow
|
||||
|
||||
* cc:dataflow-environment (&optional parent-env test-func channel)
|
||||
* 引数：
|
||||
* parent-env: デフォルト値として使うDataflowオブジェクト
|
||||
* test-func: keyの比較関数
|
||||
* channel: チャンネルオブジェクト
|
||||
* 返値：Dataflowオブジェクト
|
||||
* 新しくDataflowオブジェクトを作成して返します。
|
||||
* channelは引数で与えなかった場合は、内部新しいチャンネルオブジェクトを作成します。
|
||||
* 以下のシグナルがチャンネルに送信されます
|
||||
* get-first : 初回未バインド変数を参照したとき
|
||||
* get-waiting : 2回目以降の未バインド変数を参照したとき
|
||||
* set : 値をバインドしたとき
|
||||
* get : バインドされた値を参照したとき
|
||||
* clear : バインド解除されたとき
|
||||
* clear-all : すべてのバインドが解除されたとき
|
||||
|
||||
* cc:dataflow-get (df key)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* key: 変数キー
|
||||
* 返値：変数の値を受け取るDeferredオブジェクト
|
||||
* 変数の値を受け取るDeferredタスクを返すので、変数の値を使う処理を接続します。
|
||||
* 変数の値がバインドされていれば、直ちに実行されます。
|
||||
* 変数の値がバインドされていなければ、返されたDeferredタスクはバインドされるまで実行されません。
|
||||
|
||||
* cc:dataflow-get-sync (df key)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* key: 変数キー
|
||||
* 返値：nil か値
|
||||
* 変数の値を同期的に参照します。
|
||||
* 値がバインドされていなければ nil を返します。
|
||||
|
||||
* cc:dataflow-set (df key value)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* key: 変数キー
|
||||
* value: 値
|
||||
* 返値：なし
|
||||
* 変数に値をバインドします。
|
||||
* もし、すでにバインドされている変数にバインドしようとした場合はエラーが発生します。
|
||||
|
||||
* cc:dataflow-clear (df key)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* key: 変数キー
|
||||
* 返値：なし
|
||||
* 変数を未バインドに戻します。
|
||||
|
||||
* cc:dataflow-get-avalable-pairs (df)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* 返値：バインドされている変数キーと値の alist
|
||||
|
||||
* cc:dataflow-get-waiting-keys (df)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* 返値：未バインドで、受け取り待ちのタスクが存在する変数キーのリスト
|
||||
|
||||
* cc:dataflow-clear-all (df)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* 返値：なし
|
||||
* 指定されたDataflowオブジェクトを空にします。
|
||||
* 受け取り待ちのタスクについては何もしません。
|
||||
|
||||
* cc:dataflow-connect (df event-sym &optional callback)
|
||||
* 引数：
|
||||
* df: Dataflowオブジェクト
|
||||
* event-sym: イベント識別シンボル
|
||||
* callback: 受け取り関数
|
||||
* 返値：Deferredオブジェクト
|
||||
* このDataflowオブジェクトのチャンネルにシグナル受け取りタスクを追加します。
|
||||
* 内部で cc:signal-connect を呼びます。
|
||||
* 受け取れるイベント識別シンボルについては、 cc:dataflow-environment を参照してください。
|
||||
|
||||
|
||||
* * * * *
|
||||
|
||||
(C) 2011-2016 SAKURAI Masashi All rights reserved.
|
||||
m.sakurai at kiwanami.net
|
||||
@ -1,462 +0,0 @@
|
||||
# concurrent.el
|
||||
|
||||
[](https://travis-ci.org/kiwanami/emacs-deferred)
|
||||
[](https://coveralls.io/r/kiwanami/emacs-deferred)
|
||||
[](http://melpa.org/#/concurrent)
|
||||
[](http://stable.melpa.org/#/concurrent)
|
||||
[](https://github.com/kiwanami/emacs-deferred/tags)
|
||||
[](http://www.gnu.org/licenses/gpl-3.0.html)
|
||||
|
||||
`concurrent.el` is a higher level library for asynchronous tasks, based on `deferred.el`.
|
||||
|
||||
It is inspired by libraries of other environments and concurrent programing models.
|
||||
It has following facilities: *pseud-thread*, *generator*, *semaphore*, *dataflow variables* and
|
||||
*event management*.
|
||||
|
||||
## Installation ##
|
||||
|
||||
You can install `concurrent.el` from [MELPA](http://melpa.org) by `package.el`.
|
||||
|
||||
## Sample codes ##
|
||||
|
||||
You can find following sample codes in `concurrent-sample.el`.
|
||||
Executing `eval-last-sexp` (C-x C-e), you can try those codes.
|
||||
|
||||
### Pseud-thread
|
||||
|
||||
Evaluating the let in the blow code, the animation starts. After few seconds, the animation will stop.
|
||||
|
||||
Thread:
|
||||
|
||||
```el
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point)))
|
||||
(cc:thread
|
||||
60
|
||||
(message "Animation started.")
|
||||
(while (> end (cl-incf count))
|
||||
(save-excursion
|
||||
(when (< 1 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm)))))))
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))
|
||||
```
|
||||
|
||||
Using `while` clause in the body content, one can make a loop in the thread.
|
||||
|
||||
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`.
|
||||
|
||||
### Generator
|
||||
|
||||
The following code creates a generator object and binds it to the variable `fib-gen`.
|
||||
One can receive values, using `yield` function in the generator body code.
|
||||
When the generator returns a value, the evaluation process stops.
|
||||
Calling generator object as a function, the evaluation process resumes.
|
||||
|
||||
Generator:
|
||||
|
||||
```el
|
||||
(setq fib-list nil)
|
||||
(setq fib-gen
|
||||
(let ((a1 0) (a2 1))
|
||||
(cc:generator
|
||||
(lambda (x) (push x fib-list)) ; Receiving values as a callback function
|
||||
(yield a1)
|
||||
(yield a2)
|
||||
(while t
|
||||
(let ((next (+ a1 a2)))
|
||||
(setq a1 a2
|
||||
a2 next)
|
||||
(yield next))))))
|
||||
|
||||
(funcall fib-gen) ; calling 5 times
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
|
||||
fib-list ; => (3 2 1 1 0)
|
||||
```
|
||||
|
||||
### Semaphore
|
||||
|
||||
The semaphore restricts the number of concurrent tasks.
|
||||
The following code creates a semaphore object with one permit, and binds it to the variable `smp`.
|
||||
The subsequent codes and comments show how the semaphore object works.
|
||||
|
||||
Semaphore:
|
||||
|
||||
```el
|
||||
;; Create a semaphore with permit=1.
|
||||
(setq smp (cc:semaphore-create 1))
|
||||
|
||||
;; Start three tasks with acquiring permit.
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go1")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go2")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x)
|
||||
(message "go3")))
|
||||
|
||||
;; => Only the first task is executed and displays "go1".
|
||||
;; Rest ones are blocked.
|
||||
|
||||
(cc:semaphore-release smp) ; Releasing one permit
|
||||
|
||||
;; => The second task is executed, then, displays "go2".
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; => The third task object
|
||||
|
||||
(cc:semaphore-release-all smp) ; => Reset permits and return the third task object
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; => nil
|
||||
```
|
||||
|
||||
### Dataflow
|
||||
|
||||
The function `cc:dataflow-environment` creates an environment for dataflow variables.
|
||||
The function `cc:dataflow-get` returns a deferred object that can refer the value.
|
||||
The function `cc:dataflow-set` binds a value to a dataflow variable.
|
||||
Any objects can be variable keys in the environment. This sample code uses strings as keys.
|
||||
|
||||
Dataflow:
|
||||
|
||||
```el
|
||||
;; Create an environment.
|
||||
(setq dfenv (cc:dataflow-environment))
|
||||
|
||||
;;## Basic usage
|
||||
|
||||
;; Referring a variable synchronously. This function doesn't block.
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => nil
|
||||
|
||||
(deferred:$ ; Start the task that gets the value of `abc` and that displays the value.
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Got abc : %s" x))))
|
||||
;; => This task is blocked because no value is bound to the variable `abc`.
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 256) ; Binding a value to the variable `abc`.
|
||||
;; => The blocked task resumes and displays "Got abc : 256".
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => 256
|
||||
|
||||
(cc:dataflow-clear dfenv "abc") ; unbind the variable `abc`
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => nil
|
||||
|
||||
;;## Complex key
|
||||
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "a.jpg:300 OK %s" x))))
|
||||
|
||||
(cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)
|
||||
|
||||
;; => a.jpg:300 OK jpeg
|
||||
|
||||
;;## Waiting for two variables
|
||||
|
||||
(deferred:$ ; Start the task that refers two variables, `abc` and `def`.
|
||||
(deferred:parallel
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(cc:dataflow-get dfenv "def"))
|
||||
(deferred:nextc it
|
||||
(lambda (values)
|
||||
(apply 'message "Got values : %s, %s" values)
|
||||
(apply '+ values)))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert (format ">> %s" x)))))
|
||||
;; => This task is blocked.
|
||||
|
||||
(cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc")
|
||||
(cc:dataflow-get-avalable-pairs dfenv) ; => ((("http://example.com/a.jpg" 300) . jpeg))
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 128) ; Binding one value. The task is still blocked.
|
||||
(cc:dataflow-set dfenv "def" 256) ; Binding the next value. Then, the task resumes.
|
||||
;; => Got values : 128, 256
|
||||
```
|
||||
|
||||
### Signal
|
||||
|
||||
The function `cc:signal-channel` creates a channel for signals.
|
||||
Then, one can connect receivers and send signals.
|
||||
|
||||
Signal:
|
||||
|
||||
```el
|
||||
;; Create a channel.
|
||||
(setq channel (cc:signal-channel))
|
||||
|
||||
(cc:signal-connect ; Connect the receiver for the signal 'foo.
|
||||
channel 'foo
|
||||
(lambda (event) (message "Signal : %S" event)))
|
||||
|
||||
(cc:signal-connect
|
||||
channel t ; The signal symbol 't' means any signals.
|
||||
(lambda (event)
|
||||
(cl-destructuring-bind (event-name (args)) event
|
||||
(message "Listener : %S / %S" event-name args))))
|
||||
|
||||
(deferred:$ ; Connect the deferred task.
|
||||
(cc:signal-connect channel 'foo)
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Deferred Signal : %S" x))))
|
||||
|
||||
(cc:signal-send channel 'foo "hello signal!")
|
||||
;; =>
|
||||
;; Listener : foo / "hello signal!"
|
||||
;; Signal : (foo ("hello signal!"))
|
||||
;; Deferred Signal : (foo ("hello signal!"))
|
||||
|
||||
(cc:signal-send channel 'some "some signal!")
|
||||
;; =>
|
||||
;; Listener : some / "some signal!"
|
||||
```
|
||||
|
||||
Dataflow objects have the own channel to notify accessing to the variables.
|
||||
Receiving the signals for referring unbound variables, one can create values on demand.
|
||||
|
||||
The signal and dataflow objects can be cascades, creating objects with the parent ones.
|
||||
It enables that the dataflow object can have the default values, and that
|
||||
one can use the different scope signals in the tree structure of the channel objects, such as global signals and local signals.
|
||||
|
||||
## API Details
|
||||
|
||||
### Thread
|
||||
|
||||
* cc:thread (wait-time-msec &rest body)
|
||||
* Arguments
|
||||
* wait-time-msec: The interval time between tasks (millisecond).
|
||||
* Return
|
||||
* A thread object.
|
||||
* This function creates a thread and start it.
|
||||
* 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`.
|
||||
* The `while` form in the body part acts as a loop.
|
||||
* 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.
|
||||
|
||||
### Generator
|
||||
|
||||
* cc:generator (callback &rest body)
|
||||
* Arguments
|
||||
* callback: A function to receive the value passed by `yield` form.
|
||||
* body: Generator forms.
|
||||
* Return
|
||||
* A generating function.
|
||||
* 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.
|
||||
* The `yield` form in the body part passes the value to the `callback` function and pause the asynchronous tasks.
|
||||
* Calling the generating function, the asynchronous tasks resume.
|
||||
|
||||
### Semaphore
|
||||
|
||||
* cc:semaphore-create (permits-num)
|
||||
* Arguments
|
||||
* permits-num: The number of permits.
|
||||
* Return
|
||||
* A semaphore object.
|
||||
* This function creates a semaphore object.
|
||||
|
||||
* cc:semaphore-acquire (semaphore)
|
||||
* Argument
|
||||
* semaphore: A semaphore object.
|
||||
* Return
|
||||
* A deferred object.
|
||||
* Acquire an execution permission and return deferred object to chain.
|
||||
* If this semaphore object has permissions, the subsequent deferred task is executed immediately.
|
||||
* If this semaphore object has no permissions, the subsequent deferred task is blocked. After the permission is returned, the task is executed.
|
||||
|
||||
* cc:semaphore-release (semaphore)
|
||||
* Arguments
|
||||
* semaphore: A semaphore object
|
||||
* Return
|
||||
* The given semaphore object
|
||||
* Release an execution permission.
|
||||
* The programmer is responsible to return the permissions.
|
||||
|
||||
* cc:semaphore-with (semaphore body-func &optional error-func)
|
||||
* Arguments
|
||||
* semaphore: A semaphore object
|
||||
* body-func: A task function
|
||||
* error-func: An error handling function (which is connected by `deferred:error`.)
|
||||
* Return
|
||||
* A deferred object
|
||||
* Execute the task function asynchronously with the semaphore block.
|
||||
* Using this function is bit safer than using a pair of `cc:semaphore-acquire` and `cc:semaphore-release`.
|
||||
|
||||
* cc:semaphore-release-all (semaphore)
|
||||
* Arguments
|
||||
* semaphore: A semaphore object
|
||||
* Return
|
||||
* Deferred objects those were waiting for permission.
|
||||
* Release all permissions for resetting the semaphore object.
|
||||
* 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.
|
||||
|
||||
* cc:semaphore-interrupt-all (semaphore)
|
||||
* Arguments
|
||||
* semaphore: A semaphore object
|
||||
* Return
|
||||
* A deferred object
|
||||
* Clear the list of the blocked tasks in the semaphore and return a deferred object to chain.
|
||||
* This function is used for the interruption cases.
|
||||
|
||||
### Signal
|
||||
|
||||
* cc:signal-channel (&optional name parent-channel)
|
||||
* Arguments
|
||||
* name: A channel name for debug.
|
||||
* parent-channel: An upstream channel object.
|
||||
* Return
|
||||
* A channel object.
|
||||
* Create a new channel object.
|
||||
* The observers of this channel can receive the upstream signals.
|
||||
* 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.
|
||||
|
||||
* cc:signal-connect (channel event-sym &optional callback)
|
||||
* Arguments
|
||||
* channel: A channel object
|
||||
* event-sym: A signal symbol
|
||||
* callback: A receiver function
|
||||
* Return
|
||||
* A deferred object
|
||||
* Append an observer for the symbol of the channel and return a deferred object.
|
||||
* If `event-sym` is `t`, the observer receives all signals of the channel.
|
||||
* If the callback function is given, the deferred object executes the callback function asynchronously.
|
||||
* One can connect subsequent tasks to the returned deferred object.
|
||||
|
||||
* cc:signal-send (channel event-sym &rest args)
|
||||
* Arguments
|
||||
* channel: A channel object
|
||||
* event-sym: A signal symbol
|
||||
* args: Signal arguments
|
||||
* Return
|
||||
* None
|
||||
* Send a signal to the channel.
|
||||
* If the `args` are given, observers can get the values by following code:
|
||||
* `(lambda (event) (cl-destructuring-bind (event-sym (args)) event ... ))`
|
||||
|
||||
* cc:signal-send-global (channel event-sym &rest args)
|
||||
* Arguments
|
||||
* channel: A channel object
|
||||
* event-sym: A signal symbol
|
||||
* args: Signal arguments
|
||||
* Return
|
||||
* None
|
||||
* Send a signal to the most upstream channel.
|
||||
|
||||
* cc:signal-disconnect (channel deferred)
|
||||
* Arguments
|
||||
* channel: A channel object
|
||||
* deferred: The deferred object to delete
|
||||
* Return
|
||||
* The deleted deferred object
|
||||
* Remove the observer object from the channel and return the removed deferred object.
|
||||
|
||||
* cc:signal-disconnect-all (channel)
|
||||
* Arguments
|
||||
* channel: A channel object
|
||||
* Return
|
||||
* None
|
||||
* Remove all observers.
|
||||
|
||||
### Dataflow
|
||||
|
||||
* cc:dataflow-environment (&optional parent-env test-func channel)
|
||||
* Arguments
|
||||
* parent-env: A dataflow object as the default value.
|
||||
* test-func: A test function that compares the entry keys.
|
||||
* channel: A channel object that sends signals of variable events.
|
||||
* Return
|
||||
* A dataflow object
|
||||
* Create a dataflow environment.
|
||||
* The parent 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.
|
||||
* If no channel is given, this function creates a new channel object internally.
|
||||
* Observers can receive following signals:
|
||||
* `get-first` : the fist referrer is waiting for binding,
|
||||
* `get-waiting` : another referrer is waiting for binding,
|
||||
* `set` : a value is bound,
|
||||
* `get` : returned a bound value,
|
||||
* `clear` : cleared one entry,
|
||||
* `clear-all` : cleared all entries.
|
||||
|
||||
* cc:dataflow-get (df key)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* key: A key object
|
||||
* Return
|
||||
* A deferred object
|
||||
* Return a deferred object that can refer the value which is indicated by the key.
|
||||
* If the dataflow object has the entry that bound value, the subsequent deferred task is executed immediately.
|
||||
* If not, the task is deferred till a value is bound.
|
||||
|
||||
* cc:dataflow-get-sync (df key)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* key: A key object
|
||||
* Return
|
||||
* Nil or a value
|
||||
* Return the value which is indicated by the key synchronously.
|
||||
* If the environment doesn't have an entry of the key, this function returns nil.
|
||||
|
||||
* cc:dataflow-set (df key value)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* key: A key object
|
||||
* value: A value
|
||||
* Return
|
||||
* None
|
||||
* Bind the value to the key in the environment.
|
||||
* If the dataflow already has the bound entry of the key, this function throws an error signal.
|
||||
* The value can be nil as a value.
|
||||
|
||||
* cc:dataflow-clear (df key)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* key: A key object
|
||||
* Return
|
||||
* None
|
||||
* Clear the entry which is indicated by the key.
|
||||
* This function does nothing for the waiting deferred objects.
|
||||
|
||||
* cc:dataflow-get-avalable-pairs (df)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* Return
|
||||
* An available key-value alist in the environment and the parent ones.
|
||||
|
||||
* cc:dataflow-get-waiting-keys (df)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* Return
|
||||
* A list of keys which have waiting deferred objects in the environment and the parent ones.
|
||||
|
||||
* cc:dataflow-clear-all (df)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* Return
|
||||
* None
|
||||
* Clear all entries in the environment.
|
||||
* This function does nothing for the waiting deferred objects.
|
||||
|
||||
* cc:dataflow-connect (df event-sym &optional callback)
|
||||
* Arguments
|
||||
* df: A dataflow object
|
||||
* event-sym: A signal symbol
|
||||
* callback: A receiver function
|
||||
* Return
|
||||
* A deferred object
|
||||
* Append an observer for the symbol of the channel of the environment and return a deferred object.
|
||||
* See the document of `cc:dataflow-environment` for details of signals.
|
||||
|
||||
|
||||
* * * * *
|
||||
|
||||
(C) 2011-2016 SAKURAI Masashi All rights reserved.
|
||||
m.sakurai at kiwanami.net
|
||||
@ -1,669 +0,0 @@
|
||||
# deferred.el #
|
||||
|
||||
[](https://travis-ci.org/kiwanami/emacs-deferred)
|
||||
[](https://coveralls.io/r/kiwanami/emacs-deferred)
|
||||
[](http://melpa.org/#/deferred)
|
||||
[](http://stable.melpa.org/#/deferred)
|
||||
[](https://github.com/kiwanami/emacs-deferred/tags)
|
||||
[](http://www.gnu.org/licenses/gpl-3.0.html)
|
||||
|
||||
deferred.el は非同期処理を抽象化して書きやすくするためのライブラリです。
|
||||
APIや実装については
|
||||
[JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45さん)と
|
||||
[Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html
|
||||
"Mochikit.Async") (by Bob Ippolitoさん)を参考にしています。
|
||||
|
||||
## インストール ##
|
||||
|
||||
deferred.elは package.elを使って, [MELPA](http://melpa.org)からインストールすることができます.
|
||||
|
||||
## 使い方例 ##
|
||||
|
||||
以下のサンプルで例示したソースは deferred-samples.el の中にあります。
|
||||
eval-last-sexp (C-x C-e) などで実行してみてください。
|
||||
|
||||
### 基本 ###
|
||||
|
||||
基本的な deferred の連結です。messageにいくつか表示し、ミニバッファから
|
||||
入力を受け付けます。
|
||||
|
||||
Chain:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda () (message "deferred start")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(message "chain 1")
|
||||
1))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "chain 2 : %s" x)))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(read-minibuffer "Input a number: ")))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Got the number : %i" x)))
|
||||
(deferred:error it
|
||||
(lambda (err)
|
||||
(message "Wrong input : %s" err))))
|
||||
```
|
||||
|
||||
|
||||
* この式を実行すると、直ちに結果が帰ってきます。
|
||||
* 実際の処理自体はすぐ後に非同期で実行されます。
|
||||
* deferred:$ は deferred を連結するためのマクロです。
|
||||
* itには前の式(deferred:nextなど)の返値が入っています。
|
||||
* 前の deferred 処理の返値が、次の処理の引数になっています。
|
||||
* 数字以外を入力するとエラーになりますが、 deferred:error でエラーを拾っています。
|
||||
|
||||
|
||||
### タイマーで一定時間後 ###
|
||||
|
||||
1秒待ってメッセージを表示します。
|
||||
|
||||
Timer:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; 1000msec
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Timer sample! : %s msec" x))))
|
||||
```
|
||||
|
||||
* deferred:wait の次の処理には、実際に経過した時間が渡ってきます。
|
||||
|
||||
### 外部プロセス・コマンド実行 ###
|
||||
|
||||
外部プロセスで「ls -la」を実行して結果を現在のバッファに表示します。（素のWindowsで動かす場合は、dirなどに変更してみてください。）
|
||||
|
||||
Command process:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:process "ls" "-la")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
* 非同期で実行するため、処理がブロックしたりしません。
|
||||
|
||||
|
||||
### HTTP GET ###
|
||||
|
||||
GNUのトップページのHTMLを取ってきて、現在のバッファに貼り付けます（大量のHTMLが張り付きますが、undoで戻せます）。
|
||||
|
||||
HTTP GET:
|
||||
|
||||
```el
|
||||
(require 'url)
|
||||
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.gnu.org")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert (with-current-buffer buf (buffer-string)))
|
||||
(kill-buffer buf))))
|
||||
```
|
||||
|
||||
### 画像 ###
|
||||
|
||||
googleの画像を取ってきてそのままバッファに貼り付けます。
|
||||
|
||||
Get an image:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert-image
|
||||
(create-image
|
||||
(let ((data (with-current-buffer buf (buffer-string))))
|
||||
(substring data (+ (string-match "\n\n" data) 2)))
|
||||
'png t))
|
||||
(kill-buffer buf))))
|
||||
```
|
||||
|
||||
### 並列 ###
|
||||
|
||||
2つの画像を取ってきて、結果がそろったところで各画像のファイルサイズを現在のバッファに表示します。
|
||||
|
||||
Parallel deferred:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png"))
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
|
||||
(deferred:nextc it
|
||||
(lambda (buffers)
|
||||
(cl-loop for i in buffers
|
||||
do
|
||||
(insert
|
||||
(format
|
||||
"size: %s\n"
|
||||
(with-current-buffer i (length (buffer-string)))))
|
||||
(kill-buffer i)))))
|
||||
```
|
||||
|
||||
* deferred:parallel 内部で、並列に実行できるものは並列に動作します。
|
||||
* 各処理が完了するかエラーが発生して、すべての処理が完了したところで次の処理が開始されます。
|
||||
* 次の処理には結果がリストで渡されます。
|
||||
* 順番は保持されます
|
||||
* alistを渡して名前で結果を選ぶことも出来ます
|
||||
|
||||
### deferred組み合わせ、try-catch-finally ###
|
||||
|
||||
外部プロセスの wget で画像を取ってきて、ImageMagic の convert コマンドでリサイズし、バッファに画像を表示します。（wget, convertが無いと動きません）
|
||||
deferred を組み合わせて、非同期処理の try-catch のような構造を作ることが出来ます。
|
||||
|
||||
Get an image by wget and resize by ImageMagick:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
|
||||
;; try
|
||||
(deferred:$
|
||||
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
(deferred:nextc it
|
||||
(lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(clear-image-cache)
|
||||
(insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
|
||||
|
||||
;; catch
|
||||
(deferred:error it ;
|
||||
(lambda (err)
|
||||
(insert "Can not get a image! : " err)))
|
||||
|
||||
;; finally
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(deferred:parallel
|
||||
(lambda () (delete-file "a.jpg"))
|
||||
(lambda () (delete-file "b.jpg")))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message ">> %s" x))))
|
||||
```
|
||||
|
||||
* deferred を静的につなげることで、自由に組み合わせることが出来ます。
|
||||
* 関数などで個別の deferred 処理を作って、後で一つにまとめるなど。
|
||||
|
||||
なお、この例は以下のようにも書けます。（注意：完全に同じ動作ではありません。また、非同期の仕組み上、finallyタスクは必ず実行することを保証するものではありません。）
|
||||
|
||||
Try-catch-finally:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:try
|
||||
(deferred:$
|
||||
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
(deferred:nextc it
|
||||
(lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(clear-image-cache)
|
||||
(insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
|
||||
:catch
|
||||
(lambda (err) (insert "Can not get a image! : " err))
|
||||
:finally
|
||||
(lambda ()
|
||||
(delete-file "a.jpg")
|
||||
(delete-file "b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message ">> %s" x))))
|
||||
```
|
||||
|
||||
### earlierでtimeout ###
|
||||
|
||||
外部プロセスで3秒待つコマンドを実行しますが、途中でキャンセルします。
|
||||
|
||||
deferred:earlier は parallel と同様に、引数の処理を並列に実行しますが、一番早く完了した処理の結果を次の処理に渡します。他の処理はその時点でキャンセルされます。
|
||||
|
||||
Timeout Process:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:earlier
|
||||
(deferred:process "sh" "-c" "sleep 3 | echo 'hello!'")
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; timeout msec
|
||||
(deferred:nextc it (lambda () "canceled!"))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
* deferred:wait の待つ時間を5秒などにすると、コマンドの結果が渡ってきます。
|
||||
* エラーは完了と見なされません。すべての処理がエラーになった場合は nil が次に渡ります。
|
||||
* deferred:parallel と deferred:earlier は lisp の and や or のようなイメージです。
|
||||
|
||||
なお、この例は deferred:timeout マクロを使って以下のようにも書けます。
|
||||
|
||||
Timeout macro:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:timeout
|
||||
1000 "canceled!"
|
||||
(deferred:process "sh" "-c" "sleep 3 | echo 'hello!'"))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
### ループとアニメーション・スレッド ###
|
||||
|
||||
数秒間カーソールのある位置に文字でアニメーションを表示します。その間、カーソールを自由に動かして普通にEmacsを操作できます。
|
||||
|
||||
deferredの処理の中でdeferredオブジェクトを返すと、ソースコードで（静的に）繋がっている次のdeferred処理へ移る前に、返した方のdeferredオブジェクトを実行します（動的なdeferredの接続）。再帰的な構造にしてwaitを入れて負荷を調節することで、マルチスレッドのような処理を実現することが出来ます。
|
||||
|
||||
Loop and animation:
|
||||
|
||||
```el
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point))
|
||||
(wait-time 50))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (x) (message "Animation started.")))
|
||||
|
||||
(deferred:nextc it
|
||||
(deferred:lambda (x)
|
||||
(save-excursion
|
||||
(when (< 0 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm))))))
|
||||
(if (> end (cl-incf count)) ; 止める場合はdeferredでないものを返す（この場合はnil）
|
||||
(deferred:nextc (deferred:wait wait-time) self)))) ; 続けるときはdeferredを返す
|
||||
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))))
|
||||
```
|
||||
|
||||
* deferred:lambda は自分自身をselfとして使えるマクロです。再帰的構造を作るのに便利です。
|
||||
|
||||
## インタフェース解説 ##
|
||||
|
||||
「関数」の章では各関数の簡単な説明を行います。「実行・接続」の章では、deferredオブジェクトの接続（実行順序）などの説明を行います。
|
||||
|
||||
### 関数 ###
|
||||
|
||||
#### 基本 ####
|
||||
|
||||
良く使用する基本的な関数やマクロです。
|
||||
|
||||
* deferred:next (callback)
|
||||
* 引数：
|
||||
* callback: 引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成して返します。また実行キューに入れて非同期実行をスケジュールします。
|
||||
* →関数を非同期で実行します。
|
||||
|
||||
|
||||
* deferred:nextc (d callback)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* callback: 引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。
|
||||
* →前のdeferredの後に関数を実行するように連結します。
|
||||
|
||||
* deferred:error (d errorback)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* errorback: 引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の関数をエラー処理コールバックとしてラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。
|
||||
* →前のdeferredでエラーが起きたときに、この関数で処理するようにします。
|
||||
* この関数内で例外を発生しなければ、後続のdeferredのコールバック関数が実行されます。
|
||||
|
||||
* deferred:cancel (d)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* 返値：引数のdeferredオブジェクト（無効になっている）
|
||||
* 引数のdeferredオブジェクトを無効にして、コールバックやエラーバック関数が実行されないようにします。
|
||||
* この関数は引数のdeferredオブジェクトを破壊的に変更します。
|
||||
|
||||
* deferred:watch (d callback)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* callback: 引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の関数をコールバックとエラーバックの両方でラップしたdeferredオブジェクトを生成し、引数のdeferredオブジェクトに接続して返します。
|
||||
* 次のdeferredタスクへの値は前のタスクの結果をそのまま渡します。
|
||||
* callbackが何を返しても、callback内部でエラーが発生しても、deferredの流れに影響を与えません。
|
||||
* callback内部の非同期タスクは後続のdeferredタスクと非同期に実行されます。
|
||||
* →deferred処理の流れに割り込んだり、実行状況を監視したいときに使います。
|
||||
|
||||
* deferred:wait (msec)
|
||||
* 引数：
|
||||
* msec: 数値
|
||||
* 返値：deferredオブジェクト
|
||||
* この関数が実行された時点から引数で指定されたミリ秒待って、後続のdeferredオブジェクトを実行します。
|
||||
* 後続のdeferredオブジェクトのコールバック関数の引数には、実際に経過した時間がミリ秒で渡ってきます。
|
||||
|
||||
* deferred:$ (forms...)
|
||||
* 引数：1つ以上のdeferredフォーム
|
||||
* 返値：一番最後のdeferredオブジェクト
|
||||
* deferredオブジェクトのチェインを書きやすくするためのアナフォリックマクロです。
|
||||
* 一つ前のdeferredオブジェクトが「it」で渡ってきます。
|
||||
|
||||
#### ユーティリティ ####
|
||||
|
||||
複数のdeferredを扱う関数です。
|
||||
|
||||
* deferred:loop (number-or-list callback)
|
||||
* 引数：
|
||||
* number-or-list: 1以上の整数もしくはリスト
|
||||
* callback: 引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の数値で指定された数だけループするようなdeferredオブジェクトを生成して返します。関数には0から始まるカウンタが渡ってきます。
|
||||
* 整数ではなくリストが渡ってきた場合は、mapcのようにループします。
|
||||
|
||||
* deferred:parallel (list-or-alist)
|
||||
* 引数：以下のどちらか
|
||||
* 1つ以上のdeferredオブジェクトか引数1つか0個の関数のリスト
|
||||
* 1つ以上のシンボルとdeferredオブジェクトか引数1つか0個の関数によるconsセルのリスト（つまりalist）
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数に与えられたdeferredオブジェクトを並列に実行し、結果を待ち合わせます。
|
||||
* 後続のdeferredには結果が順番の保持されたリストとして渡ります。
|
||||
* 引数にalistが渡した場合は、結果もalistで渡ります。この場合は順番は保持されません。
|
||||
* deferred処理の中でエラーが発生した場合は、結果のリストの中にエラーオブジェクトが入ります。
|
||||
|
||||
* deferred:earlier (list-or-alist)
|
||||
* 引数：以下のどちらか
|
||||
* 1つ以上のdeferredオブジェクトか引数1つか0個の関数のリスト
|
||||
* 1つ以上のシンボルとdeferredオブジェクトか引数1つか0個の関数によるconsセルのリスト（つまりalist）
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数に与えられたdeferredオブジェクトを並列に実行し、最初に帰ってきた結果を後続のdeferredに渡します。
|
||||
* 2番目以降の処理はキャンセルされ、結果が帰ってきても無視されます。
|
||||
* 引数にalistを渡した場合は、結果はconsセルで渡ります。
|
||||
* deferred処理の中でエラーが発生した場合は、結果が帰ってこなかったものとして扱われます。
|
||||
* すべての処理がエラーになった場合は、後続のdeferredにnilが渡ります。つまり、エラーバックで処理されません。
|
||||
|
||||
#### ラッパー ####
|
||||
|
||||
元からある処理をdeferredでラップする関数です。
|
||||
|
||||
* deferred:call (function args...)
|
||||
* 引数：
|
||||
* function: 関数のシンボル
|
||||
* args: 引数（可変長）
|
||||
* 返値：deferredオブジェクト
|
||||
* オリジナルのfuncallを非同期にした関数です
|
||||
|
||||
* deferred:apply (function args)
|
||||
* 引数：
|
||||
* function: 関数のシンボル
|
||||
* args: 引数（リスト）
|
||||
* 返値：deferredオブジェクト
|
||||
* オリジナルのapplyを非同期にした関数です
|
||||
|
||||
* deferred:process (command args...) / deferred:process-shell (command args...)
|
||||
* 引数：
|
||||
* command: 外部実行コマンド
|
||||
* args: コマンドの引数(可変長)
|
||||
* 返値：deferredオブジェクト
|
||||
* 外部コマンドを非同期で実行します。（start-process, start-process-shell-command のラッパー）
|
||||
* 外部コマンドのstdoutとstderrの結果が文字列として後続のdeferredに渡ります。
|
||||
|
||||
* deferred:process-buffer (command args...) / deferred:process-shell-buffer (command args...)
|
||||
* 引数：
|
||||
* command: 外部実行コマンド
|
||||
* args: コマンドの引数(可変長)
|
||||
* 返値：deferredオブジェクト
|
||||
* 外部コマンドを非同期で実行します。（start-process, start-process-shell-command のラッパー）
|
||||
* 外部コマンドのstdoutとstderrの結果がバッファとして後続のdeferredに渡ります。
|
||||
* バッファの処分は後続のdeferredに任されます。
|
||||
|
||||
* deferred:wait-idle (msec)
|
||||
* 引数：
|
||||
* msec: 数値
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数で指定されたミリ秒間Emacsがアイドル状態だったときに、後続のdeferredオブジェクトを実行します。
|
||||
* 後続のdeferredオブジェクトのコールバック関数の引数には、この関数が呼ばれてから経過した時間がミリ秒で渡ってきます。
|
||||
|
||||
* deferred:url-retrieve (url [cbargs])
|
||||
* 引数：
|
||||
* url: 取ってきたいURL
|
||||
* cbargs: コールバック引数（オリジナル関数のもの。省略可。）
|
||||
* 返値：deferredオブジェクト
|
||||
* urlパッケージにある、オリジナルのurl-retrieveをdeferredでラップした関数です。
|
||||
* HTTPで取得した結果が、後続のdeferredにバッファで渡ります。
|
||||
* バッファの処分は後続のdeferredに任されます。
|
||||
|
||||
* （仮）deferred:url-get (url params)
|
||||
* 引数：
|
||||
* url: 取ってきたいURL
|
||||
* params: パラメーターのalist
|
||||
* 返値：deferredオブジェクト
|
||||
* パラメーターを指定しやすくした関数です。仮実装ですので今後仕様が変わる可能性があります。
|
||||
|
||||
* （仮）deferred:url-post (url params)
|
||||
* 引数：
|
||||
* url: 取ってきたいURL
|
||||
* params: パラメーターのalist
|
||||
* 返値：deferredオブジェクト
|
||||
* パラメーターを指定しやすくして、POSTでアクセスする関数です。仮実装ですので今後仕様が変わる可能性があります。
|
||||
|
||||
#### インスタンスメソッド ####
|
||||
|
||||
プリミティブな操作を行う関数です。典型的でないdeferred処理を行いたい場合に、組み合わせて使います。
|
||||
|
||||
* deferred:new (callback)
|
||||
* 引数：引数1つか0個の関数
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の関数をコールバックとしてラップしたdeferredオブジェクトを生成して返します。
|
||||
* 実行キューに入れないため、deferred:callbackやdeferred:errorbackが呼ばれない限り実行されません。
|
||||
* 一時停止して他のイベントを待つような、deferredチェインを作りたいときに使います。 → deferred:wait のソースなどを参考。
|
||||
|
||||
* deferred:succeed ([value])
|
||||
* 引数：値（省略可）
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の値を使って、既にコールバックが呼ばれた状態のdeferredを返します。
|
||||
* 後続のdeferredは接続されたら直ちに（同期的に）実行されます。
|
||||
|
||||
* deferred:fail ([error])
|
||||
* 引数：値（省略可）
|
||||
* 返値：deferredオブジェクト
|
||||
* 引数の値を使って、既にエラーバックが呼ばれた状態のdeferredを返します。
|
||||
* 後続のdeferredは接続されたら直ちに（同期的に）実行されます。
|
||||
|
||||
* deferred:callback (d [value])
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* value: 値（省略可）
|
||||
* 返値：deferredオブジェクトか、結果値
|
||||
* 引数のdeferredオブジェクトを同期的に開始します。
|
||||
* ただし、同期的な実行は初回のみで、引数のdeferred以降のdeferredオブジェクトは非同期に実行されます。
|
||||
|
||||
* deferred:callback-post (d [value])
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* value: 値（省略可）
|
||||
* 返値：deferredオブジェクトか、結果値
|
||||
* 引数のdeferredオブジェクトを非同期に開始します。
|
||||
|
||||
* deferred:errorback (d [error])
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* error: 値（省略可）
|
||||
* 返値：deferredオブジェクトか、結果値
|
||||
* 引数のdeferredオブジェクトからエラーバックを同期的に開始します。
|
||||
|
||||
* deferred:errorback-post (d [error])
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* error: 値（省略可）
|
||||
* 返値：deferredオブジェクトか、結果値
|
||||
* 引数のdeferredオブジェクトからエラーバックを非同期に開始します。
|
||||
|
||||
|
||||
### ユーティリティマクロ ###
|
||||
|
||||
いくつかの便利なマクロを用意しています。マクロですので、スコープや評価順序などに注意して予想外の動作に気をつけてください。
|
||||
|
||||
* deferred:try (d &key catch finally)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* catch: [キーワード引数] dのタスクを実行中にエラーが起きたときに実行される関数。（マクロ展開によって deferred:error の引数に入る）
|
||||
* finally: [キーワード引数] dのタスクが正常・エラーに関わらず終了したあとに実行する関数（マクロ展開によって deferred:watch の引数に入る）
|
||||
* 返値：deferredオブジェクト
|
||||
* 非同期処理で try-catch-finally のような処理を実現するマクロです。所詮非同期なので、メインのdeferredタスクの内容によっては、finallyタスクに処理が回ってこない可能性もあります。
|
||||
* deferred:error と deferred:watch を使って実装しています。
|
||||
|
||||
* deferred:timeout (msec timeout-form d)
|
||||
* 引数：
|
||||
* msec: 数値
|
||||
* timeout-form: キャンセル時に評価する sexp-form
|
||||
* d: deferredオブジェクト
|
||||
* 返値：deferredオブジェクト
|
||||
* dのタスクを開始してmsecミリ秒経過した場合、dのタスクをキャンセルして、timeout-formの結果を後続のdeferredに渡します。
|
||||
* deferred:earlierとdeferred:waitを使って実装しています。
|
||||
|
||||
* deferred:process〜
|
||||
* deferred:processc (d command args...)
|
||||
* deferred:process-bufferc (d command args...)
|
||||
* deferred:process-shellc (d command args...)
|
||||
* deferred:process-shell-bufferc (d command args...)
|
||||
* 引数：
|
||||
* d: deferredオブジェクト
|
||||
* command: 外部実行コマンド
|
||||
* args: コマンドの引数(可変長)
|
||||
* 返値：deferredオブジェクト
|
||||
* 外部コマンドを非同期で実行するdeferredオブジェクトをdに接続します。
|
||||
* deferred:nextc の lambda の中に元の関数を埋め込んで実装しています。
|
||||
|
||||
### 実行・接続 ###
|
||||
|
||||
#### 処理開始について ####
|
||||
|
||||
関数の中には処理を自動的に開始するものとしないものがあります。
|
||||
|
||||
以下の関数は、非同期実行用のキューにdeferredオブジェクトを登録します。つまり、自動的に実行を開始します。
|
||||
|
||||
* next
|
||||
* wait
|
||||
* loop
|
||||
* parallel
|
||||
* earlier
|
||||
* call, apply
|
||||
* process
|
||||
* url-retrieve, url-get, url-post
|
||||
|
||||
new は callback や errorback を呼ぶまで実行が開始されません。他のイベントを待って実行を開始するような用途で使います。
|
||||
|
||||
deferredオブジェクトは先にコールバックを実行しておいて、後で後続のdeferredオブジェクトをつなげることも出来ます。つまり、一番最後のdeferredオブジェクトは、続きのdeferredオブジェクトが接続されるまで結果を保持し続けます。succeed と fail は、そのような既に実行された状態の deferred を生成します。
|
||||
|
||||
#### ソースコード上のでの接続 ####
|
||||
|
||||
deferredオブジェクトを$などを使ってソースコード上で連結することを、静的な接続と呼びます。
|
||||
|
||||
これはdeferredの基本的な使い方で、コールバック処理の書き方を変えたものだと言えます。
|
||||
|
||||
処理がコード上に並びますので読みやすく、流れも理解しやすいです。通常、このパターンを使います。
|
||||
|
||||
#### 実行時に接続 ####
|
||||
|
||||
deferred処理の中でdeferredオブジェクトを返すと、静的に接続された（ソースコード上の）後続のdeferredオブジェクトの前に、そのdeferredを割り込ませます。
|
||||
|
||||
この動作により、ループや分岐などの高度な非同期処理を行うことができます。
|
||||
|
||||
## ポイント ##
|
||||
|
||||
ここでは、いくつかの実装上のポイントを示します。
|
||||
|
||||
### レキシカルスコープ ###
|
||||
|
||||
deferredの処理に値を持って行く場合、let などを用いてレキシカルスコープを使うと大変便利です。
|
||||
|
||||
特に、一連のdeferred処理の中で共通に使う値にレキシカルスコープを使うと、ローカル変数のようにアクセスすること出来るため、非同期処理のために値をグローバルに保持しておく必要が無くなります。
|
||||
|
||||
let 例:
|
||||
|
||||
```el
|
||||
(let ((a (point)))
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(goto-char a)
|
||||
(insert "here!")))))
|
||||
```
|
||||
|
||||
逆に、letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。
|
||||
|
||||
### カレント状態 ###
|
||||
|
||||
save-execursion や with-current-buffer など、S式の範囲で状態を保持する関数がありますが、deferred関数を囲っていても非同期で処理される時点では無効になっています。
|
||||
|
||||
ダメな例:
|
||||
|
||||
```el
|
||||
(with-current-buffer (get-buffer "*Message*")
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(insert "Time: %s " x) ; ここは *Message* バッファとは限らない！
|
||||
))))
|
||||
```
|
||||
|
||||
このような場合は、レキシカルスコープなどでdeferredの中にバッファオブジェクトを持って行き、その中でバッファを切り替える必要があります。
|
||||
|
||||
改善例:
|
||||
|
||||
```el
|
||||
(let ((buf (get-buffer "*Message*")))
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(with-current-buffer buf ; 非同期処理の中で設定する
|
||||
(insert "Time: %s " x))))))
|
||||
```
|
||||
|
||||
### lambdaの返り値に気を使う ###
|
||||
|
||||
先に述べたとおり、deferredの処理の中でdeferredオブジェクトを返すと、動的な接続によりdeferred処理が割り込まれます。しかしながら、意図せずdeferredオブジェクトを返してしまい、実行順序がおかしくなり、バグに繋がるケースがあります。
|
||||
|
||||
そのため、deferredのコールバックで返す値には気をつける必要があります。特に値を返さない場合は、予防として明示的にnilを返すようにするといいと思います。
|
||||
|
||||
### デバッグ ###
|
||||
|
||||
通常の処理に比べて、非同期の処理はデバッグが難しいことが多いです。デバッガが使える場面も多いですが、デバッガで停止中に他の非同期処理が行われたりすることがあるため、正しくデバッグできないこともあります。その場合は、message文をちりばめるとか、独自のログバッファに出力するなどしてデバッグすることが確実だと思います。
|
||||
|
||||
意図せず無限ループに陥って、非同期処理が延々と走り続けてしまうことがあります。その場合は、 deferred:clear-queue 関数を呼ぶ（M-xからも呼べます）ことで、実行キューを空にして止めることが出来ます。
|
||||
|
||||
非同期のタスクで発生したエラーは、エラーバックで拾わないと最終的にはmessageに表示されます。deferredの実装内部は condition-case で囲っていますので、デバッガでエラーを拾いたい場合は toggle-debug-on-error でデバッガを有効にすると同時に、 deferred:debug-on-signal を t に設定して発生したエラー取得するようにしてください。
|
||||
|
||||
deferred:sync! 関数を使うことによって、deferred タスクを待ち合わせて同期的にすることができます。ただし、待ち合わせは完全ではないため、テストやデバッグ目的にのみ使うようにして、実アプリでは使わないようにしてください。
|
||||
|
||||
### マクロ ###
|
||||
|
||||
deferred.elを使うと、nextcやlambdaをたくさん書くことになると思います。これらをマクロでラップすることで短く書くことが可能になります。deferred.elのテストコードのtest-deferred.elでは、マクロを使ってとにかく短く書いています。
|
||||
|
||||
一方、マクロでlambdaを隠蔽することで、フォームを実行した値を渡したいのか、あるいは非同期に実行される関数が引数なのか、分かりづらくなるおそれがあります。そういった理由からdeferred.elでは積極的に便利なマクロを提供していません。マクロで短く書く場合には、実行されるタイミングに気をつける必要があります。
|
||||
|
||||
### deferred入門 ###
|
||||
|
||||
deferredによってどのようなことが可能になるかなどについては、JavaScriptの例ではありますが、以下のドキュメントが大変参考になると思います。
|
||||
|
||||
* [JSDeferred紹介](http://cho45.stfuawsc.com/jsdeferred/doc/intro.html "JSDeferred紹介")
|
||||
* [特集：JSDeferredで，面倒な非同期処理とサヨナラ｜gihyo.jp … 技術評論社](http://gihyo.jp/dev/feature/01/jsdeferred "特集：JSDeferredで，面倒な非同期処理とサヨナラ｜gihyo.jp … 技術評論社")
|
||||
|
||||
|
||||
* * * * *
|
||||
|
||||
(C) 2010-2016 SAKURAI Masashi All rights reserved.
|
||||
m.sakurai at kiwanami.net
|
||||
@ -1,721 +0,0 @@
|
||||
# deferred.el #
|
||||
|
||||
[](https://travis-ci.org/kiwanami/emacs-deferred)
|
||||
[](https://coveralls.io/r/kiwanami/emacs-deferred)
|
||||
[](http://melpa.org/#/deferred)
|
||||
[](http://stable.melpa.org/#/deferred)
|
||||
[](https://github.com/kiwanami/emacs-deferred/tags)
|
||||
[](http://www.gnu.org/licenses/gpl-3.0.html)
|
||||
|
||||
`deferred.el` provides facilities to manage asynchronous tasks.
|
||||
|
||||
The API and implementations were translated from
|
||||
[JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45) and
|
||||
[Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html
|
||||
"Mochikit.Async") (by Bob Ippolito) in JavaScript.
|
||||
|
||||
*(note the README for `concurrent` is [here in the same repo](./README-concurrent.markdown))*
|
||||
|
||||
## Installation ##
|
||||
|
||||
You can install deferred.el from [MELPA](http://melpa.org) by package.el.
|
||||
|
||||
## Sample codes ##
|
||||
|
||||
You can find following sample codes in `deferred-sample.el`.
|
||||
Executing `eval-last-sexp` (C-x C-e), you can try those codes.
|
||||
|
||||
### Basic usage ###
|
||||
|
||||
This is a basic deferred chain. This code puts some outputs into
|
||||
message buffer, and then require a number from minibuffer.
|
||||
|
||||
Chain:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda () (message "deferred start")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(message "chain 1")
|
||||
1))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "chain 2 : %s" x)))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(read-minibuffer "Input a number: ")))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Got the number : %i" x)))
|
||||
(deferred:error it
|
||||
(lambda (err)
|
||||
(message "Wrong input : %s" err))))
|
||||
```
|
||||
|
||||
* This s-exp returns immediately.
|
||||
* Asynchronous tasks start subsequently.
|
||||
* The macro `deferred:$` chains deferred objects.
|
||||
* The anaphoric variable `it` holds a deferred object in the previous line.
|
||||
* The next deferred task receives the value that is returned by the previous deferred one.
|
||||
* 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`.
|
||||
|
||||
### Timer ###
|
||||
|
||||
After evaluating this s-exp and waiting for 1 second, a message is shown in the minibuffer.
|
||||
|
||||
Timer:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; 1000msec
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Timer sample! : %s msec" x))))
|
||||
```
|
||||
|
||||
* The next deferred task subsequent to deferred:wait receives the actual elapse time in millisecond.
|
||||
|
||||
### Commands and Sub-process ###
|
||||
|
||||
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.)
|
||||
|
||||
Command process:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:process "ls" "-la")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
* This s-exp hardly blocks Emacs because of asynchronous mechanisms.
|
||||
|
||||
|
||||
### HTTP GET : Text ###
|
||||
|
||||
This s-exp inserts a text from http://www.gnu.org asynchronously. (You can clear the result with undo command.)
|
||||
|
||||
HTTP GET:
|
||||
|
||||
```el
|
||||
(require 'url)
|
||||
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.gnu.org")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert (with-current-buffer buf (buffer-string)))
|
||||
(kill-buffer buf))))
|
||||
```
|
||||
|
||||
### HTTP Get : Image ###
|
||||
|
||||
This s-exp inserts an image from google asynchronously.
|
||||
|
||||
Get an image:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert-image
|
||||
(create-image
|
||||
(let ((data (with-current-buffer buf (buffer-string))))
|
||||
(substring data (+ (string-match "\n\n" data) 2)))
|
||||
'png t))
|
||||
(kill-buffer buf))))
|
||||
```
|
||||
|
||||
### Parallel ###
|
||||
|
||||
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.
|
||||
|
||||
Parallel deferred:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png"))
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
|
||||
(deferred:nextc it
|
||||
(lambda (buffers)
|
||||
(cl-loop for i in buffers
|
||||
do
|
||||
(insert
|
||||
(format
|
||||
"size: %s\n"
|
||||
(with-current-buffer i (length (buffer-string)))))
|
||||
(kill-buffer i)))))
|
||||
```
|
||||
|
||||
* The function `deferred:parallel` runs asynchronous tasks concurrently.
|
||||
* The function wait for all results, regardless normal or abnormal. Then, the subsequent tasks are executed.
|
||||
* The next task receives a list of the results.
|
||||
* The order of the results is corresponding to one of the argument.
|
||||
* Giving an alist of tasks as the argument, the results alist is returned.
|
||||
|
||||
### Deferred Combination : try-catch-finally ###
|
||||
|
||||
This s-exp executes following tasks:
|
||||
* Getting an image by wget command,
|
||||
* Resizing the image by convert command in ImageMagick,
|
||||
* Insert the re-sized image into the current buffer.
|
||||
You can construct the control structure of deferred tasks, like try-catch-finally in Java.
|
||||
|
||||
Get an image by wget and resize by ImageMagick:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
|
||||
;; try
|
||||
(deferred:$
|
||||
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
(deferred:nextc it
|
||||
(lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(clear-image-cache)
|
||||
(insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
|
||||
|
||||
;; catch
|
||||
(deferred:error it ;
|
||||
(lambda (err)
|
||||
(insert "Can not get a image! : " err)))
|
||||
|
||||
;; finally
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(deferred:parallel
|
||||
(lambda () (delete-file "a.jpg"))
|
||||
(lambda () (delete-file "b.jpg")))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message ">> %s" x))))
|
||||
```
|
||||
|
||||
* In this case, the deferred tasks are statically connected.
|
||||
|
||||
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.)
|
||||
|
||||
Try-catch-finally:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:try
|
||||
(deferred:$
|
||||
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
(deferred:nextc it
|
||||
(lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(clear-image-cache)
|
||||
(insert-image (create-image (expand-file-name "b.jpg") `jpeg nil)))))
|
||||
:catch
|
||||
(lambda (err) (insert "Can not get a image! : " err))
|
||||
:finally
|
||||
(lambda ()
|
||||
(delete-file "a.jpg")
|
||||
(delete-file "b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message ">> %s" x))))
|
||||
```
|
||||
|
||||
### Timeout ###
|
||||
|
||||
Although a long time command is executed (3 second sleeping), the task is rejected by timeout for 1 second.
|
||||
|
||||
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).
|
||||
|
||||
Timeout Process:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:earlier
|
||||
(deferred:process "sh" "-c" "sleep 3 | echo 'hello!'")
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; timeout msec
|
||||
(deferred:nextc it (lambda () "canceled!"))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
* Changing longer timeout for `deferred:wait`, the next task receives a result of the command.
|
||||
* When a task finishes abnormally, the task is ignored.
|
||||
* When all tasks finishes abnormally, the next task receives nil.
|
||||
* The functions `deferred:parallel` and `deferred:earlier` may be corresponding to `and` and `or`, respectively.
|
||||
|
||||
Here is an another sample code for timeout, employing `deferred:timeout` macro.
|
||||
|
||||
Timeout macro:
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:timeout
|
||||
1000 "canceled!"
|
||||
(deferred:process "sh" "-c" "sleep 3 | echo 'hello!'"))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
```
|
||||
|
||||
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`.
|
||||
|
||||
### Loop and Animation ###
|
||||
|
||||
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.
|
||||
|
||||
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.)
|
||||
|
||||
Employing a recursive structure of deferred tasks, you can construct a deferred loop.
|
||||
It may seem the multi-thread in Emacs Lisp.
|
||||
|
||||
Loop and animation:
|
||||
|
||||
```el
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point))
|
||||
(wait-time 50))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (x) (message "Animation started.")))
|
||||
|
||||
(deferred:nextc it
|
||||
(deferred:lambda (x)
|
||||
(save-excursion
|
||||
(when (< 0 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm))))))
|
||||
(if (> end (cl-incf count)) ; return nil to stop this loop
|
||||
(deferred:nextc (deferred:wait wait-time) self)))) ; return the deferred
|
||||
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))))
|
||||
```
|
||||
|
||||
* `deferred:lambda` is an anaphoric macro in which `self` refers itself. It is convenient to construct a recursive structure.
|
||||
|
||||
### Wrapping asynchronous function ###
|
||||
|
||||
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.
|
||||
|
||||
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`.
|
||||
|
||||
```el
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda ()
|
||||
(message "1")
|
||||
1))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(let ((d (deferred:new #'identity)))
|
||||
(run-at-time 0 nil (lambda (x)
|
||||
;; Start the following callback queue now.
|
||||
(deferred:callback-post d x))
|
||||
x)
|
||||
;; Return the unregistered (not yet started) callback
|
||||
;; queue, so that the following queue will wait until it
|
||||
;; is started.
|
||||
d)))
|
||||
;; You can connect deferred callback queues
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "%s" (1+ x)))))
|
||||
```
|
||||
|
||||
## API ##
|
||||
|
||||
### Functions ###
|
||||
|
||||
#### Basic functions ####
|
||||
|
||||
* deferred:next (callback)
|
||||
* Arguments
|
||||
* callback: a function with zero or one argument
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that wrap the given callback function. Then, put the deferred object into the execution queue to run asynchronously.
|
||||
* Namely, run the given function asynchronously.
|
||||
|
||||
|
||||
* deferred:nextc (d callback)
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* callback: a function with zero or one argument
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that wrap the given callback function. Then, connect the created deferred object with the given deferred object.
|
||||
* Namely, add the given function to the previous deferred object.
|
||||
|
||||
* deferred:error (d errorback)
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* errorback: a function with zero or one argument
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that wrap the given function as errorback. Then, connect the created deferred object with the given deferred object.
|
||||
* Namely, the given function catches the error occurred in the previous task.
|
||||
* If this function does not throw an error, the subsequent callback functions are executed.
|
||||
|
||||
* deferred:cancel (d)
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* Return
|
||||
* the given deferred object (invalidated)
|
||||
* Invalidate the given deferred object.
|
||||
* Because this function modifies the deferred object, one can not used the given deferred instance again.
|
||||
* 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.
|
||||
|
||||
* deferred:watch (d callback)
|
||||
* Arguments
|
||||
* d: deferred object
|
||||
* callback: a function with zero or one argument
|
||||
* Return
|
||||
* a deferred object
|
||||
* Create a deferred object with watch task and connect it to the given deferred object.
|
||||
* The watch task CALLBACK can not affect deferred chains with return values.
|
||||
* This function is used in following purposes, simulation of try-finally block in asynchronous tasks, monitoring of progress of deferred tasks.
|
||||
|
||||
* deferred:wait (msec)
|
||||
* Arguments
|
||||
* msec: a number (millisecond)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that will be called after the specified millisecond.
|
||||
* The subsequent deferred task receives the actual elapse time in millisecond.
|
||||
|
||||
* deferred:$
|
||||
* Arguments / more than one deferred forms
|
||||
* Return / the last deferred object
|
||||
* An anaphoric macro chains deferred objects.
|
||||
* The anaphoric variable `it` holds a deferred object in the previous line.
|
||||
|
||||
#### Utility functions ####
|
||||
|
||||
* deferred:loop (number-or-list callback)
|
||||
* Arguments
|
||||
* number-or-list: an integer or a list
|
||||
* callback: a function with zero or one argument
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that iterates the function for the specified times.
|
||||
* The function receives the count number that begins zero.
|
||||
* If a list is given, not a number, the function visits each elements in the list like `mapc`.
|
||||
|
||||
* deferred:parallel (list-or-alist)
|
||||
* Arguments
|
||||
* list-or-alist:
|
||||
* more than one deferred objects or a list of functions
|
||||
* an alist consist of cons cells with a symbol and a deferred object or a function
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that executes given functions in parallel and wait for all callback values.
|
||||
* The subsequent deferred task receives a list of the results. The order of the results is corresponding to one of the argument.
|
||||
* Giving an alist of tasks as the argument, the results alist is returned.
|
||||
* If the parallel task throws an error, the error object is passed as a result.
|
||||
|
||||
* deferred:earlier (list-or-alist)
|
||||
* Arguments
|
||||
* list-or-alist:
|
||||
* more than one deferred objects or a list of functions
|
||||
* an alist consist of cons cells with a symbol and a deferred object or a function
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that executes given functions in parallel and wait for the first callback value.
|
||||
* The other tasks are rejected. (See the document for `deferred:cancel`)
|
||||
* Giving an alist of tasks as the argument, a cons cell is returned as a result.
|
||||
* When a task finishes abnormally, the task is ignored.
|
||||
* When all tasks finishes abnormally, the next task receives nil. That is, no errorback function is called.
|
||||
|
||||
#### Wrapper functions ####
|
||||
|
||||
* deferred:call (function args...)
|
||||
* Arguments
|
||||
* function: a function
|
||||
* args: arguments (variable length)
|
||||
* Return
|
||||
* a deferred object
|
||||
* a wrapper of the function `funcall`
|
||||
|
||||
* deferred:apply (function args)
|
||||
* Arguments
|
||||
* function: a function
|
||||
* args: a list of arguments
|
||||
* Return
|
||||
* a deferred object
|
||||
* a wrapper of the function `apply`
|
||||
|
||||
* deferred:process (command args...) / deferred:process-shell (command args...)
|
||||
* Arguments
|
||||
* command: command to execute
|
||||
* args: command arguments (variable length)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Execute a command asynchronously. These functions are wrappers of `start-process` and `start-process-shell-command`.
|
||||
* The subsequent deferred task receives the stdout and stderr from the command as a string.
|
||||
|
||||
* deferred:process-buffer (command args...) / deferred:process-shell-buffer (command args...)
|
||||
* Arguments
|
||||
* command: command to execute
|
||||
* args: command arguments (variable length)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Execute a command asynchronously. These functions are wrappers of `start-process` and `start-process-shell-command`.
|
||||
* The subsequent deferred task receives the stdout and stderr from the command as a buffer.
|
||||
* The following tasks are responsible to kill the buffer.
|
||||
|
||||
* deferred:wait-idle (msec)
|
||||
* Arguments
|
||||
* msec: a number (millisecond)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Return a deferred object that will be called when Emacs has been idle for the specified millisecond.
|
||||
* The subsequent deferred task receives the elapse time in millisecond.
|
||||
|
||||
* deferred:url-retrieve (url [cbargs])
|
||||
* Arguments
|
||||
* url: URL to get
|
||||
* cbargs: callback argument (optional)
|
||||
* Return
|
||||
* a deferred object
|
||||
* A wrapper function of `url-retrieve` in the `url` package.
|
||||
* The subsequent deferred task receives the content as a buffer.
|
||||
* The following tasks are responsible to kill the buffer.
|
||||
|
||||
* [experimental] deferred:url-get (url [params])
|
||||
* Arguments
|
||||
* url: URL to get
|
||||
* params: alist of parameters
|
||||
* Return
|
||||
* a deferred object
|
||||
|
||||
* [experimental] deferred:url-post (url [params])
|
||||
* Arguments
|
||||
* url: URL to get
|
||||
* params: alist of parameters
|
||||
* Return
|
||||
* a deferred object
|
||||
|
||||
#### Primitive functions ####
|
||||
|
||||
* deferred:new ([callback])
|
||||
* Arguments
|
||||
* callback: a function with zero or one argument (optional)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Create a deferred object
|
||||
* The created deferred object is never called until someone call the function `deferred:callback` or `deferred:errorback`.
|
||||
* Using this object, a deferred chain can pause to wait for other events. (See the source for `deferred:wait`.)
|
||||
|
||||
* deferred:succeed ([value])
|
||||
* Arguments
|
||||
* value: a value (optional)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Create a deferred object that has been called the callback function.
|
||||
* When a deferred task is connected, the subsequent task will be executed immediately (synchronously).
|
||||
|
||||
* deferred:fail ([error])
|
||||
* Arguments
|
||||
* error: an error value (optional)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Create a deferred object that has been called the errorback function.
|
||||
* When a deferred task is connected, the subsequent task will be executed immediately (synchronously).
|
||||
|
||||
* deferred:callback (d [value])
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* value: a value (optional)
|
||||
* Return
|
||||
* a deferred object or a result value
|
||||
* Start executing the deferred tasks. The first task is executed synchronously.
|
||||
|
||||
* deferred:callback-post (d [value])
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* value: a value (optional)
|
||||
* Return
|
||||
* a deferred object or a result value
|
||||
* Start executing the deferred tasks. The first task is executed asynchronously.
|
||||
|
||||
* deferred:errorback (d [error])
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* error: an error value (optional)
|
||||
* Return
|
||||
* a deferred object or a result value
|
||||
* Start executing the deferred tasks from errorback. The first task is executed synchronously.
|
||||
|
||||
* deferred:errorback-post (d [error])
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* error: an error value (optional)
|
||||
* Return
|
||||
* a deferred object or a result value
|
||||
* Start executing the deferred tasks from errorback. The first task is executed asynchronously.
|
||||
|
||||
### Utility Macros ###
|
||||
|
||||
* deferred:try (d &key catch finally)
|
||||
* Arguments
|
||||
* d: deferred object
|
||||
* 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`.)
|
||||
* 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.)
|
||||
* Return
|
||||
* a deferred object
|
||||
* Try-catch-finally macro. This macro simulates the try-catch-finally block asynchronously.
|
||||
* Because of asynchrony, this macro does not ensure that the `finally` task should be called.
|
||||
* This macro is implemented by `deferred:error` and `deferred:watch`.
|
||||
|
||||
* deferred:timeout (msec timeout-form d)
|
||||
* Arguments
|
||||
* msec: a number
|
||||
* timeout-form: sexp-form
|
||||
* d: a deferred object
|
||||
* Return
|
||||
* a deferred object
|
||||
* Time out macro on a deferred task `d`.
|
||||
* 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`)
|
||||
* This macro is implemented by `deferred:earlier` and `deferred:wait`.
|
||||
|
||||
* deferred:process...
|
||||
* deferred:processc (d command args...)
|
||||
* deferred:process-bufferc (d command args...)
|
||||
* deferred:process-shellc (d command args...)
|
||||
* deferred:process-shell-bufferc (d command args...)
|
||||
* Arguments
|
||||
* d: a deferred object
|
||||
* command: command to execute
|
||||
* args: command arguments (variable length)
|
||||
* Return
|
||||
* a deferred object
|
||||
* This macro wraps the deferred:process function in deferred:nextc and connect the given deferred task.
|
||||
|
||||
### Execution and Connection ###
|
||||
|
||||
#### Firing ####
|
||||
|
||||
Some deferred functions can fire a deferred chain implicitly. Following functions register a deferred object with the execution queue to run asynchronously.
|
||||
|
||||
* next
|
||||
* wait
|
||||
* loop
|
||||
* parallel
|
||||
* earlier
|
||||
* call, apply
|
||||
* process
|
||||
* url-retrieve, url-get, url-post
|
||||
|
||||
|
||||
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`.)
|
||||
|
||||
|
||||
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.
|
||||
|
||||
#### Static connection ####
|
||||
|
||||
The `static connection (statically connected)` is a connection between deferred tasks on the source code.
|
||||
This is a basic usage for the deferred chain.
|
||||
|
||||
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.
|
||||
|
||||
#### Dynamic Connection ####
|
||||
|
||||
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)`.
|
||||
|
||||
Employing a recursive structure of deferred tasks, you can construct higher level control structures, such as loop.
|
||||
|
||||
## Discussion ##
|
||||
|
||||
Some discussions of writing deferred codes.
|
||||
|
||||
### Using lexical scope ###
|
||||
|
||||
Using the lexical scope macro, such as `let`, the deferred tasks defined by lambdas can access local variables.
|
||||
|
||||
`let` Ex.:
|
||||
|
||||
```el
|
||||
(let ((a (point)))
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(goto-char a)
|
||||
(insert "here!")))))
|
||||
```
|
||||
|
||||
If you write a code of deferred tasks without lexical scope macros, you should be careful with the scopes of each variables.
|
||||
|
||||
### Excursion (Current status) ###
|
||||
|
||||
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.
|
||||
|
||||
Wrong Ex.:
|
||||
|
||||
```el
|
||||
(with-current-buffer (get-buffer "*Message*")
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(insert "Time: %s " x) ; `insert` may not be in the *Message* buffer!
|
||||
))))
|
||||
```
|
||||
|
||||
In this case, using lexical scope macros to access the buffer variable, you can change the buffer in the deferred task.
|
||||
|
||||
Corrected:
|
||||
|
||||
```el
|
||||
(let ((buf (get-buffer "*Message*")))
|
||||
(deferred:$
|
||||
(deferred:wait 1000)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(with-current-buffer buf ; Set buffer in the asynchronous task.
|
||||
(insert "Time: %s " x))))))
|
||||
```
|
||||
|
||||
|
||||
### Be aware of return values ###
|
||||
|
||||
However the dynamic connection is a powerful feature, sometimes it causes bugs of the wrong execution order, because of returning not intended deferred objects.
|
||||
|
||||
Then, you should watch the return values of the deferred tasks not to cause an unexpected dynamic connection.
|
||||
|
||||
### Debugging ###
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
### Using macros ###
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
### Introduction for deferred ###
|
||||
|
||||
Following documents are good introduction to deferred.
|
||||
|
||||
* [Introduction to JSDeferred](http://cho45.stfuawsc.com/jsdeferred/doc/intro.en.html "Introduction to JSDeferred")
|
||||
* [JSDeferred site](http://cho45.stfuawsc.com/jsdeferred/ "JSDeferred site")
|
||||
|
||||
* * * * *
|
||||
|
||||
(C) 2010-2016 SAKURAI Masashi All rights reserved.
|
||||
m.sakurai at kiwanami.net
|
||||
@ -1,501 +0,0 @@
|
||||
;;; concurrent.el --- Concurrent utility functions for emacs lisp -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010-2016 SAKURAI Masashi
|
||||
|
||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
||||
;; Version: 0.5.0
|
||||
;; Keywords: deferred, async, concurrent
|
||||
;; Package-Requires: ((emacs "24.3") (deferred "0.5.0"))
|
||||
;; URL: https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; 'concurrent.el' is a higher level library for concurrent tasks
|
||||
;; based on 'deferred.el'. This library has following features:
|
||||
;;
|
||||
;; - Generator
|
||||
;; - Green thread
|
||||
;; - Semaphore
|
||||
;; - Dataflow
|
||||
;; - Signal/Channel
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(require 'deferred)
|
||||
|
||||
(defvar cc:version nil "version number")
|
||||
(setq cc:version "0.3")
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
|
||||
(defmacro cc:aif (test-form then-form &rest else-forms)
|
||||
(declare (debug (form form &rest form)))
|
||||
`(let ((it ,test-form))
|
||||
(if it ,then-form ,@else-forms)))
|
||||
(put 'cc:aif 'lisp-indent-function 2)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Generator
|
||||
|
||||
(defun cc:generator-replace-yield (tree)
|
||||
"[internal] Replace `yield' symbols to calling a function in TREE."
|
||||
(let (ret)
|
||||
(cl-loop for i in tree
|
||||
do (cond
|
||||
((eq i 'yield)
|
||||
(push 'funcall ret)
|
||||
(push i ret))
|
||||
((listp i)
|
||||
(push (cc:generator-replace-yield i) ret))
|
||||
(t
|
||||
(push i ret))))
|
||||
(nreverse ret)))
|
||||
|
||||
(defun cc:generator-line (chain line)
|
||||
"[internal] Return a macro expansion to execute the sexp LINE
|
||||
asynchronously."
|
||||
(cond
|
||||
;; function object
|
||||
((functionp line)
|
||||
`(setq ,chain (deferred:nextc ,chain ,line)))
|
||||
;; while loop form
|
||||
((eq 'while (car line))
|
||||
(let ((condition (cadr line))
|
||||
(body (cddr line)))
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x)
|
||||
(if ,condition
|
||||
(deferred:nextc
|
||||
(progn
|
||||
,@(cc:generator-replace-yield body)) self)))))))
|
||||
;; statement
|
||||
(t
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x) ,(cc:generator-replace-yield line)))))))
|
||||
|
||||
(defmacro cc:generator (callback &rest body)
|
||||
"Create a generator object. If BODY has `yield' symbols, it
|
||||
means calling callback function CALLBACK."
|
||||
(let ((chain (cl-gensym))
|
||||
(cc (cl-gensym))
|
||||
(waiter (cl-gensym)))
|
||||
`(let* (,chain
|
||||
(,cc ,callback)
|
||||
(,waiter (deferred:new))
|
||||
(yield (lambda (x) (funcall ,cc x) ,waiter)))
|
||||
(setq ,chain ,waiter)
|
||||
,@(cl-loop for i in body
|
||||
collect
|
||||
(cc:generator-line chain i))
|
||||
(lambda () (deferred:callback ,waiter)))))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Thread
|
||||
|
||||
(defun cc:thread-line (wait-time chain line)
|
||||
"[internal] Return a macro expansion to execute the sexp LINE asynchronously.
|
||||
WAIT-TIME is an interval time between tasks.
|
||||
CHAIN is the previous deferred task."
|
||||
(cond
|
||||
;; function object
|
||||
((functionp line)
|
||||
`(setq ,chain (deferred:nextc ,chain ,line)))
|
||||
;; while loop form
|
||||
((eq 'while (car line))
|
||||
(let ((condition (cadr line))
|
||||
(body (cddr line))
|
||||
(retsym (cl-gensym)))
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(deferred:lambda (x)
|
||||
(if ,condition
|
||||
(deferred:nextc
|
||||
(let ((,retsym (progn ,@body)))
|
||||
(if (deferred-p ,retsym) ,retsym
|
||||
(deferred:wait ,wait-time)))
|
||||
self)))))))
|
||||
;; statement
|
||||
(t
|
||||
`(setq ,chain
|
||||
(deferred:nextc ,chain
|
||||
(lambda (x) ,line))))))
|
||||
|
||||
(defmacro cc:thread (wait-time-msec &rest body)
|
||||
"Return a thread object."
|
||||
(let ((chain (cl-gensym))
|
||||
(dstart (cl-gensym)))
|
||||
`(let* (,chain
|
||||
(,dstart (deferred:new)))
|
||||
(setq ,chain ,dstart)
|
||||
,@(cl-loop for i in body
|
||||
collect
|
||||
(cc:thread-line wait-time-msec chain i))
|
||||
(deferred:callback ,dstart))))
|
||||
(put 'cc:thread 'lisp-indent-function 1)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Semaphore
|
||||
|
||||
(cl-defstruct cc:semaphore max-permits permits waiting-deferreds)
|
||||
|
||||
(defun cc:semaphore-create(permits-num)
|
||||
"Return a semaphore object with PERMITS-NUM permissions."
|
||||
(make-cc:semaphore :max-permits permits-num :permits permits-num))
|
||||
|
||||
(defun cc:semaphore-acquire(semaphore)
|
||||
"Acquire an execution permission and return deferred object to chain.
|
||||
If this semaphore object has permissions, the subsequent deferred
|
||||
task is executed immediately. If this semaphore object has no
|
||||
permissions, the subsequent deferred task is blocked. After the
|
||||
permission is returned, the task is executed."
|
||||
(cond
|
||||
((< 0 (cc:semaphore-permits semaphore))
|
||||
(cl-decf (cc:semaphore-permits semaphore))
|
||||
(deferred:succeed))
|
||||
(t
|
||||
(let ((d (deferred:new)))
|
||||
(push d (cc:semaphore-waiting-deferreds semaphore))
|
||||
d))))
|
||||
|
||||
(defun cc:semaphore-release(semaphore)
|
||||
"Release an execution permission. The programmer is responsible to return the permissions."
|
||||
(when (<= (cc:semaphore-max-permits semaphore)
|
||||
(cc:semaphore-permits semaphore))
|
||||
(error "Too many calling semaphore-release. [max:%s <= permits:%s]"
|
||||
(cc:semaphore-max-permits semaphore)
|
||||
(cc:semaphore-permits semaphore)))
|
||||
(let ((waiting-deferreds
|
||||
(cc:semaphore-waiting-deferreds semaphore)))
|
||||
(cond
|
||||
(waiting-deferreds
|
||||
(let* ((d (car (last waiting-deferreds))))
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore)
|
||||
(nbutlast waiting-deferreds))
|
||||
(deferred:callback-post d)))
|
||||
(t
|
||||
(cl-incf (cc:semaphore-permits semaphore)))))
|
||||
semaphore)
|
||||
|
||||
(defun cc:semaphore-with (semaphore body-func &optional error-func)
|
||||
"Execute the task BODY-FUNC asynchronously with the semaphore block."
|
||||
(deferred:try
|
||||
(deferred:nextc (cc:semaphore-acquire semaphore) body-func)
|
||||
:catch
|
||||
error-func
|
||||
:finally
|
||||
(lambda (_x) (cc:semaphore-release semaphore))))
|
||||
(put 'cc:semaphore-with 'lisp-indent-function 1)
|
||||
|
||||
(defun cc:semaphore-release-all (semaphore)
|
||||
"Release all permissions for resetting the semaphore object.
|
||||
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."
|
||||
(setf (cc:semaphore-permits semaphore)
|
||||
(cc:semaphore-max-permits semaphore))
|
||||
(let ((ds (cc:semaphore-waiting-deferreds semaphore)))
|
||||
(when ds
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore) nil))
|
||||
ds))
|
||||
|
||||
(defun cc:semaphore-interrupt-all (semaphore)
|
||||
"Clear the list of the blocked tasks in the semaphore and return a deferred object to chain.
|
||||
This function is used for the interruption cases."
|
||||
(when (cc:semaphore-waiting-deferreds semaphore)
|
||||
(setf (cc:semaphore-waiting-deferreds semaphore) nil)
|
||||
(setf (cc:semaphore-permits semaphore) 0))
|
||||
(cc:semaphore-acquire semaphore))
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Signal / Channel
|
||||
|
||||
(defun cc:signal-channel (&optional name parent-channel)
|
||||
"Create a channel.
|
||||
NAME is a channel name for debug.
|
||||
PARENT-CHANNEL is an upstream channel. The observers of this channel can receive the upstream signals.
|
||||
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."
|
||||
(let ((ch (cons
|
||||
(or name (format "signal%s" (deferred:uid))) ; name for debug
|
||||
(cons
|
||||
parent-channel ; parent-channel
|
||||
nil)))) ; observers
|
||||
(when parent-channel
|
||||
(cc:signal-connect
|
||||
parent-channel
|
||||
t (lambda (event)
|
||||
(cl-destructuring-bind
|
||||
(event-name event-args) event
|
||||
(apply 'cc:signal-send
|
||||
ch event-name event-args)))))
|
||||
ch))
|
||||
|
||||
(defmacro cc:signal-name (ch)
|
||||
"[internal] Return signal name."
|
||||
`(car ,ch))
|
||||
|
||||
(defmacro cc:signal-parent-channel (ch)
|
||||
"[internal] Return parent channel object."
|
||||
`(cadr ,ch))
|
||||
|
||||
(defmacro cc:signal-observers (ch)
|
||||
"[internal] Return observers."
|
||||
`(cddr ,ch))
|
||||
|
||||
(defun cc:signal-connect (channel event-sym &optional callback)
|
||||
"Append an observer for EVENT-SYM of CHANNEL and return a deferred object.
|
||||
If EVENT-SYM is `t', the observer receives all signals of the channel.
|
||||
If CALLBACK function is given, the deferred object executes the
|
||||
CALLBACK function asynchronously. One can connect subsequent
|
||||
tasks to the returned deferred object."
|
||||
(let ((d (if callback
|
||||
(deferred:new callback)
|
||||
(deferred:new))))
|
||||
(push (cons event-sym d)
|
||||
(cc:signal-observers channel))
|
||||
d))
|
||||
|
||||
(defun cc:signal-send (channel event-sym &rest args)
|
||||
"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 ... )). "
|
||||
(let ((observers (cc:signal-observers channel))
|
||||
(event (list event-sym args)))
|
||||
(cl-loop for i in observers
|
||||
for name = (car i)
|
||||
for d = (cdr i)
|
||||
if (or (eq event-sym name) (eq t name))
|
||||
do (deferred:callback-post d event))))
|
||||
|
||||
(defun cc:signal-send-global (channel event-sym &rest args)
|
||||
"Send a signal to the most upstream channel. "
|
||||
(cc:aif (cc:signal-parent-channel channel)
|
||||
(apply 'cc:signal-send-global it event-sym args)
|
||||
(apply 'cc:signal-send channel event-sym args)))
|
||||
|
||||
|
||||
(defun cc:signal-disconnect (channel deferred)
|
||||
"Remove the observer object DEFERRED from CHANNEL and return
|
||||
the removed deferred object. "
|
||||
(let ((observers (cc:signal-observers channel)) deleted)
|
||||
(setf
|
||||
(cc:signal-observers channel) ; place
|
||||
(cl-loop for i in observers
|
||||
for d = (cdr i)
|
||||
unless (eq d deferred)
|
||||
collect i
|
||||
else
|
||||
do (push i deleted)))
|
||||
deleted))
|
||||
|
||||
(defun cc:signal-disconnect-all (channel)
|
||||
"Remove all observers."
|
||||
(setf
|
||||
(cc:signal-observers channel) ; place
|
||||
nil))
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dataflow
|
||||
|
||||
;; Dataflow variable entry
|
||||
(cl-defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
|
||||
|
||||
(defun cc:dataflow-undefine-p (obj)
|
||||
"[internal] If the variable entry is not bound, return `t'."
|
||||
(eq 'cc:dataflow-undefine (cc:dataflow-value obj)))
|
||||
|
||||
(defmacro cc:dataflow-parent-environment (df)
|
||||
"[internal] Return the parent environment."
|
||||
`(car ,df))
|
||||
|
||||
(defmacro cc:dataflow-test (df)
|
||||
"[internal] Return the test function."
|
||||
`(cadr ,df))
|
||||
|
||||
(defmacro cc:dataflow-channel (df)
|
||||
"[internal] Return the channel object."
|
||||
`(cl-caddr ,df))
|
||||
|
||||
(defmacro cc:dataflow-list (df)
|
||||
"[internal] Return the list of deferred object which are waiting for value binding."
|
||||
`(cl-cdddr ,df))
|
||||
|
||||
(defun cc:dataflow-environment (&optional parent-env test-func channel)
|
||||
"Create a dataflow environment.
|
||||
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.
|
||||
TEST-FUNC is a test function that compares the entry keys. The default function is `equal'.
|
||||
CHANNEL is a channel object that sends signals of variable events. Observers can receive following signals:
|
||||
-get-first : the fist referrer is waiting for binding,
|
||||
-get-waiting : another referrer is waiting for binding,
|
||||
-set : a value is bound,
|
||||
-get : returned a bound value,
|
||||
-clear : cleared one entry,
|
||||
-clear-all : cleared all entries.
|
||||
"
|
||||
(let ((this (list parent-env
|
||||
(or test-func 'equal)
|
||||
(or channel
|
||||
(cc:signal-channel
|
||||
'dataflow
|
||||
(and parent-env
|
||||
(cc:dataflow-channel parent-env)))))))
|
||||
(cc:dataflow-init-connect this)
|
||||
this))
|
||||
|
||||
(defun cc:dataflow-init-connect (df)
|
||||
"[internal] Initialize the channel object."
|
||||
(cc:dataflow-connect
|
||||
df 'set
|
||||
(lambda (args)
|
||||
(cl-destructuring-bind (_event (key)) args
|
||||
(let* ((obj (cc:dataflow-get-object-for-value df key))
|
||||
(value (and obj (cc:dataflow-value obj))))
|
||||
(when obj
|
||||
(cl-loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
|
||||
(cc:dataflow-deferred-list it) nil)
|
||||
do (deferred:callback-post i value))
|
||||
(setf (cc:dataflow-deferred-list obj) nil)))))))
|
||||
|
||||
(defun cc:dataflow-get-object-for-value (df key)
|
||||
"[internal] Return an entry object that is indicated by KEY.
|
||||
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."
|
||||
(or
|
||||
(cl-loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
if (and (funcall test key (cc:dataflow-key i))
|
||||
(not (cc:dataflow-undefine-p i)))
|
||||
return i)
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-object-for-value it key))))
|
||||
|
||||
(defun cc:dataflow-get-object-for-deferreds (df key)
|
||||
"[internal] Return a list of the deferred objects those are waiting for value binding.
|
||||
This function doesn't affect the waiting list and doesn't refer the parent environment."
|
||||
(cl-loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
if (funcall test key (cc:dataflow-key i))
|
||||
return i))
|
||||
|
||||
(defun cc:dataflow-connect (df event-sym &optional callback)
|
||||
"Append an observer for EVENT-SYM of the channel of DF and return a deferred object.
|
||||
See the docstring of `cc:dataflow-environment' for details."
|
||||
(cc:signal-connect (cc:dataflow-channel df) event-sym callback))
|
||||
|
||||
(defun cc:dataflow-signal (df event &optional arg)
|
||||
"[internal] Send a signal to the channel of DF."
|
||||
(cc:signal-send (cc:dataflow-channel df) event arg))
|
||||
|
||||
(defun cc:dataflow-get (df key)
|
||||
"Return a deferred object that can refer the value which is indicated by KEY.
|
||||
If DF has the entry that bound value, the subsequent deferred task is executed immediately.
|
||||
If not, the task is deferred till a value is bound."
|
||||
(let ((obj (cc:dataflow-get-object-for-value df key)))
|
||||
(cond
|
||||
((and obj (cc:dataflow-value obj))
|
||||
(cc:dataflow-signal df 'get key)
|
||||
(deferred:succeed (cc:dataflow-value obj)))
|
||||
(t
|
||||
(setq obj (cc:dataflow-get-object-for-deferreds df key))
|
||||
(unless obj
|
||||
(setq obj (make-cc:dataflow :key key))
|
||||
(push obj (cc:dataflow-list df))
|
||||
(cc:dataflow-signal df 'get-first key))
|
||||
(let ((d (deferred:new)))
|
||||
(push d (cc:dataflow-deferred-list obj))
|
||||
(cc:dataflow-signal df 'get-waiting key)
|
||||
d)))))
|
||||
|
||||
(defun cc:dataflow-get-sync (df key)
|
||||
"Return the value which is indicated by KEY synchronously.
|
||||
If the environment DF doesn't have an entry of KEY, this function returns nil."
|
||||
(let ((obj (cc:dataflow-get-object-for-value df key)))
|
||||
(and obj (cc:dataflow-value obj))))
|
||||
|
||||
(defun cc:dataflow-set (df key value)
|
||||
"Bind the VALUE to KEY in the environment DF.
|
||||
If DF already has the bound entry of KEY, this function throws an error signal.
|
||||
VALUE can be nil as a value."
|
||||
(let ((obj (cc:dataflow-get-object-for-deferreds df key)))
|
||||
(cond
|
||||
((and obj (not (cc:dataflow-undefine-p obj)))
|
||||
;; overwrite!
|
||||
(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)))
|
||||
(obj
|
||||
(setf (cc:dataflow-value obj) value))
|
||||
(t
|
||||
;; just value arrived
|
||||
(push (make-cc:dataflow :key key :value value)
|
||||
(cc:dataflow-list df))))
|
||||
;; value arrived and start deferred objects
|
||||
(cc:dataflow-signal df 'set key)
|
||||
value))
|
||||
|
||||
(defun cc:dataflow-clear (df key)
|
||||
"Clear the entry which is indicated by KEY.
|
||||
This function does nothing for the waiting deferred objects."
|
||||
(cc:dataflow-signal df 'clear key)
|
||||
(setf (cc:dataflow-list df)
|
||||
(cl-loop for i in (cc:dataflow-list df)
|
||||
with test = (cc:dataflow-test df)
|
||||
unless (funcall test key (cc:dataflow-key i))
|
||||
collect i)))
|
||||
|
||||
(defun cc:dataflow-get-avalable-pairs (df)
|
||||
"Return an available key-value alist in the environment DF and the parent ones."
|
||||
(append
|
||||
(cl-loop for i in (cc:dataflow-list df)
|
||||
for key = (cc:dataflow-key i)
|
||||
for val = (cc:dataflow-value i)
|
||||
unless (cc:dataflow-undefine-p i) collect (cons key val))
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-avalable-pairs it))))
|
||||
|
||||
(defun cc:dataflow-get-waiting-keys (df)
|
||||
"Return a list of keys which have waiting deferred objects in the environment DF and the parent ones."
|
||||
(append
|
||||
(cl-loop for i in (cc:dataflow-list df)
|
||||
for key = (cc:dataflow-key i)
|
||||
if (cc:dataflow-undefine-p i) collect key)
|
||||
(deferred:aand
|
||||
(cc:dataflow-parent-environment df)
|
||||
(cc:dataflow-get-waiting-keys it))))
|
||||
|
||||
(defun cc:dataflow-clear-all (df)
|
||||
"Clear all entries in the environment DF.
|
||||
This function does nothing for the waiting deferred objects."
|
||||
(cc:dataflow-signal df 'clear-all)
|
||||
(setf (cc:dataflow-list df) nil))
|
||||
|
||||
|
||||
(provide 'concurrent)
|
||||
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
||||
;;; concurrent.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,185 +0,0 @@
|
||||
;;; Sample code for concurrent.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Evaluate following code in the scratch buffer.
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'concurrent)
|
||||
|
||||
;;==================================================
|
||||
;;; generator
|
||||
|
||||
(defvar fib-list nil)
|
||||
|
||||
(defvar fib-gen ; Create a generator object.
|
||||
(let ((a1 0) (a2 1))
|
||||
(cc:generator
|
||||
(lambda (x) (push x fib-list)) ; receiving values
|
||||
(yield a1)
|
||||
(yield a2)
|
||||
(while t
|
||||
(let ((next (+ a1 a2)))
|
||||
(setq a1 a2
|
||||
a2 next)
|
||||
(yield next))))))
|
||||
|
||||
(funcall fib-gen) ; Generate 5 times
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
(funcall fib-gen) (funcall fib-gen)
|
||||
|
||||
fib-list ;=> (3 2 1 1 0)
|
||||
|
||||
|
||||
;;==================================================
|
||||
;;; thread
|
||||
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point)))
|
||||
(cc:thread
|
||||
60
|
||||
(message "Animation started.")
|
||||
(while (> end (cl-incf count))
|
||||
(save-excursion
|
||||
(when (< 1 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm)))))))
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))
|
||||
|
||||
;; Play the simple character animation here.
|
||||
|
||||
|
||||
;;==================================================
|
||||
;;; semaphore
|
||||
|
||||
;; create a semaphore object with permit=1.
|
||||
(defvar smp (cc:semaphore-create 1))
|
||||
|
||||
;; executing three tasks...
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda (_)
|
||||
(message "go1")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda (_)
|
||||
(message "go2")))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda (_)
|
||||
(message "go3")))
|
||||
|
||||
;; => Only the fist task is executed and displays "go1".
|
||||
|
||||
(cc:semaphore-release smp)
|
||||
|
||||
;; => The second task is executed and displays "go2".
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; return the deferred object that displays "go3".
|
||||
|
||||
(cc:semaphore-release-all smp) ; => reset permit count and return the deferred object that displays "go3".
|
||||
|
||||
(cc:semaphore-waiting-deferreds smp) ; => nil
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Dataflow
|
||||
|
||||
;; create a parent environment and bind "aaa" to 256.
|
||||
(defvar dfenv-parent (cc:dataflow-environment))
|
||||
(cc:dataflow-set dfenv-parent "aaa" 256)
|
||||
|
||||
;; create an environment with the parent one.
|
||||
(defvar dfenv (cc:dataflow-environment dfenv-parent))
|
||||
|
||||
;; Return the parent value.
|
||||
(cc:dataflow-get-sync dfenv "aaa") ; => 256
|
||||
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Got abc : %s" x))))
|
||||
;; => This task is blocked
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 256) ; bind 256 to "abc"
|
||||
|
||||
;; => The blocked task is executed and displays "Got abc : 256".
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => 256
|
||||
|
||||
;; unbind the variable "abc"
|
||||
(cc:dataflow-clear dfenv "abc")
|
||||
|
||||
(cc:dataflow-get-sync dfenv "abc") ; => nil
|
||||
|
||||
|
||||
;; complicated key (`equal' can compare nested lists.)
|
||||
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "a.jpg:300 OK %s" x))))
|
||||
|
||||
(cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)
|
||||
|
||||
;; waiting for two variables
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(cc:dataflow-get dfenv "def"))
|
||||
(deferred:nextc it
|
||||
(lambda (values)
|
||||
(apply 'message "Got values : %s, %s" values)
|
||||
(apply '+ values)))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert (format ">> %s" x)))))
|
||||
|
||||
(cc:dataflow-get-waiting-keys dfenv) ; => ("def" "abc")
|
||||
(cc:dataflow-get-avalable-pairs dfenv) ; => (("aaa" . 256))
|
||||
|
||||
(cc:dataflow-set dfenv "abc" 128)
|
||||
(cc:dataflow-set dfenv "def" 256)
|
||||
|
||||
;; => "Got values : 128, 256"
|
||||
;; inserted ">> 384"
|
||||
|
||||
(cc:dataflow-get-avalable-pairs dfenv)
|
||||
|
||||
(cc:dataflow-clear-all dfenv)
|
||||
|
||||
(cc:dataflow-get-avalable-pairs dfenv)
|
||||
|
||||
|
||||
;;==================================================
|
||||
;; Signal
|
||||
|
||||
(progn
|
||||
(defvar parent-channel (cc:signal-channel "parent"))
|
||||
(cc:signal-connect
|
||||
parent-channel 'parent-load
|
||||
(lambda (event) (message "Parent Signal : %s" event)))
|
||||
(cc:signal-connect
|
||||
parent-channel t
|
||||
(lambda (event) (message "Parent Listener : %s" event)))
|
||||
|
||||
(defvar channel (cc:signal-channel "child" parent-channel))
|
||||
(cc:signal-connect
|
||||
channel 'window-load
|
||||
(lambda (event) (message "Signal : %s" event)))
|
||||
(cc:signal-connect
|
||||
channel t
|
||||
(lambda (event) (message "Listener : %s" event)))
|
||||
(deferred:$
|
||||
(cc:signal-connect channel 'window-load)
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message "Deferred Signal : %s" x))))
|
||||
)
|
||||
|
||||
(cc:signal-send channel 'window-load "hello signal!")
|
||||
(cc:signal-send channel 'some "some signal!")
|
||||
|
||||
(cc:signal-send parent-channel 'parent-load "parent hello!")
|
||||
(cc:signal-send parent-channel 'window-load "parent hello!")
|
||||
(cc:signal-send parent-channel 'some "parent some hello!")
|
||||
(cc:signal-send-global channel 'some "parent some hello!")
|
||||
|
||||
(cc:signal-disconnect-all channel)
|
||||
@ -1,166 +0,0 @@
|
||||
;; deferred.el samples -*- lexical-binding: t; -*-
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'deferred)
|
||||
|
||||
;;; Basic Chain
|
||||
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda () (message "deferred start")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(message "chain 1")
|
||||
1))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "chain 2 : %s" x)))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(read-minibuffer "Input a number: ")))
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Got the number : %i" x)))
|
||||
(deferred:error it
|
||||
(lambda (err)
|
||||
(message "Wrong input : %s" err))))
|
||||
|
||||
|
||||
;;; Timer
|
||||
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; 1000msec
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(message "Timer sample! : %s msec" x))))
|
||||
|
||||
|
||||
;;; Command process
|
||||
|
||||
(deferred:$
|
||||
(deferred:process "ls" "-la")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
|
||||
|
||||
;;; Web Access
|
||||
|
||||
;; Simple web access
|
||||
|
||||
(require 'url)
|
||||
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.gnu.org")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert (with-current-buffer buf (buffer-string)))
|
||||
(kill-buffer buf))))
|
||||
|
||||
;; Get an image
|
||||
|
||||
(deferred:$
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert-image
|
||||
(create-image
|
||||
(let ((data (with-current-buffer buf (buffer-string))))
|
||||
(substring data (+ (string-match "\n\n" data) 2)))
|
||||
'png t))
|
||||
(kill-buffer buf))))
|
||||
|
||||
;; HTTP POST
|
||||
|
||||
(deferred:$
|
||||
(deferred:url-post
|
||||
"http://127.0.0.1:8080/post-test.cgi"
|
||||
'(('a . "test") ('param . "OK")))
|
||||
(deferred:nextc it
|
||||
(lambda (buf)
|
||||
(insert (with-current-buffer buf (buffer-string)))
|
||||
(kill-buffer buf))))
|
||||
|
||||
|
||||
;; Parallel deferred
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png"))
|
||||
(lambda ()
|
||||
(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
|
||||
(deferred:nextc it
|
||||
(lambda (buffers)
|
||||
(cl-loop for i in buffers
|
||||
do
|
||||
(insert
|
||||
(format
|
||||
"size: %s\n"
|
||||
(with-current-buffer i (length (buffer-string)))))
|
||||
(kill-buffer i)))))
|
||||
|
||||
;; Get an image by wget and resize by ImageMagick
|
||||
|
||||
(deferred:$
|
||||
|
||||
;; try
|
||||
(deferred:$
|
||||
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
|
||||
(deferred:nextc it
|
||||
(lambda () (deferred:process "convert" "a.jpg" "-resize" "100x100" "jpg:b.jpg")))
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(clear-image-cache)
|
||||
(insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
|
||||
|
||||
;; catch
|
||||
(deferred:error it ;
|
||||
(lambda (err)
|
||||
(insert "Can not get a image! : " err)))
|
||||
|
||||
;; finally
|
||||
(deferred:nextc it
|
||||
(lambda ()
|
||||
(deferred:parallel
|
||||
(lambda () (delete-file "a.jpg"))
|
||||
(lambda () (delete-file "b.jpg")))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (message ">> %s" x))))
|
||||
|
||||
|
||||
;; Timeout Process
|
||||
|
||||
(deferred:$
|
||||
(deferred:earlier
|
||||
(deferred:process "sh" "-c" "sleep 3 | echo 'hello!'")
|
||||
(deferred:$
|
||||
(deferred:wait 1000) ; timeout msec
|
||||
(deferred:nextc it (lambda () "canceled!"))))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (insert x))))
|
||||
|
||||
|
||||
;; Loop and animation
|
||||
|
||||
(let ((count 0) (anm "-/|\\-")
|
||||
(end 50) (pos (point))
|
||||
(wait-time 50))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_) (message "Animation started.")))
|
||||
|
||||
(deferred:nextc it
|
||||
(deferred:lambda (_)
|
||||
(save-excursion
|
||||
(when (< 0 count)
|
||||
(goto-char pos) (delete-char 1))
|
||||
(insert (char-to-string
|
||||
(aref anm (% count (length anm))))))
|
||||
(if (> end (cl-incf count))
|
||||
(deferred:nextc (deferred:wait wait-time) self))))
|
||||
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(save-excursion
|
||||
(goto-char pos) (delete-char 1))
|
||||
(message "Animation finished.")))))
|
||||
@ -1,610 +0,0 @@
|
||||
;;; test code for concurrent.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2010 SAKURAI Masashi
|
||||
;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;; How to run this test ?
|
||||
;; $ emacs -L . -L $HOME/.emacs.d/elisp -batch -l deferred -l concurrent -l test-concurrent -f cc:test-all
|
||||
|
||||
(require 'undercover)
|
||||
(undercover "concurrent.el"
|
||||
(:send-report nil)
|
||||
(:report-file "/tmp/undercover-report.json"))
|
||||
(require 'concurrent)
|
||||
(require 'cl-lib)
|
||||
(require 'pp)
|
||||
(require 'ert)
|
||||
|
||||
(defmacro cc:debug (d msg &rest args)
|
||||
`(deferred:nextc ,d
|
||||
(lambda (x) (funcall 'message ,msg ,@args) x)))
|
||||
|
||||
;; generator
|
||||
|
||||
(defun cc:fib-gen (callback)
|
||||
(let ((a1 0) (a2 1)
|
||||
(callback callback))
|
||||
(cc:generator
|
||||
callback
|
||||
(yield a1)
|
||||
(yield a2)
|
||||
(while t
|
||||
(let ((next (+ a1 a2)))
|
||||
(setq a1 a2
|
||||
a2 next)
|
||||
(yield next))))))
|
||||
|
||||
(defun cc:test-fib-gen ()
|
||||
(let* ((count 0)
|
||||
(dfinish (deferred:new))
|
||||
gen
|
||||
(cc (lambda (x)
|
||||
(cond
|
||||
((= count 10)
|
||||
(deferred:callback
|
||||
dfinish
|
||||
(if (= x 55) t
|
||||
(format "Fib 10 = 55 -> %s" x))))
|
||||
(t
|
||||
(cl-incf count)
|
||||
(deferred:call gen))))))
|
||||
(setq gen (cc:fib-gen cc))
|
||||
(deferred:call gen)
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-fib-gen) "Fib10 : %s" x)
|
||||
|
||||
;; thread
|
||||
|
||||
(defun cc:test-thread ()
|
||||
(let ((dfinish (deferred:new))
|
||||
(result nil) (start-time (float-time))
|
||||
(count 0) (end 20))
|
||||
(push 1 result)
|
||||
(cc:thread
|
||||
60
|
||||
(push 2 result)
|
||||
(while (> end (cl-incf count))
|
||||
(when (= 0 (% count 10))
|
||||
(push count result)))
|
||||
(push 99 result)
|
||||
(setq result (reverse result))
|
||||
(deferred:callback dfinish
|
||||
(and (or (equal '(1 2 10 99) result) result)
|
||||
(let ((elapsed-time (- (float-time) start-time)))
|
||||
(or (and (< 1.0 elapsed-time) (< elapsed-time 6)) elapsed-time)))))
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-thread) "Thread : %s" x)
|
||||
|
||||
;; semaphore
|
||||
|
||||
(defun cc:test-semaphore1 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result)
|
||||
result))))
|
||||
(smp (cc:semaphore-create 1)))
|
||||
|
||||
(push 1 result)
|
||||
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(_) (push 2 result)))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(_) (push 3 result)))
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda(x) (push x result)))
|
||||
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(push 5 result)
|
||||
(cc:semaphore-release smp)
|
||||
(push 6 result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push 7 result)
|
||||
(cl-loop for i in (cc:semaphore-release-all smp)
|
||||
do (deferred:callback i 'canceled))
|
||||
(push 8 result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_) (deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-semaphore1) "Semaphore1 : %s" x)
|
||||
|
||||
(defun cc:test-semaphore2 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal '(0 a b c d e f g) result)
|
||||
result))))
|
||||
(smp (cc:semaphore-create 1)))
|
||||
|
||||
(push 0 result)
|
||||
|
||||
(cc:semaphore-with
|
||||
smp (lambda (_)
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda (_)
|
||||
(push 'c result)
|
||||
(cc:semaphore-release smp)))
|
||||
(push 'a result)
|
||||
(deferred:nextc
|
||||
(deferred:wait 100)
|
||||
(lambda (_) (push 'b result)))))
|
||||
|
||||
(cc:semaphore-with
|
||||
smp (lambda (_)
|
||||
(deferred:nextc (cc:semaphore-acquire smp)
|
||||
(lambda (_)
|
||||
(push 'g result)
|
||||
(cc:semaphore-release smp)
|
||||
(deferred:callback dfinish)))
|
||||
(push 'd result)
|
||||
(deferred:nextc
|
||||
(deferred:wait 100)
|
||||
(lambda (_)
|
||||
(push 'e result)
|
||||
(error "SMP CC ERR"))))
|
||||
(lambda (e)
|
||||
(cl-destructuring-bind (sym msg) e
|
||||
(when (and (eq 'error sym) (equal "SMP CC ERR" msg))
|
||||
(push 'f result)))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-semaphore2) "Semaphore2 : %s" x)
|
||||
|
||||
;; Dataflow
|
||||
|
||||
(defun cc:test-dataflow-simple1 ()
|
||||
(let* ((result '(1))
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result)
|
||||
result))))
|
||||
(dfenv (cc:dataflow-environment)))
|
||||
|
||||
(push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (cons 3 x) result))))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(push 4 result)
|
||||
(cc:dataflow-set dfenv "abc" 256)
|
||||
(push 5 result)))))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push (cons 6 (cc:dataflow-get-sync dfenv "abc")) result)
|
||||
(cc:dataflow-clear dfenv "abc")
|
||||
(push (cons 7 (cc:dataflow-get-sync dfenv "abc")) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-simple1) "Dataflow1 : %s" x)
|
||||
|
||||
(defun cc:test-dataflow-simple2 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(or (equal '("a.jpg:300 OK jpeg") result)
|
||||
result))))
|
||||
(dfenv (cc:dataflow-environment)))
|
||||
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (format "a.jpg:300 OK %s" x) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
(cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-simple2) "Dataflow2 : %s" x)
|
||||
|
||||
(defun cc:test-dataflow-simple3 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(or (equal '(">> 384") result)
|
||||
result))))
|
||||
(dfenv (cc:dataflow-environment)))
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(cc:dataflow-get dfenv "def")
|
||||
(cc:dataflow-get dfenv "abc"))
|
||||
(deferred:nextc it
|
||||
(lambda (values)
|
||||
(apply '+ values)))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (format ">> %s" x) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
(deferred:nextc (deferred:wait 0.2)
|
||||
(lambda (_)
|
||||
(cc:dataflow-set dfenv "def" 128)
|
||||
(cc:dataflow-set dfenv "abc" 256)
|
||||
(cc:dataflow-set dfenv "aaa" 512)
|
||||
))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-simple3) "Dataflow3 : %s" x)
|
||||
|
||||
(defun cc:test-dataflow-simple4 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(or (equal '(">> 3") result)
|
||||
result))))
|
||||
(dfenv (cc:dataflow-environment)))
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(cc:dataflow-get dfenv "abc"))
|
||||
(deferred:nextc it
|
||||
(lambda (values)
|
||||
(apply '+ values)))
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (format ">> %s" x) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
(deferred:nextc (deferred:wait 0.2)
|
||||
(lambda (_)
|
||||
(cc:dataflow-set dfenv "abc" 1)
|
||||
))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-simple4) "Dataflow4 : %s" x)
|
||||
|
||||
(defun cc:test-dataflow-signal ()
|
||||
(let* ((result '(1))
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal
|
||||
'(1
|
||||
(2 . nil)
|
||||
(get-first ("abc"))
|
||||
(get-waiting ("abc"))
|
||||
4 5
|
||||
(set ("abc"))
|
||||
(3 . 256)
|
||||
6 7
|
||||
(get ("abc"))
|
||||
(8 . 256)
|
||||
(9 . nil)
|
||||
(clear ("abc"))
|
||||
(clear-all (nil))
|
||||
)
|
||||
result)
|
||||
result))))
|
||||
(dfenv (cc:dataflow-environment)))
|
||||
|
||||
(cl-loop for i in '(get get-first get-waiting set clear clear-all)
|
||||
do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result))))
|
||||
|
||||
(push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (cons 3 x) result))))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(push 4 result)
|
||||
(cc:dataflow-set dfenv "abc" 256)
|
||||
(push 5 result)))))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push 6 result)
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(push 7 result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(push (cons 8 (cc:dataflow-get-sync dfenv "abc")) result)
|
||||
(cc:dataflow-clear dfenv "abc")
|
||||
(push (cons 9 (cc:dataflow-get-sync dfenv "abc")) result)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(cc:dataflow-clear-all dfenv)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-signal) "Dataflow Signal : %s" x)
|
||||
|
||||
|
||||
(defun cc:test-dataflow-parent1 ()
|
||||
(let* ((result '(1))
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal
|
||||
'(1
|
||||
(available-parent . (("abc" . 128)))
|
||||
(available-child . (("abc" . 128)))
|
||||
(waiting-parent . nil)
|
||||
(waiting-child . ("aaa"))
|
||||
(get-sync . 256)
|
||||
(get . 256)
|
||||
)
|
||||
result)
|
||||
result))))
|
||||
(dfenv-parent (cc:dataflow-environment))
|
||||
(dfenv (cc:dataflow-environment dfenv-parent)))
|
||||
|
||||
(cc:dataflow-set dfenv-parent "abc" 128)
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv "aaa")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (cons 'get x) result))))
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(push (cons 'available-parent (cc:dataflow-get-avalable-pairs dfenv-parent)) result)
|
||||
(push (cons 'available-child (cc:dataflow-get-avalable-pairs dfenv)) result)
|
||||
(push (cons 'waiting-parent (cc:dataflow-get-waiting-keys dfenv-parent)) result)
|
||||
(push (cons 'waiting-child (cc:dataflow-get-waiting-keys dfenv)) result)))
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(cc:dataflow-set dfenv-parent "aaa" 256)
|
||||
(push (cons 'get-sync (cc:dataflow-get-sync dfenv "aaa")) result)))))
|
||||
(deferred:nextc it
|
||||
(lambda (_) (deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-parent1) "Dataflow Parent1 : %s" x)
|
||||
|
||||
(defun cc:test-dataflow-parent2 ()
|
||||
(let* ((result '())
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal
|
||||
'("parent get 256" "child get 256") result)
|
||||
result))))
|
||||
(dfenv-parent (cc:dataflow-environment))
|
||||
(dfenv (cc:dataflow-environment dfenv-parent)))
|
||||
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv-parent "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (format "parent get %s" x) result))))
|
||||
(deferred:$
|
||||
(cc:dataflow-get dfenv "abc")
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (format "child get %s" x) result))))
|
||||
(deferred:nextc (deferred:wait 0.2)
|
||||
(lambda (_) (cc:dataflow-set dfenv-parent "abc" 256))))
|
||||
(deferred:nextc it
|
||||
(lambda (_) (deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-dataflow-parent2) "Dataflow Parent : %s" x)
|
||||
|
||||
|
||||
;; Signal
|
||||
|
||||
(defun cc:test-signal1 ()
|
||||
(let* ((result '())
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal
|
||||
'(
|
||||
(ls ev1 (1))
|
||||
(sig ev1 (1))
|
||||
(ls ev2 (2))
|
||||
(def ev1 (1))
|
||||
)
|
||||
result)
|
||||
result))))
|
||||
(channel (cc:signal-channel "child")))
|
||||
|
||||
(cc:signal-connect channel 'ev1
|
||||
(lambda (event)
|
||||
(push (cons 'sig event) result)))
|
||||
(cc:signal-connect channel t
|
||||
(lambda (event)
|
||||
(push (cons 'ls event) result)))
|
||||
(deferred:$
|
||||
(cc:signal-connect channel 'ev1)
|
||||
(deferred:nextc it
|
||||
(lambda (x) (push (cons 'def x) result))))
|
||||
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(cc:signal-send channel 'ev1 1)
|
||||
(cc:signal-send channel 'ev2 2)))
|
||||
(deferred:nextc it
|
||||
(lambda (_) (deferred:wait 300)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-signal1) "Signal1 : %s" x)
|
||||
|
||||
;; (cc:debug (cc:test-signal2) "Signal2 : %s" x)
|
||||
|
||||
(defun cc:test-signal2 ()
|
||||
(let* ((result nil)
|
||||
(dfinish (deferred:new
|
||||
(lambda (_)
|
||||
(setq result (reverse result))
|
||||
(or (equal
|
||||
'(
|
||||
(pls pev1 (1))
|
||||
(psig pev1 (1))
|
||||
(pls ev1 (2))
|
||||
(ls ev1 (3))
|
||||
(sig ev1 (3))
|
||||
(pls ev2 (4))
|
||||
(pls ev2 (5))
|
||||
|
||||
(ls pev1 (1))
|
||||
(ls ev1 (2))
|
||||
|
||||
(sig ev1 (2))
|
||||
(def ev1 (3))
|
||||
(ls ev2 (4))
|
||||
(ls ev2 (5))
|
||||
|
||||
(def ev1 (2))
|
||||
)
|
||||
result)
|
||||
result))))
|
||||
(parent-channel (cc:signal-channel "parent"))
|
||||
(channel (cc:signal-channel "child" parent-channel)))
|
||||
|
||||
(cc:signal-connect parent-channel 'pev1
|
||||
(lambda (event)
|
||||
(push (cons 'psig event) result)))
|
||||
(cc:signal-connect parent-channel t
|
||||
(lambda (event)
|
||||
(push (cons 'pls event) result)))
|
||||
(cc:signal-connect channel 'ev1
|
||||
(lambda (event)
|
||||
(push (cons 'sig event) result)))
|
||||
(cc:signal-connect channel t
|
||||
(lambda (event)
|
||||
(push (cons 'ls event) result)))
|
||||
(deferred:$
|
||||
(cc:signal-connect channel 'ev1)
|
||||
(deferred:nextc it
|
||||
(lambda (x)
|
||||
(push (cons 'def x) result))))
|
||||
|
||||
(deferred:$
|
||||
(deferred:next
|
||||
(lambda (_)
|
||||
(cc:signal-send parent-channel 'pev1 1)
|
||||
(cc:signal-send parent-channel 'ev1 2)
|
||||
(cc:signal-send channel 'ev1 3)
|
||||
(cc:signal-send parent-channel 'ev2 4)
|
||||
(cc:signal-send-global channel 'ev2 5)))
|
||||
(deferred:nextc it
|
||||
(lambda (_) (deferred:wait 300)))
|
||||
(deferred:nextc it
|
||||
(lambda (_)
|
||||
(deferred:callback-post dfinish))))
|
||||
|
||||
dfinish))
|
||||
|
||||
;; (cc:debug (cc:test-signal2) "Signal2 : %s" x)
|
||||
|
||||
(defvar cc:test-finished-flag nil)
|
||||
(defvar cc:test-fails 0)
|
||||
|
||||
(defun cc:test-all ()
|
||||
(interactive)
|
||||
(setq cc:test-finished-flag nil)
|
||||
(setq cc:test-fails 0)
|
||||
(deferred:$
|
||||
(deferred:parallel
|
||||
(cl-loop for i in '(cc:test-fib-gen
|
||||
cc:test-thread
|
||||
cc:test-semaphore1
|
||||
cc:test-semaphore2
|
||||
cc:test-dataflow-simple1
|
||||
cc:test-dataflow-simple2
|
||||
cc:test-dataflow-simple3
|
||||
cc:test-dataflow-simple4
|
||||
cc:test-dataflow-signal
|
||||
cc:test-dataflow-parent1
|
||||
cc:test-dataflow-parent2
|
||||
cc:test-signal1
|
||||
cc:test-signal2
|
||||
)
|
||||
collect (cons i (deferred:timeout 5000 "timeout" (funcall i)))))
|
||||
(deferred:nextc it
|
||||
(lambda (results)
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create "*cc:test*")
|
||||
(erase-buffer)
|
||||
(cl-loop for i in results
|
||||
for name = (car i)
|
||||
for result = (cdr i)
|
||||
with fails = 0
|
||||
do (insert (format "%s : %s\n" name
|
||||
(if (eq t result) "OK"
|
||||
(format "FAIL > %s" result))))
|
||||
(unless (eq t result) (cl-incf fails))
|
||||
finally
|
||||
(goto-char (point-min))
|
||||
(insert (format "Test Finished : %s\nTests Fails: %s / %s\n"
|
||||
(format-time-string "%Y/%m/%d %H:%M:%S" (current-time))
|
||||
fails (length results)))
|
||||
(setq cc:test-fails fails))
|
||||
(message (buffer-string))
|
||||
(current-buffer)))
|
||||
(setq cc:test-finished-flag t))))
|
||||
|
||||
(while (null cc:test-finished-flag)
|
||||
(sleep-for 0 100) (sit-for 0 100))
|
||||
(when (and noninteractive
|
||||
(> cc:test-fails 0))
|
||||
(error "Test failed")))
|
||||
|
||||
(ert-deftest concurrent-all-the-thing ()
|
||||
(should-not (cc:test-all)))
|
||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user