Commit 6ef229bbbe33b98d30590ec92af9059f78c3a01f - emacs-deferred

Merge tag 'upstream/0.5.0' Upstream version 0.5.0 Lev Lamberov 6 years ago

13 changed file(s) with 1323 addition(s) and 661 deletion(s). Raw diff Collapse all Expand all

-0

.travis.yml less more

7	7	- EVM_EMACS=emacs-24.3-travis
8	8	- EVM_EMACS=emacs-24.4-travis
9	9	- EVM_EMACS=emacs-24.5-travis
	10	- EVM_EMACS=emacs-25.1-travis
10	11
11	12	script:
12	13	- emacs --version

+674

-0

LICENSE less more

	0	GNU GENERAL PUBLIC LICENSE
	1	Version 3, 29 June 2007
	2
	3	Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
	4	Everyone is permitted to copy and distribute verbatim copies
	5	of this license document, but changing it is not allowed.
	6
	7	Preamble
	8
	9	The GNU General Public License is a free, copyleft license for
	10	software and other kinds of works.
	11
	12	The licenses for most software and other practical works are designed
	13	to take away your freedom to share and change the works. By contrast,
	14	the GNU General Public License is intended to guarantee your freedom to
	15	share and change all versions of a program--to make sure it remains free
	16	software for all its users. We, the Free Software Foundation, use the
	17	GNU General Public License for most of our software; it applies also to
	18	any other work released this way by its authors. You can apply it to
	19	your programs, too.
	20
	21	When we speak of free software, we are referring to freedom, not
	22	price. Our General Public Licenses are designed to make sure that you
	23	have the freedom to distribute copies of free software (and charge for
	24	them if you wish), that you receive source code or can get it if you
	25	want it, that you can change the software or use pieces of it in new
	26	free programs, and that you know you can do these things.
	27
	28	To protect your rights, we need to prevent others from denying you
	29	these rights or asking you to surrender the rights. Therefore, you have
	30	certain responsibilities if you distribute copies of the software, or if
	31	you modify it: responsibilities to respect the freedom of others.
	32
	33	For example, if you distribute copies of such a program, whether
	34	gratis or for a fee, you must pass on to the recipients the same
	35	freedoms that you received. You must make sure that they, too, receive
	36	or can get the source code. And you must show them these terms so they
	37	know their rights.
	38
	39	Developers that use the GNU GPL protect your rights with two steps:
	40	(1) assert copyright on the software, and (2) offer you this License
	41	giving you legal permission to copy, distribute and/or modify it.
	42
	43	For the developers' and authors' protection, the GPL clearly explains
	44	that there is no warranty for this free software. For both users' and
	45	authors' sake, the GPL requires that modified versions be marked as
	46	changed, so that their problems will not be attributed erroneously to
	47	authors of previous versions.
	48
	49	Some devices are designed to deny users access to install or run
	50	modified versions of the software inside them, although the manufacturer
	51	can do so. This is fundamentally incompatible with the aim of
	52	protecting users' freedom to change the software. The systematic
	53	pattern of such abuse occurs in the area of products for individuals to
	54	use, which is precisely where it is most unacceptable. Therefore, we
	55	have designed this version of the GPL to prohibit the practice for those
	56	products. If such problems arise substantially in other domains, we
	57	stand ready to extend this provision to those domains in future versions
	58	of the GPL, as needed to protect the freedom of users.
	59
	60	Finally, every program is threatened constantly by software patents.
	61	States should not allow patents to restrict development and use of
	62	software on general-purpose computers, but in those that do, we wish to
	63	avoid the special danger that patents applied to a free program could
	64	make it effectively proprietary. To prevent this, the GPL assures that
	65	patents cannot be used to render the program non-free.
	66
	67	The precise terms and conditions for copying, distribution and
	68	modification follow.
	69
	70	TERMS AND CONDITIONS
	71
	72	0. Definitions.
	73
	74	"This License" refers to version 3 of the GNU General Public License.
	75
	76	"Copyright" also means copyright-like laws that apply to other kinds of
	77	works, such as semiconductor masks.
	78
	79	"The Program" refers to any copyrightable work licensed under this
	80	License. Each licensee is addressed as "you". "Licensees" and
	81	"recipients" may be individuals or organizations.
	82
	83	To "modify" a work means to copy from or adapt all or part of the work
	84	in a fashion requiring copyright permission, other than the making of an
	85	exact copy. The resulting work is called a "modified version" of the
	86	earlier work or a work "based on" the earlier work.
	87
	88	A "covered work" means either the unmodified Program or a work based
	89	on the Program.
	90
	91	To "propagate" a work means to do anything with it that, without
	92	permission, would make you directly or secondarily liable for
	93	infringement under applicable copyright law, except executing it on a
	94	computer or modifying a private copy. Propagation includes copying,
	95	distribution (with or without modification), making available to the
	96	public, and in some countries other activities as well.
	97
	98	To "convey" a work means any kind of propagation that enables other
	99	parties to make or receive copies. Mere interaction with a user through
	100	a computer network, with no transfer of a copy, is not conveying.
	101
	102	An interactive user interface displays "Appropriate Legal Notices"
	103	to the extent that it includes a convenient and prominently visible
	104	feature that (1) displays an appropriate copyright notice, and (2)
	105	tells the user that there is no warranty for the work (except to the
	106	extent that warranties are provided), that licensees may convey the
	107	work under this License, and how to view a copy of this License. If
	108	the interface presents a list of user commands or options, such as a
	109	menu, a prominent item in the list meets this criterion.
	110
	111	1. Source Code.
	112
	113	The "source code" for a work means the preferred form of the work
	114	for making modifications to it. "Object code" means any non-source
	115	form of a work.
	116
	117	A "Standard Interface" means an interface that either is an official
	118	standard defined by a recognized standards body, or, in the case of
	119	interfaces specified for a particular programming language, one that
	120	is widely used among developers working in that language.
	121
	122	The "System Libraries" of an executable work include anything, other
	123	than the work as a whole, that (a) is included in the normal form of
	124	packaging a Major Component, but which is not part of that Major
	125	Component, and (b) serves only to enable use of the work with that
	126	Major Component, or to implement a Standard Interface for which an
	127	implementation is available to the public in source code form. A
	128	"Major Component", in this context, means a major essential component
	129	(kernel, window system, and so on) of the specific operating system
	130	(if any) on which the executable work runs, or a compiler used to
	131	produce the work, or an object code interpreter used to run it.
	132
	133	The "Corresponding Source" for a work in object code form means all
	134	the source code needed to generate, install, and (for an executable
	135	work) run the object code and to modify the work, including scripts to
	136	control those activities. However, it does not include the work's
	137	System Libraries, or general-purpose tools or generally available free
	138	programs which are used unmodified in performing those activities but
	139	which are not part of the work. For example, Corresponding Source
	140	includes interface definition files associated with source files for
	141	the work, and the source code for shared libraries and dynamically
	142	linked subprograms that the work is specifically designed to require,
	143	such as by intimate data communication or control flow between those
	144	subprograms and other parts of the work.
	145
	146	The Corresponding Source need not include anything that users
	147	can regenerate automatically from other parts of the Corresponding
	148	Source.
	149
	150	The Corresponding Source for a work in source code form is that
	151	same work.
	152
	153	2. Basic Permissions.
	154
	155	All rights granted under this License are granted for the term of
	156	copyright on the Program, and are irrevocable provided the stated
	157	conditions are met. This License explicitly affirms your unlimited
	158	permission to run the unmodified Program. The output from running a
	159	covered work is covered by this License only if the output, given its
	160	content, constitutes a covered work. This License acknowledges your
	161	rights of fair use or other equivalent, as provided by copyright law.
	162
	163	You may make, run and propagate covered works that you do not
	164	convey, without conditions so long as your license otherwise remains
	165	in force. You may convey covered works to others for the sole purpose
	166	of having them make modifications exclusively for you, or provide you
	167	with facilities for running those works, provided that you comply with
	168	the terms of this License in conveying all material for which you do
	169	not control copyright. Those thus making or running the covered works
	170	for you must do so exclusively on your behalf, under your direction
	171	and control, on terms that prohibit them from making any copies of
	172	your copyrighted material outside their relationship with you.
	173
	174	Conveying under any other circumstances is permitted solely under
	175	the conditions stated below. Sublicensing is not allowed; section 10
	176	makes it unnecessary.
	177
	178	3. Protecting Users' Legal Rights From Anti-Circumvention Law.
	179
	180	No covered work shall be deemed part of an effective technological
	181	measure under any applicable law fulfilling obligations under article
	182	11 of the WIPO copyright treaty adopted on 20 December 1996, or
	183	similar laws prohibiting or restricting circumvention of such
	184	measures.
	185
	186	When you convey a covered work, you waive any legal power to forbid
	187	circumvention of technological measures to the extent such circumvention
	188	is effected by exercising rights under this License with respect to
	189	the covered work, and you disclaim any intention to limit operation or
	190	modification of the work as a means of enforcing, against the work's
	191	users, your or third parties' legal rights to forbid circumvention of
	192	technological measures.
	193
	194	4. Conveying Verbatim Copies.
	195
	196	You may convey verbatim copies of the Program's source code as you
	197	receive it, in any medium, provided that you conspicuously and
	198	appropriately publish on each copy an appropriate copyright notice;
	199	keep intact all notices stating that this License and any
	200	non-permissive terms added in accord with section 7 apply to the code;
	201	keep intact all notices of the absence of any warranty; and give all
	202	recipients a copy of this License along with the Program.
	203
	204	You may charge any price or no price for each copy that you convey,
	205	and you may offer support or warranty protection for a fee.
	206
	207	5. Conveying Modified Source Versions.
	208
	209	You may convey a work based on the Program, or the modifications to
	210	produce it from the Program, in the form of source code under the
	211	terms of section 4, provided that you also meet all of these conditions:
	212
	213	a) The work must carry prominent notices stating that you modified
	214	it, and giving a relevant date.
	215
	216	b) The work must carry prominent notices stating that it is
	217	released under this License and any conditions added under section
	218	7. This requirement modifies the requirement in section 4 to
	219	"keep intact all notices".
	220
	221	c) You must license the entire work, as a whole, under this
	222	License to anyone who comes into possession of a copy. This
	223	License will therefore apply, along with any applicable section 7
	224	additional terms, to the whole of the work, and all its parts,
	225	regardless of how they are packaged. This License gives no
	226	permission to license the work in any other way, but it does not
	227	invalidate such permission if you have separately received it.
	228
	229	d) If the work has interactive user interfaces, each must display
	230	Appropriate Legal Notices; however, if the Program has interactive
	231	interfaces that do not display Appropriate Legal Notices, your
	232	work need not make them do so.
	233
	234	A compilation of a covered work with other separate and independent
	235	works, which are not by their nature extensions of the covered work,
	236	and which are not combined with it such as to form a larger program,
	237	in or on a volume of a storage or distribution medium, is called an
	238	"aggregate" if the compilation and its resulting copyright are not
	239	used to limit the access or legal rights of the compilation's users
	240	beyond what the individual works permit. Inclusion of a covered work
	241	in an aggregate does not cause this License to apply to the other
	242	parts of the aggregate.
	243
	244	6. Conveying Non-Source Forms.
	245
	246	You may convey a covered work in object code form under the terms
	247	of sections 4 and 5, provided that you also convey the
	248	machine-readable Corresponding Source under the terms of this License,
	249	in one of these ways:
	250
	251	a) Convey the object code in, or embodied in, a physical product
	252	(including a physical distribution medium), accompanied by the
	253	Corresponding Source fixed on a durable physical medium
	254	customarily used for software interchange.
	255
	256	b) Convey the object code in, or embodied in, a physical product
	257	(including a physical distribution medium), accompanied by a
	258	written offer, valid for at least three years and valid for as
	259	long as you offer spare parts or customer support for that product
	260	model, to give anyone who possesses the object code either (1) a
	261	copy of the Corresponding Source for all the software in the
	262	product that is covered by this License, on a durable physical
	263	medium customarily used for software interchange, for a price no
	264	more than your reasonable cost of physically performing this
	265	conveying of source, or (2) access to copy the
	266	Corresponding Source from a network server at no charge.
	267
	268	c) Convey individual copies of the object code with a copy of the
	269	written offer to provide the Corresponding Source. This
	270	alternative is allowed only occasionally and noncommercially, and
	271	only if you received the object code with such an offer, in accord
	272	with subsection 6b.
	273
	274	d) Convey the object code by offering access from a designated
	275	place (gratis or for a charge), and offer equivalent access to the
	276	Corresponding Source in the same way through the same place at no
	277	further charge. You need not require recipients to copy the
	278	Corresponding Source along with the object code. If the place to
	279	copy the object code is a network server, the Corresponding Source
	280	may be on a different server (operated by you or a third party)
	281	that supports equivalent copying facilities, provided you maintain
	282	clear directions next to the object code saying where to find the
	283	Corresponding Source. Regardless of what server hosts the
	284	Corresponding Source, you remain obligated to ensure that it is
	285	available for as long as needed to satisfy these requirements.
	286
	287	e) Convey the object code using peer-to-peer transmission, provided
	288	you inform other peers where the object code and Corresponding
	289	Source of the work are being offered to the general public at no
	290	charge under subsection 6d.
	291
	292	A separable portion of the object code, whose source code is excluded
	293	from the Corresponding Source as a System Library, need not be
	294	included in conveying the object code work.
	295
	296	A "User Product" is either (1) a "consumer product", which means any
	297	tangible personal property which is normally used for personal, family,
	298	or household purposes, or (2) anything designed or sold for incorporation
	299	into a dwelling. In determining whether a product is a consumer product,
	300	doubtful cases shall be resolved in favor of coverage. For a particular
	301	product received by a particular user, "normally used" refers to a
	302	typical or common use of that class of product, regardless of the status
	303	of the particular user or of the way in which the particular user
	304	actually uses, or expects or is expected to use, the product. A product
	305	is a consumer product regardless of whether the product has substantial
	306	commercial, industrial or non-consumer uses, unless such uses represent
	307	the only significant mode of use of the product.
	308
	309	"Installation Information" for a User Product means any methods,
	310	procedures, authorization keys, or other information required to install
	311	and execute modified versions of a covered work in that User Product from
	312	a modified version of its Corresponding Source. The information must
	313	suffice to ensure that the continued functioning of the modified object
	314	code is in no case prevented or interfered with solely because
	315	modification has been made.
	316
	317	If you convey an object code work under this section in, or with, or
	318	specifically for use in, a User Product, and the conveying occurs as
	319	part of a transaction in which the right of possession and use of the
	320	User Product is transferred to the recipient in perpetuity or for a
	321	fixed term (regardless of how the transaction is characterized), the
	322	Corresponding Source conveyed under this section must be accompanied
	323	by the Installation Information. But this requirement does not apply
	324	if neither you nor any third party retains the ability to install
	325	modified object code on the User Product (for example, the work has
	326	been installed in ROM).
	327
	328	The requirement to provide Installation Information does not include a
	329	requirement to continue to provide support service, warranty, or updates
	330	for a work that has been modified or installed by the recipient, or for
	331	the User Product in which it has been modified or installed. Access to a
	332	network may be denied when the modification itself materially and
	333	adversely affects the operation of the network or violates the rules and
	334	protocols for communication across the network.
	335
	336	Corresponding Source conveyed, and Installation Information provided,
	337	in accord with this section must be in a format that is publicly
	338	documented (and with an implementation available to the public in
	339	source code form), and must require no special password or key for
	340	unpacking, reading or copying.
	341
	342	7. Additional Terms.
	343
	344	"Additional permissions" are terms that supplement the terms of this
	345	License by making exceptions from one or more of its conditions.
	346	Additional permissions that are applicable to the entire Program shall
	347	be treated as though they were included in this License, to the extent
	348	that they are valid under applicable law. If additional permissions
	349	apply only to part of the Program, that part may be used separately
	350	under those permissions, but the entire Program remains governed by
	351	this License without regard to the additional permissions.
	352
	353	When you convey a copy of a covered work, you may at your option
	354	remove any additional permissions from that copy, or from any part of
	355	it. (Additional permissions may be written to require their own
	356	removal in certain cases when you modify the work.) You may place
	357	additional permissions on material, added by you to a covered work,
	358	for which you have or can give appropriate copyright permission.
	359
	360	Notwithstanding any other provision of this License, for material you
	361	add to a covered work, you may (if authorized by the copyright holders of
	362	that material) supplement the terms of this License with terms:
	363
	364	a) Disclaiming warranty or limiting liability differently from the
	365	terms of sections 15 and 16 of this License; or
	366
	367	b) Requiring preservation of specified reasonable legal notices or
	368	author attributions in that material or in the Appropriate Legal
	369	Notices displayed by works containing it; or
	370
	371	c) Prohibiting misrepresentation of the origin of that material, or
	372	requiring that modified versions of such material be marked in
	373	reasonable ways as different from the original version; or
	374
	375	d) Limiting the use for publicity purposes of names of licensors or
	376	authors of the material; or
	377
	378	e) Declining to grant rights under trademark law for use of some
	379	trade names, trademarks, or service marks; or
	380
	381	f) Requiring indemnification of licensors and authors of that
	382	material by anyone who conveys the material (or modified versions of
	383	it) with contractual assumptions of liability to the recipient, for
	384	any liability that these contractual assumptions directly impose on
	385	those licensors and authors.
	386
	387	All other non-permissive additional terms are considered "further
	388	restrictions" within the meaning of section 10. If the Program as you
	389	received it, or any part of it, contains a notice stating that it is
	390	governed by this License along with a term that is a further
	391	restriction, you may remove that term. If a license document contains
	392	a further restriction but permits relicensing or conveying under this
	393	License, you may add to a covered work material governed by the terms
	394	of that license document, provided that the further restriction does
	395	not survive such relicensing or conveying.
	396
	397	If you add terms to a covered work in accord with this section, you
	398	must place, in the relevant source files, a statement of the
	399	additional terms that apply to those files, or a notice indicating
	400	where to find the applicable terms.
	401
	402	Additional terms, permissive or non-permissive, may be stated in the
	403	form of a separately written license, or stated as exceptions;
	404	the above requirements apply either way.
	405
	406	8. Termination.
	407
	408	You may not propagate or modify a covered work except as expressly
	409	provided under this License. Any attempt otherwise to propagate or
	410	modify it is void, and will automatically terminate your rights under
	411	this License (including any patent licenses granted under the third
	412	paragraph of section 11).
	413
	414	However, if you cease all violation of this License, then your
	415	license from a particular copyright holder is reinstated (a)
	416	provisionally, unless and until the copyright holder explicitly and
	417	finally terminates your license, and (b) permanently, if the copyright
	418	holder fails to notify you of the violation by some reasonable means
	419	prior to 60 days after the cessation.
	420
	421	Moreover, your license from a particular copyright holder is
	422	reinstated permanently if the copyright holder notifies you of the
	423	violation by some reasonable means, this is the first time you have
	424	received notice of violation of this License (for any work) from that
	425	copyright holder, and you cure the violation prior to 30 days after
	426	your receipt of the notice.
	427
	428	Termination of your rights under this section does not terminate the
	429	licenses of parties who have received copies or rights from you under
	430	this License. If your rights have been terminated and not permanently
	431	reinstated, you do not qualify to receive new licenses for the same
	432	material under section 10.
	433
	434	9. Acceptance Not Required for Having Copies.
	435
	436	You are not required to accept this License in order to receive or
	437	run a copy of the Program. Ancillary propagation of a covered work
	438	occurring solely as a consequence of using peer-to-peer transmission
	439	to receive a copy likewise does not require acceptance. However,
	440	nothing other than this License grants you permission to propagate or
	441	modify any covered work. These actions infringe copyright if you do
	442	not accept this License. Therefore, by modifying or propagating a
	443	covered work, you indicate your acceptance of this License to do so.
	444
	445	10. Automatic Licensing of Downstream Recipients.
	446
	447	Each time you convey a covered work, the recipient automatically
	448	receives a license from the original licensors, to run, modify and
	449	propagate that work, subject to this License. You are not responsible
	450	for enforcing compliance by third parties with this License.
	451
	452	An "entity transaction" is a transaction transferring control of an
	453	organization, or substantially all assets of one, or subdividing an
	454	organization, or merging organizations. If propagation of a covered
	455	work results from an entity transaction, each party to that
	456	transaction who receives a copy of the work also receives whatever
	457	licenses to the work the party's predecessor in interest had or could
	458	give under the previous paragraph, plus a right to possession of the
	459	Corresponding Source of the work from the predecessor in interest, if
	460	the predecessor has it or can get it with reasonable efforts.
	461
	462	You may not impose any further restrictions on the exercise of the
	463	rights granted or affirmed under this License. For example, you may
	464	not impose a license fee, royalty, or other charge for exercise of
	465	rights granted under this License, and you may not initiate litigation
	466	(including a cross-claim or counterclaim in a lawsuit) alleging that
	467	any patent claim is infringed by making, using, selling, offering for
	468	sale, or importing the Program or any portion of it.
	469
	470	11. Patents.
	471
	472	A "contributor" is a copyright holder who authorizes use under this
	473	License of the Program or a work on which the Program is based. The
	474	work thus licensed is called the contributor's "contributor version".
	475
	476	A contributor's "essential patent claims" are all patent claims
	477	owned or controlled by the contributor, whether already acquired or
	478	hereafter acquired, that would be infringed by some manner, permitted
	479	by this License, of making, using, or selling its contributor version,
	480	but do not include claims that would be infringed only as a
	481	consequence of further modification of the contributor version. For
	482	purposes of this definition, "control" includes the right to grant
	483	patent sublicenses in a manner consistent with the requirements of
	484	this License.
	485
	486	Each contributor grants you a non-exclusive, worldwide, royalty-free
	487	patent license under the contributor's essential patent claims, to
	488	make, use, sell, offer for sale, import and otherwise run, modify and
	489	propagate the contents of its contributor version.
	490
	491	In the following three paragraphs, a "patent license" is any express
	492	agreement or commitment, however denominated, not to enforce a patent
	493	(such as an express permission to practice a patent or covenant not to
	494	sue for patent infringement). To "grant" such a patent license to a
	495	party means to make such an agreement or commitment not to enforce a
	496	patent against the party.
	497
	498	If you convey a covered work, knowingly relying on a patent license,
	499	and the Corresponding Source of the work is not available for anyone
	500	to copy, free of charge and under the terms of this License, through a
	501	publicly available network server or other readily accessible means,
	502	then you must either (1) cause the Corresponding Source to be so
	503	available, or (2) arrange to deprive yourself of the benefit of the
	504	patent license for this particular work, or (3) arrange, in a manner
	505	consistent with the requirements of this License, to extend the patent
	506	license to downstream recipients. "Knowingly relying" means you have
	507	actual knowledge that, but for the patent license, your conveying the
	508	covered work in a country, or your recipient's use of the covered work
	509	in a country, would infringe one or more identifiable patents in that
	510	country that you have reason to believe are valid.
	511
	512	If, pursuant to or in connection with a single transaction or
	513	arrangement, you convey, or propagate by procuring conveyance of, a
	514	covered work, and grant a patent license to some of the parties
	515	receiving the covered work authorizing them to use, propagate, modify
	516	or convey a specific copy of the covered work, then the patent license
	517	you grant is automatically extended to all recipients of the covered
	518	work and works based on it.
	519
	520	A patent license is "discriminatory" if it does not include within
	521	the scope of its coverage, prohibits the exercise of, or is
	522	conditioned on the non-exercise of one or more of the rights that are
	523	specifically granted under this License. You may not convey a covered
	524	work if you are a party to an arrangement with a third party that is
	525	in the business of distributing software, under which you make payment
	526	to the third party based on the extent of your activity of conveying
	527	the work, and under which the third party grants, to any of the
	528	parties who would receive the covered work from you, a discriminatory
	529	patent license (a) in connection with copies of the covered work
	530	conveyed by you (or copies made from those copies), or (b) primarily
	531	for and in connection with specific products or compilations that
	532	contain the covered work, unless you entered into that arrangement,
	533	or that patent license was granted, prior to 28 March 2007.
	534
	535	Nothing in this License shall be construed as excluding or limiting
	536	any implied license or other defenses to infringement that may
	537	otherwise be available to you under applicable patent law.
	538
	539	12. No Surrender of Others' Freedom.
	540
	541	If conditions are imposed on you (whether by court order, agreement or
	542	otherwise) that contradict the conditions of this License, they do not
	543	excuse you from the conditions of this License. If you cannot convey a
	544	covered work so as to satisfy simultaneously your obligations under this
	545	License and any other pertinent obligations, then as a consequence you may
	546	not convey it at all. For example, if you agree to terms that obligate you
	547	to collect a royalty for further conveying from those to whom you convey
	548	the Program, the only way you could satisfy both those terms and this
	549	License would be to refrain entirely from conveying the Program.
	550
	551	13. Use with the GNU Affero General Public License.
	552
	553	Notwithstanding any other provision of this License, you have
	554	permission to link or combine any covered work with a work licensed
	555	under version 3 of the GNU Affero General Public License into a single
	556	combined work, and to convey the resulting work. The terms of this
	557	License will continue to apply to the part which is the covered work,
	558	but the special requirements of the GNU Affero General Public License,
	559	section 13, concerning interaction through a network will apply to the
	560	combination as such.
	561
	562	14. Revised Versions of this License.
	563
	564	The Free Software Foundation may publish revised and/or new versions of
	565	the GNU General Public License from time to time. Such new versions will
	566	be similar in spirit to the present version, but may differ in detail to
	567	address new problems or concerns.
	568
	569	Each version is given a distinguishing version number. If the
	570	Program specifies that a certain numbered version of the GNU General
	571	Public License "or any later version" applies to it, you have the
	572	option of following the terms and conditions either of that numbered
	573	version or of any later version published by the Free Software
	574	Foundation. If the Program does not specify a version number of the
	575	GNU General Public License, you may choose any version ever published
	576	by the Free Software Foundation.
	577
	578	If the Program specifies that a proxy can decide which future
	579	versions of the GNU General Public License can be used, that proxy's
	580	public statement of acceptance of a version permanently authorizes you
	581	to choose that version for the Program.
	582
	583	Later license versions may give you additional or different
	584	permissions. However, no additional obligations are imposed on any
	585	author or copyright holder as a result of your choosing to follow a
	586	later version.
	587
	588	15. Disclaimer of Warranty.
	589
	590	THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
	591	APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
	592	HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
	593	OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
	594	THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
	595	PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
	596	IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
	597	ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
	598
	599	16. Limitation of Liability.
	600
	601	IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
	602	WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
	603	THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
	604	GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
	605	USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
	606	DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
	607	PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
	608	EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
	609	SUCH DAMAGES.
	610
	611	17. Interpretation of Sections 15 and 16.
	612
	613	If the disclaimer of warranty and limitation of liability provided
	614	above cannot be given local legal effect according to their terms,
	615	reviewing courts shall apply local law that most closely approximates
	616	an absolute waiver of all civil liability in connection with the
	617	Program, unless a warranty or assumption of liability accompanies a
	618	copy of the Program in return for a fee.
	619
	620	END OF TERMS AND CONDITIONS
	621
	622	How to Apply These Terms to Your New Programs
	623
	624	If you develop a new program, and you want it to be of the greatest
	625	possible use to the public, the best way to achieve this is to make it
	626	free software which everyone can redistribute and change under these terms.
	627
	628	To do so, attach the following notices to the program. It is safest
	629	to attach them to the start of each source file to most effectively
	630	state the exclusion of warranty; and each file should have at least
	631	the "copyright" line and a pointer to where the full notice is found.
	632
	633	<one line to give the program's name and a brief idea of what it does.>
	634	Copyright (C) <year> <name of author>
	635
	636	This program is free software: you can redistribute it and/or modify
	637	it under the terms of the GNU General Public License as published by
	638	the Free Software Foundation, either version 3 of the License, or
	639	(at your option) any later version.
	640
	641	This program is distributed in the hope that it will be useful,
	642	but WITHOUT ANY WARRANTY; without even the implied warranty of
	643	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	644	GNU General Public License for more details.
	645
	646	You should have received a copy of the GNU General Public License
	647	along with this program. If not, see <http://www.gnu.org/licenses/>.
	648
	649	Also add information on how to contact you by electronic and paper mail.
	650
	651	If the program does terminal interaction, make it output a short
	652	notice like this when it starts in an interactive mode:
	653
	654	<program> Copyright (C) <year> <name of author>
	655	This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
	656	This is free software, and you are welcome to redistribute it
	657	under certain conditions; type `show c' for details.
	658
	659	The hypothetical commands `show w' and `show c' should show the appropriate
	660	parts of the General Public License. Of course, your program's commands
	661	might be different; for a GUI interface, you would use an "about box".
	662
	663	You should also get your employer (if you work as a programmer) or school,
	664	if any, to sign a "copyright disclaimer" for the program, if necessary.
	665	For more information on this, and how to apply and follow the GNU GPL, see
	666	<http://www.gnu.org/licenses/>.
	667
	668	The GNU General Public License does not permit incorporating your program
	669	into proprietary programs. If your program is a subroutine library, you
	670	may consider it more useful to permit linking proprietary applications with
	671	the library. If this is what you want to do, use the GNU Lesser General
	672	Public License instead of this License. But first, please read
	673	<http://www.gnu.org/philosophy/why-not-lgpl.html>.

-6

Makefile less more

0	0	EMACS ?= emacs
1	1	CASK ?= cask
2
3		CURL=curl --silent -L
4		ERT_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24
5		ERT=ert
6		CL_URL=https://raw.githubusercontent.com/emacsmirror/cl-lib/master/cl-lib.el
7		CL=cl-lib
8	2
9	3	.PHONY: test test-deferred test-concurrent compile clean print-deps travis-ci
10	4

-8

README-concurrent.ja.markdown less more

19	19
20	20	### Threadの例
21	21
22		lexical-letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。
	22	letを評価するとその場でアニメーションします。引数の時間は、bodyの処理の間隔です。
23	23
24	24	Thread:
25	25
26	26	```el
27		(lexical-let
28		((count 0) (anm "-/\|\\-")
29		(end 50) (pos (point)))
	27	(let ((count 0) (anm "-/\|\\-")
	28	(end 50) (pos (point)))
30	29	(cc:thread
31	30	60
32	31	(message "Animation started.")
33		(while (> end (incf count))
	32	(while (> end (cl-incf count))
34	33	(save-excursion
35	34	(when (< 1 count)
36	35	(goto-char pos) (delete-char 1))

55	54	```el
56	55	(setq fib-list nil)
57	56	(setq fib-gen
58		(lexical-let ((a1 0) (a2 1))
	57	(let ((a1 0) (a2 1))
59	58	(cc:generator
60	59	(lambda (x) (push x fib-list)) ; コールバックで結果受け取り
61	60	(yield a1)

184	183	(cc:signal-connect
185	184	channel t ; t にするとすべてのシグナルを拾う
186	185	(lambda (event)
187		(destructuring-bind (event-name (args)) event
	186	(cl-destructuring-bind (event-name (args)) event
188	187	(message "Listener : %S / %S" event-name args))))
189	188
190	189	(deferred:$ ; deferred で非同期タスクを接続できる

306	305	* args: イベント引数
307	306	* 返値：なし
308	307	* シグナルを発信します。
309		* args は、受信側で (lambda (event) (destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。
	308	* args は、受信側で (lambda (event) (cl-destructuring-bind (event-sym (args)) event ... )) のようにすると受け取れます。
310	309
311	310
312	311	* cc:signal-send-global (channel event-sym &rest args)

-8

README-concurrent.markdown less more

23	23
24	24	### Pseud-thread
25	25
26		Evaluating the lexical-let in the blow code, the animation starts. After few seconds, the animation will stop.
	26	Evaluating the let in the blow code, the animation starts. After few seconds, the animation will stop.
27	27
28	28	Thread:
29	29
30	30	```el
31		(lexical-let
32		((count 0) (anm "-/\|\\-")
33		(end 50) (pos (point)))
	31	(let ((count 0) (anm "-/\|\\-")
	32	(end 50) (pos (point)))
34	33	(cc:thread
35	34	60
36	35	(message "Animation started.")
37		(while (> end (incf count))
	36	(while (> end (cl-incf count))
38	37	(save-excursion
39	38	(when (< 1 count)
40	39	(goto-char pos) (delete-char 1))

61	60	```el
62	61	(setq fib-list nil)
63	62	(setq fib-gen
64		(lexical-let ((a1 0) (a2 1))
	63	(let ((a1 0) (a2 1))
65	64	(cc:generator
66	65	(lambda (x) (push x fib-list)) ; Receiving values as a callback function
67	66	(yield a1)

200	199	(cc:signal-connect
201	200	channel t ; The signal symbol 't' means any signals.
202	201	(lambda (event)
203		(destructuring-bind (event-name (args)) event
	202	(cl-destructuring-bind (event-name (args)) event
204	203	(message "Listener : %S / %S" event-name args))))
205	204
206	205	(deferred:$ ; Connect the deferred task.

338	337	* None
339	338	* Send a signal to the channel.
340	339	* If the `args` are given, observers can get the values by following code:
341		* `(lambda (event) (destructuring-bind (event-sym (args)) event ... ))`
	340	* `(lambda (event) (cl-destructuring-bind (event-sym (args)) event ... ))`
342	341
343	342	* cc:signal-send-global (channel event-sym &rest args)
344	343	* Arguments

+20

-20

README.ja.markdown less more

6	6	[![Tag Version](https://img.shields.io/github/tag/kiwanami/emacs-deferred.svg)](https://github.com/kiwanami/emacs-deferred/tags)
7	7	[![License](http://img.shields.io/:license-gpl3-blue.svg)](http://www.gnu.org/licenses/gpl-3.0.html)
8	8
9		deferred.elは非同期処理を抽象化して書きやすくするためのライブラリです。APIや
10		実装については
	9	deferred.el は非同期処理を抽象化して書きやすくするためのライブラリです。
	10	APIや実装については
11	11	[JSDeferred](https://github.com/cho45/jsdeferred "JSDeferred") (by cho45さん)と
12	12	[Mochikit.Async](http://mochikit.com/doc/html/MochiKit/Async.html
13	13	"Mochikit.Async") (by Bob Ippolitoさん)を参考にしています。

142	142	(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
143	143	(deferred:nextc it
144	144	(lambda (buffers)
145		(loop for i in buffers
146		do
147		(insert
148		(format
149		"size: %s\n"
150		(with-current-buffer i (length (buffer-string)))))
151		(kill-buffer i)))))
	145	(cl-loop for i in buffers
	146	do
	147	(insert
	148	(format
	149	"size: %s\n"
	150	(with-current-buffer i (length (buffer-string)))))
	151	(kill-buffer i)))))
152	152	```
153	153
154	154	* deferred:parallel 内部で、並列に実行できるものは並列に動作します。

265	265	Loop and animation:
266	266
267	267	```el
268		(lexical-let ((count 0) (anm "-/\|\\-")
269		(end 50) (pos (point))
270		(wait-time 50))
	268	(let ((count 0) (anm "-/\|\\-")
	269	(end 50) (pos (point))
	270	(wait-time 50))
271	271	(deferred:$
272	272	(deferred:next
273	273	(lambda (x) (message "Animation started.")))

279	279	(goto-char pos) (delete-char 1))
280	280	(insert (char-to-string
281	281	(aref anm (% count (length anm))))))
282		(if (> end (incf count)) ; 止める場合はdeferredでないものを返す（この場合はnil）
	282	(if (> end (cl-incf count)) ; 止める場合はdeferredでないものを返す（この場合はnil）
283	283	(deferred:nextc (deferred:wait wait-time) self)))) ; 続けるときはdeferredを返す
284	284
285	285	(deferred:nextc it

584	584
585	585	### レキシカルスコープ ###
586	586
587		deferredの処理に値を持って行く場合、lexical-let などを用いてレキシカルスコープを使うと大変便利です。
	587	deferredの処理に値を持って行く場合、let などを用いてレキシカルスコープを使うと大変便利です。
588	588
589	589	特に、一連のdeferred処理の中で共通に使う値にレキシカルスコープを使うと、ローカル変数のようにアクセスすること出来るため、非同期処理のために値をグローバルに保持しておく必要が無くなります。
590	590
591		lexical-let 例:
592
593		```el
594		(lexical-let ((a (point)))
	591	let 例:
	592
	593	```el
	594	(let ((a (point)))
595	595	(deferred:$
596	596	(deferred:wait 1000)
597	597	(deferred:nextc it

600	600	(insert "here!")))))
601	601	```
602	602
603		逆に、lexical-letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。
	603	逆に、letでレキシカルスコープにバインドしていないシンボルを参照しようとして、エラーになることがよくあります。
604	604
605	605	### カレント状態 ###
606	606

623	623	改善例:
624	624
625	625	```el
626		(lexical-let ((buf (get-buffer "Message")))
	626	(let ((buf (get-buffer "Message")))
627	627	(deferred:$
628	628	(deferred:wait 1000)
629	629	(deferred:nextc it

+19

-19

README.markdown less more

143	143	(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
144	144	(deferred:nextc it
145	145	(lambda (buffers)
146		(loop for i in buffers
147		do
148		(insert
149		(format
150		"size: %s\n"
151		(with-current-buffer i (length (buffer-string)))))
152		(kill-buffer i)))))
	146	(cl-loop for i in buffers
	147	do
	148	(insert
	149	(format
	150	"size: %s\n"
	151	(with-current-buffer i (length (buffer-string)))))
	152	(kill-buffer i)))))
153	153	```
154	154
155	155	* The function `deferred:parallel` runs asynchronous tasks concurrently.

274	274	Loop and animation:
275	275
276	276	```el
277		(lexical-let ((count 0) (anm "-/\|\\-")
278		(end 50) (pos (point))
279		(wait-time 50))
	277	(let ((count 0) (anm "-/\|\\-")
	278	(end 50) (pos (point))
	279	(wait-time 50))
280	280	(deferred:$
281	281	(deferred:next
282	282	(lambda (x) (message "Animation started.")))

288	288	(goto-char pos) (delete-char 1))
289	289	(insert (char-to-string
290	290	(aref anm (% count (length anm))))))
291		(if (> end (incf count)) ; return nil to stop this loop
	291	(if (> end (cl-incf count)) ; return nil to stop this loop
292	292	(deferred:nextc (deferred:wait wait-time) self)))) ; return the deferred
293	293
294	294	(deferred:nextc it

314	314	1))
315	315	(deferred:nextc it
316	316	(lambda (x)
317		(lexical-let ((d (deferred:new #'identity)))
	317	(let ((d (deferred:new #'identity)))
318	318	(run-at-time 0 nil (lambda (x)
319	319	;; Start the following callback queue now.
320	320	(deferred:callback-post d x))

638	638
639	639	### Using lexical scope ###
640	640
641		Using the lexical scope macro, such as `lexical-let`, the deferred tasks defined by lambdas can access local variables.
642
643		`lexical-let` Ex.:
644
645		```el
646		(lexical-let ((a (point)))
	641	Using the lexical scope macro, such as `let`, the deferred tasks defined by lambdas can access local variables.
	642
	643	`let` Ex.:
	644
	645	```el
	646	(let ((a (point)))
647	647	(deferred:$
648	648	(deferred:wait 1000)
649	649	(deferred:nextc it

675	675	Corrected:
676	676
677	677	```el
678		(lexical-let ((buf (get-buffer "Message")))
	678	(let ((buf (get-buffer "Message")))
679	679	(deferred:$
680	680	(deferred:wait 1000)
681	681	(deferred:nextc it

+91

-96

concurrent.el less more

0		;;; concurrent.el --- Concurrent utility functions for emacs lisp
	0	;;; concurrent.el --- Concurrent utility functions for emacs lisp -- lexical-binding: t; --
1	1
2	2	;; Copyright (C) 2010-2016 SAKURAI Masashi
3	3
4	4	;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
5		;; Version: 0.4.0
	5	;; Version: 0.5.0
6	6	;; Keywords: deferred, async, concurrent
7		;; Package-Requires: ((deferred "0.4.0"))
	7	;; Package-Requires: ((emacs "24.3") (deferred "0.5.0"))
8	8	;; URL: https://github.com/kiwanami/emacs-deferred/blob/master/README-concurrent.markdown
9	9
10	10	;; This program is free software; you can redistribute it and/or modify

31	31	;; - Dataflow
32	32	;; - Signal/Channel
33	33
34		(require 'cl)
	34	(require 'cl-lib)
35	35
36	36	(require 'deferred)
37	37

54	54	(defun cc:generator-replace-yield (tree)
55	55	"[internal] Replace `yield' symbols to calling a function in TREE."
56	56	(let (ret)
57		(loop for i in tree
58		do (cond
59		((eq i 'yield)
60		(push 'funcall ret)
61		(push i ret))
62		((listp i)
63		(push (cc:generator-replace-yield i) ret))
64		(t
65		(push i ret))))
	57	(cl-loop for i in tree
	58	do (cond
	59	((eq i 'yield)
	60	(push 'funcall ret)
	61	(push i ret))
	62	((listp i)
	63	(push (cc:generator-replace-yield i) ret))
	64	(t
	65	(push i ret))))
66	66	(nreverse ret)))
67	67
68	68	(defun cc:generator-line (chain line)

92	92	(defmacro cc:generator (callback &rest body)
93	93	"Create a generator object. If BODY has `yield' symbols, it
94	94	means calling callback function CALLBACK."
95		(let ((chain (gensym))
96		(cc (gensym))
97		(waiter (gensym)))
98		`(lexical-let*
99		(,chain
100		(,cc ,callback)
101		(,waiter (deferred:new))
102		(yield (lambda (x) (funcall ,cc x) ,waiter)))
	95	(let ((chain (cl-gensym))
	96	(cc (cl-gensym))
	97	(waiter (cl-gensym)))
	98	`(let* (,chain
	99	(,cc ,callback)
	100	(,waiter (deferred:new))
	101	(yield (lambda (x) (funcall ,cc x) ,waiter)))
103	102	(setq ,chain ,waiter)
104		,@(loop for i in body
105		collect
106		(cc:generator-line chain i))
	103	,@(cl-loop for i in body
	104	collect
	105	(cc:generator-line chain i))
107	106	(lambda () (deferred:callback ,waiter)))))
108	107
109	108

123	122	((eq 'while (car line))
124	123	(let ((condition (cadr line))
125	124	(body (cddr line))
126		(retsym (gensym)))
	125	(retsym (cl-gensym)))
127	126	`(setq ,chain
128	127	(deferred:nextc ,chain
129	128	(deferred:lambda (x)

141	140
142	141	(defmacro cc:thread (wait-time-msec &rest body)
143	142	"Return a thread object."
144		(let ((chain (gensym))
145		(dstart (gensym)))
146		`(lexical-let*
147		(,chain
148		(,dstart (deferred:new)))
	143	(let ((chain (cl-gensym))
	144	(dstart (cl-gensym)))
	145	`(let* (,chain
	146	(,dstart (deferred:new)))
149	147	(setq ,chain ,dstart)
150		,@(loop for i in body
151		collect
152		(cc:thread-line wait-time-msec chain i))
	148	,@(cl-loop for i in body
	149	collect
	150	(cc:thread-line wait-time-msec chain i))
153	151	(deferred:callback ,dstart))))
154	152	(put 'cc:thread 'lisp-indent-function 1)
155	153

158	156	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159	157	;; Semaphore
160	158
161		(defstruct cc:semaphore max-permits permits waiting-deferreds)
	159	(cl-defstruct cc:semaphore max-permits permits waiting-deferreds)
162	160
163	161	(defun cc:semaphore-create(permits-num)
164	162	"Return a semaphore object with PERMITS-NUM permissions."

172	170	permission is returned, the task is executed."
173	171	(cond
174	172	((< 0 (cc:semaphore-permits semaphore))
175		(decf (cc:semaphore-permits semaphore))
	173	(cl-decf (cc:semaphore-permits semaphore))
176	174	(deferred:succeed))
177	175	(t
178	176	(let ((d (deferred:new)))

195	193	(nbutlast waiting-deferreds))
196	194	(deferred:callback-post d)))
197	195	(t
198		(incf (cc:semaphore-permits semaphore)))))
	196	(cl-incf (cc:semaphore-permits semaphore)))))
199	197	semaphore)
200	198
201	199	(defun cc:semaphore-with (semaphore body-func &optional error-func)
202	200	"Execute the task BODY-FUNC asynchronously with the semaphore block."
203		(lexical-let ((semaphore semaphore))
204		(deferred:try
205		(deferred:nextc (cc:semaphore-acquire semaphore) body-func)
206		:catch
207		error-func
208		:finally
209		(lambda (_x) (cc:semaphore-release semaphore)))))
	201	(deferred:try
	202	(deferred:nextc (cc:semaphore-acquire semaphore) body-func)
	203	:catch
	204	error-func
	205	:finally
	206	(lambda (_x) (cc:semaphore-release semaphore))))
210	207	(put 'cc:semaphore-with 'lisp-indent-function 1)
211	208
212	209	(defun cc:semaphore-release-all (semaphore)

239	236	NAME is a channel name for debug.
240	237	PARENT-CHANNEL is an upstream channel. The observers of this channel can receive the upstream signals.
241	238	In the case of using the function `cc:signal-send', the observers of the upstream channel can not receive the signals of this channel. The function `cc:signal-send-global' can send a signal to the upstream channels from the downstream channels."
242		(lexical-let
243		((ch (cons
244		(or name (format "signal%s" (deferred:uid))) ; name for debug
245		(cons
246		parent-channel ; parent-channel
247		nil)))) ; observers
	239	(let ((ch (cons
	240	(or name (format "signal%s" (deferred:uid))) ; name for debug
	241	(cons
	242	parent-channel ; parent-channel
	243	nil)))) ; observers
248	244	(when parent-channel
249	245	(cc:signal-connect
250	246	parent-channel
251	247	t (lambda (event)
252		(destructuring-bind
	248	(cl-destructuring-bind
253	249	(event-name event-args) event
254	250	(apply 'cc:signal-send
255	251	ch event-name event-args)))))

284	280	"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 ... )). "
285	281	(let ((observers (cc:signal-observers channel))
286	282	(event (list event-sym args)))
287		(loop for i in observers
288		for name = (car i)
289		for d = (cdr i)
290		if (or (eq event-sym name) (eq t name))
291		do (deferred:callback-post d event))))
	283	(cl-loop for i in observers
	284	for name = (car i)
	285	for d = (cdr i)
	286	if (or (eq event-sym name) (eq t name))
	287	do (deferred:callback-post d event))))
292	288
293	289	(defun cc:signal-send-global (channel event-sym &rest args)
294	290	"Send a signal to the most upstream channel. "

303	299	(let ((observers (cc:signal-observers channel)) deleted)
304	300	(setf
305	301	(cc:signal-observers channel) ; place
306		(loop for i in observers
307		for d = (cdr i)
308		unless (eq d deferred)
309		collect i
310		else
311		do (push i deleted)))
	302	(cl-loop for i in observers
	303	for d = (cdr i)
	304	unless (eq d deferred)
	305	collect i
	306	else
	307	do (push i deleted)))
312	308	deleted))
313	309
314	310	(defun cc:signal-disconnect-all (channel)

324	320	;; Dataflow
325	321
326	322	;; Dataflow variable entry
327		(defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
	323	(cl-defstruct cc:dataflow key (value 'cc:dataflow-undefine) deferred-list)
328	324
329	325	(defun cc:dataflow-undefine-p (obj)
330	326	"[internal] If the variable entry is not bound, return `t'."

340	336
341	337	(defmacro cc:dataflow-channel (df)
342	338	"[internal] Return the channel object."
343		`(caddr ,df))
	339	`(cl-caddr ,df))
344	340
345	341	(defmacro cc:dataflow-list (df)
346	342	"[internal] Return the list of deferred object which are waiting for value binding."
347		`(cdddr ,df))
	343	`(cl-cdddr ,df))
348	344
349	345	(defun cc:dataflow-environment (&optional parent-env test-func channel)
350	346	"Create a dataflow environment.

370	366
371	367	(defun cc:dataflow-init-connect (df)
372	368	"[internal] Initialize the channel object."
373		(lexical-let ((df df))
374		(cc:dataflow-connect
375		df 'set
376		(lambda (args)
377		(destructuring-bind (_event (key)) args
378		(let* ((obj (cc:dataflow-get-object-for-value df key))
379		(value (and obj (cc:dataflow-value obj))))
380		(when obj
381		(loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
382		(cc:dataflow-deferred-list it) nil)
383		do (deferred:callback-post i value))
384		(setf (cc:dataflow-deferred-list obj) nil))))))))
	369	(cc:dataflow-connect
	370	df 'set
	371	(lambda (args)
	372	(cl-destructuring-bind (_event (key)) args
	373	(let* ((obj (cc:dataflow-get-object-for-value df key))
	374	(value (and obj (cc:dataflow-value obj))))
	375	(when obj
	376	(cl-loop for i in (cc:aif (cc:dataflow-get-object-for-deferreds df key)
	377	(cc:dataflow-deferred-list it) nil)
	378	do (deferred:callback-post i value))
	379	(setf (cc:dataflow-deferred-list obj) nil)))))))
385	380
386	381	(defun cc:dataflow-get-object-for-value (df key)
387	382	"[internal] Return an entry object that is indicated by KEY.
388	383	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."
389	384	(or
390		(loop for i in (cc:dataflow-list df)
391		with test = (cc:dataflow-test df)
392		if (and (funcall test key (cc:dataflow-key i))
393		(not (cc:dataflow-undefine-p i)))
394		return i)
	385	(cl-loop for i in (cc:dataflow-list df)
	386	with test = (cc:dataflow-test df)
	387	if (and (funcall test key (cc:dataflow-key i))
	388	(not (cc:dataflow-undefine-p i)))
	389	return i)
395	390	(deferred:aand
396	391	(cc:dataflow-parent-environment df)
397	392	(cc:dataflow-get-object-for-value it key))))

399	394	(defun cc:dataflow-get-object-for-deferreds (df key)
400	395	"[internal] Return a list of the deferred objects those are waiting for value binding.
401	396	This function doesn't affect the waiting list and doesn't refer the parent environment."
402		(loop for i in (cc:dataflow-list df)
403		with test = (cc:dataflow-test df)
404		if (funcall test key (cc:dataflow-key i))
405		return i))
	397	(cl-loop for i in (cc:dataflow-list df)
	398	with test = (cc:dataflow-test df)
	399	if (funcall test key (cc:dataflow-key i))
	400	return i))
406	401
407	402	(defun cc:dataflow-connect (df event-sym &optional callback)
408	403	"Append an observer for EVENT-SYM of the channel of DF and return a deferred object.

463	458	This function does nothing for the waiting deferred objects."
464	459	(cc:dataflow-signal df 'clear key)
465	460	(setf (cc:dataflow-list df)
466		(loop for i in (cc:dataflow-list df)
467		with test = (cc:dataflow-test df)
468		unless (funcall test key (cc:dataflow-key i))
469		collect i)))
	461	(cl-loop for i in (cc:dataflow-list df)
	462	with test = (cc:dataflow-test df)
	463	unless (funcall test key (cc:dataflow-key i))
	464	collect i)))
470	465
471	466	(defun cc:dataflow-get-avalable-pairs (df)
472	467	"Return an available key-value alist in the environment DF and the parent ones."
473	468	(append
474		(loop for i in (cc:dataflow-list df)
475		for key = (cc:dataflow-key i)
476		for val = (cc:dataflow-value i)
477		unless (cc:dataflow-undefine-p i) collect (cons key val))
	469	(cl-loop for i in (cc:dataflow-list df)
	470	for key = (cc:dataflow-key i)
	471	for val = (cc:dataflow-value i)
	472	unless (cc:dataflow-undefine-p i) collect (cons key val))
478	473	(deferred:aand
479	474	(cc:dataflow-parent-environment df)
480	475	(cc:dataflow-get-avalable-pairs it))))

482	477	(defun cc:dataflow-get-waiting-keys (df)
483	478	"Return a list of keys which have waiting deferred objects in the environment DF and the parent ones."
484	479	(append
485		(loop for i in (cc:dataflow-list df)
486		for key = (cc:dataflow-key i)
487		if (cc:dataflow-undefine-p i) collect key)
	480	(cl-loop for i in (cc:dataflow-list df)
	481	for key = (cc:dataflow-key i)
	482	if (cc:dataflow-undefine-p i) collect key)
488	483	(deferred:aand
489	484	(cc:dataflow-parent-environment df)
490	485	(cc:dataflow-get-waiting-keys it))))

+171

-167

deferred.el less more

0		;;; deferred.el --- Simple asynchronous functions for emacs lisp
	0	;;; deferred.el --- Simple asynchronous functions for emacs lisp -- lexical-binding: t; --
1	1
2	2	;; Copyright (C) 2010-2016 SAKURAI Masashi
3	3
4	4	;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>
5		;; Version: 0.4.0
	5	;; Version: 0.5.0
6	6	;; Keywords: deferred, async
	7	;; Package-Requires: ((emacs "24.3"))
7	8	;; URL: https://github.com/kiwanami/emacs-deferred
8	9
9	10	;; This program is free software; you can redistribute it and/or modify

64	65	;; This program makes simple multi-thread function, using
65	66	;; deferred.el.
66	67
67		(require 'cl)
	68	(require 'cl-lib)
68	69
69	70	(declare-function pp-display-expression 'pp)
70	71

83	84	"Anaphoric function chain macro for deferred chains."
84	85	(declare (debug (&rest form)))
85	86	`(let (it)
86		,@(loop for i in elements
87		collect
88		`(setq it ,i))
	87	,@(cl-loop for i in elements
	88	collect
	89	`(setq it ,i))
89	90	it))
90	91
91	92	(defmacro deferred:lambda (args &rest body)
92	93	"Anaphoric lambda macro for self recursion."
93	94	(declare (debug ("args" form &rest form)))
94		(let ((argsyms (loop repeat (length args) collect (gensym))))
	95	(let ((argsyms (cl-loop repeat (length args) collect (cl-gensym))))
95	96	`(lambda (,@argsyms)
96		(lexical-let (self)
	97	(let (self)
97	98	(setq self (lambda( ,@args ) ,@body))
98	99	(funcall self ,@argsyms)))))
99	100
100		(defmacro* deferred:try (d &key catch finally)
	101	(cl-defmacro deferred:try (d &key catch finally)
101	102	"Try-catch-finally macro. This macro simulates the
102	103	try-catch-finally block asynchronously. CATCH and FINALLY can be
103	104	nil. Because of asynchrony, this macro does not ensure that the

150	151	(save-excursion
151	152	(goto-char (point-max))
152	153	(insert (format "%5i %s\n" deferred:debug-count (format ,@args)))))
153		(incf deferred:debug-count))))
	154	(cl-incf deferred:debug-count))))
154	155
155	156	(defun deferred:message-mark ()
156	157	"[internal] Debug log function."

253	254	"Wait for the given deferred task. For test and debugging.
254	255	Error is raised if it is not processed within deferred chain D."
255	256	(progn
256		(lexical-let ((last-value 'deferred:undefined*)
257		uncaught-error)
	257	(let ((last-value 'deferred:undefined*)
	258	uncaught-error)
258	259	(deferred:try
259	260	(deferred:nextc d
260	261	(lambda (x) (setq last-value x)))

279	280	;; status : if 'ok or 'ng, this deferred has a result (error) value. (default nil)
280	281	;; value : saved value (default nil)
281	282	;;
282		(defstruct deferred
	283	(cl-defstruct deferred
283	284	(callback 'deferred:default-callback)
284	285	(errorback 'deferred:default-errorback)
285	286	(cancel 'deferred:default-cancel)

317	318	(setf (deferred-errorback d) 'deferred:default-errorback)
318	319	(setf (deferred-next d) nil)
319	320	d)
	321
	322	(defvar deferred:onerror nil
	323	"Default error handler. This value is nil or a function that
	324	have one argument for the error message.")
320	325
321	326	(defun deferred:exec-task (d which &optional arg)
322	327	"[internal] Executing deferred task. If the deferred object has

427	432	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428	433	;; Basic utility functions
429	434
430		(defvar deferred:onerror nil
431		"Default error handler. This value is nil or a function that
432		have one argument for the error message.")
433
434	435	(defun deferred:succeed (&optional arg)
435	436	"Create a synchronous deferred object."
436	437	(let ((d (deferred:new)))

469	470	return values. This function is used in following purposes,
470	471	simulation of try-finally block in asynchronous tasks, progress
471	472	monitoring of tasks."
472		(lexical-let*
473		((callback callback)
474		(normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x))
475		(err (lambda (e)
476		(ignore-errors (deferred:call-lambda callback e))
477		(deferred:resignal e))))
	473	(let* ((callback callback)
	474	(normal (lambda (x) (ignore-errors (deferred:call-lambda callback x)) x))
	475	(err (lambda (e)
	476	(ignore-errors (deferred:call-lambda callback e))
	477	(deferred:resignal e))))
478	478	(let ((nd (make-deferred :callback normal :errorback err)))
479	479	(deferred:set-next d nd))))
480	480
481	481	(defun deferred:wait (msec)
482	482	"Return a deferred object scheduled at MSEC millisecond later."
483		(lexical-let
484		((d (deferred:new)) (start-time (float-time)) timer)
	483	(let ((d (deferred:new)) (start-time (float-time)) timer)
485	484	(deferred:message "WAIT : %s" msec)
486	485	(setq timer (deferred:setTimeout
487	486	(lambda ()

497	496	(defun deferred:wait-idle (msec)
498	497	"Return a deferred object which will run when Emacs has been
499	498	idle for MSEC millisecond."
500		(lexical-let
501		((d (deferred:new)) (start-time (float-time)) timer)
	499	(let ((d (deferred:new)) (start-time (float-time)) timer)
502	500	(deferred:message "WAIT-IDLE : %s" msec)
503	501	(setq timer
504	502	(deferred:run-with-idle-timer

515	513
516	514	(defun deferred:call (f &rest args)
517	515	"Call the given function asynchronously."
518		(lexical-let ((f f) (args args))
519		(deferred:next
520		(lambda (_x)
521		(apply f args)))))
	516	(deferred:next
	517	(lambda (_x)
	518	(apply f args))))
522	519
523	520	(defun deferred:apply (f &optional args)
524	521	"Call the given function asynchronously."
525		(lexical-let ((f f) (args args))
526		(deferred:next
527		(lambda (_x)
528		(apply f args)))))
	522	(deferred:next
	523	(lambda (_x)
	524	(apply f args))))
529	525
530	526
531	527

541	537	"Return a iteration deferred object."
542	538	(deferred:message "LOOP : %s" times-or-seq)
543	539	(if (deferred:empty-p times-or-seq) (deferred:next)
544		(lexical-let*
545		(items (rd
546		(cond
547		((numberp times-or-seq)
548		(loop for i from 0 below times-or-seq
549		with ld = (deferred:next)
550		do
551		(push ld items)
552		(setq ld
553		(lexical-let ((i i) (func func))
554		(deferred:nextc ld (lambda (_x) (deferred:call-lambda func i)))))
555		finally return ld))
556		((sequencep times-or-seq)
557		(loop for i in (append times-or-seq nil) ; seq->list
558		with ld = (deferred:next)
559		do
560		(push ld items)
561		(setq ld
562		(lexical-let ((i i) (func func))
563		(deferred:nextc ld (lambda (_x) (deferred:call-lambda func i)))))
564		finally return ld)))))
	540	(let* (items (rd
	541	(cond
	542	((numberp times-or-seq)
	543	(cl-loop for i from 0 below times-or-seq
	544	with ld = (deferred:next)
	545	do
	546	(push ld items)
	547	(setq ld
	548	(let ((i i))
	549	(deferred:nextc ld
	550	(lambda (_x) (deferred:call-lambda func i)))))
	551	finally return ld))
	552	((sequencep times-or-seq)
	553	(cl-loop for i in (append times-or-seq nil) ; seq->list
	554	with ld = (deferred:next)
	555	do
	556	(push ld items)
	557	(setq ld
	558	(let ((i i))
	559	(deferred:nextc ld
	560	(lambda (_x) (deferred:call-lambda func i)))))
	561	finally return ld)))))
565	562	(setf (deferred-cancel rd)
566	563	(lambda (x) (deferred:default-cancel x)
567		(loop for i in items
568		do (deferred:cancel i))))
	564	(cl-loop for i in items
	565	do (deferred:cancel i))))
569	566	rd)))
570	567
571	568	(defun deferred:trans-multi-args (args self-func list-func main-func)

587	584
588	585	(defun deferred:parallel-array-to-alist (lst)
589	586	"[internal] Translation array to alist."
590		(loop for d in lst
591		for i from 0 below (length lst)
592		collect (cons i d)))
	587	(cl-loop for d in lst
	588	for i from 0 below (length lst)
	589	collect (cons i d)))
593	590
594	591	(defun deferred:parallel-alist-to-array (alst)
595	592	"[internal] Translation alist to array."
596		(loop for pair in
597		(sort alst (lambda (x y)
598		(< (car x) (car y))))
599		collect (cdr pair)))
	593	(cl-loop for pair in
	594	(sort alst (lambda (x y)
	595	(< (car x) (car y))))
	596	collect (cdr pair)))
600	597
601	598	(defun deferred:parallel-func-to-deferred (alst)
602	599	"[internal] Normalization for parallel and earlier arguments."
603		(loop for pair in alst
604		for d = (cdr pair)
605		collect
606		(progn
607		(unless (deferred-p d)
608		(setf (cdr pair) (deferred:next d)))
609		pair)))
	600	(cl-loop for pair in alst
	601	for d = (cdr pair)
	602	collect
	603	(progn
	604	(unless (deferred-p d)
	605	(setf (cdr pair) (deferred:next d)))
	606	pair)))
610	607
611	608	(defun deferred:parallel-main (alst)
612	609	"[internal] Deferred alist implementation for `deferred:parallel'. "
613	610	(deferred:message "PARALLEL<KEY . VALUE>" )
614		(lexical-let ((nd (deferred:new))
615		(len (length alst))
616		values)
617		(loop for pair in
618		(deferred:parallel-func-to-deferred alst)
619		with cd ; current child deferred
620		do
621		(lexical-let ((name (car pair)))
622		(setq cd
623		(deferred:nextc (cdr pair)
624		(lambda (x)
625		(push (cons name x) values)
626		(deferred:message "PARALLEL VALUE [%s/%s] %s"
627		(length values) len (cons name x))
628		(when (= len (length values))
629		(deferred:message "PARALLEL COLLECTED")
630		(deferred:post-task nd 'ok (nreverse values)))
631		nil)))
632		(deferred:error cd
633		(lambda (e)
634		(push (cons name e) values)
635		(deferred:message "PARALLEL ERROR [%s/%s] %s"
636		(length values) len (cons name e))
637		(when (= (length values) len)
638		(deferred:message "PARALLEL COLLECTED")
639		(deferred:post-task nd 'ok (nreverse values)))
640		nil))))
	611	(let ((nd (deferred:new))
	612	(len (length alst))
	613	values)
	614	(cl-loop for pair in
	615	(deferred:parallel-func-to-deferred alst)
	616	with cd ; current child deferred
	617	do
	618	(let ((name (car pair)))
	619	(setq cd
	620	(deferred:nextc (cdr pair)
	621	(lambda (x)
	622	(push (cons name x) values)
	623	(deferred:message "PARALLEL VALUE [%s/%s] %s"
	624	(length values) len (cons name x))
	625	(when (= len (length values))
	626	(deferred:message "PARALLEL COLLECTED")
	627	(deferred:post-task nd 'ok (nreverse values)))
	628	nil)))
	629	(deferred:error cd
	630	(lambda (e)
	631	(push (cons name e) values)
	632	(deferred:message "PARALLEL ERROR [%s/%s] %s"
	633	(length values) len (cons name e))
	634	(when (= (length values) len)
	635	(deferred:message "PARALLEL COLLECTED")
	636	(deferred:post-task nd 'ok (nreverse values)))
	637	nil))))
641	638	nd))
642	639
643	640	(defun deferred:parallel-list (lst)
644	641	"[internal] Deferred list implementation for `deferred:parallel'. "
645	642	(deferred:message "PARALLEL<LIST>" )
646		(lexical-let*
647		((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst)))
648		(rd (deferred:nextc pd 'deferred:parallel-alist-to-array)))
	643	(let* ((pd (deferred:parallel-main (deferred:parallel-array-to-alist lst)))
	644	(rd (deferred:nextc pd 'deferred:parallel-alist-to-array)))
649	645	(setf (deferred-cancel rd)
650	646	(lambda (x) (deferred:default-cancel x)
651	647	(deferred:cancel pd)))

664	660	(defun deferred:earlier-main (alst)
665	661	"[internal] Deferred alist implementation for `deferred:earlier'. "
666	662	(deferred:message "EARLIER<KEY . VALUE>" )
667		(lexical-let ((nd (deferred:new))
668		(len (length alst))
669		value results)
670		(loop for pair in
671		(deferred:parallel-func-to-deferred alst)
672		with cd ; current child deferred
673		do
674		(lexical-let ((name (car pair)))
675		(setq cd
676		(deferred:nextc (cdr pair)
677		(lambda (x)
678		(push (cons name x) results)
679		(cond
680		((null value)
681		(setq value (cons name x))
682		(deferred:message "EARLIER VALUE %s" (cons name value))
683		(deferred:post-task nd 'ok value))
684		(t
685		(deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value))
686		(when (eql (length results) len)
687		(deferred:message "EARLIER COLLECTED"))))
688		nil)))
689		(deferred:error cd
690		(lambda (e)
691		(push (cons name e) results)
692		(deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e))
693		(when (and (eql (length results) len) (null value))
694		(deferred:message "EARLIER FAILED")
695		(deferred:post-task nd 'ok nil))
696		nil))))
	663	(let ((nd (deferred:new))
	664	(len (length alst))
	665	value results)
	666	(cl-loop for pair in
	667	(deferred:parallel-func-to-deferred alst)
	668	with cd ; current child deferred
	669	do
	670	(let ((name (car pair)))
	671	(setq cd
	672	(deferred:nextc (cdr pair)
	673	(lambda (x)
	674	(push (cons name x) results)
	675	(cond
	676	((null value)
	677	(setq value (cons name x))
	678	(deferred:message "EARLIER VALUE %s" (cons name value))
	679	(deferred:post-task nd 'ok value))
	680	(t
	681	(deferred:message "EARLIER MISS [%s/%s] %s" (length results) len (cons name value))
	682	(when (eql (length results) len)
	683	(deferred:message "EARLIER COLLECTED"))))
	684	nil)))
	685	(deferred:error cd
	686	(lambda (e)
	687	(push (cons name e) results)
	688	(deferred:message "EARLIER ERROR [%s/%s] %s" (length results) len (cons name e))
	689	(when (and (eql (length results) len) (null value))
	690	(deferred:message "EARLIER FAILED")
	691	(deferred:post-task nd 'ok nil))
	692	nil))))
697	693	nd))
698	694
699	695	(defun deferred:earlier-list (lst)
700	696	"[internal] Deferred list implementation for `deferred:earlier'. "
701	697	(deferred:message "EARLIER<LIST>" )
702		(lexical-let*
703		((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst)))
704		(rd (deferred:nextc pd (lambda (x) (cdr x)))))
	698	(let* ((pd (deferred:earlier-main (deferred:parallel-array-to-alist lst)))
	699	(rd (deferred:nextc pd (lambda (x) (cdr x)))))
705	700	(setf (deferred-cancel rd)
706	701	(lambda (x) (deferred:default-cancel x)
707	702	(deferred:cancel pd)))

736	731
737	732	(defun deferred:uid ()
738	733	"[internal] Generate a sequence number."
739		(incf deferred:uid))
	734	(cl-incf deferred:uid))
740	735
741	736	(defun deferred:buffer-string (strformat buf)
742	737	"[internal] Return a string in the buffer with the given format."

777	772
778	773	(defun deferred:process-gen (f command args)
779	774	"[internal]"
780		(lexical-let
781		((pd (deferred:process-buffer-gen f command args)) d)
	775	(let ((pd (deferred:process-buffer-gen f command args)) d)
782	776	(setq d (deferred:nextc pd
783	777	(lambda (buf)
784	778	(prog1

793	787	(defun deferred:process-buffer-gen (f command args)
794	788	"[internal]"
795	789	(let ((d (deferred:next)) (uid (deferred:uid)))
796		(lexical-let
797		((f f) (command command) (args args)
798		(proc-name (format "deferred:%s*:%s" command uid))
799		(buf-name (format " deferred:%s*:%s" command uid))
800		(pwd default-directory)
801		(env process-environment)
802		(con-type process-connection-type)
803		(nd (deferred:new)) proc-buf proc)
	790	(let ((proc-name (format "deferred:%s*:%s" command uid))
	791	(buf-name (format " deferred:%s*:%s" command uid))
	792	(pwd default-directory)
	793	(env process-environment)
	794	(con-type process-connection-type)
	795	(nd (deferred:new)) proc-buf proc)
804	796	(deferred:nextc d
805	797	(lambda (_x)
806	798	(setq proc-buf (get-buffer-create buf-name))

825	817	(kill-buffer proc-buf)
826	818	(deferred:post-task nd 'ng msg)))
827	819	((equal event "finished\n")
828		(deferred:post-task nd 'ok proc-buf)))))
	820	(deferred:post-task nd 'ok proc-buf)))))
829	821	(setf (deferred-cancel nd)
830	822	(lambda (x) (deferred:default-cancel x)
831	823	(when proc

838	830	(defmacro deferred:processc (d command &rest args)
839	831	"Process chain of `deferred:process'."
840	832	`(deferred:nextc ,d
841		(lambda (,(gensym)) (deferred:process ,command ,@args))))
	833	(lambda (,(cl-gensym)) (deferred:process ,command ,@args))))
842	834
843	835	(defmacro deferred:process-bufferc (d command &rest args)
844	836	"Process chain of `deferred:process-buffer'."
845	837	`(deferred:nextc ,d
846		(lambda (,(gensym)) (deferred:process-buffer ,command ,@args))))
	838	(lambda (,(cl-gensym)) (deferred:process-buffer ,command ,@args))))
847	839
848	840	(defmacro deferred:process-shellc (d command &rest args)
849	841	"Process chain of `deferred:process'."
850	842	`(deferred:nextc ,d
851		(lambda (,(gensym)) (deferred:process-shell ,command ,@args))))
	843	(lambda (,(cl-gensym)) (deferred:process-shell ,command ,@args))))
852	844
853	845	(defmacro deferred:process-shell-bufferc (d command &rest args)
854	846	"Process chain of `deferred:process-buffer'."
855	847	`(deferred:nextc ,d
856		(lambda (,(gensym)) (deferred:process-shell-buffer ,command ,@args))))
	848	(lambda (,(cl-gensym)) (deferred:process-shell-buffer ,command ,@args))))
	849
	850	;; Special variables defined in url-vars.el.
	851	(defvar url-request-data)
	852	(defvar url-request-method)
	853	(defvar url-request-extra-headers)
	854
	855	(declare-function url-http-symbol-value-in-buffer "url-http"
	856	(symbol buffer &optional unbound-value))
	857
	858	(declare-function deferred:url-param-serialize "request" (params))
	859
	860	(declare-function deferred:url-escape "request" (val))
857	861
858	862	(eval-after-load "url"
859	863	;; for url package
860	864	;; TODO: proxy, charaset
861	865	;; List of gloabl variables to preserve and restore before url-retrieve call
862		'(lexical-let ((url-global-variables '(url-request-data
863		url-request-method
864		url-request-extra-headers)))
	866	'(let ((url-global-variables '(url-request-data
	867	url-request-method
	868	url-request-extra-headers)))
865	869
866	870	(defun deferred:url-retrieve (url &optional cbargs silent inhibit-cookies)
867	871	"A wrapper function for url-retrieve. The next deferred
868	872	object receives the buffer object that URL will load
869	873	into. Values of dynamically bound 'url-request-data', 'url-request-method' and
870	874	'url-request-extra-headers' are passed to url-retrieve call."
871		(lexical-let ((nd (deferred:new)) (url url)
872		(cbargs cbargs) (silent silent) (inhibit-cookies inhibit-cookies) buf
873		(local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables)))
	875	(let ((nd (deferred:new))
	876	buf
	877	(local-values (mapcar (lambda (symbol) (symbol-value symbol)) url-global-variables)))
874	878	(deferred:next
875	879	(lambda (_x)
876		(progv url-global-variables local-values
	880	(cl-progv url-global-variables local-values
877	881	(condition-case err
878	882	(setq buf
879	883	(url-retrieve

945	949	(when params
946	950	(mapconcat
947	951	'identity
948		(loop for p in params
949		collect
950		(cond
951		((consp p)
952		(concat
953		(deferred:url-escape (car p)) "="
954		(deferred:url-escape (cdr p))))
955		(t
956		(deferred:url-escape p))))
	952	(cl-loop for p in params
	953	collect
	954	(cond
	955	((consp p)
	956	(concat
	957	(deferred:url-escape (car p)) "="
	958	(deferred:url-escape (cdr p))))
	959	(t
	960	(deferred:url-escape p))))
957	961	"&")))
958	962	))
959	963

+27

-25

sample/concurrent-sample.el less more

0		;;; Sample code for concurrent.el
	0	;;; Sample code for concurrent.el -- lexical-binding: t; --
1	1
2	2	;; Evaluate following code in the scratch buffer.
	3
	4	(require 'cl-lib)
	5	(require 'concurrent)
3	6
4	7	;;==================================================
5	8	;;; generator
6	9
7		(setq fib-list nil)
	10	(defvar fib-list nil)
8	11
9		(setq fib-gen ; Create a generator object.
10		(lexical-let ((a1 0) (a2 1))
11		(cc:generator
12		(lambda (x) (push x fib-list)) ; receiving values
13		(yield a1)
14		(yield a2)
15		(while t
16		(let ((next (+ a1 a2)))
17		(setq a1 a2
18		a2 next)
19		(yield next))))))
	12	(defvar fib-gen ; Create a generator object.
	13	(let ((a1 0) (a2 1))
	14	(cc:generator
	15	(lambda (x) (push x fib-list)) ; receiving values
	16	(yield a1)
	17	(yield a2)
	18	(while t
	19	(let ((next (+ a1 a2)))
	20	(setq a1 a2
	21	a2 next)
	22	(yield next))))))
20	23
21	24	(funcall fib-gen) ; Generate 5 times
22	25	(funcall fib-gen) (funcall fib-gen)

28	31	;;==================================================
29	32	;;; thread
30	33
31		(lexical-let
32		((count 0) (anm "-/\|\\-")
33		(end 50) (pos (point)))
	34	(let ((count 0) (anm "-/\|\\-")
	35	(end 50) (pos (point)))
34	36	(cc:thread
35	37	60
36	38	(message "Animation started.")
37		(while (> end (incf count))
	39	(while (> end (cl-incf count))
38	40	(save-excursion
39	41	(when (< 1 count)
40	42	(goto-char pos) (delete-char 1))

51	53	;;; semaphore
52	54
53	55	;; create a semaphore object with permit=1.
54		(setq smp (cc:semaphore-create 1))
	56	(defvar smp (cc:semaphore-create 1))
55	57
56	58	;; executing three tasks...
57	59	(deferred:nextc (cc:semaphore-acquire smp)
58		(lambda(x)
	60	(lambda (_)
59	61	(message "go1")))
60	62	(deferred:nextc (cc:semaphore-acquire smp)
61		(lambda(x)
	63	(lambda (_)
62	64	(message "go2")))
63	65	(deferred:nextc (cc:semaphore-acquire smp)
64		(lambda(x)
	66	(lambda (_)
65	67	(message "go3")))
66	68
67	69	;; => Only the fist task is executed and displays "go1".

81	83	;; Dataflow
82	84
83	85	;; create a parent environment and bind "aaa" to 256.
84		(setq dfenv-parent (cc:dataflow-environment))
	86	(defvar dfenv-parent (cc:dataflow-environment))
85	87	(cc:dataflow-set dfenv-parent "aaa" 256)
86	88
87	89	;; create an environment with the parent one.
88		(setq dfenv (cc:dataflow-environment dfenv-parent))
	90	(defvar dfenv (cc:dataflow-environment dfenv-parent))
89	91
90	92	;; Return the parent value.
91	93	(cc:dataflow-get-sync dfenv "aaa") ; => 256

150	152	;; Signal
151	153
152	154	(progn
153		(setq parent-channel (cc:signal-channel "parent"))
	155	(defvar parent-channel (cc:signal-channel "parent"))
154	156	(cc:signal-connect
155	157	parent-channel 'parent-load
156	158	(lambda (event) (message "Parent Signal : %s" event)))

158	160	parent-channel t
159	161	(lambda (event) (message "Parent Listener : %s" event)))
160	162
161		(setq channel (cc:signal-channel "child" parent-channel))
	163	(defvar channel (cc:signal-channel "child" parent-channel))
162	164	(cc:signal-connect
163	165	channel 'window-load
164	166	(lambda (event) (message "Signal : %s" event)))

+16

-15

sample/deferred-samples.el less more

0		;; deferred.el samples
	0	;; deferred.el samples -- lexical-binding: t; --
1	1
	2	(require 'cl-lib)
2	3	(require 'deferred)
3	4
4	5	;;; Basic Chain

89	90	(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
90	91	(deferred:nextc it
91	92	(lambda (buffers)
92		(loop for i in buffers
93		do
94		(insert
95		(format
96		"size: %s\n"
97		(with-current-buffer i (length (buffer-string)))))
98		(kill-buffer i)))))
	93	(cl-loop for i in buffers
	94	do
	95	(insert
	96	(format
	97	"size: %s\n"
	98	(with-current-buffer i (length (buffer-string)))))
	99	(kill-buffer i)))))
99	100
100	101	;; Get an image by wget and resize by ImageMagick
101	102

140	141
141	142	;; Loop and animation
142	143
143		(lexical-let ((count 0) (anm "-/\|\\-")
144		(end 50) (pos (point))
145		(wait-time 50))
	144	(let ((count 0) (anm "-/\|\\-")
	145	(end 50) (pos (point))
	146	(wait-time 50))
146	147	(deferred:$
147	148	(deferred:next
148		(lambda (x) (message "Animation started.")))
	149	(lambda (_) (message "Animation started.")))
149	150
150	151	(deferred:nextc it
151		(deferred:lambda (x)
	152	(deferred:lambda (_)
152	153	(save-excursion
153	154	(when (< 0 count)
154	155	(goto-char pos) (delete-char 1))
155	156	(insert (char-to-string
156	157	(aref anm (% count (length anm))))))
157		(if (> end (incf count))
	158	(if (> end (cl-incf count))
158	159	(deferred:nextc (deferred:wait wait-time) self))))
159	160
160	161	(deferred:nextc it
161		(lambda (x)
	162	(lambda (_)
162	163	(save-excursion
163	164	(goto-char pos) (delete-char 1))
164	165	(message "Animation finished.")))))

+225

-235

test/concurrent-test.el less more

0		;;; test code for concurrent.el
	0	;;; test code for concurrent.el -- lexical-binding: t; --
1	1
2	2	;; Copyright (C) 2010 SAKURAI Masashi
3	3	;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>

23	23	(:send-report nil)
24	24	(:report-file "/tmp/undercover-report.json"))
25	25	(require 'concurrent)
26		(require 'cl)
	26	(require 'cl-lib)
27	27	(require 'pp)
28	28	(require 'ert)
29	29

34	34	;; generator
35	35
36	36	(defun cc:fib-gen (callback)
37		(lexical-let ((a1 0) (a2 1)
38		(callback callback))
	37	(let ((a1 0) (a2 1)
	38	(callback callback))
39	39	(cc:generator
40	40	callback
41	41	(yield a1)

47	47	(yield next))))))
48	48
49	49	(defun cc:test-fib-gen ()
50		(lexical-let*
51		((count 0)
52		(dfinish (deferred:new))
53		gen
54		(cc (lambda (x)
55		(cond
56		((= count 10)
57		(deferred:callback
58		dfinish
59		(if (= x 55) t
60		(format "Fib 10 = 55 -> %s" x))))
61		(t
62		(incf count)
63		(deferred:call gen))))))
	50	(let* ((count 0)
	51	(dfinish (deferred:new))
	52	gen
	53	(cc (lambda (x)
	54	(cond
	55	((= count 10)
	56	(deferred:callback
	57	dfinish
	58	(if (= x 55) t
	59	(format "Fib 10 = 55 -> %s" x))))
	60	(t
	61	(cl-incf count)
	62	(deferred:call gen))))))
64	63	(setq gen (cc:fib-gen cc))
65	64	(deferred:call gen)
66	65	dfinish))

70	69	;; thread
71	70
72	71	(defun cc:test-thread ()
73		(lexical-let
74		((dfinish (deferred:new))
75		(result nil) (start-time (float-time))
76		(count 0) (end 20))
	72	(let ((dfinish (deferred:new))
	73	(result nil) (start-time (float-time))
	74	(count 0) (end 20))
77	75	(push 1 result)
78	76	(cc:thread
79	77	60
80	78	(push 2 result)
81		(while (> end (incf count))
	79	(while (> end (cl-incf count))
82	80	(when (= 0 (% count 10))
83	81	(push count result)))
84	82	(push 99 result)

94	92	;; semaphore
95	93
96	94	(defun cc:test-semaphore1 ()
97		(lexical-let*
98		((result nil)
99		(dfinish (deferred:new
100		(lambda (x)
101		(setq result (reverse result))
102		(or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result)
103		result))))
104		(smp (cc:semaphore-create 1)))
	95	(let* ((result nil)
	96	(dfinish (deferred:new
	97	(lambda (_)
	98	(setq result (reverse result))
	99	(or (equal '(1 2 5 6 (size . 1) 3 7 8 canceled (size . 0)) result)
	100	result))))
	101	(smp (cc:semaphore-create 1)))
105	102
106	103	(push 1 result)
107	104
108	105	(deferred:nextc (cc:semaphore-acquire smp)
109		(lambda(x) (push 2 result)))
	106	(lambda(_) (push 2 result)))
110	107	(deferred:nextc (cc:semaphore-acquire smp)
111		(lambda(x) (push 3 result)))
	108	(lambda(_) (push 3 result)))
112	109	(deferred:nextc (cc:semaphore-acquire smp)
113	110	(lambda(x) (push x result)))
114	111
115	112	(deferred:$
116	113	(deferred:next
117		(lambda (x)
	114	(lambda (_)
118	115	(push 5 result)
119	116	(cc:semaphore-release smp)
120	117	(push 6 result)))
121	118	(deferred:nextc it
122		(lambda (x)
	119	(lambda (_)
123	120	(push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
124	121	(deferred:nextc it
125		(lambda (x)
	122	(lambda (_)
126	123	(push 7 result)
127		(loop for i in (cc:semaphore-release-all smp)
128		do (deferred:callback i 'canceled))
	124	(cl-loop for i in (cc:semaphore-release-all smp)
	125	do (deferred:callback i 'canceled))
129	126	(push 8 result)))
130	127	(deferred:nextc it
131		(lambda (x)
	128	(lambda (_)
132	129	(push (cons 'size (length (cc:semaphore-waiting-deferreds smp))) result)))
133	130	(deferred:nextc it
134		(lambda (x) (deferred:callback dfinish))))
	131	(lambda (_) (deferred:callback dfinish))))
135	132
136	133	dfinish))
137	134
138	135	;; (cc:debug (cc:test-semaphore1) "Semaphore1 : %s" x)
139	136
140	137	(defun cc:test-semaphore2 ()
141		(lexical-let*
142		((result nil)
143		(dfinish (deferred:new
144		(lambda (x)
145		(setq result (reverse result))
146		(or (equal '(0 a b c d e f g) result)
147		result))))
148		(smp (cc:semaphore-create 1)))
	138	(let* ((result nil)
	139	(dfinish (deferred:new
	140	(lambda (_)
	141	(setq result (reverse result))
	142	(or (equal '(0 a b c d e f g) result)
	143	result))))
	144	(smp (cc:semaphore-create 1)))
149	145
150	146	(push 0 result)
151	147
152	148	(cc:semaphore-with
153		smp (lambda (x)
	149	smp (lambda (_)
154	150	(deferred:nextc (cc:semaphore-acquire smp)
155		(lambda (x)
	151	(lambda (_)
156	152	(push 'c result)
157	153	(cc:semaphore-release smp)))
158	154	(push 'a result)
159	155	(deferred:nextc
160	156	(deferred:wait 100)
161		(lambda (x) (push 'b result)))))
	157	(lambda (_) (push 'b result)))))
162	158
163	159	(cc:semaphore-with
164		smp (lambda (x)
	160	smp (lambda (_)
165	161	(deferred:nextc (cc:semaphore-acquire smp)
166		(lambda (x)
	162	(lambda (_)
167	163	(push 'g result)
168	164	(cc:semaphore-release smp)
169	165	(deferred:callback dfinish)))
170	166	(push 'd result)
171	167	(deferred:nextc
172	168	(deferred:wait 100)
173		(lambda (x)
	169	(lambda (_)
174	170	(push 'e result)
175	171	(error "SMP CC ERR"))))
176	172	(lambda (e)
177		(destructuring-bind (sym msg) e
	173	(cl-destructuring-bind (sym msg) e
178	174	(when (and (eq 'error sym) (equal "SMP CC ERR" msg))
179	175	(push 'f result)))))
180	176

185	181	;; Dataflow
186	182
187	183	(defun cc:test-dataflow-simple1 ()
188		(lexical-let*
189		((result '(1))
190		(dfinish (deferred:new
191		(lambda (x)
192		(setq result (reverse result))
193		(or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result)
194		result))))
195		(dfenv (cc:dataflow-environment)))
	184	(let* ((result '(1))
	185	(dfinish (deferred:new
	186	(lambda (_)
	187	(setq result (reverse result))
	188	(or (equal '(1 (2 . nil) 4 5 (3 . 256) (6 . 256) (7 . nil)) result)
	189	result))))
	190	(dfenv (cc:dataflow-environment)))
196	191
197	192	(push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
198	193

204	199	(lambda (x) (push (cons 3 x) result))))
205	200	(deferred:$
206	201	(deferred:next
207		(lambda (x)
	202	(lambda (_)
208	203	(push 4 result)
209	204	(cc:dataflow-set dfenv "abc" 256)
210	205	(push 5 result)))))
211	206	(deferred:nextc it
212		(lambda (x)
	207	(lambda (_)
213	208	(push (cons 6 (cc:dataflow-get-sync dfenv "abc")) result)
214	209	(cc:dataflow-clear dfenv "abc")
215	210	(push (cons 7 (cc:dataflow-get-sync dfenv "abc")) result)))
216	211	(deferred:nextc it
217		(lambda (x)
	212	(lambda (_)
218	213	(deferred:callback dfinish))))
219	214
220	215	dfinish))

222	217	;; (cc:debug (cc:test-dataflow-simple1) "Dataflow1 : %s" x)
223	218
224	219	(defun cc:test-dataflow-simple2 ()
225		(lexical-let*
226		((result nil)
227		(dfinish (deferred:new
228		(lambda (x)
229		(or (equal '("a.jpg:300 OK jpeg") result)
230		result))))
231		(dfenv (cc:dataflow-environment)))
	220	(let* ((result nil)
	221	(dfinish (deferred:new
	222	(lambda (_)
	223	(or (equal '("a.jpg:300 OK jpeg") result)
	224	result))))
	225	(dfenv (cc:dataflow-environment)))
232	226
233	227	(deferred:$
234	228	(cc:dataflow-get dfenv '("http://example.com/a.jpg" 300))
235	229	(deferred:nextc it
236	230	(lambda (x) (push (format "a.jpg:300 OK %s" x) result)))
237	231	(deferred:nextc it
238		(lambda (x)
	232	(lambda (_)
239	233	(deferred:callback dfinish))))
240	234
241	235	(cc:dataflow-set dfenv '("http://example.com/a.jpg" 300) 'jpeg)

245	239	;; (cc:debug (cc:test-dataflow-simple2) "Dataflow2 : %s" x)
246	240
247	241	(defun cc:test-dataflow-simple3 ()
248		(lexical-let*
249		((result nil)
250		(dfinish (deferred:new
251		(lambda (x)
252		(or (equal '(">> 384") result)
253		result))))
254		(dfenv (cc:dataflow-environment)))
	242	(let* ((result nil)
	243	(dfinish (deferred:new
	244	(lambda (_)
	245	(or (equal '(">> 384") result)
	246	result))))
	247	(dfenv (cc:dataflow-environment)))
255	248
256	249	(deferred:$
257	250	(deferred:parallel

263	256	(deferred:nextc it
264	257	(lambda (x) (push (format ">> %s" x) result)))
265	258	(deferred:nextc it
266		(lambda (x)
	259	(lambda (_)
267	260	(deferred:callback dfinish))))
268	261
269	262	(deferred:nextc (deferred:wait 0.2)
270		(lambda (x)
	263	(lambda (_)
271	264	(cc:dataflow-set dfenv "def" 128)
272	265	(cc:dataflow-set dfenv "abc" 256)
273	266	(cc:dataflow-set dfenv "aaa" 512)

278	271	;; (cc:debug (cc:test-dataflow-simple3) "Dataflow3 : %s" x)
279	272
280	273	(defun cc:test-dataflow-simple4 ()
281		(lexical-let*
282		((result nil)
283		(dfinish (deferred:new
284		(lambda (x)
285		(or (equal '(">> 3") result)
286		result))))
287		(dfenv (cc:dataflow-environment)))
	274	(let* ((result nil)
	275	(dfinish (deferred:new
	276	(lambda (_)
	277	(or (equal '(">> 3") result)
	278	result))))
	279	(dfenv (cc:dataflow-environment)))
288	280
289	281	(deferred:$
290	282	(deferred:parallel

297	289	(deferred:nextc it
298	290	(lambda (x) (push (format ">> %s" x) result)))
299	291	(deferred:nextc it
300		(lambda (x)
	292	(lambda (_)
301	293	(deferred:callback dfinish))))
302	294
303	295	(deferred:nextc (deferred:wait 0.2)
304		(lambda (x)
	296	(lambda (_)
305	297	(cc:dataflow-set dfenv "abc" 1)
306	298	))
307	299

310	302	;; (cc:debug (cc:test-dataflow-simple4) "Dataflow4 : %s" x)
311	303
312	304	(defun cc:test-dataflow-signal ()
313		(lexical-let*
314		((result '(1))
315		(dfinish (deferred:new
316		(lambda (x)
317		(setq result (reverse result))
318		(or (equal
319		'(1
320		(2 . nil)
321		(get-first ("abc"))
322		(get-waiting ("abc"))
323		4 5
324		(set ("abc"))
325		(3 . 256)
326		6 7
327		(get ("abc"))
328		(8 . 256)
329		(9 . nil)
330		(clear ("abc"))
331		(clear-all (nil))
332		) result)
333		result))))
334		(dfenv (cc:dataflow-environment)))
335
336		(loop for i in '(get get-first get-waiting set clear clear-all)
337		do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result))))
	305	(let* ((result '(1))
	306	(dfinish (deferred:new
	307	(lambda (_)
	308	(setq result (reverse result))
	309	(or (equal
	310	'(1
	311	(2 . nil)
	312	(get-first ("abc"))
	313	(get-waiting ("abc"))
	314	4 5
	315	(set ("abc"))
	316	(3 . 256)
	317	6 7
	318	(get ("abc"))
	319	(8 . 256)
	320	(9 . nil)
	321	(clear ("abc"))
	322	(clear-all (nil))
	323	)
	324	result)
	325	result))))
	326	(dfenv (cc:dataflow-environment)))
	327
	328	(cl-loop for i in '(get get-first get-waiting set clear clear-all)
	329	do (cc:dataflow-connect dfenv i (lambda (ev) (push ev result))))
338	330
339	331	(push (cons 2 (cc:dataflow-get-sync dfenv "aaa")) result)
340	332

346	338	(lambda (x) (push (cons 3 x) result))))
347	339	(deferred:$
348	340	(deferred:next
349		(lambda (x)
	341	(lambda (_)
350	342	(push 4 result)
351	343	(cc:dataflow-set dfenv "abc" 256)
352	344	(push 5 result)))))
353	345	(deferred:nextc it
354		(lambda (x)
	346	(lambda (_)
355	347	(push 6 result)
356	348	(cc:dataflow-get dfenv "abc")
357	349	(push 7 result)))
358	350	(deferred:nextc it
359		(lambda (x)
	351	(lambda (_)
360	352	(push (cons 8 (cc:dataflow-get-sync dfenv "abc")) result)
361	353	(cc:dataflow-clear dfenv "abc")
362	354	(push (cons 9 (cc:dataflow-get-sync dfenv "abc")) result)))
363	355	(deferred:nextc it
364		(lambda (x)
	356	(lambda (_)
365	357	(cc:dataflow-clear-all dfenv)))
366	358	(deferred:nextc it
367		(lambda (x)
	359	(lambda (_)
368	360	(deferred:callback dfinish))))
369	361
370	362	dfinish))

373	365
374	366
375	367	(defun cc:test-dataflow-parent1 ()
376		(lexical-let*
377		((result '(1))
378		(dfinish (deferred:new
379		(lambda (x)
380		(setq result (reverse result))
381		(or (equal
382		'(1
383		(available-parent . (("abc" . 128)))
384		(available-child . (("abc" . 128)))
385		(waiting-parent . nil)
386		(waiting-child . ("aaa"))
387		(get-sync . 256)
388		(get . 256)
389		) result)
390		result))))
391		(dfenv-parent (cc:dataflow-environment))
392		(dfenv (cc:dataflow-environment dfenv-parent)))
	368	(let* ((result '(1))
	369	(dfinish (deferred:new
	370	(lambda (_)
	371	(setq result (reverse result))
	372	(or (equal
	373	'(1
	374	(available-parent . (("abc" . 128)))
	375	(available-child . (("abc" . 128)))
	376	(waiting-parent . nil)
	377	(waiting-child . ("aaa"))
	378	(get-sync . 256)
	379	(get . 256)
	380	)
	381	result)
	382	result))))
	383	(dfenv-parent (cc:dataflow-environment))
	384	(dfenv (cc:dataflow-environment dfenv-parent)))
393	385
394	386	(cc:dataflow-set dfenv-parent "abc" 128)
395	387

401	393	(lambda (x) (push (cons 'get x) result))))
402	394	(deferred:$
403	395	(deferred:next
404		(lambda (x)
	396	(lambda (_)
405	397	(push (cons 'available-parent (cc:dataflow-get-avalable-pairs dfenv-parent)) result)
406	398	(push (cons 'available-child (cc:dataflow-get-avalable-pairs dfenv)) result)
407	399	(push (cons 'waiting-parent (cc:dataflow-get-waiting-keys dfenv-parent)) result)
408	400	(push (cons 'waiting-child (cc:dataflow-get-waiting-keys dfenv)) result)))
409	401	(deferred:next
410		(lambda (x)
	402	(lambda (_)
411	403	(cc:dataflow-set dfenv-parent "aaa" 256)
412	404	(push (cons 'get-sync (cc:dataflow-get-sync dfenv "aaa")) result)))))
413	405	(deferred:nextc it
414		(lambda (x) (deferred:callback dfinish))))
	406	(lambda (_) (deferred:callback dfinish))))
415	407
416	408	dfinish))
417	409
418	410	;; (cc:debug (cc:test-dataflow-parent1) "Dataflow Parent1 : %s" x)
419	411
420	412	(defun cc:test-dataflow-parent2 ()
421		(lexical-let*
422		((result '())
423		(dfinish (deferred:new
424		(lambda (x)
425		(setq result (reverse result))
426		(or (equal
427		'("parent get 256" "child get 256") result)
428		result))))
429		(dfenv-parent (cc:dataflow-environment))
430		(dfenv (cc:dataflow-environment dfenv-parent)))
	413	(let* ((result '())
	414	(dfinish (deferred:new
	415	(lambda (_)
	416	(setq result (reverse result))
	417	(or (equal
	418	'("parent get 256" "child get 256") result)
	419	result))))
	420	(dfenv-parent (cc:dataflow-environment))
	421	(dfenv (cc:dataflow-environment dfenv-parent)))
431	422
432	423	(deferred:$
433	424	(deferred:parallel

440	431	(deferred:nextc it
441	432	(lambda (x) (push (format "child get %s" x) result))))
442	433	(deferred:nextc (deferred:wait 0.2)
443		(lambda (x) (cc:dataflow-set dfenv-parent "abc" 256))))
444		(deferred:nextc it
445		(lambda (x) (deferred:callback dfinish))))
	434	(lambda (_) (cc:dataflow-set dfenv-parent "abc" 256))))
	435	(deferred:nextc it
	436	(lambda (_) (deferred:callback dfinish))))
446	437
447	438	dfinish))
448	439

452	443	;; Signal
453	444
454	445	(defun cc:test-signal1 ()
455		(lexical-let*
456		((result '())
457		(dfinish (deferred:new
458		(lambda (x)
459		(setq result (reverse result))
460		(or (equal
461		'(
462		(ls ev1 (1))
463		(sig ev1 (1))
464		(ls ev2 (2))
465		(def ev1 (1))
466		) result)
467		result))))
468		(channel (cc:signal-channel "child")))
	446	(let* ((result '())
	447	(dfinish (deferred:new
	448	(lambda (_)
	449	(setq result (reverse result))
	450	(or (equal
	451	'(
	452	(ls ev1 (1))
	453	(sig ev1 (1))
	454	(ls ev2 (2))
	455	(def ev1 (1))
	456	)
	457	result)
	458	result))))
	459	(channel (cc:signal-channel "child")))
469	460
470	461	(cc:signal-connect channel 'ev1
471	462	(lambda (event)

480	471
481	472	(deferred:$
482	473	(deferred:next
483		(lambda (x)
	474	(lambda (_)
484	475	(cc:signal-send channel 'ev1 1)
485	476	(cc:signal-send channel 'ev2 2)))
486	477	(deferred:nextc it
487		(lambda (x) (deferred:wait 300)))
488		(deferred:nextc it
489		(lambda (x)
	478	(lambda (_) (deferred:wait 300)))
	479	(deferred:nextc it
	480	(lambda (_)
490	481	(deferred:callback dfinish))))
491	482
492	483	dfinish))

496	487	;; (cc:debug (cc:test-signal2) "Signal2 : %s" x)
497	488
498	489	(defun cc:test-signal2 ()
499		(lexical-let*
500		((result nil)
501		(dfinish (deferred:new
502		(lambda (x)
503		(setq result (reverse result))
504		(or (equal
505		'(
506		(pls pev1 (1))
507		(psig pev1 (1))
508		(pls ev1 (2))
509		(ls ev1 (3))
510		(sig ev1 (3))
511		(pls ev2 (4))
512		(pls ev2 (5))
513
514		(ls pev1 (1))
515		(ls ev1 (2))
516
517		(sig ev1 (2))
518		(def ev1 (3))
519		(ls ev2 (4))
520		(ls ev2 (5))
521
522		(def ev1 (2))
523		)
524		result)
525		result))))
526		(parent-channel (cc:signal-channel "parent"))
527		(channel (cc:signal-channel "child" parent-channel)))
	490	(let* ((result nil)
	491	(dfinish (deferred:new
	492	(lambda (_)
	493	(setq result (reverse result))
	494	(or (equal
	495	'(
	496	(pls pev1 (1))
	497	(psig pev1 (1))
	498	(pls ev1 (2))
	499	(ls ev1 (3))
	500	(sig ev1 (3))
	501	(pls ev2 (4))
	502	(pls ev2 (5))
	503
	504	(ls pev1 (1))
	505	(ls ev1 (2))
	506
	507	(sig ev1 (2))
	508	(def ev1 (3))
	509	(ls ev2 (4))
	510	(ls ev2 (5))
	511
	512	(def ev1 (2))
	513	)
	514	result)
	515	result))))
	516	(parent-channel (cc:signal-channel "parent"))
	517	(channel (cc:signal-channel "child" parent-channel)))
528	518
529	519	(cc:signal-connect parent-channel 'pev1
530	520	(lambda (event)

546	536
547	537	(deferred:$
548	538	(deferred:next
549		(lambda (x)
	539	(lambda (_)
550	540	(cc:signal-send parent-channel 'pev1 1)
551	541	(cc:signal-send parent-channel 'ev1 2)
552	542	(cc:signal-send channel 'ev1 3)
553	543	(cc:signal-send parent-channel 'ev2 4)
554	544	(cc:signal-send-global channel 'ev2 5)))
555	545	(deferred:nextc it
556		(lambda (x) (deferred:wait 300)))
557		(deferred:nextc it
558		(lambda (x)
	546	(lambda (_) (deferred:wait 300)))
	547	(deferred:nextc it
	548	(lambda (_)
559	549	(deferred:callback-post dfinish))))
560	550
561	551	dfinish))

571	561	(setq cc:test-fails 0)
572	562	(deferred:$
573	563	(deferred:parallel
574		(loop for i in '(cc:test-fib-gen
575		cc:test-thread
576		cc:test-semaphore1
577		cc:test-semaphore2
578		cc:test-dataflow-simple1
579		cc:test-dataflow-simple2
580		cc:test-dataflow-simple3
581		cc:test-dataflow-simple4
582		cc:test-dataflow-signal
583		cc:test-dataflow-parent1
584		cc:test-dataflow-parent2
585		cc:test-signal1
586		cc:test-signal2
587		)
588		collect (cons i (deferred:timeout 5000 "timeout" (funcall i)))))
	564	(cl-loop for i in '(cc:test-fib-gen
	565	cc:test-thread
	566	cc:test-semaphore1
	567	cc:test-semaphore2
	568	cc:test-dataflow-simple1
	569	cc:test-dataflow-simple2
	570	cc:test-dataflow-simple3
	571	cc:test-dataflow-simple4
	572	cc:test-dataflow-signal
	573	cc:test-dataflow-parent1
	574	cc:test-dataflow-parent2
	575	cc:test-signal1
	576	cc:test-signal2
	577	)
	578	collect (cons i (deferred:timeout 5000 "timeout" (funcall i)))))
589	579	(deferred:nextc it
590	580	(lambda (results)
591	581	(pop-to-buffer
592	582	(with-current-buffer (get-buffer-create "cc:test")
593	583	(erase-buffer)
594		(loop for i in results
595		for name = (car i)
596		for result = (cdr i)
597		with fails = 0
598		do (insert (format "%s : %s\n" name
599		(if (eq t result) "OK"
600		(format "FAIL > %s" result))))
601		(unless (eq t result) (incf fails))
602		finally
603		(goto-char (point-min))
604		(insert (format "Test Finished : %s\nTests Fails: %s / %s\n"
605		(format-time-string "%Y/%m/%d %H:%M:%S" (current-time))
606		fails (length results)))
607		(setq cc:test-fails fails))
	584	(cl-loop for i in results
	585	for name = (car i)
	586	for result = (cdr i)
	587	with fails = 0
	588	do (insert (format "%s : %s\n" name
	589	(if (eq t result) "OK"
	590	(format "FAIL > %s" result))))
	591	(unless (eq t result) (cl-incf fails))
	592	finally
	593	(goto-char (point-min))
	594	(insert (format "Test Finished : %s\nTests Fails: %s / %s\n"
	595	(format-time-string "%Y/%m/%d %H:%M:%S" (current-time))
	596	fails (length results)))
	597	(setq cc:test-fails fails))
608	598	(message (buffer-string))
609	599	(current-buffer)))
610	600	(setq cc:test-finished-flag t))))

+65

-62

test/deferred-test.el less more

0		;;; test code for deferred.el
	0	;;; test code for deferred.el -- lexical-binding: t; --
1	1
2	2	;; Copyright (C) 2010, 2011 SAKURAI Masashi
3	3	;; Author: SAKURAI Masashi <m.sakurai at kiwanami.net>

27	27	(:send-report nil)
28	28	(:report-file "/tmp/undercover-report.json"))
29	29	(require 'deferred)
30		(require 'cl)
	30	(require 'cl-lib)
31	31	(require 'pp)
32	32
33	33	(defmacro should= (a &rest b)

40	40
41	41	(defmacro $ (&rest elements)
42	42	`(let (it)
43		,@(loop for i in elements
44		with it = nil
45		collect
46		`(setq it ,i))
	43	,@(cl-loop for i in elements
	44	with it = nil
	45	collect
	46	`(setq it ,i))
47	47	it))
48	48
49	49	(defmacro dnew(&rest aforms)

87	87	(defmacro dtest (&rest form)
88	88	`(progn
89	89	(clear)
90		(lexical-let (last-value)
	90	(let (last-value)
91	91	(nextc
92	92	($
93	93	,@form)

98	98	(defmacro wtest (time &rest form)
99	99	`(progn
100	100	(clear)
101		(lexical-let (last-value)
	101	(let (last-value)
102	102	(nextc
103	103	($
104	104	,@form)

108	108	(flush)
109	109	last-value)))
110	110
111		(defun deferred:setTimeout (f msec)
	111	(defun deferred:setTimeout (f _msec)
112	112	"overrided for test"
113	113	(deferred:call f))
114	114

117	117	(when (deferred-p id)
118	118	(deferred:cancel id)))
119	119
120		(defun deferred:run-with-idle-timer (sec f)
	120	(defun deferred:run-with-idle-timer (_sec f)
121	121	"overrided for test"
122	122	(deferred:call f))
123	123

130	130	"> call-lambda simple"
131	131	(should= 1 (deferred:call-lambda (lambda () 1)))
132	132	(should= 1 (deferred:call-lambda (lambda () 1) 1))
133		(should= 1 (deferred:call-lambda (lambda (x) 1)))
134		(should= 1 (deferred:call-lambda (lambda (x) 1) 1))
	133	(should= 1 (deferred:call-lambda (lambda (_) 1)))
	134	(should= 1 (deferred:call-lambda (lambda (_) 1) 1))
135	135	(should= 1 (deferred:call-lambda (deferred:lambda () 1)))
136	136	(should= 1 (deferred:call-lambda (deferred:lambda () 1) 1))
137	137	(should= nil (deferred:call-lambda 'car))

141	141
142	142	(ert-deftest deferred-primitive-scope ()
143	143	"> call-lambda lexical-scope"
144		(should= 3 (lexical-let ((st 1))
	144	(should= 3 (let ((st 1))
145	145	(deferred:call-lambda
146	146	(lambda () (+ st 2)))))
147		(should= 3 (lexical-let ((st 1))
	147	(should= 3 (let ((st 1))
148	148	(deferred:call-lambda
149	149	(lambda () (+ st 2)) 0)))
150		(should= 3 (lexical-let ((st 1))
	150	(should= 3 (let ((st 1))
151	151	(deferred:call-lambda
152		(lambda (x) (+ st 2)))))
153		(should= 3 (lexical-let ((st 1))
	152	(lambda (_) (+ st 2)))))
	153	(should= 3 (let ((st 1))
154	154	(deferred:call-lambda
155		(lambda (x) (+ st 2)) 0))))
156
157		(ert-deftest deferred-primitive-compile ()
158		"> call-lambda byte-compile"
159		(should= 1 (deferred:call-lambda (byte-compile (lambda (x) 1))))
160		(should= 1 (deferred:call-lambda (byte-compile (lambda (x) 1)) 1))
161		(should= 1 (deferred:call-lambda (byte-compile (lambda () 1))))
162		(should= 1 (deferred:call-lambda (byte-compile (lambda () 1)) 1))
163
164		(should= 3 (lexical-let ((st 1))
165		(deferred:call-lambda
166		(byte-compile (lambda () (+ st 2))))))
167		(should= 3 (lexical-let ((st 1)) ;ng
168		(deferred:call-lambda
169		(byte-compile (lambda () (+ st 2))) 0)))
170		(should= 3 (lexical-let ((st 1))
171		(deferred:call-lambda
172		(byte-compile (lambda (x) (+ st 2))))))
173		(should= 3 (lexical-let ((st 1)) ;ng
174		(deferred:call-lambda
175		(byte-compile (lambda (x) (+ st 2))) 0)))
176
177		(should-error
178		(deferred:call-lambda
179		(lambda (x) (signal 'wrong-number-of-arguments '("org"))))
180		:type 'wrong-number-of-arguments))
	155	(lambda (_) (+ st 2)) 0))))
	156
	157	(when (version<= "25.0" emacs-version)
	158	;; Emacs 24 doesn’t know how to byte-compile closures, so run this test only
	159	;; under Emacs 25.
	160	(ert-deftest deferred-primitive-compile ()
	161	"> call-lambda byte-compile"
	162	(should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1))))
	163	(should= 1 (deferred:call-lambda (byte-compile (lambda (_) 1)) 1))
	164	(should= 1 (deferred:call-lambda (byte-compile (lambda () 1))))
	165	(should= 1 (deferred:call-lambda (byte-compile (lambda () 1)) 1))
	166
	167	(should= 3 (let ((st 1))
	168	(deferred:call-lambda
	169	(byte-compile (lambda () (+ st 2))))))
	170	(should= 3 (let ((st 1)) ;ng
	171	(deferred:call-lambda
	172	(byte-compile (lambda () (+ st 2))) 0)))
	173	(should= 3 (let ((st 1))
	174	(deferred:call-lambda
	175	(byte-compile (lambda (_) (+ st 2))))))
	176	(should= 3 (let ((st 1)) ;ng
	177	(deferred:call-lambda
	178	(byte-compile (lambda (_) (+ st 2))) 0)))
	179
	180	(should-error
	181	(deferred:call-lambda
	182	(lambda (x) (signal 'wrong-number-of-arguments '("org"))))
	183	:type 'wrong-number-of-arguments)))
181	184
182	185	(ert-deftest deferred-basic ()
183	186	"Basic test for deferred functions."

193	196	;; basic post function test
194	197	(progn
195	198	(clear)
196		(lexical-let ((d (dnew)))
	199	(let ((d (dnew)))
197	200	(nextc d x)
198	201	(deferred:exec-task d 'ok "ok!")))))
199	202	(should (deferred-p
200	203	;; basic error post function test
201	204	(progn
202	205	(clear)
203		(lexical-let ((d (dnew)))
	206	(let ((d (dnew)))
204	207	(deferred:error d (lambda (e) e))
205	208	(deferred:exec-task d 'ng "error"))))))
206	209

260	263	(should= '(2 1 0)
261	264	;; basic deferred chain test
262	265	(clear)
263		(lexical-let (vs)
	266	(let (vs)
264	267	($ (next (push 1 vs))
265	268	(nextc it (push 2 vs)))
266	269	(push 0 vs)

324	327	(dtest
325	328	(next "chain")
326	329	(deferred:watch it
327		(lambda (x) (setq val " watch") nil))
	330	(lambda (_) (setq val " watch") nil))
328	331	(nextc it (concat x val " ok")))))
329	332
330	333	(should= "error!! watch ok"

342	345	(dtest
343	346	(next "chain")
344	347	(deferred:watch it
345		(lambda (x) (error "ERROR")))
	348	(lambda (_) (error "ERROR")))
346	349	(nextc it (concat x " watch ok2"))))))
347	350
348	351	(ert-deftest deferred-async-connect ()

362	365	"> global onerror"
363	366	(should= "ONERROR"
364	367	;; default onerror handler test
365		(lexical-let (ret)
	368	(let (ret)
366	369	(let ((deferred:onerror
367	370	(lambda (e) (setq ret (concat "ON" (error-message-string e))))))
368	371	(dtest

537	540	"> loop"
538	541	(should= 10
539	542	;; basic loop test
540		(lexical-let ((v 0))
	543	(let ((v 0))
541	544	(dtest
542	545	(dloop 5 (lambda (i) (setq v (+ v i))))
543	546	(errorf it "Error on simple loop calling : %s"))

552	555
553	556	(should= "nested loop ok (4 nil 3 2 1 0)"
554	557	;; nested deferred task in a loop
555		(lexical-let (count)
	558	(let (count)
556	559	(dtest
557	560	(dloop 5 (lambda (i)
558	561	(push i count)

564	567
565	568	(should= '(6 4 2)
566	569	;; do-loop test
567		(lexical-let (count)
	570	(let (count)
568	571	(dtest
569	572	(dloop '(1 2 3)
570	573	(lambda (x) (push (* 2 x) count)))

592	595
593	596	(should= "loop error catch ok"
594	597	;; try catch finally test
595		(lexical-let ((body (lambda ()
596		(deferred:loop 5
597		(lambda (i) (if (= 2 i) (error "loop error")))))))
	598	(let ((body (lambda ()
	599	(deferred:loop 5
	600	(lambda (i) (if (= 2 i) (error "loop error")))))))
598	601	(dtest
599	602	(next "try ") ; try
600	603	(nextc it (funcall body)) ; body

603	606
604	607	(should= "4 ok"
605	608	;; try catch finally test
606		(lexical-let ((body (lambda ()
607		(deferred:loop 5
608		(lambda (i) i)))))
	609	(let ((body (lambda ()
	610	(deferred:loop 5
	611	(lambda (i) i)))))
609	612	(dtest
610	613	(next "try ") ; try
611	614	(nextc it (funcall body)) ; body

720	723
721	724	(should= "nest parallel ok"
722	725	;; parallel next
723		(lexical-let* ((flow (lambda (x)
724		(parallel
725		(next "nest ")
726		(next "parallel ")))))
	726	(let* ((flow (lambda (x)
	727	(parallel
	728	(next "nest ")
	729	(next "parallel ")))))
727	730	(dtest
728	731	(next "start ")
729	732	(nextc it (funcall flow x))