Commit 562ed8a51cefeb98d577636bd2fb84db939f3ff3 - tuareg-mode

Merge branch 'master' into 'scrub-obsolete' # Conflicts: # debian/changelog Stéphane Glondu 8 months ago

31 changed file(s) with 3472 addition(s) and 2663 deletion(s). Raw diff Collapse all Expand all

-0

.dir-locals.el less more

((emacs-lisp-mode . ((indent-tabs-mode . nil))))

+38

-0

.github/workflows/test.yml less more

	0	name: test
	1
	2	on:
	3	push:
	4	paths-ignore:
	5	- '*.md'
	6	- 'COPYING'
	7	- 'HISTORY'
	8	pull_request:
	9	paths-ignore:
	10	- '*.md'
	11	- 'COPYING'
	12	- 'HISTORY'
	13
	14	jobs:
	15	test:
	16	runs-on: ubuntu-latest
	17	strategy:
	18	matrix:
	19	emacs_version:
	20	- "26.3"
	21	- "27.2"
	22	- "28.1"
	23	- snapshot
	24	steps:
	25	- name: Set up Emacs
	26	uses: purcell/setup-emacs@master
	27	with:
	28	version: ${{matrix.emacs_version}}
	29
	30	- name: Check out tuareg
	31	uses: actions/checkout@v2
	32
	33	- name: Byte-compile
	34	run: make elc-werror
	35
	36	- name: Test
	37	run: make check

-0

.gitignore less more

6	6	packages
7	7	/tuareg.*/
8	8	ChangeLog
	9	tuareg-site-file.el
	10	tuareg.install

-25

~~.travis.yml~~ less more

0		# Inspired by http://sachachua.com/blog/2015/02/continuous-integration-code-coverage-emacs-packages-travis-coveralls/
1
2		language: emacs-lisp
3		sudo: false
4
5		env:
6		matrix:
7		- EVM_EMACS=emacs-24.3
8		- EVM_EMACS=emacs-24.4
9		- EVM_EMACS=emacs-24.5
10		- EVM_EMACS=emacs-25.1
11
12		before_install:
13		- export PATH="$HOME/.evm/bin:$PATH"
14		- git clone https://github.com/rejeep/evm.git $HOME/.evm
15		- evm config path /tmp
16		- evm install ${EVM_EMACS}-travis --use --skip
17
18		script:
19		- emacs --version
20		- make elc
21		- make indent-test
22
23		notifications:
24		email: true

+80

-8

CHANGES.md less more

0		2.2.0 2018-
1		-----------
	0	3.0 2022-09-27
	1	--------------
2	2
3		* New mode `tuareg-menhir` thanks to Stefan Monnier.
	3	Backward incompatible changes are marked with “⚠”.
	4
	5	* New option `tuareg-mode-line-other-file`.
	6	* New mode `tuareg-menhir-mode`.
4	7	Note that <kbd>C-c C-c</kbd> launches the compilation.
5		* `tuareg-jbuilder`: <kbd>C-c C-c</kbd> launches the compilation.
	8	* ⚠ `tuareg-eval-phrase` (<kbd>C-c C-e</kbd> and <kbd>C-x C-e</kbd>) now
	9	evaluate the smallest set of phrases containing the region if the
	10	latter is active.
	11	* ⚠ `tuareg-eval-phrase` now skips `;;` even on a separate line when moving
	12	forward. This permits quick evaluation of multiple phrases in succession.
	13	* ⚠ `tuareg-eval-region` (<kbd>C-c C-r</kbd>): only send the content of
	14	the region to the REPL.
6	15	* Be more subtle in phrase detection.
7		* Syntax highlighting improvements (`type nonrec`, `raise_notrace`,
8		`with type`).
9		* `tuareg-comment-dwim` is now bound to <kbd>C-cC-;</kbd> (fixes #149).
	16	* Bogus mismatched parentheses at the end of comment fixed.
	17	* ⚠ `show-paren-mode`: also highlight comment delimiters. You can
	18	turn that off by setting `tuareg-comment-show-paren` to `nil`.
	19	* Syntax highlighting improvements: much faster; much better highlighting
	20	of function, class, and method arguments (including setting the
	21	`font-lock-multiline` property); `[]` and `::` have the constructor
	22	face; first class module, `type nonrec`, `raise_notrace`, `with
	23	type` are handled. Finer highlighting of infix operators. Support
	24	for [binding operators][]. Moreover, font-lock now has 3 possible
	25	levels of fontification (see the README).
	26	* The switch .ml ↔ .mli now uses the Emacs built-in `find-file` and
	27	was extended to `.eliom` ↔ `.eliomi` and `.mly` ↔ `.mli`. It also
	28	works for pre-processed files named `.pp.ml` and `.pp.mli`.
	29	* When switching from an `.ml` to a non-existing `.mli` file using
	30	<kbd>C-c C-a</kbd>, one is offered to fill the `.mli` buffer with the
	31	generated interface.
	32	* Set `beginning-of-defun-function` and `end-of-defun-function` which
	33	allows to go to the beginning of the current function (resp. end)
	34	with <kbd>C-M-home</kbd>, <kbd>C-M-a</kbd> or <kbd>ESC
	35	C-home</kbd> (resp. <kbd>C-M-end</kbd>, <kbd>C-M-e</kbd>, or
	36	<kbd>ESC C-end</kbd>).
	37	* ⚠ `beginning-of-defun` (<kbd>C-M-a</kbd>, <kbd>C-M-home</kbd>) is
	38	now repeatable. Previously it would not move the cursor if invoked
	39	at the beginning of a defun. Now it goes to the start of the
	40	previous defun, which is the standard in Emacs and generally more
	41	useful.
	42	* ⚠ Movement by defun now considers `and` clauses of a `type` or
	43	declarative `let` to be defuns in their own right, since that's
	44	closer to how programmers think. This generally makes defun-based
	45	operations more useful.
	46	* ⚠ `tuareg-comment-dwim` is now bound to <kbd>C-c C-;</kbd> (fixes #149).
	47	* Fix the highlighting of errors locations in interactive mode.
	48	* ocamldebug: Handle correctly the new code pointer format (issue #205).
10	49	* Rework electric functions (fixes issues #150 and #162).
11		* Remove `tuareg-light`, you should now use `tuareg`.
	50	* Update the compilation regexp to detect warnings and errors for the
	51	OCaml ≥ 4.08 (fixes #202).
	52	* Autoload compilation error regexp so it is correct even if Tuareg
	53	was not loaded.
	54	* Messages from recent OCaml compiler versions are now parsed
	55	correctly for severity and source location. This includes precise
	56	parsing of the location start and end columns. Exception backtraces
	57	are now also recognised.
	58	* Ancillary locations are now treated as Info-level messages, not
	59	errors in their own right. This way they no longer contribute to
	60	Emacs's compilation-mode error count, but they will be ignored by
	61	`next-error` and `previous-error`. Set `compilation-skip-threshold`
	62	to `0` if you want `next-error` to step into these locations.
	63	* Evaluation of phrases: evaluate the above phrase if the point is in
	64	or after comments immediately following the let-binding (without
	65	separating blank lines).
	66	* Better indentation of empty lines (fixes #179).
	67	* Use a pty to communicate with the `ocaml` process (fixes #83).
	68	* `tuareg-opam`: syntax highlighting updates.
	69	* ⚠ Remove `tuareg-light`, you should now use `tuareg`.
	70	* `class type` is now parsed correctly (#239).
	71	* Improved indentation of class definition with non-hanging `object` (#239).
	72	The new behaviour agrees with ocp-indent and seems to be the more modern
	73	usage. `initialize` clauses are also indented correctly.
	74	* Better default colour for extension nodes on dark background.
	75	`tuareg-font-lock-extension-node-face` was nigh-unreadable against
	76	a dark background. The face now uses the default background colour.
	77	* Ocamldoc `(** ... *)` comments are now fontified by their structure.
	78	This makes markup constructs stand out in order to improve legibility
	79	and reduces the risk of mistakes. The body text is set in
	80	`font-lock-doc-face` as before; mark-up constructs use
	81	`tuareg-font-lock-doc-markup-face`, which defaults to
	82	`font-lock-doc-markup-face` (new in Emacs 28) if available.
12	83
13	84	Note that the mode `tuareg-dune` which was in the development version
14	85	of this package is now part of [Dune](https://github.com/ocaml/dune).
15	86
	87	[binding operators]: https://v2.ocaml.org/releases/4.08/htmlman/index.html
16	88
17	89	2.1.0 2017-11-10
18	90	----------------

+628

-295

COPYING less more

0		GNU GENERAL PUBLIC LICENSE
1		Version 2, June 1991
2
3		Copyright (C) 1989, 1991 Free Software Foundation, Inc.
4		59 Temple Place - Suite 330
5		Boston, MA 02111-1307, USA.
	0	GNU GENERAL PUBLIC LICENSE
	1	Version 3, 29 June 2007
	2
	3	Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
6	4	Everyone is permitted to copy and distribute verbatim copies
7	5	of this license document, but changing it is not allowed.
8	6
9		Preamble
10
11		The licenses for most software are designed to take away your
12		freedom to share and change it. By contrast, the GNU General Public
13		License is intended to guarantee your freedom to share and change free
14		software--to make sure the software is free for all its users. This
15		General Public License applies to most of the Free Software
16		Foundation's software and to any other program whose authors commit to
17		using it. (Some other Free Software Foundation software is covered by
18		the GNU Library General Public License instead.) You can apply it to
	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	19	your programs, too.
20	20
21	21	When we speak of free software, we are referring to freedom, not
22	22	price. Our General Public Licenses are designed to make sure that you
23	23	have the freedom to distribute copies of free software (and charge for
24		this service if you wish), that you receive source code or can get it
25		if you want it, that you can change the software or use pieces of it
26		in new free programs; and that you know you can do these things.
27
28		To protect your rights, we need to make restrictions that forbid
29		anyone to deny you these rights or to ask you to surrender the rights.
30		These restrictions translate to certain responsibilities for you if you
31		distribute copies of the software, or if you modify it.
	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	32
33	33	For example, if you distribute copies of such a program, whether
34		gratis or for a fee, you must give the recipients all the rights that
35		you have. You must make sure that they, too, receive or can get the
36		source code. And you must show them these terms so they know their
37		rights.
38
39		We protect your rights with two steps: (1) copyright the software, and
40		(2) offer you this license which gives you legal permission to copy,
41		distribute and/or modify the software.
42
43		Also, for each author's protection and ours, we want to make certain
44		that everyone understands that there is no warranty for this free
45		software. If the software is modified by someone else and passed on, we
46		want its recipients to know that what they have is not the original, so
47		that any problems introduced by others will not reflect on the original
48		authors' reputations.
49
50		Finally, any free program is threatened constantly by software
51		patents. We wish to avoid the danger that redistributors of a free
52		program will individually obtain patent licenses, in effect making the
53		program proprietary. To prevent this, we have made it clear that any
54		patent must be licensed for everyone's free use or not licensed at all.
	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.
55	66
56	67	The precise terms and conditions for copying, distribution and
57	68	modification follow.
58	69
59		GNU GENERAL PUBLIC LICENSE
60		TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
61
62		0. This License applies to any program or other work which contains
63		a notice placed by the copyright holder saying it may be distributed
64		under the terms of this General Public License. The "Program", below,
65		refers to any such program or work, and a "work based on the Program"
66		means either the Program or any derivative work under copyright law:
67		that is to say, a work containing the Program or a portion of it,
68		either verbatim or with modifications and/or translated into another
69		language. (Hereinafter, translation is included without limitation in
70		the term "modification".) Each licensee is addressed as "you".
71
72		Activities other than copying, distribution and modification are not
73		covered by this License; they are outside its scope. The act of
74		running the Program is not restricted, and the output from the Program
75		is covered only if its contents constitute a work based on the
76		Program (independent of having been made by running the Program).
77		Whether that is true depends on what the Program does.
78
79		1. You may copy and distribute verbatim copies of the Program's
80		source code as you receive it, in any medium, provided that you
81		conspicuously and appropriately publish on each copy an appropriate
82		copyright notice and disclaimer of warranty; keep intact all the
83		notices that refer to this License and to the absence of any warranty;
84		and give any other recipients of the Program a copy of this License
85		along with the Program.
86
87		You may charge a fee for the physical act of transferring a copy, and
88		you may at your option offer warranty protection in exchange for a fee.
89
90		2. You may modify your copy or copies of the Program or any portion
91		of it, thus forming a work based on the Program, and copy and
92		distribute such modifications or work under the terms of Section 1
93		above, provided that you also meet all of these conditions:
94
95		a) You must cause the modified files to carry prominent notices
96		stating that you changed the files and the date of any change.
97
98		b) You must cause any work that you distribute or publish, that in
99		whole or in part contains or is derived from the Program or any
100		part thereof, to be licensed as a whole at no charge to all third
101		parties under the terms of this License.
102
103		c) If the modified program normally reads commands interactively
104		when run, you must cause it, when started running for such
105		interactive use in the most ordinary way, to print or display an
106		announcement including an appropriate copyright notice and a
107		notice that there is no warranty (or else, saying that you provide
108		a warranty) and that users may redistribute the program under
109		these conditions, and telling the user how to view a copy of this
110		License. (Exception: if the Program itself is interactive but
111		does not normally print such an announcement, your work based on
112		the Program is not required to print an announcement.)
113
114		These requirements apply to the modified work as a whole. If
115		identifiable sections of that work are not derived from the Program,
116		and can be reasonably considered independent and separate works in
117		themselves, then this License, and its terms, do not apply to those
118		sections when you distribute them as separate works. But when you
119		distribute the same sections as part of a whole which is a work based
120		on the Program, the distribution of the whole must be on the terms of
121		this License, whose permissions for other licensees extend to the
122		entire whole, and thus to each and every part regardless of who wrote it.
123
124		Thus, it is not the intent of this section to claim rights or contest
125		your rights to work written entirely by you; rather, the intent is to
126		exercise the right to control the distribution of derivative or
127		collective works based on the Program.
128
129		In addition, mere aggregation of another work not based on the Program
130		with the Program (or with a work based on the Program) on a volume of
131		a storage or distribution medium does not bring the other work under
132		the scope of this License.
133
134		3. You may copy and distribute the Program (or a work based on it,
135		under Section 2) in object code or executable form under the terms of
136		Sections 1 and 2 above provided that you also do one of the following:
137
138		a) Accompany it with the complete corresponding machine-readable
139		source code, which must be distributed under the terms of Sections
140		1 and 2 above on a medium customarily used for software interchange; or,
141
142		b) Accompany it with a written offer, valid for at least three
143		years, to give any third party, for a charge no more than your
144		cost of physically performing source distribution, a complete
145		machine-readable copy of the corresponding source code, to be
146		distributed under the terms of Sections 1 and 2 above on a medium
147		customarily used for software interchange; or,
148
149		c) Accompany it with the information you received as to the offer
150		to distribute corresponding source code. (This alternative is
151		allowed only for noncommercial distribution and only if you
152		received the program in object code or executable form with such
153		an offer, in accord with Subsection b above.)
154
155		The source code for a work means the preferred form of the work for
156		making modifications to it. For an executable work, complete source
157		code means all the source code for all modules it contains, plus any
158		associated interface definition files, plus the scripts used to
159		control compilation and installation of the executable. However, as a
160		special exception, the source code distributed need not include
161		anything that is normally distributed (in either source or binary
162		form) with the major components (compiler, kernel, and so on) of the
163		operating system on which the executable runs, unless that component
164		itself accompanies the executable.
165
166		If distribution of executable or object code is made by offering
167		access to copy from a designated place, then offering equivalent
168		access to copy the source code from the same place counts as
169		distribution of the source code, even though third parties are not
170		compelled to copy the source along with the object code.
171
172		4. You may not copy, modify, sublicense, or distribute the Program
173		except as expressly provided under this License. Any attempt
174		otherwise to copy, modify, sublicense or distribute the Program is
175		void, and will automatically terminate your rights under this License.
176		However, parties who have received copies, or rights, from you under
177		this License will not have their licenses terminated so long as such
178		parties remain in full compliance.
179
180		5. You are not required to accept this License, since you have not
181		signed it. However, nothing else grants you permission to modify or
182		distribute the Program or its derivative works. These actions are
183		prohibited by law if you do not accept this License. Therefore, by
184		modifying or distributing the Program (or any work based on the
185		Program), you indicate your acceptance of this License to do so, and
186		all its terms and conditions for copying, distributing or modifying
187		the Program or works based on it.
188
189		6. Each time you redistribute the Program (or any work based on the
190		Program), the recipient automatically receives a license from the
191		original licensor to copy, distribute or modify the Program subject to
192		these terms and conditions. You may not impose any further
193		restrictions on the recipients' exercise of the rights granted herein.
194		You are not responsible for enforcing compliance by third parties to
	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
195	484	this License.
196	485
197		7. If, as a consequence of a court judgment or allegation of patent
198		infringement or for any other reason (not limited to patent issues),
199		conditions are imposed on you (whether by court order, agreement or
	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
200	542	otherwise) that contradict the conditions of this License, they do not
201		excuse you from the conditions of this License. If you cannot
202		distribute so as to satisfy simultaneously your obligations under this
203		License and any other pertinent obligations, then as a consequence you
204		may not distribute the Program at all. For example, if a patent
205		license would not permit royalty-free redistribution of the Program by
206		all those who receive copies directly or indirectly through you, then
207		the only way you could satisfy both it and this License would be to
208		refrain entirely from distribution of the Program.
209
210		If any portion of this section is held invalid or unenforceable under
211		any particular circumstance, the balance of the section is intended to
212		apply and the section as a whole is intended to apply in other
213		circumstances.
214
215		It is not the purpose of this section to induce you to infringe any
216		patents or other property right claims or to contest validity of any
217		such claims; this section has the sole purpose of protecting the
218		integrity of the free software distribution system, which is
219		implemented by public license practices. Many people have made
220		generous contributions to the wide range of software distributed
221		through that system in reliance on consistent application of that
222		system; it is up to the author/donor to decide if he or she is willing
223		to distribute software through any other system and a licensee cannot
224		impose that choice.
225
226		This section is intended to make thoroughly clear what is believed to
227		be a consequence of the rest of this License.
228
229		8. If the distribution and/or use of the Program is restricted in
230		certain countries either by patents or by copyrighted interfaces, the
231		original copyright holder who places the Program under this License
232		may add an explicit geographical distribution limitation excluding
233		those countries, so that distribution is permitted only in or among
234		countries not thus excluded. In such case, this License incorporates
235		the limitation as if written in the body of this License.
236
237		9. The Free Software Foundation may publish revised and/or new versions
238		of the General Public License from time to time. Such new versions will
	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
239	566	be similar in spirit to the present version, but may differ in detail to
240	567	address new problems or concerns.
241	568
242		Each version is given a distinguishing version number. If the Program
243		specifies a version number of this License which applies to it and "any
244		later version", you have the option of following the terms and conditions
245		either of that version or of any later version published by the Free
246		Software Foundation. If the Program does not specify a version number of
247		this License, you may choose any version ever published by the Free Software
248		Foundation.
249
250		10. If you wish to incorporate parts of the Program into other free
251		programs whose distribution conditions are different, write to the author
252		to ask for permission. For software which is copyrighted by the Free
253		Software Foundation, write to the Free Software Foundation; we sometimes
254		make exceptions for this. Our decision will be guided by the two goals
255		of preserving the free status of all derivatives of our free software and
256		of promoting the sharing and reuse of software generally.
257
258		NO WARRANTY
259
260		11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
261		FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
262		OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
263		PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
264		OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
265		MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
266		TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
267		PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
268		REPAIR OR CORRECTION.
269
270		12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
271		WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
272		REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
273		INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
274		OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
275		TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
276		YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
277		PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
278		POSSIBILITY OF SUCH DAMAGES.
279
280		END OF TERMS AND CONDITIONS
281
282		How to Apply These Terms to Your New Programs
	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
283	623
284	624	If you develop a new program, and you want it to be of the greatest
285	625	possible use to the public, the best way to achieve this is to make it

287	627
288	628	To do so, attach the following notices to the program. It is safest
289	629	to attach them to the start of each source file to most effectively
290		convey the exclusion of warranty; and each file should have at least
	630	state the exclusion of warranty; and each file should have at least
291	631	the "copyright" line and a pointer to where the full notice is found.
292	632
293	633	<one line to give the program's name and a brief idea of what it does.>
294		Copyright (C) 19yy <name of author>
295
296		This program is free software; you can redistribute it and/or modify
	634	Copyright (C) <year> <name of author>
	635
	636	This program is free software: you can redistribute it and/or modify
297	637	it under the terms of the GNU General Public License as published by
298		the Free Software Foundation; either version 2 of the License, or
	638	the Free Software Foundation, either version 3 of the License, or
299	639	(at your option) any later version.
300	640
301	641	This program is distributed in the hope that it will be useful,

304	644	GNU General Public License for more details.
305	645
306	646	You should have received a copy of the GNU General Public License
307		along with this program; see the file COPYING. If not, write to
308		the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
309		Boston, MA 02111-1307, USA.
	647	along with this program. If not, see <https://www.gnu.org/licenses/>.
310	648
311	649	Also add information on how to contact you by electronic and paper mail.
312	650
313		If the program is interactive, make it output a short notice like this
314		when it starts in an interactive mode:
315
316		Gnomovision version 69, Copyright (C) 19yy name of author
317		Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
	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'.
318	656	This is free software, and you are welcome to redistribute it
319	657	under certain conditions; type `show c' for details.
320	658
321	659	The hypothetical commands `show w' and `show c' should show the appropriate
322		parts of the General Public License. Of course, the commands you use may
323		be called something other than `show w' and `show c'; they could even be
324		mouse-clicks or menu items--whatever suits your program.
325
326		You should also get your employer (if you work as a programmer) or your
327		school, if any, to sign a "copyright disclaimer" for the program, if
328		necessary. Here is a sample; alter the names:
329
330		Yoyodyne, Inc., hereby disclaims all copyright interest in the program
331		`Gnomovision' (which makes passes at compilers) written by James Hacker.
332
333		<signature of Ty Coon>, 1 April 1989
334		Ty Coon, President of Vice
335
336		This General Public License does not permit incorporating your program into
337		proprietary programs. If your program is a subroutine library, you may
338		consider it more useful to permit linking proprietary applications with the
339		library. If this is what you want to do, use the GNU Library General
340		Public License instead of this License.
	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	<https://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	<https://www.gnu.org/licenses/why-not-lgpl.html>.

+30

-20

Makefile less more

5	5	\| sed 's/;; Package-Requires: $.$/\1/')
6	6	DIST_NAME = tuareg-$(VERSION)
7	7	TARBALL = $(DIST_NAME).tar.gz
8		OPAM_DIR = packages/tuareg/tuareg.$(VERSION)
	8	OPAM_FILE = packages/tuareg/tuareg.$(VERSION)/opam
9	9
10		SOURCES = tuareg.el ocamldebug.el tuareg-opam.el tuareg-jbuild.el \
11		tuareg-menhir.el
	10	SOURCES = tuareg.el ocamldebug.el tuareg-opam.el \
	11	tuareg-menhir.el tuareg-compat.el
12	12	ELS = $(SOURCES) tuareg-site-file.el
13	13	ELC = $(ELS:.el=.elc)
14	14
15	15	INSTALL_FILES = $(ELS) $(ELC)
16		INSTALL_DIR ?= $(shell opam config var share)/emacs/site-lisp
	16	INSTALL_DIR ?= $(shell opam var share)/emacs/site-lisp
17	17
18	18	DIST_FILES += $(ELS) Makefile README.md tuareg.install
19	19
20	20	EMACSFORMACOSX = /Applications/Emacs.app/Contents/MacOS/Emacs
21	21	EMACSMACPORTS = /Applications/MacPorts/Emacs.app/Contents/MacOS/Emacs
22		AQUAMACS = $(shell test -d /Applications \
23		&& find /Applications -type f \| grep 'Aquamacs$$')
	22	AQUAMACS = /Applications/Aquamacs.app/Contents/MacOS/Aquamacs
24	23	ifeq ($(wildcard $(EMACSFORMACOSX)),$(EMACSFORMACOSX))
25	24	EMACS ?= $(EMACSFORMACOSX)
26	25	else
27	26	ifeq ($(wildcard $(EMACSMACPORTS)),$(EMACSMACPORTS))
28	27	EMACS ?= $(EMACSMACPORTS)
29	28	else
30		ifneq ($(strip $(AQUAMACS)),)
31	29	ifeq ($(wildcard $(AQUAMACS)),$(AQUAMACS))
32	30	EMACS ?= $(AQUAMACS)
33	31	endif
34	32	endif
35	33	endif
36		endif
37	34	EMACS ?= emacs
38	35
39		#ENABLE_SMIE = --eval '(setq tuareg-use-smie t)'
40	36	RM ?= rm -f
41	37	CP ?= cp -f
42	38	LN = ln

44	40
45	41	INSTALL_RM_R = $(RM) -r
46	42	INSTALL_MKDIR = mkdir -p
47		INSTALL_CP = $(CP)
	43	INSTALL_CP = cp
48	44
49	45	all elc : $(ELC) tuareg-site-file.el
50	46
	47	elc-werror: WERROR=--eval '(setq byte-compile-error-on-warn t)'
	48	elc-werror: elc
	49
51	50	%.elc : %.el
52		$(EMACS) --batch -L . --no-init-file -f batch-byte-compile $<
53		@echo "Files byte-compiled using $(EMACS)"
	51	$(EMACS) --batch -L . --no-init-file $(WERROR) -f batch-byte-compile $<
54	52
55	53	install : $(INSTALL_FILES)
56	54	$(INSTALL_MKDIR) $(INSTALL_DIR)

64	62	.PHONY: refresh
65	63	refresh:
66	64
67		check : sample.ml.test
	65	.PHONY: check
	66	check:
	67	$(EMACS) -batch -Q -L . -l tuareg-tests -f ert-run-tests-batch-and-exit
68	68
69	69	%.test: % $(ELC) refresh
70	70	@echo ====Indent $*====

81	81	indent-test: indent-test.ml.test
82	82
83	83	tuareg-site-file.el: $(SOURCES)
84		(echo ";;; $@ --- Automatically extracted autoloads.";\
	84	(echo ";;; $@ --- Automatically extracted autoloads. -- lexical-binding: t; --";\
85	85	echo ";;; Code:";\
86	86	echo "(add-to-list 'load-path";\
87	87	echo " (or (file-name-directory load-file-name) (car load-path)))";\
88	88	echo "") >$@
89		$(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$@")' -f batch-update-autoloads "."
	89	$(EMACS) --batch --eval '(if (>= emacs-major-version 28) (make-directory-autoloads "." "'`pwd`'/$@") (setq generated-autoload-file "'`pwd`'/$@") (batch-update-autoloads))' "."
	90
	91	tuareg.install:
	92	echo "share_root: [" > $@
	93	for f in $(ELS); do \
	94	echo " \"$$f\" {\"emacs/site-lisp/$$f\"}" >> $@; \
	95	echo " \"?$${f}c\" {\"emacs/site-lisp/$${f}c\"}" >> $@; \
	96	done
	97	echo "]" >> $@
90	98
91	99	dist distrib: $(TARBALL)
92	100

102	110	echo "Make a symbolic link packages → OPAM repository/packages"; \
103	111	exit 1; \
104	112	fi
105		$(INSTALL_MKDIR) $(OPAM_DIR)
106		$(CP) -a $(wildcard .opam .descr) $(OPAM_DIR)
107		echo "archive: \"https://github.com/ocaml/tuareg/releases/download/$(VERSION)/$(TARBALL)\"" > $(OPAM_DIR)/url
108		echo "checksum: \"`md5sum $(TARBALL) \| cut -d ' ' -f 1`\"" \
109		>> $(OPAM_DIR)/url
	113	$(INSTALL_MKDIR) $(dir $(OPAM_FILE))
	114	$(CP) -a tuareg.opam $(OPAM_FILE)
	115	echo "url {" >> $(OPAM_FILE)
	116	echo " src: \"https://github.com/ocaml/tuareg/releases/download/$(VERSION)/$(TARBALL)\"" >> $(OPAM_FILE)
	117	echo " checksum: \"`md5sum $(TARBALL) \| cut -d ' ' -f 1`\"" \
	118	>> $(OPAM_FILE)
	119	echo "}" >> $(OPAM_FILE)
110	120
111	121	clean :
112	122	$(RM) $(ELC) "$(DIST_NAME).tar.gz" "$(DIST_NAME).tar"

+92

-30

README.md less more

	0	[![NonGNU ELPA](https://elpa.nongnu.org/nongnu/tuareg.svg)](https://elpa.nongnu.org/nongnu/tuareg.html)
0	1	[![MELPA](https://melpa.org/packages/tuareg-badge.svg)](https://melpa.org/#/tuareg)
1		[![LGPL v2](https://img.shields.io/badge/licence-lgpl2-blue.svg)](COPYING)
2		[![Build Status](https://travis-ci.org/ocaml/tuareg.svg?branch=master)](https://travis-ci.org/ocaml/tuareg)
	2	[![DebianBadge](https://badges.debian.net/badges/debian/stable/elpa-tuareg/version.svg)](https://packages.debian.org/stable/elpa-tuareg)
	3	[![License GPL 3](https://img.shields.io/badge/license-GPL_3-green.svg)](COPYING)
	4	[![Build Status](https://github.com/ocaml/tuareg/workflows/test/badge.svg)](https://github.com/ocaml/tuareg/actions?query=workflow%3Atest)
3	5
4	6	Tuareg: an Emacs OCaml mode
5	7	===========================

10	12	(also called toplevel),
11	13	and to run the OCaml debugger within Emacs.
12	14
13		Contents
	15	Package Contents
14	16	--------
15	17
16		`README.md` — This file.
17		`HISTORY` — Differences with previous versions.
18		`tuareg.el` — A major mode for editing OCaml code in Emacs.
19		`ocamldebug.el` — To run the OCaml debugger under Emacs.
20		`sample.ml` — Sample file to check the indentation engine.
	18	- `README.md` — This file.
	19	- `HISTORY` — Differences with previous versions.
	20	- `tuareg.el` — A major mode for editing OCaml code in Emacs.
	21	- `ocamldebug.el` — To run the OCaml debugger under Emacs.
	22	- `sample.ml` — Sample file to check the indentation engine.
	23	- `compilation.txt` — To check the compilation regexp `tuareg--error-regexp`.
21	24
22	25	Install
23	26	-------
24	27
25	28	The easier way to install Tuareg is though
26	29	the [Emacs package system](https://www.gnu.org/software/emacs/manual/html_node/emacs/Packages.html)
27		and [Melpa](https://melpa.org/) — you first have to
28		[configure the latter](https://melpa.org/#/getting-started).
29
30		You can also install it using [OPAM](http://opam.ocaml.org/):
	30	with [NonGNU ELPA][] or
	31	[MELPA][] ([configuration](https://melpa.org/#/getting-started)).
	32
	33	You can also install it using [OPAM][]:
31	34
32	35	opam install tuareg
33	36

49	52	---------------------
50	53
51	54	The Tuareg major mode is triggered by visiting a file with extension
52		`.ml`, `.mli`, `.mly`, `.mll`, and `.mlp` or manually by
53		<kbd>M-x tuareg-mode</kbd>.
	55	`.ml`, `.mli`, and `.mlp` or manually by <kbd>M-x tuareg-mode</kbd>.
	56	A [Menhir][] mode, `tuareg-menhir`, supports `.mly` files. (A special
	57	mode for `.mll` has yet to be written.)
	58
	59	For the convenience of users of [ocsigen][], the extensions
	60	[`.eliom`](http://ocsigen.org/eliom/), `.eliomi` trigger `tuareg-mode`.
54	61
55	62	Start the OCaml REPL with <kbd>M-x run-ocaml</kbd>.
56	63	To evaluate a

120	127
121	128	[electric-indent-mode]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Indent-Convenience.html
122	129
	130	- Tuareg respects you default commenting style. However, in OCaml,
	131	commenting a region is usually done with a single multi-line comment
	132	and without leading stars on each line. You can have that behavior
	133	in OCaml buffers by setting:
	134
	135	(add-hook 'tuareg-mode-hook
	136	(lambda()
	137	(setq-local comment-style 'multi-line)
	138	(setq-local comment-continue " ")))
	139
	140	- If you turn on `show-paren-mode`, the delimiters of comments will
	141	also be highlighted. If you do not like this behavior, set
	142	`tuareg-comment-show-paren` to `nil`.
	143
	144	- Syntax highlighting has 3 levels. You can select the one you prefer
	145	by setting [font-lock-maximum-decoration][] from `0` to `2`. By
	146	default, [font-lock-maximum-decoration][] is set to `t` which
	147	means that the maximum level of decoration will be used.
	148
	149	[font-lock-maximum-decoration]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Font-Lock.html
	150
	151	- Fontifying all operators (as opposed to only non-standard ones) is a
	152	costly operation that slows down font-lock. This is why it is
	153	disabled by default. If you nonetheless want it, set
	154	`tuareg-highlight-all-operators` to `t` in your [Init File][]
	155	(before `tuareg-mode` is initialized; in particular, not in a hook
	156	added to `'tuareg-mode-hook`).
	157
123	158	- You can turn on and off the rendering of certain sequences of
124	159	characters as symbols (such as `∔` and `∧` instead of `+.`and `&&`),
125	160	use `prettify-symbols-mode` or use the check box in the _Tuareg

154	189
155	190	- If you wish to have a nice 🐫 as the mode name, add
156	191
157		(add-hook 'tuareg-mode-hook #'(lambda() (setq mode-name "🐫")))
	192	(add-hook 'tuareg-mode-hook
	193	(lambda() (setq tuareg-mode-name "🐫")))
158	194
159	195	to your [Init File][].
160	196

183	219
184	220	(add-hook 'tuareg-mode-hook
185	221	;; Turn on auto-fill minor mode.
186		(lambda () (auto-fill-mode 1)))
	222	#'auto-fill-mode)
187	223
188	224	See [dot-emacs.el](dot-emacs.el) for some examples.
189	225
190	226	[Init File]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Init-File.html
191	227
192
193		Bugs
194		----
195
196		See the [Github project](https://github.com/ocaml/tuareg/issues).
197
	228	Additional packages
	229	-------------------
	230
	231	### Merlin
	232
	233	It is recommended to install [Merlin][] which is available in
	234	[OPAM][]. Tuareg will automatically detect it and use some of its
	235	features (e.g. for imenu). Merlin offers auto-completion, the
	236	possibility to query the type with <kbd>C-cC-t</kbd>, to find the
	237	location of an identifier with <kbd>C-cC-l</kbd>, to go to the next
	238	(resp. previous) phrase with <kbd>C-cC-n</kbd>
	239	(resp. <kbd>C-cC-p</kbd>),... Highly recommended.
	240
	241	### Caml mode
	242
	243	[caml-mode][] (available in [NonGNU ELPA][] and [MELPA][]) is used to
	244	display types (using
	245	the obsolete `*.annot` files), open a module for documentation,...
	246
	247	[Menhir]: http://gallium.inria.fr/~fpottier/menhir/
	248	[ocsigen]: http://ocsigen.org/
	249	[Merlin]: https://github.com/ocaml/merlin
	250	[OPAM]: http://opam.ocaml.org/
	251	[caml-mode]: https://github.com/ocaml/caml-mode
	252	[NonGNU ELPA]: https://elpa.nongnu.org/
	253	[MELPA]: https://melpa.org/
	254
	255
	256	Reporting
	257	---------
	258
	259	The official Tuareg home page is located at:
	260	<https://github.com/ocaml/tuareg>.
	261
	262	Bug reports & patches: use the tracker:
	263	<https://github.com/ocaml/tuareg/issues>.
198	264
199	265	Thanks
200	266	------

232	298	Jane Street took over maintenance based on Albert Cohen's version 1.46
233	299	(later retracted by him), and released its first version as 2.0.
234	300
235		Reporting
236		---------
237
238		The official Tuareg home page is located at:
239		<https://github.com/ocaml/tuareg>.
240
241		Bug reports & patches: use the tracker:
242		<https://github.com/ocaml/tuareg/issues>.
	301	License
	302	-------
	303
	304	Tuareg is distributed under the GNU General Public License, version 3 or later.

+154

-0

compilation.txt less more

	0	OCaml Error Messages --compilation--
	1
	2	Shows different OCaml error messages and how they are rendered.
	3
	4	File "file.ml", line 4, characters 6-7:
	5	Error: This expression has type int
	6	This is not a function; it cannot be applied.
	7
	8	File "file.ml", line 3, characters 6-7:
	9	Warning 26: unused variable y.
	10
	11	File "file.ml", line 6, characters 15-38:
	12	Error: Signature mismatch:
	13	Modules do not match: sig val x : float end is not included in X
	14	Values do not match: val x : float is not included in val x : int
	15	File "file.ml", line 3, characters 2-13: Expected declaration
	16	File "file.ml", line 7, characters 6-7: Actual declaration
	17
	18	File "file.ml", line 8, characters 6-7:
	19	Warning 32: unused value y.
	20
	21
	22	* Since OCaml 4.08, the error messages have the following form.
	23
	24	File "helloworld.ml", line 2, characters 36-64:
	25	2 \| module rec A: sig type t += A end = struct type t += A = B.A end
	26	^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	27	Error: Cannot safely evaluate the definition of the following cycle
	28	of recursively-defined modules: A -> B -> A.
	29	There are no safe modules in this cycle (see manual section 8.2).
	30
	31	File "helloworld.ml", lines 4-7, characters 6-3:
	32	4 \| ......struct
	33	5 \| module F(X:sig end) = struct end
	34	6 \| let f () = B.value
	35	7 \| end
	36	Error: Cannot safely evaluate the definition of the following cycle
	37	of recursively-defined modules: A -> B -> A.
	38	There are no safe modules in this cycle (see manual section 8.2).
	39
	40	File "robustmatch.ml", lines 33-37, characters 6-23:
	41	9 \| ......match t1, t2, x with
	42	10 \| \| AB, AB, A -> ()
	43	11 \| \| MAB, _, A -> ()
	44	12 \| \| _, AB, B -> ()
	45	13 \| \| _, MAB, B -> ()
	46	Warning 8: this pattern-matching is not exhaustive.
	47	Here is an example of a case that is not matched:
	48	(AB, MAB, A)
	49
	50	File "helloworld.ml", line 2, characters 36-64:
	51	Error: Cannot safely evaluate the definition of the following cycle
	52	of recursively-defined modules: A -> B -> A.
	53	There are no safe modules in this cycle (see manual section 8.2).
	54
	55	File "helloworld.ml", line 2, characters 36-64:
	56	Warning 3: Cannot safely evaluate the definition of the following cycle
	57	of recursively-defined modules: A -> B -> A.
	58	There are no safe modules in this cycle (see manual section 8.2).
	59
	60	File "helloworld.ml", line 2, characters 36-64:
	61	2 \| module rec A: sig type t += A end = struct type t += A = B.A end
	62	^^^^^^^^^^^^^^^^^^^^^^^^
	63	Warning: Cannot safely evaluate the definition of the following cycle
	64	of recursively-defined modules: A -> B -> A.
	65	There are no safe modules in this cycle (see manual section 8.2).
	66
	67	File "main.ml", line 3, characters 8-50:
	68	Error: This expression has type float but an expression was expected of type
	69	int
	70
	71	File "main.ml", line 3, characters 8-50:
	72	Warning 3: This expression has type float but an expression was expected of type
	73	int
	74
	75	File "main.ml", line 13, characters 34-35:
	76	13 \| let f : M.t -> M.t = fun M.C -> y
	77	^
	78	Error: This expression has type M/2.t but an expression was expected of type
	79	M/1.t
	80	File "main.ml", line 10, characters 2-41:
	81	Definition of module M/1
	82	File "main.ml", line 7, characters 0-32:
	83	Definition of module M/2
	84
	85	File "main.ml", line 13, characters 34-35:
	86	13 \| let f : M.t -> M.t = fun M.C -> y
	87	^
	88	Error: This expression has type M/2.t but an expression was expected of type
	89	M/1.t
	90	File "main.ml", line 10, characters 2-41:
	91	Definition of module M/1
	92	File "main.ml", line 7, characters 0-32:
	93	Definition of module M/2
	94
	95
	96	* Since OCaml 4.12, warnings come with mnemonics.
	97
	98	File "moo.ml", line 6, characters 6-10:
	99	6 \| let fish = 13 in
	100	^^^^
	101	Warning 26 [unused-var]: unused variable fish.
	102
	103
	104	* Example of a warning with ancillary locations
	105
	106	File "urk.ml", line 1:
	107	Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
	108	The inferred interface contained items which could not be printed
	109	properly due to name collisions between identifiers.
	110	File "urk.ml", lines 23-25, characters 2-5:
	111	Definition of module M/1
	112	File "urk.ml", lines 17-20, characters 0-3:
	113	Definition of module M/2
	114	Beware that this warning is purely informational and will not catch
	115	all instances of erroneous printed interface.
	116	module M : sig type t val v : t end
	117	module F : sig module M : sig val v : M.t end val v : M/2.t end
	118
	119
	120	* Alert: treat like warning
	121
	122	File "alrt.ml", line 25, characters 9-10:
	123	25 \| val x: t [@@ocaml.deprecated]
	124	^
	125	Alert deprecated: t
	126
	127
	128	* Backtrace messages
	129
	130	Before 4.11:
	131
	132	OCAMLRUNPARAM=b ./bad
	133	Fatal error: exception Bad.Disaster("oh no!")
	134	Raised at file "bad.ml", line 5, characters 4-22
	135	Called from file "bad.ml" (inlined), line 9, characters 2-5
	136	Called from file "bad.ml", line 12, characters 8-18
	137
	138	4.11 and later:
	139
	140	OCAMLRUNPARAM=b ./bad
	141	Fatal error: exception Bad.Disaster("oh no!")
	142	Raised at Bad.f in file "bad.ml", line 5, characters 4-22
	143	Called from Bad.g in file "bad.ml" (inlined), line 9, characters 2-5
	144	Called from Bad in file "bad.ml", line 12, characters 8-18
	145
	146	OCAMLRUNPARAM=b ./bad
	147	Fatal error: exception Sys_error("non.existing.file: No such file or directory")
	148	Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 399, characters 28-54
	149	Called from Bad.h in file "bad.ml", line 7, characters 13-40
	150	Called from Bad.f in file "bad.ml", line 13, characters 4-7
	151	Re-raised at Bad.f in file "bad.ml", line 14, characters 12-19
	152	Called from Bad.g in file "bad.ml", line 17, characters 2-5
	153	Called from Bad in file "bad.ml", line 20, characters 8-18

-9

debian/README.Debian less more

0		tuareg-mode for Debian
1		----------------------
	0	The easiest way to automatically use tuareg-mode on OCaml files is to
	1	add the following line to your emacs initialisation (file ~/.emacs) :
2	2
3		tuareg-mode is now automatically loaded on all files with filename
4		extension .ml[iylp]?. If the debian package "ocaml-mode", which provides
5		an alternative emacs mode for (O)Caml files, is installed together
6		with the tuareg-mode package then tuareg takes precedence. Users who
7		wish to overwrite this behaviour should consult the instuctions given
8		in the file /usr/share/doc/ocaml-mode/README.Debian.
	3	(load "activate-tuareg-mode")
9	4
10		-- Ralf Treinen <treinen@debian.org>, Fri Sep 2 20:38:53 2005
	5	-- Ralf Treinen <treinen@debian.org>, Sat, 15 Jul 2023 16:23:49 +0200

+13

-0

debian/activate-tuareg-mode.el less more

	0	(add-to-list 'auto-mode-alist '("\\.ml[iylp]?\\'" . tuareg-mode))
	1	(autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
	2	(autoload 'camldebug "ocamldebug-tuareg" "Run the Caml debugger" t)
	3	(autoload 'tuareg-run-ocaml "tuareg"
	4	"Run an OCaml toplevel process. I/O via buffer `ocaml-toplevel'."
	5	t)
	6	(defalias 'run-ocaml 'tuareg-run-ocaml)
	7	(dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmi"))
	8	(add-to-list 'completion-ignored-extensions ext))
	9	(debian-pkg-add-load-path-item
	10	(concat "/usr/share/"
	11	(symbol-name debian-emacs-flavor)
	12	"/site-lisp/tuareg-mode"))

+13

-1

debian/changelog less more

0		tuareg-mode (1:2.2.0-2) UNRELEASED; urgency=medium
	0	tuareg-mode (1:3.0.1-2) UNRELEASED; urgency=medium
1	1
2	2	* Remove constraints unnecessary since buster:
3	3	+ elpa-tuareg: Drop versioned constraint on emacs in Recommends.
4	4
5	5	-- Debian Janitor <janitor@jelmer.uk> Sun, 24 Jul 2022 01:01:04 -0000
	6
	7	tuareg-mode (1:3.0.1-1) unstable; urgency=medium
	8
	9	* New upstream version
	10	* Refresh patch ocaml-path
	11	* Standards-version 4.6.2 (no change)
	12	* Drop transitional package tuareg-mode (closes: #1038321)
	13	* Add a file "activate-tuareg-mode" that a user can load to automatically
	14	use tuareg mode on OCaml files, and describe this in README.Debian.
	15	* Rephrase the package description.
	16
	17	-- Ralf Treinen <treinen@debian.org> Sat, 15 Jul 2023 16:25:07 +0200
6	18
7	19	tuareg-mode (1:2.2.0-1) unstable; urgency=medium
8	20

+15

-16

debian/control less more

7	7	Stéphane Glondu <glondu@debian.org>
8	8	Build-Depends: debhelper-compat (= 12),
9	9	dh-elpa
10		Standards-Version: 4.5.0
	10	Standards-Version: 4.6.2
11	11	Vcs-Browser: https://salsa.debian.org/ocaml-team/tuareg-mode
12	12	Vcs-Git: https://salsa.debian.org/ocaml-team/tuareg-mode.git
13	13	Homepage: https://github.com/ocaml/tuareg

25	25	Breaks: tuareg-mode (<< 1:2.1.0-3)
26	26	Replaces: tuareg-mode (<< 1:2.1.0-3)
27	27	Description: emacs-mode for OCaml programs
	28	OCaml (Objective Caml) is a programming language featuring functional
	29	programming, mutable data structures, algebraic data types, and type
	30	inference.
	31	.
	32	This package provides tuareg-mode for editing OCaml programs with
	33	Emacs and XEmacs. It also works on Caml Light, the predecessor
	34	language of OCaml.
	35	.
28	36	Tuareg handles automatic indentation of Objective Caml and Caml-Light
29	37	code. Key parts of the code are highlighted using Font-Lock. It
30	38	provides support to run an interactive OCaml toplevel and debugger.
31	39	.
32		This mode attempts to give better results than the caml-mode provided by
33		the elpa-caml package. Indentation rules are slightly different but
34		closer to classical functional languages indentation. Tuareg
35		gives access to some functionalities from caml-mode when the elpa-caml
36		package is installed.
37
38		Package: tuareg-mode
39		Architecture: all
40		Depends: elpa-tuareg,
41		${misc:Depends}
42		Section: oldlibs
43		Description: transitional package, tuareg-mode to elpa-tuareg
44		Tuareg for GNU Emacs has been elpafied. This dummy transitional
45		package facilitates the transition from tuareg-mode to
46		elpa-tuareg-mode and is safe to remove.
	40	Another popular emacs mode for editing OCaml files is caml-mode,
	41	available through the elpa-caml package. Tuareg attempts to give
	42	better results than caml-mode. Indentation rules are slightly
	43	different but closer to classical functional languages
	44	indentation. Tuareg gives access to some functionalities from
	45	caml-mode.

-0

debian/elpa-tuareg.elpa less more

0	0	*.el
	1	debian/activate-tuareg-mode
	2

-5

debian/patches/ocaml-path less more

2	2
3	3	Index: tuareg-mode/tuareg.el
4	4	===================================================================
5		--- tuareg-mode.orig/tuareg.el 2017-11-22 21:10:18.131827060 +0100
6		+++ tuareg-mode/tuareg.el 2017-11-22 21:10:18.127827042 +0100
7		@@ -312,7 +312,7 @@
	5	--- tuareg-mode.orig/tuareg.el 2023-03-07 12:14:37.978977547 +0100
	6	+++ tuareg-mode/tuareg.el 2023-03-07 12:15:24.103242629 +0100
	7	@@ -291,7 +291,7 @@
8	8	Valid names are `browse-url', `browse-url-firefox', etc."
9		:group 'tuareg)
	9	:group 'tuareg :type 'function)
10	10
11	11	-(defcustom tuareg-library-path "/usr/local/lib/ocaml/"
12	12	+(defcustom tuareg-library-path "/usr/lib/ocaml/"
13		"*Path to the OCaml library."
	13	"Name of directory holding the OCaml library."
14	14	:group 'tuareg :type 'string)
15	15

-3

dot-emacs.el less more

	0	;; -- lexical-binding: t; --
0	1	(require 'tuareg)
1	2
2	3	;; See README

21	22
22	23
23	24	;; Easy keys to navigate errors after compilation:
24		(define-key tuareg-mode-map [(f12)] 'next-error)
25		(define-key tuareg-mode-map [(shift f12)] 'previous-error)
	25	(define-key tuareg-mode-map [(f12)] #'next-error)
	26	(define-key tuareg-mode-map [(shift f12)] #'previous-error)
26	27
27	28
28	29	;; Use Merlin if available

31	32	(add-to-list 'auto-mode-alist '("/\\.merlin\\'" . conf-mode))
32	33
33	34	(when (functionp 'merlin-document)
34		(define-key tuareg-mode-map (kbd "\C-c\C-h") 'merlin-document))
	35	(define-key tuareg-mode-map (kbd "\C-c\C-h") #'merlin-document))
35	36
36	37	;; Run Merlin if a .merlin file in the parent dirs is detected
37	38	(add-hook 'tuareg-mode-hook

+241

-0

indent-test-failed.ml less more

	0	(* This fail contains code samples that are currently not indented
	1	properly.
	2
	3	As indentation bugs are fixed, the corresponding samples should
	4	be moved to the file indent-test.ml. *)
	5
	6	let quux list = List.map list ~f:(fun item ->
	7	print_item item
	8	)
	9
	10	let h x =
	11	try ff a b
	12	c d;
	13	gg 1 2
	14	3 4;
	15	with e -> raise e
	16
	17	let x = foo ~f:(fun _ -> 0 (* Comment. *)
	18	)
	19
	20	let () =
	21	foo (sprintf ("a: %s"
	22	^ " b: %s")
	23	a
	24	b)
	25
	26	let () =
	27	Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
	28	Clock.at time
	29	>>> fun () ->
	30	Db.iter t.db ~f:(fun dbo ->
	31	if S.mem azot (Dbo.azo dbo) then
	32	Dbo.dont dbo))
	33
	34	let w f =
	35	List.map f ~f:(fun (a, b) ->
	36	L.r a
	37	>>= function
	38	\| Ok s -> `Fst (b, s)
	39	\| Error e -> `Snd (b, a, e))
	40
	41	let a =
	42	B.c d ~e:f [
	43	"g";
	44	"h";
	45	]
	46
	47	let a =
	48	foo
	49	~f:(fun () -> a
	50	)
	51
	52	let () =
	53	(* Comment. *)
	54	bar a b
	55	c d;
	56	foo ~size
	57	(* Comment. *)
	58	~min:foo
	59	?reduce
	60	?override
	61	()
	62
	63	let foo =
	64	(* Comment. *)
	65	List.map z
	66	~f:(fun m ->
	67	M.q m
	68	\|! T.u ~pr ~verbose:false
	69	~p:H.P.US ~is_bar:false)
	70	\|! List.sort ~cmp:(fun a b ->
	71	compare
	72	(I.r a.T.s)
	73	(I.r b.T.s))
	74
	75	let () =
	76	snoo ~f:(fun foo ->
	77	foo = bar
	78	&& snoo)
	79
	80	let () =
	81	snoo ~f:(fun foo ->
	82	foo + bar
	83	&& snoo)
	84
	85	let () =
	86	snoo ~f:(fun foo ->
	87	foo
	88	&& snoo)
	89
	90	let variants a =
	91	match String.split a ~on:'-' with
	92	\| [ s1; s2; s3 ] ->
	93	let a0 = String.concat ~sep:"" [ s1; s2] in
	94	let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
	95	List.map [ a0; a1; a]
	96	~f:(fun a_s -> lookup a_s)
	97	\|! List.flatten
	98	\| _ -> failwith "bad"
	99
	100	let optional_sci_float =
	101	do_something ~a:1e-7
	102	~b:(fun x -> x + 1)
	103
	104	let array_args =
	105	fold s multi_sms.(0).message_number folder
	106	more_args (* FIXME *)
	107
	108	let () =
	109	match var with
	110	\| <:expr< $lid:f$ >> ->
	111	KO
	112	\| <:expr< $lid:f$ >> when f x ->
	113	KO
	114	\| y when f y ->
	115	OK
	116	\| long_pattern
	117	when f long_pattern -> (* Should be more indented than the clause body *)
	118	z
	119
	120	let subscribe_impl dir topic ~aborted =
	121	return (
	122	match Directory.subscribe dir topic with
	123	\| None -> Error ()
	124	\| Some pipe ->
	125	whenever (aborted >>\| fun () -> Pipe.close_read pipe);
	126	Ok pipe
	127	)
	128	next_argument (* should be indented correctly, given the braces *)
	129
	130
	131	let command =
	132	Command.Spec.(
	133	empty
	134	+> flag "-hello" (optional_with_default "Hello" string)
	135	~doc:" The 'hello' of 'hello world'"
	136	+> flag "-world" (optional_with_default "World" string)
	137	~doc:" The 'world' of 'hello world'"
	138	)
	139
	140	let server_comments request t =
	141	t >>= Grep.server_comments
	142	lazy
	143	parser
	144	every
	145
	146	let x = match y, z with
	147	\| A, (B \| C)
	148	\| X, Y -> do_something() (* Issue #78 *)
	149
	150	type t = a
	151	and typey = 4
	152	and x = b
	153
	154	type 'a v = id:O.t ->
	155	ssss:Ssss.t ->
	156	dddd:ddd.t ->
	157	t:S_m.t ->
	158	mmm:Safe_float.t ->
	159	qqq:int ->
	160	c:C.t ->
	161	uuuu:string option ->
	162	aaaaaa:Aaaaaa.t ->
	163	a:A.t ->
	164	rrrrr:Rrrrr.t ->
	165	time:Time.t ->
	166	typ:[ `L_p of Safe_float.t ] ->
	167	bazonk:present option ->
	168	o_p_e:O_m.t option ->
	169	only_hjkl:present option ->
	170	show_junk:int option ->
	171	d_p_o: Safe_float.t option ->
	172	asdf:present option ->
	173	generic:Sexp.t list ->
	174	'a
	175
	176	let () =
	177	try f a
	178	with A () ->
	179	()
	180	\| B () ->
	181	()
	182	\| C () ->
	183	()
	184
	185	let () =
	186	match _ with
	187	\| foo ->
	188	bar
	189	>>\| function _ ->
	190	_
	191
	192	let foo x =
	193	f1 x >= f2 x
	194	&& f3
	195	(f4 x)
	196
	197	let foo x =
	198	(>=)
	199	(f1 x) (f2 x)
	200	&& f3
	201	(f4 x)
	202
	203	let splitting_long_expression =
	204	quad.{band, i3} <- quad.{band, i3} +. g +.
	205	area_12 *. (P.potential x13 y13 +. P.potential x23 y23)
	206
	207	let x =
	208	try a
	209	with Not_found ->
	210	b
	211	\| _ ->
	212	c
	213	let x =
	214	try a
	215	with Not_found ->
	216	if a then b
	217	\| flag when String.is_prefix flag ~prefix:"-" ->
	218	a
	219	\| _ ->
	220	c
	221
	222	let () =
	223	match var with
	224	\| <:expr< $lid:f$ >> ->
	225	KO
	226	\| <:expr< $lid:f$ >> when f x ->
	227	KO
	228	\| y when f y ->
	229	OK
	230	\| long_pattern
	231	when f long_pattern -> (* Should be more indented than the clause body *)
	232	z
	233
	234	let _ =
	235	List.map
	236	(function x ->
	237	blabla (* FIXME: indentation afer "(function" *)
	238	blabla
	239	blabla)
	240	l

+248

-141

indent-test.ml less more

3	3	* - the indentation is acceptable (maybe not perfect for everyone,
4	4	* but at least correct for some users).
5	5	* - the indentation code does find this indentation.
6		* We use this for regression testing: "make indent-test" should normally
7		* show no changes, and if it does show changes it should be improvements.
	6	* This file is used for regression testing in tuareg-tests.el.
8	7	*
9		* This is in contrast to sample.ml which contains indentation layouts
10		* which the indentation code doesn't know how to find, so it's normal
11		* for "make sample.ml.test" to show changes which are regressions.
	8	* This is in contrast to indent-test-failed.ml which contains indentation
	9	* layouts which the indentation code doesn't know how to find.
12	10	*)
13	11
14	12	let server_comments request t =

18	16	let module M = N in
19	17	let open Grep.Server in
20	18	let x = 5 in
	19	let () =
	20	a;%ext (* bug:121 *)
	21	b in
21	22	let modue x y = 5 in
22	23	let open M in
23	24

42	43	let qs2 = {eof\| other quoted string \|noteof} \|eof}
43	44
44	45	(* ocp-indent does it as follows:
45		let test1 = with_connection (fun conn ->
46		do_something conn x;
47		...
48		)
49		toto
	46
	47	let test1 = with_connection (fun conn ->
	48	␣␣␣␣do_something conn x;
	49	␣␣␣␣...
	50	␣␣)
	51	␣␣␣␣toto
	52
	53	(space written as ␣ to avoid reindent smashing this comment)
50	54	*)
51	55	let test1 = with_connection (fun conn ->
52	56	do_something conn x;
53	57	...
54	58	)
	59	toto
55	60
56	61	let x = match y with (* Issue #71 *)
57	62	\| A \| B \| C ->

142	147
143	148	type t =
144	149	\| A
145		\| B
	150	\| B (* issue #76 *)
146	151	\| C
147	152	with sexp
148	153

439	444	else c
440	445	)
441	446
442		let quux list = List.map list ~f:(fun item ->
443		print_item item
444		)
445
446	447	let foo x = function
447	448	\| Some _ -> true
448	449	\| None -> false

476	477	f x;
477	478	g x;
478	479	y x;
479		with e -> raise e
480
481		let h x =
482		try ff a b
483		c d;
484		gg 1 2
485		3 4;
486	480	with e -> raise e
487	481
488	482	let () =

534	528	\| 4 -> 3
535	529	\| 5 -> 7)
536	530
537		let x = foo ~f:(fun _ -> 0 (* Comment. *)
538		)
539
540	531	let f = function x ->
541	532	y
542	533

614	605	let () = (try
615	606	f x;
616	607	with _ -> ())
617
618		let () =
619		foo (sprintf ("a: %s"
620		^ " b: %s")
621		a
622		b)
623	608
624	609	let () =
625	610	try f a

798	783	x
799	784
800	785	let () =
801		Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
802		Clock.at time
803		>>> fun () ->
804		Db.iter t.db ~f:(fun dbo ->
805		if S.mem azot (Dbo.azo dbo) then
806		Dbo.dont dbo))
807
808		let () =
809	786	f 1
810	787	\|! (fun x ->
811	788	g x x)

876	853	step1
877	854	>>= fun () -> step2)
878	855
879		let w f =
880		List.map f ~f:(fun (a, b) ->
881		L.r a
882		>>= function
883		\| Ok s -> `Fst (b, s)
884		\| Error e -> `Snd (b, a, e))
885
886	856	class c (a : b) =
887		object
	857	object
	858	inherit d
	859	method m = 1
	860	end
	861
	862	class c (a : b) =
	863	object(self)
	864	inherit d
	865	method m = 1
	866	end
	867
	868	class c (a : b) = object
888	869	inherit d
889	870	method m = 1
	871	end
	872
	873	class c (a : b) = object(self)
	874	inherit d
	875	method m = 1
	876	end
	877
	878	class type restricted_point_type =
	879	object
	880	method get_x : int
	881	method bump : unit
	882	end
	883
	884	class type restricted_point_type = object
	885	method get_x : int
	886	method bump : unit
890	887	end
891	888
892	889	let f = {

907	904	for i = 10 to 17 do
908	905	printf "%d" i;
909	906	done
910
911		let a =
912		B.c d ~e:f [
913		"g";
914		"h";
915		]
916	907
917	908	let () =
918	909	f a ~b:c ~d ~e:g

1014	1005	(fun () -> a
1015	1006	)
1016	1007
1017		let a =
1018		foo
1019		~f:(fun () -> a
1020		)
1021
1022		let () =
1023		(* Comment. *)
1024		bar a b
1025		c d;
1026		foo ~size
1027		(* Comment. *)
1028		~min:foo
1029		?reduce
1030		?override
1031		()
1032
1033		let foo =
1034		(* Comment. *)
1035		List.map z
1036		~f:(fun m ->
1037		M.q m
1038		\|! T.u ~pr ~verbose:false
1039		~p:H.P.US ~is_bar:false)
1040		\|! List.sort ~cmp:(fun a b ->
1041		compare
1042		(I.r a.T.s)
1043		(I.r b.T.s))
1044
1045	1008	let check =
1046	1009	a lsr 30 >= 3
1047	1010	&& b lsr 20 >= 1
1048	1011	&& c * 10 > f
1049
1050		let () =
1051		snoo ~f:(fun foo ->
1052		foo = bar
1053		&& snoo)
1054
1055		let () =
1056		snoo ~f:(fun foo ->
1057		foo + bar
1058		&& snoo)
1059
1060		let () =
1061		snoo ~f:(fun foo ->
1062		foo
1063		&& snoo)
1064
1065		let variants a =
1066		match String.split a ~on:'-' with
1067		\| [ s1; s2; s3 ] ->
1068		let a0 = String.concat ~sep:"" [ s1; s2] in
1069		let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
1070		List.map [ a0; a1; a]
1071		~f:(fun a_s -> lookup a_s)
1072		\|! List.flatten
1073		\| _ -> failwith "bad"
1074	1012
1075	1013	let f a1 a2 a3
1076	1014	b1 b2 b3 d1 d2 d3 = {

1174	1112	let x =
1175	1113	try a
1176	1114	with Not_found ->
1177		b
1178		let x =
1179		try a
1180		with Not_found ->
1181	1115	b
1182	1116	\| _ ->
1183	1117	c

1193	1127	let x = "toto try \
1194	1128	tata"
1195	1129
1196		let optional_sci_float =
1197		do_something ~a:1e-7
1198		~b:(fun x -> x + 1)
1199
1200	1130	let () =
1201	1131	f x ~tol:1.0
1202	1132	more arguments;
1203	1133	f x ~tol:1.
1204	1134	more arguments
1205	1135
1206		let array_args =
1207		fold s multi_sms.(0).message_number folder
1208		more_args (* FIXME *)
1209
1210		let () =
1211		match var with
1212		\| <:expr< $lid:f$ >> ->
1213		KO
1214		\| <:expr< $lid:f$ >> when f x ->
1215		KO
1216		\| y when f y ->
1217		OK
1218		\| long_pattern
1219		when f long_pattern -> (* Should be more indented than the clause body *)
1220		z
1221
1222	1136	type t = {
1223	1137	mutable a: float;
1224	1138	b : int;

1293	1207	?x : int ->
1294	1208	int ->
1295	1209	int
	1210
	1211	let x = List.map
	1212	(function x ->
	1213	blabla
	1214	blabla
	1215	blabla)
	1216	l
	1217
	1218	(* The two "let"s below are indented under the assumption that
	1219	tuareg-indent-align-with-first-arg is nil! *)
	1220	let x = List.map (fun x -> 5)
	1221	my list
	1222
	1223	let x =
	1224	logf `Info "User %s has %i new messages" ba
	1225	(Uid.to_string uid)
	1226	(List.length new_messages)
	1227
	1228	(* MetaOCaml thingies, issue #195. *)
	1229	let f x = .< 0.0 + g .~ x
	1230	5
	1231	* 7
	1232	+ .<.~x
	1233	+. 10>.
	1234	>.
	1235
	1236	let f = function
	1237	\| A -> 1
	1238	\| B \| C -> 2
	1239
	1240	let quux list = List.map list ~f:(fun item ->
	1241	print_item item
	1242	)
	1243
	1244	let h x =
	1245	try ff a b
	1246	c d;
	1247	gg 1 2
	1248	3 4;
	1249	with e -> raise e
	1250
	1251	let x = foo ~f:(fun _ -> 0 (* Comment. *)
	1252	)
	1253
	1254	let x =
	1255	let foo = 1 and bar = 2 and zot = 3 in
	1256	let quux = 4 in
	1257	foo
	1258	+ bar
	1259	+ zot
	1260	+ quux
	1261
	1262	let () =
	1263	foo (sprintf ("a: %s"
	1264	^ " b: %s")
	1265	a
	1266	b)
	1267
	1268	let () =
	1269	Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
	1270	Clock.at time
	1271	>>> fun () ->
	1272	Db.iter t.db ~f:(fun dbo ->
	1273	if S.mem azot (Dbo.azo dbo) then
	1274	Dbo.dont dbo))
	1275
	1276	let () =
	1277	f 1
	1278	\|> (fun x ->
	1279	g x x)
	1280	\|> (fun y ->
	1281	h y y)
	1282
	1283	let () =
	1284	tagL "ol" (List.map ~f:(tag ~a:[] "li") (
	1285	(List.map results ~f:(fun (what,_) ->
	1286	tag "a" ~a:[("href","#" ^ what)] (what_title what)))
	1287	@ [tag "a" ~a:[("href","#" ^ message_id)] message_title;
	1288	tag "a" ~a:[("href","#" ^ legend_id)] legend_title]))
	1289	\|> IO.println out
	1290
	1291	let w f =
	1292	List.map f ~f:(fun (a, b) ->
	1293	L.r a
	1294	>>= function
	1295	\| Ok s -> `Fst (b, s)
	1296	\| Error e -> `Snd (b, a, e))
	1297
	1298	let a =
	1299	B.c d ~e:f [
	1300	"g";
	1301	"h";
	1302	]
	1303
	1304	let x =
	1305	[(W.background `Blue (W.hbox [
	1306	x
	1307	]));
	1308	]
	1309
	1310	let c f =
	1311	if S.is_file f then
	1312	S.load f C.t
	1313	\|> fun x -> c := Some x
	1314	else
	1315	C.s C.default \|> S.save f
	1316	\|> fun () -> c := None
	1317
	1318	let c f =
	1319	if S.is_file f then (
	1320	S.load f C.t
	1321	\|> fun x -> c := Some x
	1322	) else (
	1323	C.s C.default \|> S.save f
	1324	\|> fun () -> c := None)
	1325
	1326	let a =
	1327	foo
	1328	(fun () ->
	1329	a)
	1330
	1331	let a =
	1332	foo
	1333	~f:(fun () ->
	1334	a)
	1335
	1336	let a =
	1337	foo
	1338	(fun () -> a
	1339	)
	1340
	1341	let a =
	1342	foo
	1343	~f:(fun () -> a
	1344	)
	1345
	1346	let () =
	1347	(* Comment. *)
	1348	bar a b
	1349	c d;
	1350	foo ~size
	1351	(* Comment. *)
	1352	~min:foo
	1353	?reduce
	1354	?override
	1355	()
	1356
	1357	let foo =
	1358	(* Comment. *)
	1359	List.map z
	1360	~f:(fun m ->
	1361	M.q m
	1362	\|> T.u ~pr ~verbose:false
	1363	~p:H.P.US ~is_bar:false)
	1364	\|> List.sort ~cmp:(fun a b ->
	1365	compare
	1366	(I.r a.T.s)
	1367	(I.r b.T.s))
	1368
	1369	let () =
	1370	snoo ~f:(fun foo ->
	1371	foo = bar
	1372	&& snoo)
	1373
	1374	let () =
	1375	snoo ~f:(fun foo ->
	1376	foo + bar
	1377	&& snoo)
	1378
	1379	let () =
	1380	snoo ~f:(fun foo ->
	1381	foo
	1382	&& snoo)
	1383
	1384	let variants a =
	1385	match String.split a ~on:'-' with
	1386	\| [ s1; s2; s3 ] ->
	1387	let a0 = String.concat ~sep:"" [ s1; s2] in
	1388	let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
	1389	List.map [ a0; a1; a]
	1390	~f:(fun a_s -> lookup a_s)
	1391	\|> List.flatten
	1392	\| _ -> failwith "bad"
	1393
	1394	let x =
	1395	try a
	1396	with Not_found ->
	1397	b
	1398
	1399	let optional_sci_float =
	1400	do_something ~a:1e-7
	1401	~b:(fun x -> x + 1)
	1402
	1403	let array_args =
	1404	fold s multi_sms.(0).message_number folder
	1405	more_args (* FIXME *)
	1406
	1407	type t = {
	1408	mutable a: float;
	1409	b : int;
	1410	}
1296	1411
1297	1412	let subscribe_impl dir topic ~aborted =
1298	1413	return (

1302	1417	whenever (aborted >>\| fun () -> Pipe.close_read pipe);
1303	1418	Ok pipe
1304	1419	)
1305		next_argument (* should be indented correctly, given the braces *)
1306
1307
1308		let x = List.map
1309		(function x ->
1310		blabla
1311		blabla
1312		blabla)
1313		l
	1420	next_argument (* should be indented correctly, given the braces *)
1314	1421
1315	1422	let command =
1316	1423	Command.Spec.(
1317	1424	empty
1318	1425	+> flag "-hello" (optional_with_default "Hello" string)
1319		~doc:" The 'hello' of 'hello world'"
	1426	~doc:" The 'hello' of 'hello world'"
1320	1427	+> flag "-world" (optional_with_default "World" string)
1321		~doc:" The 'world' of 'hello world'"
	1428	~doc:" The 'world' of 'hello world'"
1322	1429	)

+132

-123

ocamldebug.el less more

0		;;; ocamldebug.el --- Run ocamldebug / camldebug under Emacs.
	0	;;; ocamldebug.el --- Run ocamldebug / camldebug under Emacs -- lexical-binding:t --
1	1	;; Derived from gdb.el.
2	2
3	3	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

35	35
36	36	;;; Code:
37	37
38		(eval-when-compile (require 'cl))
39	38	(require 'comint)
40	39	(require 'shell)
41		(require 'tuareg (expand-file-name
42		"tuareg" (file-name-directory (or load-file-name
43		byte-compile-current-file))))
	40	(require 'tuareg (expand-file-name "tuareg" (file-name-directory
	41	(or load-file-name
	42	byte-compile-current-file
	43	buffer-file-name))))
44	44	(require 'derived)
45	45
46	46	;;; Variables.

62	62	(defvar ocamldebug-prompt-pattern "^(\$ocd\\\|cdb\$) *"
63	63	"A regexp to recognize the prompt for ocamldebug.")
64	64
65		(defvar ocamldebug-overlay-event nil
66		"Overlay for displaying the current event.")
67		(defvar ocamldebug-overlay-under nil
68		"Overlay for displaying the current event.")
69		(defvar ocamldebug-event-marker nil
	65	(defvar ocamldebug-overlay-event
	66	(let ((ol (make-overlay (point) (point))))
	67	(overlay-put ol 'face 'ocamldebug-event)
	68	(delete-overlay ol) ;; Disconnect it from current buffer.
	69	ol)
	70	"Overlay for displaying the first/last char of current event.")
	71	(defvar ocamldebug-overlay-under
	72	(let ((ol (make-overlay (point) (point))))
	73	(overlay-put ol 'face 'ocamldebug-underline)
	74	(delete-overlay ol) ;; Disconnect it from current buffer.
	75	ol)
	76	"Overlay for displaying the rest of current event.")
	77	(defvar ocamldebug-event-marker (make-marker)
70	78	"Marker for displaying the current event.")
71	79
72	80	(defvar ocamldebug-track-frame t
73		"*If non-nil, always display current frame position in another window.")
74
75		(cond
76		((and (fboundp 'make-overlay) window-system)
77		(make-face 'ocamldebug-event)
78		(make-face 'ocamldebug-underline)
79		(unless (face-differs-from-default-p 'ocamldebug-event)
80		(invert-face 'ocamldebug-event))
81		(unless (face-differs-from-default-p 'ocamldebug-underline)
82		(set-face-underline 'ocamldebug-underline t))
83		(setq ocamldebug-overlay-event (make-overlay 1 1))
84		(overlay-put ocamldebug-overlay-event 'face 'ocamldebug-event)
85		(setq ocamldebug-overlay-under (make-overlay 1 1))
86		(overlay-put ocamldebug-overlay-under 'face 'ocamldebug-underline))
87		(t
88		(setq ocamldebug-event-marker (make-marker))
89		(setq overlay-arrow-string "=>")))
	81	"If non-nil, always display current frame position in another window.")
	82
	83	(defface ocamldebug-event
	84	'((t :invert t))
	85	"Face to highlight the first/last char of current event."
	86	:group 'tuareg)
	87
	88	(defface ocamldebug-underline
	89	;; FIXME: The name should describe what it's used for, not what it looks
	90	;; like by default!
	91	'((t :underline t))
	92	"Face to highlight the rest of current event."
	93	:group 'tuareg)
90	94
91	95	;;; OCamldebug mode.
92	96

98	102	(defvar ocamldebug-mode-map
99	103	(let ((map (make-sparse-keymap)))
100	104	(define-key map "\C-c" ocamldebug-prefix-map)
101		(define-key map "\C-l" 'ocamldebug-refresh)
	105	(define-key map "\C-l" #'ocamldebug-refresh)
102	106	;; This is already the default anyway!
103	107	;;(define-key map "\t" 'comint-dynamic-complete)
104	108	(define-key map "\M-?"
105	109	;; FIXME: This binding is wrong since comint-dynamic-list-completions
106	110	;; is a function, not a command.
107		'comint-dynamic-list-completions)
	111	#'comint-dynamic-list-completions)
108	112	map))
109	113
110	114	(define-derived-mode ocamldebug-mode comint-mode "OCaml-Debugger"
111
112	115	"Major mode for interacting with an ocamldebug process.
113	116
114	117	The following commands are available:

137	140	(setq-local ocamldebug-filter-accumulator "")
138	141	(setq-local ocamldebug-filter-function #'ocamldebug-marker-filter)
139	142	(setq-local comint-prompt-regexp ocamldebug-prompt-pattern)
140		(setq-local comint-dynamic-complete-functions
141		(cons (if (boundp 'completion-at-point-functions)
142		#'ocamldebug-capf #'ocamldebug-complete)
143		comint-dynamic-complete-functions))
	143	(add-hook 'comint-dynamic-complete-functions #'ocamldebug-capf nil 'local)
144	144	(setq-local comint-prompt-read-only t)
145	145	(setq-local paragraph-start comint-prompt-regexp)
146	146	(setq-local ocamldebug-last-frame-displayed-p t)
147	147	(setq-local shell-dirtrackp t)
148		(add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t))
	148	(add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t))
149	149
150	150	;;; Keymaps.
151	151

183	183	(interactive "P")
184	184	(ocamldebug-call ,name ,args
185	185	(ocamldebug-numeric-arg arg))))
186		(define-key ocamldebug-prefix-map ,key ',fun))))
	186	(define-key ocamldebug-prefix-map ,key #',fun))))
187	187
188	188	(def-ocamldebug "step" "\C-s" "Step one source line with display.")
189	189	(def-ocamldebug "run" "\C-r" "Run the program.")

201	201	"@ \"%m\" # %c")
202	202
203	203	(defun ocamldebug-kill-filter (string)
204		;gob up stupid questions :-)
	204	;; Gob up stupid questions :-)
205	205	(setq ocamldebug-filter-accumulator
206	206	(concat ocamldebug-filter-accumulator string))
207		(when (string-match "\$.* \$(y or n) "
208		ocamldebug-filter-accumulator)
	207	(when (string-match "\$.* \$(y or n) " ocamldebug-filter-accumulator)
209	208	(setq ocamldebug-kill-output
210	209	(cons t (match-string 1 ocamldebug-filter-accumulator)))
211	210	(setq ocamldebug-filter-accumulator ""))

224	223	(defun ocamldebug-kill ()
225	224	"Kill the program."
226	225	(interactive)
227		(let ((ocamldebug-kill-output))
	226	(let (ocamldebug-kill-output)
228	227	(with-current-buffer ocamldebug-current-buffer
229	228	(let ((proc (get-buffer-process (current-buffer)))
230	229	(ocamldebug-filter-function #'ocamldebug-kill-filter))

234	233	(accept-process-output proc))))
235	234	(if (not (car ocamldebug-kill-output))
236	235	(error (cdr ocamldebug-kill-output))
237		(sit-for 0 300)
	236	(sit-for 0.3)
238	237	(ocamldebug-call-1 (if (y-or-n-p (cdr ocamldebug-kill-output)) "y" "n")))))
239	238	;;FIXME: ocamldebug doesn't output the Hide marker on kill
240	239
241	240	(defun ocamldebug-goto-filter (string)
242		;accumulate onto previous output
	241	;; Accumulate onto previous output
243	242	(setq ocamldebug-filter-accumulator
244	243	(concat ocamldebug-filter-accumulator string))
245		(when (or (string-match (concat
246		"\$\n\\\|\\`\$[ \t]*\$[0-9]+\$[ \t]+"
247		ocamldebug-goto-position
248		"-[0-9]+[ \t]\$before\$.\n")
249		ocamldebug-filter-accumulator)
250		(string-match (concat
251		"\$\n\\\|\\`\$[ \t]*\$[0-9]+\$[ \t]+[0-9]+-"
252		ocamldebug-goto-position
253		"[ \t]\$after\$.\n")
254		ocamldebug-filter-accumulator))
255		(setq ocamldebug-goto-output
256		(match-string 2 ocamldebug-filter-accumulator))
	244	;; Address Characters Kind Repr.
	245	;; 14452 64-82 before/fun
	246	;; 14584 182-217 after/ret
	247	;;0: 30248 -1--1 pseudo
	248	;;0: 30076 64-82 before/fun
	249	(when (or (string-match
	250	(concat "\$?:\n\\\|\\`\$[ \t]*"
	251	"\$[0-9]+\$\$?::[ \t]*\\([0-9]+\$\\)?[ \t]+"
	252	ocamldebug-goto-position
	253	"-[0-9]+[ \t]before.\n")
	254	ocamldebug-filter-accumulator)
	255	(string-match
	256	(concat "\$?:\n\\\|\\`\$[ \t]*"
	257	"\$[0-9]+\$\$?::[ \t]*\\([0-9]+\$\\)?[ \t]+[0-9]+-"
	258	ocamldebug-goto-position
	259	"[ \t]after.\n")
	260	ocamldebug-filter-accumulator))
	261	(let ((id (match-string 1 ocamldebug-filter-accumulator))
	262	(pos (match-string 2 ocamldebug-filter-accumulator)))
	263	(setq ocamldebug-goto-output (if pos (concat id ":" pos) id)))
257	264	(setq ocamldebug-filter-accumulator
258	265	(substring ocamldebug-filter-accumulator (1- (match-end 0)))))
259		(when (string-match comint-prompt-regexp
260		ocamldebug-filter-accumulator)
	266	(when (string-match comint-prompt-regexp ocamldebug-filter-accumulator)
261	267	(setq ocamldebug-goto-output (or ocamldebug-goto-output 'fail))
262	268	(setq ocamldebug-filter-accumulator ""))
263	269	(when (string-match "\n\$.*\$\\'" ocamldebug-filter-accumulator)

267	273
268	274	(def-ocamldebug "goto" "\C-g")
269	275	(defun ocamldebug-goto (&optional time)
270
271	276	"Go to the execution time TIME.
272	277
273	278	Without TIME, the command behaves as follows: In the ocamldebug buffer,
274		if the point at buffer end, goto time 0\; otherwise, try to obtain the
	279	if the point at buffer end, goto time 0; otherwise, try to obtain the
275	280	time from context around point. In an OCaml buffer, try to find the
276	281	time associated in execution history with the current point location.
277	282
278	283	With a negative TIME, move that many lines backward in the ocamldebug
279	284	buffer, then try to obtain the time from context around point."
280
281	285	(interactive "P")
282	286	(cond
283	287	(time

286	290	(save-selected-window
287	291	(select-window (get-buffer-window ocamldebug-current-buffer))
288	292	(save-excursion
289		(if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ "
290		nil t (- 1 ntime))
291		(ocamldebug-goto nil)
292		(error "I don't have %d times in my history"
293		(- 1 ntime))))))))
	293	(if (re-search-backward
	294	"^Time : [0-9]+ - pc : [0-9]+\$?::[0-9]+\$? "
	295	nil t (- 1 ntime))
	296	(ocamldebug-goto nil)
	297	(error "I don't have %d times in my history"
	298	(- 1 ntime))))))))
294	299	((eq (current-buffer) ocamldebug-current-buffer)
295		(let ((time (cond
296		((eobp) 0)
297		((save-excursion
298		(beginning-of-line 1)
299		(looking-at "^Time : \$[0-9]+\$ - pc : [0-9]+ "))
300		(string-to-number (match-string 1)))
301		((string-to-number (ocamldebug-format-command "%e"))))))
302		(ocamldebug-call "goto" nil time)))
	300	(let ((time (cond
	301	((eobp) 0)
	302	((save-excursion
	303	(beginning-of-line 1)
	304	(looking-at
	305	"^Time : \$[0-9]+\$ - pc : [0-9]+\$?::[0-9]+\$? "))
	306	(string-to-number (match-string 1)))
	307	((string-to-number (ocamldebug-format-command "%e"))))))
	308	(ocamldebug-call "goto" nil time)))
303	309	(t
304	310	(let ((module (ocamldebug-module-name (buffer-file-name)))
305		(ocamldebug-goto-position (int-to-string (1- (point))))
306		(ocamldebug-goto-output) (address))
307		;get a list of all events in the current module
	311	(ocamldebug-goto-position (int-to-string (1- (point))))
	312	ocamldebug-goto-output address)
	313	;; Get a list of all events in the current module
308	314	(with-current-buffer ocamldebug-current-buffer
309		(let* ((proc (get-buffer-process (current-buffer)))
310		(ocamldebug-filter-function #'ocamldebug-goto-filter))
311		(ocamldebug-call-1 (concat "info events " module))
312		(while (not (and ocamldebug-goto-output
313		(zerop (length ocamldebug-filter-accumulator))))
314		(accept-process-output proc))
315		(setq address (unless (eq ocamldebug-goto-output 'fail)
316		(re-search-backward
317		(concat "^Time : \$[0-9]+\$ - pc : "
318		ocamldebug-goto-output
319		" - module "
320		module "$")
	315	(let* ((proc (get-buffer-process (current-buffer)))
	316	(ocamldebug-filter-function #'ocamldebug-goto-filter))
	317	(ocamldebug-call-1 (concat "info events " module))
	318	(while (not (and ocamldebug-goto-output
	319	(zerop (length ocamldebug-filter-accumulator))))
	320	(accept-process-output proc))
	321	(setq address (unless (eq ocamldebug-goto-output 'fail)
	322	(re-search-backward
	323	(concat "^Time : \$[0-9]+\$ - pc : "
	324	ocamldebug-goto-output
	325	" - module "
	326	module "$")
321	327	nil t)
322		(match-string 1)))))
	328	(match-string 1)))))
323	329	(if address (ocamldebug-call "goto" nil (string-to-number address))
324		(error "No time at %s at %s" module ocamldebug-goto-position))))))
	330	(error "No time at %s at %s" module ocamldebug-goto-position))))))
325	331
326	332
327	333	(defun ocamldebug-delete-filter (string)
328	334	(setq ocamldebug-filter-accumulator
329		(concat ocamldebug-filter-accumulator string))
	335	(concat ocamldebug-filter-accumulator string))
330	336	(when (string-match
331		(concat "\$\n\\\|\\`\$[ \t]\$[0-9]+\$[ \t]+[0-9]+[ \t]in "
	337	;; Num Address Where
	338	;; 1 14552 file u.ml, line 5, characters 1-34
	339	;; 1 0: 30176 file u.ml, line 5, characters 1-34
	340	(concat "\$?:\n\\\|\\`\$[ \t]*\$[0-9]+\$[ \t]+"
	341	"[0-9]+\$?::[ \t]*[0-9]+\$?[ \t]+file +"
332	342	(regexp-quote ocamldebug-delete-file)
333	343	", character "
334	344	ocamldebug-delete-position "\n")
335	345	ocamldebug-filter-accumulator)
336	346	(setq ocamldebug-delete-output
337		(match-string 2 ocamldebug-filter-accumulator))
	347	(match-string 1 ocamldebug-filter-accumulator))
338	348	(setq ocamldebug-filter-accumulator
339		(substring ocamldebug-filter-accumulator (1- (match-end 0)))))
	349	(substring ocamldebug-filter-accumulator (1- (match-end 0)))))
340	350	(when (string-match comint-prompt-regexp
341	351	ocamldebug-filter-accumulator)
342	352	(setq ocamldebug-delete-output (or ocamldebug-delete-output 'fail))
343	353	(setq ocamldebug-filter-accumulator ""))
344	354	(if (string-match "\n\$.*\$\\'" ocamldebug-filter-accumulator)
345	355	(setq ocamldebug-filter-accumulator
346		(match-string 1 ocamldebug-filter-accumulator)))
	356	(match-string 1 ocamldebug-filter-accumulator)))
347	357	"")
348	358
349	359

359	369	With a negative ARG, look for the -ARGth breakpoint pattern in the
360	370	ocamldebug buffer, then try to obtain the breakpoint info from context
361	371	around point."
362
363	372	(interactive "P")
364	373	(cond
365	374	(arg
366	375	(let ((narg (ocamldebug-numeric-arg arg)))
367	376	(if (> narg 0) (ocamldebug-call "delete" nil narg)
368		(with-current-buffer ocamldebug-current-buffer
369		(if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file "
370		nil t (- 1 narg))
371		(ocamldebug-delete nil)
372		(error "I don't have %d breakpoints in my history"
	377	(with-current-buffer ocamldebug-current-buffer
	378	(if (re-search-backward
	379	"^Breakpoint [0-9]+ at [0-9]+\$?::[0-9]+\$? *: file "
	380	nil t (- 1 narg))
	381	(ocamldebug-delete nil)
	382	(error "I don't have %d breakpoints in my history"
373	383	(- 1 narg)))))))
374	384	((eq (current-buffer) ocamldebug-current-buffer)
375		(let* ((bpline "^Breakpoint \$[0-9]+\$ at [0-9]+ : file ")
	385	(let* ((bpline
	386	"^Breakpoint \$[0-9]+\$ at [0-9]+\$?::[0-9]+\$? *: file ")
376	387	(arg (cond
377	388	((eobp)
378	389	(save-excursion (re-search-backward bpline nil t))

390	401	(with-current-buffer ocamldebug-current-buffer
391	402	(let ((proc (get-buffer-process (current-buffer)))
392	403	(ocamldebug-filter-function #'ocamldebug-delete-filter)
393		(ocamldebug-delete-output))
	404	ocamldebug-delete-output)
394	405	(ocamldebug-call-1 "info break")
395	406	(while (not (and ocamldebug-delete-output
396	407	(zerop (length

433	444	(sort (all-completions command-word (nth 2 capf-data))
434	445	#'string-lessp))))
435	446
436		(when (fboundp 'completion-at-point)
437		(make-obsolete 'ocamldebug-complete 'completion-at-point "24.1"))
	447	(make-obsolete 'ocamldebug-complete 'completion-at-point "24.1")
438	448
439	449	(defun ocamldebug-capf ()
440	450	;; FIXME: Use an `end' after point when applicable.

474	484	nil
475	485	ocamldebug-complete-list)))
476	486
477		(define-key tuareg-mode-map "\C-x " 'ocamldebug-break)
	487	(define-key tuareg-mode-map "\C-x " #'ocamldebug-break)
478	488
479	489	(defvar ocamldebug-command-name "ocamldebug"
480	490	"Pathname for executing the OCaml debugger.")

514	524	"-emacs" "-cd" default-directory
515	525	(append (cdr cmdlist) (cons pgm-path args)))
516	526	(set-process-filter (get-buffer-process (current-buffer))
517		'ocamldebug-filter)
	527	#'ocamldebug-filter)
518	528	(set-process-sentinel (get-buffer-process (current-buffer))
519		'ocamldebug-sentinel)
	529	#'ocamldebug-sentinel)
520	530	(ocamldebug-mode)))
521	531	(ocamldebug-set-buffer)))
522	532
523	533	;;;###autoload
524		(defalias 'camldebug 'ocamldebug)
	534	(defalias 'camldebug #'ocamldebug)
525	535
526	536	(defun ocamldebug-set-buffer ()
527	537	(if (eq major-mode 'ocamldebug-mode)

533	543	(defun ocamldebug-marker-filter (string)
534	544	(setq ocamldebug-filter-accumulator
535	545	(concat ocamldebug-filter-accumulator string))
536		(let ((output "") (begin))
	546	(let ((output "") begin)
537	547	;; Process all the complete markers in this chunk.
538	548	(while (setq begin
539	549	(string-match

586	596
587	597	(defun ocamldebug-filter (proc string)
588	598	(when (buffer-name (process-buffer proc))
589		(let ((process-window))
	599	(let (process-window)
590	600	(with-current-buffer (process-buffer proc)
591	601	;; If we have been so requested, delete the debugger prompt.
592	602	(when (marker-buffer ocamldebug-delete-prompt-marker)

659	669	(if (not ocamldebug-last-frame)
660	670	(ocamldebug-remove-current-event)
661	671	(ocamldebug-display-line (nth 0 ocamldebug-last-frame)
662		(nth 3 ocamldebug-last-frame)
663		(nth 4 ocamldebug-last-frame)
664		(nth 2 ocamldebug-last-frame)))
	672	(nth 3 ocamldebug-last-frame)
	673	(nth 4 ocamldebug-last-frame)
	674	(nth 2 ocamldebug-last-frame)))
665	675	(setq ocamldebug-last-frame-displayed-p t))
666	676
667	677	;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen

669	679	;; Put the mark on this character in that buffer.
670	680
671	681	(defun ocamldebug-display-line (true-file schar echar kind)
672		(let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
673		(pop-up-windows t)
	682	(let* ((pop-up-windows t)
674	683	(buffer (find-file-noselect true-file))
675	684	(window (display-buffer buffer t))
676		(spos) (epos) (pos))
	685	spos epos pos)
677	686	(with-current-buffer buffer
678	687	(save-restriction
679	688	(widen)

693	702	;;; Events.
694	703
695	704	(defun ocamldebug-remove-current-event ()
696		(if (and (fboundp 'make-overlay) window-system)
	705	(if window-system
697	706	(progn
698	707	(delete-overlay ocamldebug-overlay-event)
699	708	(delete-overlay ocamldebug-overlay-under))

707	716	(move-overlay ocamldebug-overlay-under
708	717	(+ spos 1) epos buffer))
709	718	(move-overlay ocamldebug-overlay-event (1- epos) epos buffer)
710		(move-overlay ocamldebug-overlay-under spos (- epos 1) buffer))
	719	(move-overlay ocamldebug-overlay-under spos (1- epos) buffer))
711	720	(with-current-buffer buffer
712	721	(goto-char pos)
713	722	(beginning-of-line)

733	742	(cmd (match-string 1 str))
734	743	(end (match-end 0))
735	744	(subst
736		(case key
737		(?m
	745	(pcase key
	746	(`?m
738	747	(ocamldebug-module-name
739	748	(if insource buffer-file-name (nth 0 frame))))
740		(?d
	749	(`?d
741	750	(file-name-directory
742	751	(if insource buffer-file-name (nth 0 frame))))
743		(?c
	752	(`?c
744	753	(int-to-string
745	754	;; FIXME: Should this be (- (point) (point-min))?
746	755	;; What happens with multibyte chars?
747	756	(if insource (1- (point)) (nth 1 frame))))
748		(?e
	757	(`?e
749	758	(save-excursion
750	759	(skip-chars-backward "_0-9A-Za-z\277-\377")
751	760	(looking-at "[_0-9A-Za-z\277-\377]*")

-1288

~~sample.ml~~ less more

0		(* Sample file indented as we want it to be. -- tuareg -- *)
1
2		let server_comments request t =
3		let module M = N in
4		let class M = N in
5		let m M = N in
6		let module M = N in
7		let open Grep.Server in
8		let x = 5 in
9		let modue x y = 5 in
10		let open M in
11
12		t >>= Grep.server_comments
13		lazy
14		parser
15		every
16
17		let qs1 = {\| quoted string \|} (* (issue #24) *)
18		let qs2 = {eof\| other quoted string \|noteof} \|eof}
19
20		(* ocp-indent does it as follows:
21		let test1 = with_connection (fun conn ->
22		do_something conn x;
23		...
24		)
25		toto
26		*)
27		let test1 = with_connection (fun conn ->
28		do_something conn x;
29		...
30		)
31		toto
32
33		let x = match y with (* Issue #71 *)
34		\| A \| B ->
35		do_something ()
36
37		let x = match y, z with
38		\| A, (B \| C)
39		\| X, Y -> do_something() (* Issue #78 *)
40
41		let x =
42		begin match y with
43		\| A -> 1 (* Issue #73 *)
44		end
45
46		(* The two "let"s below are indented under the assumption that
47		tuareg-indent-align-with-first-arg is nil! *)
48		let x = List.map (fun x -> 5)
49		my list
50
51		let x =
52		logf `Info "User %s has %i new messages" ba
53		(Uid.to_string uid)
54		(List.length new_messages)
55
56		let x =
57		let open M in
58		let x = 5 in
59		x + x
60		;;
61
62		(* FIXME: MAJOR "function" sends SMIE into a loop (fine with "fun").
63		Use M-q to test. *)
64		let () =
65		let z = function t -> a in
66		foo z
67
68		let () =
69		foo(function t -> a)
70		;;
71
72		(* FIXME: MAJOR: M-q on the "(" raises 'Scan error: "Unbalanced
73		parentheses"'. It is fine if both () are on the same line. *)
74		let () =
75		begin
76		(begin
77		end)
78		end
79		;;
80
81		;; (* http://caml.inria.fr/mantis/view.php?id=4247 *)
82		let x = {
83		Foo.
84		a = b;
85		c = d;
86		e = {Bar.
87		f = 1;
88		g = 2;
89		};
90		h = { Quux.
91		i = 3;
92		j = 4;
93		};
94		}
95
96		;; (* http://caml.inria.fr/mantis/view.php?id=4249 *)
97		let x = { a = b;
98		c = d;
99		}
100
101		;; (* http://caml.inria.fr/mantis/view.php?id=4255 *)
102		{ foo: [ `Foo of int
103		\| `Bar of string ];
104		}
105
106		let s = { a with
107		b = 1;
108		}
109		;;
110
111		let a = {
112		M.
113		foo = foo;
114		bar = bar;
115		}
116
117		let a = { t with M.
118		foo = foo;
119		bar = bar;
120		}
121
122		let a = { t with
123		M.
124		foo = foo;
125		bar = bar;
126		}
127
128		type t = [ `Foo of int
129		\| `Bar of string ]
130
131		type t =
132		\| A
133		\| B (* issue #76 *)
134		\| C
135		with sexp
136
137		type t = \| A
138		\| B
139		\| C
140
141		type t = [
142		\| `A
143		\| `B
144		\| `C
145		]
146
147		type t = [ (* Comment. *)
148		\| `A
149		\| `B
150		\| `C
151		]
152
153		type t = a
154		and typey = 4
155		and x = b
156
157		module M = struct
158		type t =
159		\| A
160		\| B
161		\| C
162		with sexp
163
164		type s = [
165		\| `A
166		\| `B
167		\| `C
168		]
169
170		type u =
171		\| D
172		\| E
173		with sexp
174		end
175
176		module N =
177		struct
178		type u =
179		\| D
180		\| E
181		with sexp
182		end
183
184		type m =
185		\| T
186		with sexp
187
188		let f = function
189		\| A -> 1
190		\| B \| C -> 2
191
192		;; (* http://caml.inria.fr/mantis/view.php?id=4334 *)
193		type foo =
194		a
195		-> b
196		-> c
197		-> d
198
199		val f :
200		a:a
201		-> b:b
202		-> c:c
203
204		type bar = a -> b
205		-> c -> d
206		-> e -> f
207
208		type baz = a -> b ->
209		c -> d ->
210		e -> f
211
212		val quux : a -> b ->
213		c -> d ->
214		e -> f
215
216		type t : a:b -> c:d
217		-> e:f -> g
218
219		val f : a:b -> c:d
220		-> e:f -> g
221
222		type t = {
223		foo : (a
224		-> b
225		-> c
226		-> d);
227		}
228
229		type t = {
230		foo : ( a ->
231		b ->
232		c ->
233		d);
234		}
235
236		type t = {
237		foo : a
238		-> b
239		-> c
240		-> d;
241		bar :
242		a
243		-> b
244		-> c;
245		}
246
247		type t = {
248		foo : a ->
249		b ->
250		c ->
251		d;
252		bar :
253		a ->
254		b ->
255		c;
256		}
257
258		type t = {
259		a : B.t;
260		c : D.t;
261
262		e : F.t;
263
264		g : H.t I.t;
265		j :
266		K.t L.t;
267		m : N.t O.t;
268		p :
269		((q:R.t
270		-> s:T.U.t
271		-> v:(W.t -> X.t option)
272		-> y:(Z.t -> A.t -> B.t C.D.t E.t)
273		-> f:(G.t -> H.t I.t option)
274		-> j:(K.t -> L.t M.t option)
275		-> n:(O.t -> p option)
276		-> q:R.t
277		-> s:(string -> unit) -> T.t
278		)
279		-> U.t
280		-> V.W.t
281		-> X.t);
282		y : Z.t A.t;
283		b : C.t D.t E.t;
284		f : (G.t -> H.t -> I.t J.t);
285		} with sexp_of
286
287		type 'a v = id:O.t ->
288		ssss:Ssss.t ->
289		dddd:ddd.t ->
290		t:S_m.t ->
291		mmm:Safe_float.t ->
292		qqq:int ->
293		c:C.t ->
294		uuuu:string option ->
295		aaaaaa:Aaaaaa.t ->
296		a:A.t ->
297		rrrrr:Rrrrr.t ->
298		time:Time.t ->
299		typ:[ `L_p of Safe_float.t ] ->
300		bazonk:present option ->
301		o_p_e:O_m.t option ->
302		only_hjkl:present option ->
303		show_junk:int option ->
304		d_p_o: Safe_float.t option ->
305		asdf:present option ->
306		generic:Sexp.t list ->
307		'a
308
309		type 'a v =
310		id:O.t
311		-> ssss:Ssss.t
312		-> dddd:ddd.t
313		-> t:S_m.t
314		-> mmm:Safe_float.t
315		-> qqq:int
316		-> c:C.t
317		-> uuuu:string option
318		-> aaaaaa:Aaaaaa.t
319		-> a:A.t
320		-> rrrrr:Rrrrr.t
321		-> time:Time.t
322		-> typ:[ `L_p of Safe_float.t ]
323		-> bazonk:present option
324		-> o_p_e:O_m.t option
325		-> only_hjkl:present option
326		-> show_junk:int option
327		-> d_p_o: Safe_float.t option
328		-> asdf:present option
329		-> generic:Sexp.t list
330		-> 'a
331
332		;; (* Not in mantis. *)
333		let bar x =
334		if y
335		then x
336		else z
337
338		let zot x =
339		quux ~f:(if x
340		then y
341		else z)
342
343		let zot x = quux ~f:(if x
344		then y
345		else z)
346
347		let () =
348		if foo
349		then bar
350		else if foo1
351		then zot
352		else bazonk
353
354		let () =
355		if foo
356		then bar
357		else
358		if foo1
359		then zot
360		else bazonk
361
362		let _ =
363		if until
364		then _
365
366		let () =
367		if a then (
368		b
369		) else (
370		c
371		)
372
373		let rec count_append l1 l2 count =
374		(* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
375		match l1 with
376		\| [] -> l2
377		\| [x1] -> x1 :: l2
378		\| [x1; x2] -> x1 :: x2 :: l2
379		\| [x1; x2; x3] -> x1 :: x2 :: x3 :: l2
380		\| [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2
381		\| x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
382		x1 :: x2 :: x3 :: x4 :: x5 ::
383		(if count > 1000
384		then slow_append tl l2
385		else count_append tl l2 (count + 1))
386		(* New in OCaml-4.02. *)
387		\| exception Not_Found ->
388		l2
389
390
391		let x =
392		match x with
393		\| Foo of
394		< tag : t; (* FIXME *)
395		md : t;
396		is_me : t;
397		>
398		;;
399
400		let x =
401		match x with
402		\| Foo of
403		<
404		tag : t; (* FIXME *)
405		md : t;
406		is_me : t;
407		>
408		;;
409
410		let foo =
411		(
412		if a
413		then b
414		else c
415		)
416
417		let quux list = List.map list ~f:(fun item ->
418		print_item item
419		)
420
421		let foo x = function
422		\| Some _ -> true
423		\| None -> false
424
425		let bar x = fun u ->
426		match u with
427		\| Some _ -> true
428		\| None -> false
429
430		let zot u = match u with
431		\| Some _ -> true
432		\| None -> false
433
434		let () = match x with
435		Foo -> 1
436		\| Bar -> 2
437
438		let () =
439		match x with
440		Foo -> 1
441		\| Bar -> 2
442
443		let r x =
444		try f x;
445		g x;
446		y x;
447		with e -> raise e
448
449		let g x =
450		try let a = b in
451		f x;
452		g x;
453		y x;
454		with e -> raise e
455
456		let h x =
457		try ff a b
458		c d;
459		gg 1 2
460		3 4;
461		with e -> raise e
462
463		let () =
464		try
465		_
466		with
467		Bar -> ()
468
469		let () =
470		(* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
471		try () with
472		\| e ->
473		let x = z in
474
475		yyyyy
476		(a b)
477
478		let d x = function
479		(* FIXME: Should we leave it like this or align "\|" with "match"?
480		I chose with "match" because it looks otherwise odd and is more
481		consistent with the "try" alignments above. *)
482		\| A -> (match x with
483		\| X ->
484		false
485		\| Y -> true
486		\| Z ->
487		false)
488		\| B -> false
489
490		let a f = function
491		\| A ->
492		1
493		\| B ->
494		2
495		\| C ->
496		(function
497		\| X ->
498		a
499		\| Y ->
500		b) 12
501		\| D ->
502		(match z with
503		\| 4 -> 3
504		\| 5 -> 7)
505
506		let x = foo ~f:(fun _ -> 0 (* Comment. *)
507		)
508
509		let f x =
510		(let y = x in
511		f x;
512		g y;
513		h z)
514
515		let f x =
516		(let y = x in
517		f x);
518		g y;
519		h z
520
521		let g y =
522		a b;
523		c d;
524		e f;
525		(* Comment. *)
526		g h;
527		i j
528
529		let () =
530		(let a = 1 in
531		let b = 2 in
532		( a,
533		b))
534
535		let () =
536		((a b
537		c d e,
538		f g h),
539		( i j
540		k l,
541		m n
542		o p))
543
544		let () =
545		if a
546		then
547		let b = P.s ~b ~a ~m in
548		a +. e *. b,
549		b -. e *. b
550		else
551		q.a -. s *. z,
552		q.b +. s *. z
553
554		let () =
555		(* Comment. *)
556		(let x =
557		3
558		in
559		x + 5)
560
561		let x =
562		let foo = 1 and bar = 2 and zot = 3 in
563		let quux = 4 in
564		foo
565		+ bar
566		+ zot
567		+ quux
568
569		(* Indent comment to following code. *)
570		let () =
571		try (* foo!
572		bar *)
573		let a = f g c d in
574		a b
575		with _ -> ()
576
577		let () = try
578		f x;
579		with _ -> ()
580
581		let () = (try
582		f x;
583		with _ -> ())
584
585		let () =
586		foo (sprintf ("a: %s"
587		^ " b: %s")
588		a
589		b)
590
591		let () =
592		try f a
593		with A () ->
594		()
595		\| B () ->
596		()
597		\| C () ->
598		()
599
600		let f errors input =
601		let ( @@ ) string bool = if not bool then errors := string :: !errors in
602		input @@ false
603
604		let x =
605		if mode = foo then bar;
606		conn
607		>>\| fun x -> x + 1
608		>>\| fun x -> x + 1
609		>>\| fun x -> x + 1
610
611		let () =
612		match _ with
613		\| foo ->
614		bar
615		>>\| function _ ->
616		_
617
618		let () =
619		a
620		>>= fun () ->
621		b
622		>>\| fun () ->
623		Deferred.all
624
625		let x =
626		v
627		>>= fun x -> y
628		>>= fun z -> w
629		>>= fun q -> r
630
631		let x =
632		v 1 2
633		3 4
634		5 6 >>= fun x ->
635		y+1 >>= (* foo! *) fun z ->
636		f 1 2 3
637		4 5 6 >>= fun y ->
638		w*3 >>= fun q -> r
639
640		(* This does not work, see comment in tuareg-compute-arrow-indent.
641		* Workaround: wrap code in parens. *)
642		(* let () =
643		* match
644		* a 1 2 3
645		* 4 5 6 >>= fun a ->
646		* b >>= fun b ->
647		* c
648		* with
649		* \| A -> _ *)
650
651		let () =
652		match
653		let a = a in
654		let b = b in
655		c
656		with
657		\| A -> _
658
659		let () =
660		match
661		(a >>= fun a ->
662		b >>= fun b ->
663		c)
664		with
665		A -> _
666
667		let f t =
668		let (a, b) = to_open in
669		let c = g t a b in
670		()
671
672		let () =
673		begin
674		foo bar
675		end
676		>>= fun () ->
677		begin
678		foo
679		bar
680		end
681		>>= fun () ->
682		()
683
684		let () =
685		(
686		foo bar
687		)
688		>>= fun () ->
689		(
690		foo
691		bar
692		)
693		>>= fun () ->
694		()
695
696		let () =
697		match e with
698		\| `T d ->
699		notify `O `T d;
700		cancel t u ~now
701
702		let () =
703		let a = 1
704		and b = 2
705		and c = 3 in
706		a + b + c
707
708		let _ =
709		foo bar
710		\|\| snoo blue
711
712		let _ =
713		(
714		foo bar
715		\|\| snoo blue
716		)
717
718		let _ =
719		(foo bar
720		\|\| snoo blue)
721
722		let () =
723		Config.load ()
724		>>> fun config ->
725		let quux = config.Config.bazonk.Config.Bazonk.quux in
726		load_quux ~input quux config
727		>>> fun quux ->
728		let da = Poo.Snapshot.merge quux in
729		load_foobar config ~input
730		>>> fun foobar ->
731		whatever foobar
732
733		let () =
734		a
735		>>> fun () ->
736		b
737
738		let () =
739		a
740		>>= function
741		\| b -> c
742		\| d ->
743		e
744		>>= f
745
746		let () =
747		foo >>> fun bar ->
748		baz >>> fun zot ->
749		quux
750
751		let () =
752		Config.load ()
753		>>> fun config ->
754		let quux = x in
755		x
756		>>= fun quux ->
757		x
758
759		let () =
760		Config.load ()
761		>>= fun config ->
762		let quux = x in
763		x
764		>>= fun quux ->
765		x
766
767		let () =
768		Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
769		Clock.at time
770		>>> fun () ->
771		Db.iter t.db ~f:(fun dbo ->
772		if S.mem azot (Dbo.azo dbo) then
773		Dbo.dont dbo))
774
775		let () =
776		f 1
777		\|! (fun x ->
778		g x x)
779		\|! (fun y ->
780		h y y)
781
782		let () =
783		(let a,b = match c with
784		\| D -> e,f
785		\| G -> h,i in
786		let j = a + b in
787		j * j),
788		12
789
790		module type M = M2
791		with type t1 = int
792		and type t2 = int
793		and module S = M3
794		with type t2 = int
795		with type t3 = int
796
797		let () =
798		try
799		match () with
800		\| () -> ()
801		with _ -> ()
802
803		let () =
804		try
805		()
806		with _ -> ()
807
808		let () =
809		( try ()
810		with _ -> ())
811
812		let x =
813		foo ~bar
814		@ snoo
815
816		let x =
817		foo ~bar:snoo
818		@ snoo
819
820		let () =
821		tagL "ol" (List.map ~f:(tag ~a:[] "li") (
822		(List.map results ~f:(fun (what,_) ->
823		tag "a" ~a:[("href","#" ^ what)] (what_title what)))
824		@ [tag "a" ~a:[("href","#" ^ message_id)] message_title;
825		tag "a" ~a:[("href","#" ^ legend_id)] legend_title]))
826		\|> IO.println out
827
828		let x =
829		let y =
830		(a
831		^ b
832		^ c) in
833		f ~a:b ?c:d
834		?e:f ~g:(h i j)
835		~k:(l m)
836		(n o p)
837
838		let () =
839		foobar (fun () ->
840		step1
841		>>= fun () -> step2)
842
843		let w f =
844		List.map f ~f:(fun (a, b) ->
845		L.r a
846		>>= function
847		\| Ok s -> `Fst (b, s)
848		\| Error e -> `Snd (b, a, e))
849
850		class c (a : b) =
851		object
852		inherit d
853		method m = 1
854		end
855
856		let f = {
857		a = 1;
858		}
859
860		let f a = {
861		a = a;
862		}
863
864		let f a
865		b = {
866		a = a;
867		b = b;
868		}
869
870		let () =
871		for i = 10 to 17 do
872		printf "%d" i;
873		done
874
875		let a =
876		B.c d ~e:f [
877		"g";
878		"h";
879		]
880
881		let () =
882		f a ~b:c ~d ~e:g
883		u ~q:[
884		"a";
885		"b";
886		]
887
888		let a = match b with
889		\| Some c -> Some {
890		d = c;
891		e = e
892		}
893		\| None -> {
894		d = c;
895		e = e
896		}
897
898		let a = {
899		b = (
900		let z = f u in
901		z + z;
902		);
903		c = (let a = b in {
904		z = z;
905		y = h;
906		});
907		}
908
909		let () =
910		{ A.
911		b =
912		C.d e ~f:(fun g -> (h.I.j.K.l, m))
913		\|! begin fun n ->
914		match O.p n with
915		\| `Q r -> r
916		\| `S _k -> assert false
917		end;
918		t =
919		u ~v:w
920		~x:(Y.z a);
921		b =
922		c ~d:e
923		~f:(G.h i);
924		j =
925		K.l (fun m -> (N.o p m).R.S.t);
926		u =
927		V.w (fun x -> (Y.x a x).R.S.t);
928		v =
929		V.w (fun d ->
930		(D.g i d).R.S.z);
931		}
932
933		let x =
934		[(W.background `Blue (W.hbox [
935		x
936		]));
937		]
938
939		let c f =
940		if S.is_file f then
941		S.load f C.t
942		\|! fun x -> c := Some x
943		else
944		C.s C.default \|! S.save f
945		\|! fun () -> c := None
946
947		let c f =
948		if S.is_file f then (
949		S.load f C.t
950		\|! fun x -> c := Some x
951		) else (
952		C.s C.default \|! S.save f
953		\|! fun () -> c := None)
954
955		let foo x =
956		f1 x >= f2 x
957		&& f3
958		(f4 x)
959
960		let foo x =
961		(>=)
962		(f1 x) (f2 x)
963		&& f3
964		(f4 x)
965
966		let a =
967		foo
968		(fun () ->
969		a)
970
971		let a =
972		foo
973		~f:(fun () ->
974		a)
975
976		let a =
977		foo
978		(fun () -> a
979		)
980
981		let a =
982		foo
983		~f:(fun () -> a
984		)
985
986		let () =
987		(* Comment. *)
988		bar a b
989		c d;
990		foo ~size
991		(* Comment. *)
992		~min:foo
993		?reduce
994		?override
995		()
996
997		let foo =
998		(* Comment. *)
999		List.map z
1000		~f:(fun m ->
1001		M.q m
1002		\|! T.u ~pr ~verbose:false
1003		~p:H.P.US ~is_bar:false)
1004		\|! List.sort ~cmp:(fun a b ->
1005		compare
1006		(I.r a.T.s)
1007		(I.r b.T.s))
1008
1009		let check =
1010		a lsr 30 >= 3
1011		&& b lsr 20 >= 1
1012		&& c * 10 > f
1013
1014		let () =
1015		snoo ~f:(fun foo ->
1016		foo = bar
1017		&& snoo)
1018
1019		let () =
1020		snoo ~f:(fun foo ->
1021		foo + bar
1022		&& snoo)
1023
1024		let () =
1025		snoo ~f:(fun foo ->
1026		foo
1027		&& snoo)
1028
1029		let variants a =
1030		match String.split a ~on:'-' with
1031		\| [ s1; s2; s3 ] ->
1032		let a0 = String.concat ~sep:"" [ s1; s2] in
1033		let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
1034		List.map [ a0; a1; a]
1035		~f:(fun a_s -> lookup a_s)
1036		\|! List.flatten
1037		\| _ -> failwith "bad"
1038
1039		let f a1 a2 a3
1040		b1 b2 b3 d1 d2 d3 = {
1041		aa = func1 a1 a2 a3;
1042		bb = func2
1043		b1 b2 b3;
1044		(* FIXME: Here it is reasonable to have '\|' aligned with 'match' *)
1045		cc = (match c with
1046		\| A -> 1
1047		\| B -> 2);
1048		dd = func3
1049		d1 d2 d3;
1050		}
1051
1052		let fv =
1053		map3
1054		a
1055		b
1056		c
1057		~f:(fun
1058		x
1059		y
1060		z
1061		->
1062		match x y z with
1063		\| `No)
1064
1065		(* https://forge.ocamlcore.org/tracker/index.php?func=detail&aid=644&group_id=43&atid=255 *)
1066		let b =
1067		match z with
1068		\| 0 -> fun x -> x
1069		\| 1 -> fun x -> 1
1070
1071
1072		module type X =
1073		struct
1074		val f : float -> float
1075		(** This comment should be under "val", like other doc comments and not
1076		aligned to the left margin. *)
1077		end
1078
1079		let test () = (* bug#927 *)
1080		if a then
1081		if b then x
1082		else if c then y
1083		else z
1084		else something
1085
1086		let f x =
1087		if x = 1 then print "hello";
1088		print "there";
1089		print "everywhere"
1090
1091		let f x =
1092		if print "hello"; x = 1 then print "hello";
1093		print "there"
1094
1095		let f x =
1096		if x = 1 then let y = 2 in print "hello";
1097		print "there"
1098		else print "toto"
1099
1100		let f x =
1101		match x with
1102		\| 1 -> let x = 2 in
1103		if x = 1 then print "hello"
1104		\| 2 -> print "there"
1105
1106		let f x =
1107		if x = 1 then match x with
1108		\| 1 -> print "hello"
1109		\| 2 -> print "there"
1110		else print "toto"
1111
1112		let f x =
1113		x + 4 +
1114		x + 5 +
1115		x + 6
1116
1117		let splitting_long_expression =
1118		quad.{band, i3} <- quad.{band, i3} +. g +.
1119		area_12 *. (P.potential x13 y13 +. P.potential x23 y23)
1120
1121		let () =
1122		(* Beware of lexing ".;" as a single token! *)
1123		A.Axes.box vp;
1124		A.fx vp (E.on_ray u0) 0. 2000.;
1125		A.Viewport.set_color vp A.Color.green
1126
1127		let f x =
1128		1
1129		and g y =
1130		2
1131
1132		let x =
1133		let module M =
1134		struct
1135		end
1136		in 0
1137
1138		let x =
1139		try a
1140		with Not_found ->
1141		b
1142		let x =
1143		try a
1144		with Not_found ->
1145		b
1146		\| _ ->
1147		c
1148		let x =
1149		try a
1150		with Not_found ->
1151		if a then b
1152		\| flag when String.is_prefix flag ~prefix:"-" ->
1153		a
1154		\| _ ->
1155		c
1156
1157		let x = "toto try \
1158		tata"
1159
1160		let optional_sci_float =
1161		do_something ~a:1e-7
1162		~b:(fun x -> x + 1)
1163
1164		let () =
1165		f x ~tol:1.0
1166		more arguments;
1167		f x ~tol:1.
1168		more arguments
1169
1170		let array_args =
1171		fold s multi_sms.(0).message_number folder
1172		more_args (* FIXME *)
1173
1174		let () =
1175		match var with
1176		\| <:expr< $lid:f$ >> ->
1177		KO
1178		\| <:expr< $lid:f$ >> when f x ->
1179		KO
1180		\| y when f y ->
1181		OK
1182		\| long_pattern
1183		when f long_pattern -> (* Should be more indented than the clause body *)
1184		z
1185
1186		type t = {
1187		mutable a: float;
1188		b : int;
1189		}
1190
1191		(* [struct] and [sig] must be treated the same way. *)
1192		module Base64 : sig
1193		val f : int -> int
1194		end
1195
1196		external f :
1197		int -> unit (* Treated as [val]. *)
1198		= "f_stub"
1199
1200		let () =
1201		g a.[k]
1202		x (* aligned with [a], despite the dot *)
1203
1204		let () =
1205		g a.[k] 1.0
1206		x (* aligned with [a], despite the dots *)
1207
1208		(* OOP elements (from Marc Simpson <marc AT 0branch DOT com>). *)
1209
1210		class useless = object
1211		val n = 10
1212
1213		method incremented () =
1214		succ n
1215
1216		method add_option = function
1217		\| Some x -> Some(n + x)
1218		\| None -> None
1219		end
1220
1221		class useless' = object(self)
1222		val n = 10
1223
1224		method incremented () =
1225		succ n
1226
1227		method add_option = function
1228		\| Some x -> Some(n + x)
1229		\| None -> None
1230		end
1231
1232		class useless' = object(self)
1233		val n = 10
1234
1235		initializer
1236		print_endline "Initialised."
1237
1238		method incremented () =
1239		succ n
1240
1241		method private add x =
1242		n + x
1243
1244		method add_option = function
1245		\| Some x -> Some(self#add x)
1246		\| None -> None
1247		end
1248
1249		(* Signatures with labeled arguments *)
1250
1251		val f :
1252		x : int ->
1253		int ->
1254		int
1255
1256		val f :
1257		?x: int ->
1258		int ->
1259		int
1260
1261		let subscribe_impl dir topic ~aborted =
1262		return (
1263		match Directory.subscribe dir topic with
1264		\| None -> Error ()
1265		\| Some pipe ->
1266		whenever (aborted >>\| fun () -> Pipe.close_read pipe);
1267		Ok pipe
1268		)
1269		next_argument (* should be indented correctly, given the braces *)
1270
1271
1272		let _ =
1273		List.map
1274		(function x ->
1275		blabla (* FIXME: indentation afer "(function" *)
1276		blabla
1277		blabla)
1278		l
1279
1280		let command =
1281		Command.Spec.(
1282		empty
1283		+> flag "-hello" (optional_with_default "Hello" string)
1284		~doc:" The 'hello' of 'hello world'"
1285		+> flag "-world" (optional_with_default "World" string)
1286		~doc:" The 'world' of 'hello world'"
1287		)

+20

-0

sample_eval.ml less more

	0	(* Test evaluation (C-cC-e). *)
	1
	2	let a = 1 let b = 2 (* Try with cursor on second let *)
	3
	4	let c = 1 (* comment *) let d = 2
	5
	6	let e = 1 + (* cursor → *) 2
	7
	8	let f = 2 (* cursor after the comment → f *)
	9
	10	let g = 1;;
	11	(* Test with cursor on this line → g *)
	12	(* Test with cursor on this line → g *)
	13
	14	let h = 1;;
	15	(* Force new phrase after this comment *);;
	16	(* Evaluating on this line sends an empty phrase (refused) *)
	17
	18
	19	let not_well_braced = (1

+313

-0

sample_highlight.ml less more

	0	type 'a t = Int : int t \| String : string t
	1	let trois : type a . a t -> a = f
	2
	3	type a
	4	type 'a t
	5	type 'al t
	6	type 'al'l t
	7	type +'b u
	8	type ('a, 'b) t
	9	type (+'a, 'b) t
	10	type t =
	11	\| A
	12	type t +=
	13	\| A
	14
	15	type t =
	16	{ first: A.t; (* and *)
	17	second: B.t;
	18	third: C.t }
	19
	20	(* FAIL sprintf (but if one change the line it get well re-highlighted) *)
	21	(* Probably an effect of [let ...] *)
	22	let html_date_of_post p =
	23	match p.date with
	24	\| None -> []
	25	\| Some d ->
	26	let date =
	27	let open Syndic.Date in
	28	let open! Infix in
	29	sprintf "%s %02d, %d" (string_of_month(month d)) (day d) (year d) in
	30	[`Data date]
	31
	32	let (x: t) = expr
	33	let (x:t) = expr
	34	let (x: t list) = exp
	35	let (x:t list) = 1
	36	let x : t = expr
	37	let x, (yyy: t) = 1
	38	let (x, y) = A.f ()
	39	let x, y = A.f ()
	40	let x, y, z = A.f ()
	41	let (x, y), z = A.f ()
	42	let (x: y :> u) = 1
	43
	44	let x as y = 1
	45	let (x,y) as z = (1,2)
	46
	47	let X x = A.f ()
	48	let X(x) = A.f ()
	49	let `X x = A.f ()
	50	let A.X x, A.Y (y:t) = f()
	51	let A.X x, (`Y y:t) = f()
	52	let X(x, y) = A.f ()
	53	let X (x, y) = A.f ()
	54	let A.X(x, y, z) = A.f ()
	55	let A.X x = A.f ()
	56	let x : ('a, 'b) t = A.f ()
	57	let x = (x : X.t)
	58	let x = (val X : X.t)
	59	let m = __MODULE__
	60	let typecheck ast = ast_starts_with_as
	61
	62	let _ = (x :: not_a_type)
	63	let _ = (x : 'a t)
	64	let _ = (x :> t)
	65	let _ = (let x : t = 1 in x) (* not a type *)
	66	let _ = (1 + let x : t = 1 in x)
	67	let _ = (1 + 1 : int)
	68	let _ = (z : Map.t)
	69	let _ = (z x : Map.t)
	70	let _ = (z x : _ Map.t)
	71	let _ = (z x : ('a, int) Map.t)
	72	let _ = {first = x; second = y; third = z}
	73
	74	let () =
	75	printf "(v:t) in strings (expected: %g" n; printf ")"
	76
	77	let x = ref 1
	78	let f x = ignore(x+1)
	79	let f ref c = 1
	80	let f (x, (y, z)) = 1
	81	let (x, (y, z)) = 1
	82	let ((x, y): t) = 1
	83
	84	let f () = 1
	85	let f (type t) x = 1
	86	let f (module M: T) = M.f
	87	let _ = f (module M)
	88	let x = A.b
	89	let z = (compare (x: int) (1 + y: int) : t)
	90	let f x = A.B.c
	91	let f x
	92	y = 3
	93	let f = fun x -> 4
	94	let f = function x -> 1
	95	let f x y z : t = 2
	96	let f (x,y) z : t = 2
	97	let f (x: t) (y: ('a, (a, int)) t) = 2
	98	let f ~x y = 3
	99	let f ~x ?(y=2) = 3
	100	let f (X x) y = 1
	101	let f = fun (x: int) u (y,z) -> 4
	102	let f = fun (x: int) u
	103	(y,z) -> 1
	104	let f (x: int) u
	105	(y,z) = 1
	106	let f = fun ?(x=y-1) z -> 1
	107	let f = fun ?(x=true) z -> 1
	108	let f = fun ?(x=1=1) z -> "two type of '=' in option 'x'"
	109	let f x = fun u v (u,c) ?(u=v-1) ~(e: int) -> 1
	110	let f = fun x u->1
	111	let f u0 ~s:a s = "s: does not introduce a type"
	112	let f u0 ~s:(a,b) s = "s: does not introduce a type"
	113	let f x : ret = body
	114	let f (x) : ret = body
	115	let f ?x:(y = 1) ?(y = (x: t)) = body
	116	let f ?x:(y = 1) ?(y = (x: t)) : ret = body
	117	let f ?x:(y = expr + 1) (y: t) ~z:u : ret = body
	118	let f ?x:(y = (expr + 1)) (y: t) ?z:t : ret = body
	119	let x = call ~l:(fun x -> y = z)
	120	let f {first; second; third} = body
	121	let f ({first; second; third} as all) = body
	122	let f a {first; second; third} b = body
	123	let f a ({first; second; third} as all) b = body
	124	let f a ({first = x; second = y; third} as all) b = body
	125	let f a [x; y; z] u = body
	126	let f (type a) x (type b) y = body
	127	let f (A(x:t), B x, {z = s; p = Q e}) = body
	128	let f' u =
	129	(* function *)
	130	if u.low >= 0. then f'_pos u.low u.high
	131	let f' u =
	132	(* fun *)
	133	if u.low >= 0. then f'_pos u.low u.high
	134	let rec f (A(x:t), B x, {z = s; p = Q e}) = body
	135
	136	(* Labels, type annotations, and operators *)
	137	let _ =
	138	f ~foo:x;
	139	(f ~foo:x);
	140	(f ~foo:x y);
	141	(grault ~garply:(x));
	142	let x = 1 + 3 / 2 in
	143	I.(1 +:2);
	144	I.(1 +: 2);
	145	K.(x \|+ y ?: z);
	146	(expr ~- expr : ty);
	147	(expr ~label : ty)
	148
	149	let andfoo = 1.
	150	let[@x] andfoo = 1.
	151	and+ andfoo = 2
	152	let valfoo = 1
	153
	154	let x = 1 [@@@x rzfhjoi[x]]
	155	let x = 1 [@@x "payload"]
	156	let z = [%%foo let x = 2 in x + 1]
	157	let[@foo] x = 2 in x + 1
	158	let%m[@foo] x = 2 in x + 1
	159	let _ = begin[@foo][@bar x] ... end
	160	module[@foo] M = struct end
	161	type[@foo] t = T
	162	type%foo[@foo] nonrec t = t
	163
	164	let x = first ;%x second
	165	let%xx x = 1
	166	let%xx f x = 1
	167	let%x f x = 1
	168	let%foo x = 2 in x + 1
	169	let x = begin%foo ... end
	170	val%foo f : t -> t
	171	val%foo[@bar] f : t -> t
	172	module%foo Mo = struct end
	173	module%foo type Mo = struct%loo[@bah] end
	174	[%%foo module M = struct end ]
	175	val%foo f : t -> t
	176	let f = fun%foo x -> x + 1
	177	let f = fun%foo[@bar] x -> x + 1
	178	let f = fun[@bar] x -> x + 1
	179	let f = function%foo[@bar] x -> x + 1
	180
	181	let content = [%html{\|<div id="content">some content</div>\|}]
	182	let svgpath = [%svg{\|<path d="M 0 1 L 1 0"></path>\|}]
	183
	184	let my_text =
	185	[%html
	186	{\|This is an <b>HTML</b> formated <i>content</i>.\|}]
	187
	188	let my_span = Html.(span ~a:[a_class ["mytext"]] my_text)
	189	let%html content = {\|<div id="content">some content</div>\|}
	190	let my_head = [%html "<head>" my_title "</head>"]
	191
	192
	193	let x = `failwith (* Constructor, not builtin *)
	194	let y = `Not_found (* Constructor, not builtin *)
	195
	196	(* FIXME: not a type*)
	197	let _ = (Jacobi.jacobi n ~alpha:nu ~beta:nu x)**3.
	198
	199	open A.B
	200	open! A.B
	201	module X = Y
	202	module rec X = struct end
	203	module rec A.B (* path not allowed *)
	204	module type x (* lowercase allowed! *)
	205	(* with type t open! mutable virtual *)
	206	module type X = Y with module Z = A
	207	module type X = Y with module Z.U = A
	208	and module A = B.C
	209	module type X = Y with type t = u
	210	and type u = l
	211	module A = B.C
	212	module A = B.C(String)
	213	module A = B.C(U(V).T)
	214	module A = B.C(U(V))
	215	module A : E = B.C(U(V))
	216	module A : B.C(String).T = A
	217	module F(A : Y) = T
	218	module F(A: X.Y) = T
	219	module F(A : X.t) = T
	220	module F(A : X(Y).T) = T
	221	module F(A : X(Y(Z)).T) = A
	222	module F(A : A1)(B:B1) = Z
	223	module F = functor (A: A1) -> functor(B:B1) -> A.B.f
	224
	225	let module X = F(G) in ()
	226
	227	include Make (* make sure the coloring does not extend on spaces *)
	228	include Make(IO)
	229	include (Make(IO) : module type of Make(IO) with type t := t)
	230
	231	include Make(IO).T (* in a module sig *)
	232
	233	module Make_client
	234	(IO:S.IO with type 'a t = 'a Lwt.t)
	235	(Request:Request with module IO = IO)
	236	(Response:Response with module IO = IO)
	237	(Net:Net with module IO = IO) = struct end
	238
	239	class printable_point x_init =
	240	object (s)
	241	val mutable x = x_init
	242	method get_x = x
	243	method move d = x <- x + d
	244	method print = print_int s#get_x
	245	end;;
	246	class virtual abstract_point x_init =
	247	object (self)
	248	method virtual get_x : int
	249	method get_offset = self#get_x - x_init
	250	method! virtual move : int -> unit
	251	method private virtual x = body
	252	method virtual private y = body
	253	end;;
	254	class ['a] re x_init = object
	255	val mutable x = (x_init : 'a)
	256	method get = x
	257	method set y = x <- y
	258	end;;
	259	class type c2 = object ('a) method m : 'a end;;
	260	class type c2 = object (_) method m : 'a end;;
	261	class type virtual c2 = object ('a) method m : 'a end;;
	262
	263	class xx x y z = object
	264	method x yellow
	265	zero = 1
	266	method virtual x ?(y=1) t = 1
	267	method virtual private x (y:t) z = 1
	268	method private x y z = body
	269	method private x y z : t = body
	270	method private virtual x y z
	271	method x private x = 1
	272	end
	273
	274	val x
	275	val! x
	276	val mutable x
	277	val mutable virtual x
	278	val virtual x
	279	val virtual mutable x
	280	val mutable
	281	val f : int -> 'a t
	282	class virtual x = object
	283	method virtual x : int -> float
	284	end;;
	285	class x = object
	286	method virtual x : int -> float
	287	end;;
	288	class ['a] x ~ne (z: y) = object
	289	method virtual x : int -> float
	290	end;;
	291	object(self) end;;
	292	object (self) end;;
	293	object(self : ('a) t) end;;
	294	object (self : ('a, 'b) t) end;;
	295
	296	external f
	297
	298	let x = if x then y else z
	299
	300	exception E of string
	301	let _ = failwithf {\| message \|}
	302
	303	let z = .< x + 1 .>
	304	;;
	305
	306	module type T = sig
	307	val f : t -> t -> t
	308	end
	309	;;
	310	(* Local Variables: *)
	311	(* End: *)
	312	(* tuareg-support-metaocaml: t *)

+426

-0

tuareg-compat.el less more

	0	;;; tuareg-compat.el -- lexical-binding:t --
	1
	2	;; FIX: make sure `comment-region' supports `comment-continue' made
	3	;; only of spaces (and in a consistent fashion even for older Emacs).
	4
	5	(require 'newcomment)
	6
	7	;; Emacs < 26
	8	(defun tuareg--comment-padright--advice (orig-fun &rest args)
	9	(let ((str (nth 0 args)))
	10	(unless (and (eq major-mode 'tuareg-mode)
	11	(stringp str) (not (string-match "\\S-" str)))
	12	(apply orig-fun args))))
	13
	14	(when (and (< emacs-major-version 26) (fboundp 'comment-region-default))
	15	(advice-add 'comment-padright :around #'tuareg--comment-padright--advice))
	16
	17	;; Emacs < 27
	18	(defun tuareg--comment-region-default (beg end &optional arg)
	19	(let* ((numarg (prefix-numeric-value arg))
	20	(style (cdr (assoc comment-style comment-styles)))
	21	(lines (nth 2 style))
	22	(block (nth 1 style))
	23	(multi (nth 0 style)))
	24
	25	;; We use `chars' instead of `syntax' because `\n' might be
	26	;; of end-comment syntax rather than of whitespace syntax.
	27	;; sanitize BEG and END
	28	(goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
	29	(setq beg (max beg (point)))
	30	(goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
	31	(setq end (min end (point)))
	32	(if (>= beg end) (error "Nothing to comment"))
	33
	34	;; sanitize LINES
	35	(setq lines
	36	(and
	37	lines ;; multi
	38	(progn (goto-char beg) (beginning-of-line)
	39	(skip-syntax-forward " ")
	40	(>= (point) beg))
	41	(progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
	42	(<= (point) end))
	43	(or block (not (string= "" comment-end)))
	44	(or block (progn (goto-char beg) (re-search-forward "$" end t)))))
	45
	46	;; don't add end-markers just because the user asked for `block'
	47	(unless (or lines (string= "" comment-end)) (setq block nil))
	48
	49	(cond
	50	((consp arg) (uncomment-region beg end))
	51	((< numarg 0) (uncomment-region beg end (- numarg)))
	52	(t
	53	(let ((multi-char (/= (string-match "[ \t]*\\'" comment-start) 1))
	54	indent triple)
	55	(if (eq (nth 3 style) 'multi-char)
	56	(save-excursion
	57	(goto-char beg)
	58	(setq indent multi-char
	59	;; Triple if we will put the comment starter at the margin
	60	;; and the first line of the region isn't indented
	61	;; at least two spaces.
	62	triple (and (not multi-char) (looking-at "\t\\\| "))))
	63	(setq indent (nth 3 style)))
	64
	65	;; In Lisp and similar modes with one-character comment starters,
	66	;; double it by default if `comment-add' says so.
	67	;; If it isn't indented, triple it.
	68	(if (and (null arg) (not multi-char))
	69	(setq numarg (* comment-add (if triple 2 1)))
	70	(setq numarg (1- (prefix-numeric-value arg))))
	71
	72	(comment-region-internal
	73	beg end
	74	(let ((s (comment-padright comment-start numarg)))
	75	(if (string-match comment-start-skip s) s
	76	(comment-padright comment-start)))
	77	(let ((s (comment-padleft comment-end numarg)))
	78	(and s (if (string-match comment-end-skip s) s
	79	(comment-padright comment-end))))
	80	(if multi (or (comment-padright comment-continue numarg)
	81	(and (stringp comment-continue) comment-continue)))
	82	(if multi
	83	(comment-padleft (comment-string-reverse comment-continue) numarg))
	84	block
	85	lines
	86	indent))))))
	87
	88	(defun tuareg--comment-region-default--advice (orig-fun &rest args)
	89	(apply (if (eq major-mode 'tuareg-mode)
	90	'tuareg--comment-region-default
	91	orig-fun)
	92	args))
	93
	94	(when (and (< emacs-major-version 27) (fboundp 'comment-region-default))
	95	(advice-add 'comment-region-default :around
	96	#'tuareg--comment-region-default--advice))
	97
	98
	99	;; Emacs 27
	100	(defun tuareg--comment-region-default-1 (beg end &optional arg noadjust)
	101	"Comment region between BEG and END.
	102	See `comment-region' for ARG. If NOADJUST, do not skip past
	103	leading/trailing space when determining the region to comment
	104	out."
	105	(let* ((numarg (prefix-numeric-value arg))
	106	(style (cdr (assoc comment-style comment-styles)))
	107	(lines (nth 2 style))
	108	(block (nth 1 style))
	109	(multi (nth 0 style)))
	110
	111	(if noadjust
	112	(when (bolp)
	113	(setq end (1- end)))
	114	;; We use `chars' instead of `syntax' because `\n' might be
	115	;; of end-comment syntax rather than of whitespace syntax.
	116	;; sanitize BEG and END
	117	(goto-char beg)
	118	(skip-chars-forward " \t\n\r")
	119	(beginning-of-line)
	120	(setq beg (max beg (point)))
	121	(goto-char end)
	122	(skip-chars-backward " \t\n\r")
	123	(end-of-line)
	124	(setq end (min end (point)))
	125	(when (>= beg end)
	126	(error "Nothing to comment")))
	127
	128	;; sanitize LINES
	129	(setq lines
	130	(and
	131	lines ;; multi
	132	(progn (goto-char beg) (beginning-of-line)
	133	(skip-syntax-forward " ")
	134	(>= (point) beg))
	135	(progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
	136	(<= (point) end))
	137	(or block (not (string= "" comment-end)))
	138	(or block (progn (goto-char beg) (re-search-forward "$" end t)))))
	139
	140	;; don't add end-markers just because the user asked for `block'
	141	(unless (or lines (string= "" comment-end)) (setq block nil))
	142
	143	(cond
	144	((consp arg) (uncomment-region beg end))
	145	((< numarg 0) (uncomment-region beg end (- numarg)))
	146	(t
	147	(let ((multi-char (/= (string-match "[ \t]*\\'" comment-start) 1))
	148	indent triple)
	149	(if (eq (nth 3 style) 'multi-char)
	150	(save-excursion
	151	(goto-char beg)
	152	(setq indent multi-char
	153	;; Triple if we will put the comment starter at the margin
	154	;; and the first line of the region isn't indented
	155	;; at least two spaces.
	156	triple (and (not multi-char) (looking-at "\t\\\| "))))
	157	(setq indent (nth 3 style)))
	158
	159	;; In Lisp and similar modes with one-character comment starters,
	160	;; double it by default if `comment-add' says so.
	161	;; If it isn't indented, triple it.
	162	(if (and (null arg) (not multi-char))
	163	(setq numarg (* comment-add (if triple 2 1)))
	164	(setq numarg (1- (prefix-numeric-value arg))))
	165
	166	(comment-region-internal
	167	beg end
	168	(let ((s (comment-padright comment-start numarg)))
	169	(if (string-match comment-start-skip s) s
	170	(comment-padright comment-start)))
	171	(let ((s (comment-padleft comment-end numarg)))
	172	(and s (if (string-match comment-end-skip s) s
	173	(comment-padright comment-end))))
	174	(if multi
	175	(or (comment-padright comment-continue numarg)
	176	;; `comment-padright' returns nil when
	177	;; `comment-continue' contains only whitespace
	178	(and (stringp comment-continue) comment-continue)))
	179	(if multi
	180	(comment-padleft (comment-string-reverse comment-continue) numarg))
	181	block
	182	lines
	183	indent))))))
	184
	185	(defun tuareg--comment-region-default-1--advice (orig-fun &rest args)
	186	(apply (if (eq major-mode 'tuareg-mode)
	187	'tuareg--comment-region-default-1
	188	orig-fun)
	189	args))
	190
	191	(when (and (= emacs-major-version 27) (fboundp 'comment-region-default-1))
	192	(advice-add 'comment-region-default-1 :around
	193	#'tuareg--comment-region-default-1--advice))
	194
	195	;; FIX: uncommenting
	196
	197	;; Emacs < 27
	198	(defun tuareg--uncomment-region-default (beg end &optional arg)
	199	"Uncomment each line in the BEG .. END region.
	200	The numeric prefix ARG can specify a number of chars to remove from the
	201	comment delimiters.
	202	This function is the default value of `uncomment-region-function'."
	203	(goto-char beg)
	204	(setq end (copy-marker end))
	205	(let* ((numarg (prefix-numeric-value arg))
	206	(ccs comment-continue)
	207	(srei (or (comment-padright ccs 're)
	208	(and (stringp comment-continue) comment-continue)))
	209	(csre (comment-padright comment-start 're))
	210	(sre (and srei (concat "^\\s-*?\$" srei "\$")))
	211	spt)
	212	(while (and (< (point) end)
	213	(setq spt (comment-search-forward end t)))
	214	(let ((ipt (point))
	215	;; Find the end of the comment.
	216	(ept (progn
	217	(goto-char spt)
	218	(unless (or (comment-forward)
	219	;; Allow non-terminated comments.
	220	(eobp))
	221	(error "Can't find the comment end"))
	222	(point)))
	223	(box nil)
	224	(box-equal nil)) ;Whether we might be using `=' for boxes.
	225	(save-restriction
	226	(narrow-to-region spt ept)
	227
	228	;; Remove the comment-start.
	229	(goto-char ipt)
	230	(skip-syntax-backward " ")
	231	;; A box-comment starts with a looong comment-start marker.
	232	(when (and (or (and (= (- (point) (point-min)) 1)
	233	(setq box-equal t)
	234	(looking-at "=\\{7\\}")
	235	(not (eq (char-before (point-max)) ?\n))
	236	(skip-chars-forward "="))
	237	(> (- (point) (point-min) (length comment-start)) 7))
	238	(> (count-lines (point-min) (point-max)) 2))
	239	(setq box t))
	240	;; Skip the padding. Padding can come from comment-padding and/or
	241	;; from comment-start, so we first check comment-start.
	242	(if (or (save-excursion (goto-char (point-min)) (looking-at csre))
	243	(looking-at (regexp-quote comment-padding)))
	244	(goto-char (match-end 0)))
	245	(when (and sre (looking-at (concat "\\s-\n\\s-" srei)))
	246	(goto-char (match-end 0)))
	247	(if (null arg) (delete-region (point-min) (point))
	248	(let ((opoint (point-marker)))
	249	(skip-syntax-backward " ")
	250	(delete-char (- numarg))
	251	(unless (and (not (bobp))
	252	(save-excursion (goto-char (point-min))
	253	(looking-at comment-start-skip)))
	254	;; If there's something left but it doesn't look like
	255	;; a comment-start any more, just remove it.
	256	(delete-region (point-min) opoint))))
	257
	258	;; Remove the end-comment (and leading padding and such).
	259	(goto-char (point-max)) (comment-enter-backward)
	260	;; Check for special `=' used sometimes in comment-box.
	261	(when (and box-equal (not (eq (char-before (point-max)) ?\n)))
	262	(let ((pos (point)))
	263	;; skip `=' but only if there are at least 7.
	264	(when (> (skip-chars-backward "=") -7) (goto-char pos))))
	265	(unless (looking-at "\$\n\\\|\\s-\$*\\'")
	266	(when (and (bolp) (not (bobp))) (backward-char))
	267	(if (null arg) (delete-region (point) (point-max))
	268	(skip-syntax-forward " ")
	269	(delete-char numarg)
	270	(unless (or (eobp) (looking-at comment-end-skip))
	271	;; If there's something left but it doesn't look like
	272	;; a comment-end any more, just remove it.
	273	(delete-region (point) (point-max)))))
	274
	275	;; Unquote any nested end-comment.
	276	(comment-quote-nested comment-start comment-end t)
	277
	278	;; Eliminate continuation markers as well.
	279	(when sre
	280	(let* ((cce (comment-string-reverse (or comment-continue
	281	comment-start)))
	282	(erei (and box (comment-padleft cce 're)))
	283	(ere (and erei (concat "\$" erei "\$\\s-*$"))))
	284	(goto-char (point-min))
	285	(while (progn
	286	(if (and ere (re-search-forward
	287	ere (line-end-position) t))
	288	(replace-match "" t t nil (if (match-end 2) 2 1))
	289	(setq ere nil))
	290	(forward-line 1)
	291	(re-search-forward sre (line-end-position) t))
	292	(replace-match "" t t nil (if (match-end 2) 2 1)))))
	293	;; Go to the end for the next comment.
	294	(goto-char (point-max))))))
	295	(set-marker end nil))
	296
	297	(defun tuareg--uncomment-region-default--advice (orig-fun &rest args)
	298	(apply (if (eq major-mode 'tuareg-mode)
	299	'tuareg--uncomment-region-default
	300	orig-fun)
	301	args))
	302
	303	(when (and (< emacs-major-version 27) (fboundp 'uncomment-region-default))
	304	(advice-add 'uncomment-region-default :around
	305	#'tuareg--uncomment-region-default--advice))
	306
	307	;; Emacs 27
	308	(defun tuareg--uncomment-region-default-1 (beg end &optional arg)
	309	"Uncomment each line in the BEG .. END region.
	310	The numeric prefix ARG can specify a number of chars to remove from the
	311	comment delimiters.
	312	This function is the default value of `uncomment-region-function'."
	313	(goto-char beg)
	314	(setq end (copy-marker end))
	315	(let* ((numarg (prefix-numeric-value arg))
	316	(ccs comment-continue)
	317	(srei (or (comment-padright ccs 're)
	318	(and (stringp comment-continue) comment-continue)))
	319	(csre (comment-padright comment-start 're))
	320	(sre (and srei (concat "^\\s-*?\$" srei "\$")))
	321	spt)
	322	(while (and (< (point) end)
	323	(setq spt (comment-search-forward end t)))
	324	(let ((ipt (point))
	325	;; Find the end of the comment.
	326	(ept (progn
	327	(goto-char spt)
	328	(unless (or (comment-forward)
	329	;; Allow non-terminated comments.
	330	(eobp))
	331	(error "Can't find the comment end"))
	332	(point)))
	333	(box nil)
	334	(box-equal nil)) ;Whether we might be using `=' for boxes.
	335	(save-restriction
	336	(narrow-to-region spt ept)
	337
	338	;; Remove the comment-start.
	339	(goto-char ipt)
	340	(skip-syntax-backward " ")
	341	;; A box-comment starts with a looong comment-start marker.
	342	(when (and (or (and (= (- (point) (point-min)) 1)
	343	(setq box-equal t)
	344	(looking-at "=\\{7\\}")
	345	(not (eq (char-before (point-max)) ?\n))
	346	(skip-chars-forward "="))
	347	(> (- (point) (point-min) (length comment-start)) 7))
	348	(> (count-lines (point-min) (point-max)) 2))
	349	(setq box t))
	350	;; Skip the padding. Padding can come from comment-padding and/or
	351	;; from comment-start, so we first check comment-start.
	352	(if (or (save-excursion (goto-char (point-min)) (looking-at csre))
	353	(looking-at (regexp-quote comment-padding)))
	354	(goto-char (match-end 0)))
	355	(when (and sre (looking-at (concat "\\s-\n\\s-" srei)))
	356	(goto-char (match-end 0)))
	357	(if (null arg) (delete-region (point-min) (point))
	358	(let ((opoint (point-marker)))
	359	(skip-syntax-backward " ")
	360	(delete-char (- numarg))
	361	(unless (and (not (bobp))
	362	(save-excursion (goto-char (point-min))
	363	(looking-at comment-start-skip)))
	364	;; If there's something left but it doesn't look like
	365	;; a comment-start any more, just remove it.
	366	(delete-region (point-min) opoint))))
	367
	368	;; Remove the end-comment (and leading padding and such).
	369	(goto-char (point-max)) (comment-enter-backward)
	370	;; Check for special `=' used sometimes in comment-box.
	371	(when (and box-equal (not (eq (char-before (point-max)) ?\n)))
	372	(let ((pos (point)))
	373	;; skip `=' but only if there are at least 7.
	374	(when (> (skip-chars-backward "=") -7) (goto-char pos))))
	375	(unless (looking-at "\$\n\\\|\\s-\$*\\'")
	376	(when (and (bolp) (not (bobp))) (backward-char))
	377	(if (null arg) (delete-region (point) (point-max))
	378	(skip-syntax-forward " ")
	379	(delete-char numarg)
	380	(unless (or (eobp) (looking-at comment-end-skip))
	381	;; If there's something left but it doesn't look like
	382	;; a comment-end any more, just remove it.
	383	(delete-region (point) (point-max)))))
	384
	385	;; Unquote any nested end-comment.
	386	(comment-quote-nested comment-start comment-end t)
	387
	388	;; Eliminate continuation markers as well.
	389	(when sre
	390	(let* ((cce (comment-string-reverse (or comment-continue
	391	comment-start)))
	392	(erei (and box (comment-padleft cce 're)))
	393	(ere (and erei (concat "\$" erei "\$\\s-*$"))))
	394	(goto-char (point-min))
	395	(while (progn
	396	(if (and ere (re-search-forward
	397	ere (line-end-position) t))
	398	(replace-match "" t t nil (if (match-end 2) 2 1))
	399	(setq ere nil))
	400	(forward-line 1)
	401	(re-search-forward sre (line-end-position) t))
	402	(replace-match "" t t nil (if (match-end 2) 2 1)))))
	403	;; Go to the end for the next comment.
	404	(goto-char (point-max)))
	405	;; Remove any obtrusive spaces left preceding a tab at `spt'.
	406	(when (and (eq (char-after spt) ?\t) (eq (char-before spt) ? )
	407	(> tab-width 0))
	408	(save-excursion
	409	(goto-char spt)
	410	(let* ((fcol (current-column))
	411	(slim (- (point) (mod fcol tab-width))))
	412	(delete-char (- (skip-chars-backward " " slim)))))))))
	413	(set-marker end nil))
	414
	415	(defun tuareg--uncomment-region-default-1--advice (orig-fun &rest args)
	416	(apply (if (eq major-mode 'tuareg-mode)
	417	'tuareg--uncomment-region-default-1
	418	orig-fun)
	419	args))
	420
	421	(when (and (<= emacs-major-version 28) (fboundp 'uncomment-region-default-1))
	422	(advice-add 'uncomment-region-default-1 :around
	423	#'tuareg--uncomment-region-default-1--advice))
	424
	425	(provide 'tuareg-compat)

-508

~~tuareg-jbuild.el~~ less more

0		;;; tuareg-jbuild.el --- Mode for editing jbuild files -- coding: utf-8 --
1
2		;; Copyright (C) 2017- Christophe Troestler
3
4		;; This file is not part of GNU Emacs.
5
6		;; Permission to use, copy, modify, and distribute this software for
7		;; any purpose with or without fee is hereby granted, provided that
8		;; the above copyright notice and this permission notice appear in
9		;; all copies.
10		;;
11		;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
12		;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
13		;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
14		;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
15		;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
16		;; LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
17		;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
18		;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
19
20		(require 'scheme)
21
22		(defvar tuareg-jbuild-mode-hook nil
23		"Hooks for the `tuareg-jbuild-mode'.")
24
25		(defvar tuareg-jbuild-flymake nil
26		"If t, check your jbuild file with flymake.")
27
28		(defvar tuareg-jbuild-temporary-file-directory
29		(expand-file-name "Tuareg-jbuild" temporary-file-directory)
30		"Directory where to duplicate the files for flymake.")
31
32		(defvar tuareg-jbuild-program
33		(expand-file-name "jbuild-lint" tuareg-jbuild-temporary-file-directory)
34		"Script to use to check the jbuild file.")
35
36		(defgroup tuareg-jbuild nil
37		"Support for Jbuilder files."
38		:group 'languages)
39
40		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41		;;;; Syntax highlighting
42
43		(defface tuareg-jbuild-error-face
44		'((t (:foreground "yellow" :background "red" :bold t)))
45		"Face for errors (e.g. obsolete constructs).")
46
47		(defvar tuareg-jbuild-error-face 'tuareg-jbuild-error-face
48		"Face for errors (e.g. obsolete constructs).")
49
50		(defconst tuareg-jbuild-keywords-regex
51		(eval-when-compile
52		(concat (regexp-opt
53		'("jbuild_version" "library" "executable" "executables" "rule"
54		"ocamllex" "ocamlyacc" "menhir" "alias" "install"
55		"copy_files" "copy_files#" "include"
56		"documentation")
57		) "\$?:\\_>\\\|[[:space:]]\$"))
58		"Keywords in jbuild files.")
59
60		(defconst tuareg-jbuild-fields-regex
61		(eval-when-compile
62		(regexp-opt
63		'("name" "public_name" "synopsis" "modules" "libraries" "wrapped"
64		"inline_tests" "inline_tests.backend"
65		"preprocess" "preprocessor_deps" "optional" "c_names" "cxx_names"
66		"install_c_headers" "modes" "no_dynlink" "kind"
67		"ppx_runtime_libraries" "virtual_deps" "js_of_ocaml" "flags"
68		"ocamlc_flags" "ocamlopt_flags" "library_flags" "c_flags"
69		"cxx_flags" "c_library_flags" "self_build_stubs_archive"
70		"modules_without_implementation"
71		;; + for "executable" and "executables":
72		"package" "link_flags" "modes" "names" "public_names"
73		;; + for "rule":
74		"targets" "action" "deps" "mode"
75		;; + for "menhir":
76		"merge_into"
77		;; + for "install"
78		"section" "files" "lib" "libexec" "bin" "sbin" "toplevel" "share"
79		"share_root" "etc" "doc" "stublibs" "man" "misc"
80		;; for "documentation":
81		"mld_files")
82		'symbols))
83		"Field names allowed in jbuild files.")
84
85		(defvar tuareg-jbuild-builtin-regex
86		(eval-when-compile
87		(concat (regexp-opt
88		'(;; Actions
89		"run" "chdir" "setenv"
90		"with-stdout-to" "with-stderr-to" "with-outputs-to"
91		"ignore-stdout" "ignore-stderr" "ignore-outputs"
92		"progn" "echo" "write-file" "cat" "copy" "copy#" "system"
93		"bash" "diff" "diff?"
94		;; inline_tests and inline_tests.backend
95		;; FIXME: "flags" is already a field and we do not have enough
96		;; context to distinguishing both.
97		"backend" "generate_runner" "runner_libraries" "flags"
98		"extends"
99		;; Dependency specification
100		"file" "alias" "alias_rec" "glob_files" "files_recursively_in"
101		"universe" "package")
102		t)
103		"\$?:\\_>\\\|[[:space:]]\$"))
104		"Builtin sub-fields in jbuild")
105
106		(defvar tuareg-jbuild-var-kind-regex
107		(eval-when-compile
108		(regexp-opt
109		'("path" "path-no-dep" "exe" "bin" "lib" "libexec" "lib-available"
110		"version" "read" "read-lines" "read-strings")
111		'words))
112		"Optional prefix to variable names.")
113
114		(defvar tuareg-jbuild-var-regex
115		(concat "\$!?\$\\(\\(?:" tuareg-jbuild-var-kind-regex
116		":\\)?\\)\$[a-zA-Z][a-zA-Z0-9_.-]*\\\|[<@^]\$"
117		"\$\\(?::[a-zA-Z][a-zA-Z0-9_.-]*\$?\\)"))
118
119		(defmacro tuareg-jbuild--field-vals (field &rest vals)
120		`(list (concat "(" ,field "[[:space:]]+" ,(regexp-opt vals t))
121		1 font-lock-constant-face))
122
123		(defvar tuareg-jbuild-font-lock-keywords
124		`((,tuareg-jbuild-keywords-regex . font-lock-keyword-face)
125		(,(concat "(" tuareg-jbuild-fields-regex) 1 font-lock-function-name-face)
126		("\$true\\\|false\$" 1 font-lock-constant-face)
127		("(\$select\$[[:space:]]+[^[:space:]]+[[:space:]]+\$from\$\\>"
128		(1 font-lock-constant-face)
129		(2 font-lock-constant-face))
130		,(eval-when-compile
131		(tuareg-jbuild--field-vals "kind" "normal" "ppx_rewriter" "ppx_deriver"))
132		,(eval-when-compile
133		(tuareg-jbuild--field-vals "mode" "standard" "fallback" "promote"
134		"promote-until-clean"))
135		(,(concat "(" tuareg-jbuild-builtin-regex) 1 font-lock-builtin-face)
136		("(preprocess[[:space:]]+(\$pps\$" 1 font-lock-builtin-face)
137		(,(eval-when-compile
138		(concat "(" (regexp-opt '("fallback") t)))
139		1 tuareg-jbuild-error-face)
140		(,(concat "${" tuareg-jbuild-var-regex "}")
141		(1 tuareg-jbuild-error-face)
142		(2 font-lock-builtin-face)
143		(4 font-lock-variable-name-face)
144		(5 font-lock-variable-name-face))
145		(,(concat "$(" tuareg-jbuild-var-regex ")")
146		(1 tuareg-jbuild-error-face)
147		(2 font-lock-builtin-face)
148		(4 font-lock-variable-name-face)
149		(5 font-lock-variable-name-face))
150		("\$:[a-zA-Z]+\$\\b" 1 font-lock-builtin-face)))
151
152		(defvar tuareg-jbuild-mode-syntax-table
153		(let ((table (make-syntax-table)))
154		(modify-syntax-entry ?\; "< b" table)
155		(modify-syntax-entry ?\n "> b" table)
156		(modify-syntax-entry ?\( "()" table)
157		(modify-syntax-entry ?\) ")(" table)
158		(modify-syntax-entry ?\{ "(}" table)
159		(modify-syntax-entry ?\} "){" table)
160		(modify-syntax-entry ?\[ "(]" table)
161		(modify-syntax-entry ?\] ")[" table)
162		table)
163		"Tuareg-jbuild syntax table.")
164
165		;; (defun tuareg-jbuild-syntax-propertize (start end)
166		;; (funcall
167		;; (syntax-propertize-rules))
168		;; )
169
170		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
171		;;;; SMIE
172
173		(require 'smie)
174
175		(defvar tuareg-jbuild-smie-grammar
176		(when (fboundp 'smie-prec2->grammar)
177		(smie-prec2->grammar
178		(smie-bnf->prec2 '()))))
179
180		(defun tuareg-jbuild-smie-rules (kind token)
181		(cond
182		((eq kind :close-all) '(column . 0))
183		((and (eq kind :after) (equal token ")"))
184		(save-excursion
185		(goto-char (cadr (smie-indent--parent)))
186		(if (looking-at-p tuareg-jbuild-keywords-regex)
187		'(column . 0)
188		1)))
189		((eq kind :before)
190		(if (smie-rule-parent-p "(")
191		(save-excursion
192		(goto-char (cadr (smie-indent--parent)))
193		(cond
194		((looking-at-p tuareg-jbuild-keywords-regex) 1)
195		((looking-at-p tuareg-jbuild-fields-regex)
196		(smie-rule-parent 0))
197		((smie-rule-sibling-p) (cons 'column (current-column)))
198		(t (cons 'column (current-column)))))
199		'(column . 0)))
200		(t 1)))
201
202		(defun verbose-tuareg-jbuild-smie-rules (kind token)
203		(let ((value (tuareg-jbuild-smie-rules kind token)))
204		(message
205		"%s '%s'; sibling-p:%s parent:%s hanging:%s = %s"
206		kind token
207		(ignore-errors (smie-rule-sibling-p))
208		(ignore-errors smie--parent)
209		(ignore-errors (smie-rule-hanging-p))
210		value)
211		value))
212
213
214		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
215		;;;; Linting
216
217		(require 'flymake)
218
219		(defun tuareg-jbuild-create-lint-script ()
220		"Create the lint script if it does not exist. This is nedded as long as See https://github.com/ocaml/dune/issues/241 is not fixed."
221		(unless (file-exists-p tuareg-jbuild-program)
222		(let ((dir (file-name-directory tuareg-jbuild-program))
223		(pgm "#!/usr/bin/env ocaml
224		;;
225		#load \"unix.cma\";;
226		#load \"str.cma\";;
227
228		open Printf
229
230		let filename = Sys.argv.(1)
231		let root = try Some(Sys.argv.(2)) with _ -> None
232
233		let read_all fh =
234		let buf = Buffer.create 1024 in
235		let b = Bytes.create 1024 in
236		let len = ref 0 in
237		while len := input fh b 0 1024; !len > 0 do
238		Buffer.add_subbytes buf b 0 !len
239		done;
240		Buffer.contents buf
241
242		let errors =
243		let root = match root with
244		\| None \| Some \"\" -> \"\"
245		\| Some r -> \"--root=\" ^ Filename.quote r in
246		let cmd = sprintf \"jbuilder external-lib-deps %s %s\" root
247		(Filename.quote (Filename.basename filename)) in
248		let env = Unix.environment() in
249		let (_,_,fh) as p = Unix.open_process_full cmd env in
250		let out = read_all fh in
251		match Unix.close_process_full p with
252		\| Unix.WEXITED (0\|1) ->
253		(* jbuilder will normally exit with 1 as it will not be able to
254		perform the requested action. *)
255		out
256		\| Unix.WEXITED 127 -> printf \"jbuilder not found in path.\\n\"; exit 1
257		\| Unix.WEXITED n -> printf \"jbuilder exited with status %d.\\n\" n; exit 1
258		\| Unix.WSIGNALED n -> printf \"jbuilder was killed by signal %d.\\n\" n;
259		exit 1
260		\| Unix.WSTOPPED n -> printf \"jbuilder was stopped by signal %d\\n.\" n;
261		exit 1
262
263
264		let () =
265		let re = \"\\\$:?\\\$[\\r\\n]+\\\$[a-zA-Z]+\\\$\" in
266		let errors = Str.global_substitute (Str.regexp re)
267		(fun s -> let colon = Str.matched_group 1 s = \":\" in
268		let f = Str.matched_group 2 s in
269		if f = \"File\" then \"\\n File\"
270		else if colon then \": \" ^ f
271		else \", \" ^ f)
272		errors in
273		print_string errors"))
274		(make-directory dir t)
275		(append-to-file pgm nil tuareg-jbuild-program)
276		(set-file-modes tuareg-jbuild-program #o777)
277		)))
278
279		(defun tuareg-jbuild--temp-name (absolute-path)
280		"Full path of the copy of the filename in `tuareg-jbuild-temporary-file-directory'."
281		(let ((slash-pos (string-match "/" absolute-path)))
282		(file-truename (expand-file-name (substring absolute-path (1+ slash-pos))
283		tuareg-jbuild-temporary-file-directory))))
284
285		(defun tuareg-jbuild-flymake-create-temp (filename _prefix)
286		;; based on `flymake-create-temp-with-folder-structure'.
287		(unless (stringp filename)
288		(error "Invalid filename"))
289		(tuareg-jbuild--temp-name filename))
290
291		(defun tuareg-jbuild--opam-files (dir)
292		"Return all opam files in the directory DIR."
293		(let ((files nil))
294		(dolist (f (directory-files-and-attributes dir t ".*\\.opam\\'"))
295		(when (null (cadr f))
296		(push (car f) files)))
297		files))
298
299		(defun tuareg-jbuild--root (filename)
300		"Return the root and copy the necessary context files for jbuild."
301		;; FIXME: the root depends on jbuild-workspace. If none is found,
302		;; assume the commands are issued from the dir where opam files are found.
303		(let* ((dir (locate-dominating-file (file-name-directory filename)
304		#'tuareg-jbuild--opam-files)))
305		(when dir
306		(setq dir (expand-file-name dir)); In case it is ~/...
307		(make-directory (tuareg-jbuild--temp-name dir) t)
308		(dolist (f (tuareg-jbuild--opam-files dir))
309		(copy-file f (tuareg-jbuild--temp-name f) t)))
310		dir))
311
312		(defun tuareg-jbuild--delete-opam-files (dir)
313		"Delete all opam files in the directory DIR."
314		(dolist (f (tuareg-jbuild--opam-files dir))
315		(flymake-safe-delete-file f)))
316
317		(defun tuareg-jbuild-flymake-cleanup ()
318		"Attempt to delete temp dir created by `tuareg-jbuild-flymake-create-temp', do not fail on error."
319		(let ((dir (file-name-directory flymake-temp-source-file-name))
320		(temp-dir (concat (directory-file-name
321		tuareg-jbuild-temporary-file-directory) "/")))
322		(flymake-log 3 "Clean up %s" flymake-temp-source-file-name)
323		(flymake-safe-delete-file flymake-temp-source-file-name)
324		(condition-case nil
325		(delete-directory (expand-file-name "_build" dir) t)
326		(error nil))
327		;; Also delete parent dirs if empty or only contain opam files
328		(while (and (not (string-equal dir temp-dir))
329		(> (length dir) 0))
330		(condition-case nil
331		(progn
332		(tuareg-jbuild--delete-opam-files dir)
333		(delete-directory dir)
334		(setq dir (file-name-directory (directory-file-name dir))))
335		(error ; then top the loop
336		(setq dir ""))))))
337
338		(defun tuareg-jbuild-flymake-init ()
339		(tuareg-jbuild-create-lint-script)
340		(let ((fname (flymake-init-create-temp-buffer-copy
341		'tuareg-jbuild-flymake-create-temp))
342		(root (or (tuareg-jbuild--root buffer-file-name) "")))
343		(list tuareg-jbuild-program (list fname root))))
344
345		(defvar tuareg-jbuild--allowed-file-name-masks
346		'("\$?:\\`\\\|/\$jbuild\\'" tuareg-jbuild-flymake-init
347		tuareg-jbuild-flymake-cleanup)
348		"Flymake entry for jbuild files. See `flymake-allowed-file-name-masks'.")
349
350		(defvar tuareg-jbuild--err-line-patterns
351		;; Beware that the path from the root will be reported by jbuild
352		;; but flymake requires it to match the file name.
353		'(("File \"[^\"]*\$jbuild\$\", line \$[0-9]+\$, \
354		characters \$[0-9]+\$-\$[0-9]+\$: +\$[^\n]*\$$"
355		1 2 3 5))
356		"Value of `flymake-err-line-patterns' for jbuild files.")
357
358		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
359		;;;; Skeletons
360		;; See Info node "Autotype".
361
362		(define-skeleton tuareg-jbuild-insert-version-form
363		"Insert the jbuild version."
364		nil
365		"(jbuild_version 1" _ ")" > ?\n)
366
367		(define-skeleton tuareg-jbuild-insert-library-form
368		"Insert a library stanza."
369		nil
370		"(library" > \n
371		"((name " _ ")" > \n
372		"(public_name " _ ")" > \n
373		"(libraries (" _ "))" > \n
374		"(synopsis \"" _ "\")))" > ?\n)
375
376		(define-skeleton tuareg-jbuild-insert-executable-form
377		"Insert an executable stanza."
378		nil
379		"(executable" > \n
380		"((name " _ ")" > \n
381		"(public_name " _ ")" > \n
382		"(modules (" _ "))" > \n
383		"(libraries (" _ "))))" > ?\n)
384
385		(define-skeleton tuareg-jbuild-insert-executables-form
386		"Insert an executables stanza."
387		nil
388		"(executables" > \n
389		"((names (" _ "))" > \n
390		"(public_names (" _ "))" > \n
391		"(libraries (" _ "))))" > ?\n)
392
393		(define-skeleton tuareg-jbuild-insert-rule-form
394		"Insert a rule stanza."
395		nil
396		"(rule" > \n
397		"((targets (" _ "))" > \n
398		"(deps (" _ "))" > \n
399		"(action (" _ "))))" > ?\n)
400
401		(define-skeleton tuareg-jbuild-insert-ocamllex-form
402		"Insert an ocamllex stanza."
403		nil
404		"(ocamllex (" _ "))" > ?\n)
405
406		(define-skeleton tuareg-jbuild-insert-ocamlyacc-form
407		"Insert an ocamlyacc stanza."
408		nil
409		"(ocamlyacc (" _ "))" > ?\n)
410
411		(define-skeleton tuareg-jbuild-insert-menhir-form
412		"Insert a menhir stanza."
413		nil
414		"(menhir" > \n
415		"((modules (" _ "))))" > ?\n)
416
417		(define-skeleton tuareg-jbuild-insert-alias-form
418		"Insert an alias stanza."
419		nil
420		"(alias" > \n
421		"((name " _ ")" > \n
422		"(deps (" _ "))))" > ?\n)
423
424		(define-skeleton tuareg-jbuild-insert-install-form
425		"Insert an install stanza."
426		nil
427		"(install" > \n
428		"((section " _ ")" > \n
429		"(files (" _ "))))" > ?\n)
430
431		(define-skeleton tuareg-jbuild-insert-copyfiles-form
432		"Insert a copy_files stanza."
433		nil
434		"(copy_files " _ ")" > ?\n)
435
436		(define-skeleton tuareg-jbuild-insert-documentation-form
437		"Insert a documentation stanza."
438		nil
439		"(documentation" > \n
440		"((package" _ ")" > \n
441		"(mld_files :standard)))" > ?\n)
442
443		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
444
445		(defvar tuareg-jbuild-mode-map
446		(let ((map (make-sparse-keymap)))
447		(define-key map "\C-c\C-c" 'compile)
448		(define-key map "\C-c.v" 'tuareg-jbuild-insert-version-form)
449		(define-key map "\C-c.l" 'tuareg-jbuild-insert-library-form)
450		(define-key map "\C-c.e" 'tuareg-jbuild-insert-executable-form)
451		(define-key map "\C-c.x" 'tuareg-jbuild-insert-executables-form)
452		(define-key map "\C-c.r" 'tuareg-jbuild-insert-rule-form)
453		(define-key map "\C-c.p" 'tuareg-jbuild-insert-ocamllex-form)
454		(define-key map "\C-c.y" 'tuareg-jbuild-insert-ocamlyacc-form)
455		(define-key map "\C-c.m" 'tuareg-jbuild-insert-menhir-form)
456		(define-key map "\C-c.a" 'tuareg-jbuild-insert-alias-form)
457		(define-key map "\C-c.i" 'tuareg-jbuild-insert-install-form)
458		(define-key map "\C-c.c" 'tuareg-jbuild-insert-copyfiles-form)
459		(define-key map "\C-c.d" 'tuareg-jbuild-insert-documentation-form)
460		map)
461		"Keymap used in Tuareg-jbuild mode.")
462
463		(defun tuareg-jbuild-build-menu ()
464		(easy-menu-define
465		tuareg-jbuild-mode-menu (list tuareg-jbuild-mode-map)
466		"Tuareg-jbuild mode menu."
467		'("Jbuild"
468		("Stanzas"
469		["version" tuareg-jbuild-insert-version-form t]
470		["library" tuareg-jbuild-insert-library-form t]
471		["executable" tuareg-jbuild-insert-executable-form t]
472		["executables" tuareg-jbuild-insert-executables-form t]
473		["rule" tuareg-jbuild-insert-rule-form t]
474		["ocamllex" tuareg-jbuild-insert-ocamllex-form t]
475		["ocamlyacc" tuareg-jbuild-insert-ocamlyacc-form t]
476		["menhir" tuareg-jbuild-insert-menhir-form t]
477		["alias" tuareg-jbuild-insert-alias-form t]
478		["install" tuareg-jbuild-insert-install-form t]
479		["copy_files" tuareg-jbuild-insert-copyfiles-form t]
480		)))
481		(easy-menu-add tuareg-jbuild-mode-menu))
482
483
484		;;;###autoload
485		(define-derived-mode tuareg-jbuild-mode prog-mode "Tuareg-jbuild"
486		"Major mode to edit jbuild files."
487		(setq-local font-lock-defaults '(tuareg-jbuild-font-lock-keywords))
488		(setq-local comment-start ";")
489		(setq-local comment-end "")
490		(setq indent-tabs-mode nil)
491		;(setq-local syntax-propertize-function #'tuareg-jbuild-syntax-propertize)
492		(setq-local require-final-newline mode-require-final-newline)
493		(push tuareg-jbuild--allowed-file-name-masks flymake-allowed-file-name-masks)
494		(smie-setup tuareg-jbuild-smie-grammar #'tuareg-jbuild-smie-rules)
495		(setq-local flymake-err-line-patterns tuareg-jbuild--err-line-patterns)
496		(when (and tuareg-jbuild-flymake buffer-file-name)
497		(flymake-mode t))
498		(tuareg-jbuild-build-menu)
499		(run-mode-hooks 'tuareg-jbuild-mode-hook))
500
501
502		;;;###autoload
503		(add-to-list 'auto-mode-alist
504		'("\$?:\\`\\\|/\$jbuild\$?:\\.inc\$?\\'" . tuareg-jbuild-mode))
505
506
507		(provide 'tuareg-jbuild-mode)

+194

-39

tuareg-opam.el less more

0		;;; tuareg-opam.el --- Mode for editing opam files -- coding: utf-8 --
	0	;;; tuareg-opam.el --- Mode for editing opam files -- coding: utf-8; lexical-binding:t --
1	1
2	2	;; Copyright (C) 2017- Christophe Troestler
3	3

28	28
29	29	(defvar tuareg-opam-mode-map
30	30	(let ((map (make-keymap)))
31		(define-key map "\C-j" 'newline-and-indent)
	31	(define-key map "\C-j" #'newline-and-indent)
32	32	map)
33	33	"Keymap for tuareg-opam mode")
34	34

36	36	"Support for the OPAM files."
37	37	:group 'languages)
38	38
	39	;; TODO this is wrong, and doesn't respect OPAMROOT. It should probably just
	40	;; removed.
	41	(defconst tuareg-opam-compilers
	42	(when (file-directory-p "~/.opam")
	43	(let ((c (directory-files "~/.opam" t "[0-9]+\\.[0-9]+\\.[0-9]+")))
	44	(if (file-directory-p "~/.opam/system")
	45	(cons "~/.opam/system" c)
	46	c)))
	47	"The list of OPAM directories for the installed compilers.")
	48
	49	(defvar tuareg-opam
	50	(let ((opam (executable-find "opam")))
	51	(if opam opam
	52	(let ((opam (locate-file "bin/opam" tuareg-opam-compilers)))
	53	(if (and opam (file-executable-p opam)) opam)))) ; or nil
	54	"The full path of the opam executable or `nil' if opam wasn't found.")
	55
39	56	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40	57	;; Syntax highlighting
41	58
42	59	(defface tuareg-opam-error-face
43		'((t (:foreground "yellow" :background "red" :bold t)))
44		"Face for constructs considered as errors (e.g. deprecated constructs)."
45		:group 'tuareg-opam)
	60	'((t (:inherit error)))
	61	"Face for constructs considered as errors (e.g. deprecated constructs).")
46	62
47	63	(defvar tuareg-opam-error-face 'tuareg-opam-error-face
48	64	"Face for constructs considered as errors (e.g. deprecated constructs).")
	65
	66	(defface tuareg-opam-pkg-variable-name-face
	67	'((t (:inherit font-lock-variable-name-face :slant italic)))
	68	"Face for package specific variables.")
	69
	70	(defvar tuareg-opam-pkg-variable-name-face 'tuareg-opam-pkg-variable-name-face
	71	"Face for package specific variables.")
49	72
50	73	(defconst tuareg-opam-keywords
51	74	'("opam-version" "name" "version" "maintainer" "authors"
52	75	"license" "homepage" "doc" "bug-reports" "dev-repo"
53		"tags" "patches" "substs" "build" "install"
54		"build-doc" "remove" "depends" "depopts" "conflicts"
	76	"tags" "patches" "substs" "build" "install" "run-test"
	77	"remove" "depends" "depopts" "conflicts" "conflict-class"
55	78	"depexts" "messages" "post-messages" "available"
56		"flags")
	79	"flags" "features" "synopsis" "description" "url" "setenv"
	80	"build-env" "extra-files" "pin-depends")
57	81	"Kewords in OPAM files.")
58	82
59	83	(defconst tuareg-opam-keywords-regex
60	84	(regexp-opt tuareg-opam-keywords 'symbols))
61	85
62	86	(defconst tuareg-opam-variables-regex
63		(regexp-opt '("user" "group" "make" "os" "root" "prefix" "lib"
64		"bin" "sbin" "doc" "stublibs" "toplevel" "man"
65		"share" "etc"
66		"name" "pinned"
67		"ocaml-version" "opam-version" "compiler" "preinstalled"
68		"switch" "jobs" "ocaml-native" "ocaml-native-tools"
69		"ocaml-native-dynlink" "arch")
	87	(regexp-opt '("opam-version" "root" "jobs" "make" "arch"
	88	"os" "os-distribution" "os-family" "os-version"
	89	"switch" "prefix" "lib" "bin" "sbin" "share" "doc"
	90	"etc" "man" "toplevel" "stublibs" "user" "group"
	91	"name" "version" "pinned")
70	92	'symbols)
71	93	"Variables declared in OPAM.")
72	94
73	95	(defconst tuareg-opam-pkg-variables-regex
74	96	(regexp-opt '("name" "version" "depends" "installed" "enable" "pinned"
75	97	"bin" "sbin" "lib" "man" "doc" "share" "etc" "build"
76		"hash")
	98	"hash" "dev" "build-id")
77	99	'symbols)
78	100	"Package variables in OPAM.")
79	101
	102	(defconst tuareg-opam-scopes-regex
	103	(regexp-opt '("build" "with-test" "with-doc"
	104	"pinned"
	105	"true" "false")
	106	'symbols)
	107	"Package scopes")
	108
80	109	(defconst tuareg-opam-deprecated-regex
81		(eval-when-compile (regexp-opt '("build-test") 'symbols)))
	110	(eval-when-compile (regexp-opt '("build-test" "build-doc") 'symbols)))
82	111
83	112	(defvar tuareg-opam-font-lock-keywords
84	113	`((,tuareg-opam-deprecated-regex . tuareg-opam-error-face)
85		(,(concat tuareg-opam-keywords-regex ":")
	114	(,(concat "^" tuareg-opam-keywords-regex ":")
86	115	1 font-lock-keyword-face)
87		(,(regexp-opt '("build" "test" "doc" "pinned" "true" "false") 'words)
88		. font-lock-constant-face)
	116	("^\$extra-source\$\\_>" 1 font-lock-keyword-face)
	117	(,(concat "^\$x-[[:alnum:]]+\$:")
	118	1 font-lock-keyword-face)
	119	(,tuareg-opam-scopes-regex . font-lock-constant-face)
89	120	(,tuareg-opam-variables-regex . font-lock-variable-name-face)
90		(,(concat "%{" tuareg-opam-variables-regex "}%")
	121	(,(concat "%{" tuareg-opam-variables-regex "\$?:}%\\\|\\?\$")
91	122	(1 font-lock-variable-name-face t))
92	123	(,(concat "%{\$[a-zA-Z_][a-zA-Z0-9_+-]*\$:"
93		tuareg-opam-pkg-variables-regex "}%")
94		(1 font-lock-constant-face t)
95		(2 font-lock-variable-name-face t)))
	124	tuareg-opam-pkg-variables-regex "\$?:}%\\\|\\?\$")
	125	(1 font-lock-type-face t)
	126	(2 font-lock-variable-name-face t t))
	127	(,(concat "%{\$[a-zA-Z_][a-zA-Z0-9_+-]*\$:"
	128	"\$[a-zA-Z][a-zA-Z0-9_+-]*\$\$?:}%\\\|\\?\$")
	129	(1 font-lock-type-face t)
	130	(2 tuareg-opam-pkg-variable-name-face t t))
	131	;; "package-name:var-name" anywhere (do not force)
	132	(,(concat "\\_<\$[a-zA-Z_][a-zA-Z0-9_+-]*\$:"
	133	tuareg-opam-pkg-variables-regex)
	134	(1 font-lock-type-face)
	135	(2 font-lock-variable-name-face))
	136	("\\_<\$[a-zA-Z_][a-zA-Z0-9_+-]\$:\$[a-zA-Z][a-zA-Z0-9_+-]\$\\_>"
	137	(1 font-lock-type-face)
	138	(2 tuareg-opam-pkg-variable-name-face)))
96	139	"Highlighting for OPAM files")
97	140
98	141

168	211	"%s '%s'; sibling-p:%s parent:%s prev-is-[:%s hanging:%s = %s"
169	212	kind token
170	213	(ignore-errors (smie-rule-sibling-p))
171		(ignore-errors smie--parent)
	214	(bound-and-true-p smie--parent)
172	215	(ignore-errors (smie-rule-prev-p "["))
173	216	(ignore-errors (smie-rule-hanging-p))
174	217	value)

179	222
180	223	(require 'flymake)
181	224
	225	(defalias 'tuareg-opam--flymake-proc-init-create-temp-buffer-copy
	226	(if (fboundp 'flymake-proc-init-create-temp-buffer-copy)
	227	'flymake-proc-init-create-temp-buffer-copy
	228	'flymake-init-create-temp-buffer-copy))
	229
	230	(defalias 'tuareg-opam--proc-create-temp-inplace
	231	(if (fboundp 'flymake-proc-create-temp-inplace)
	232	'flymake-proc-create-temp-inplace
	233	'flymake-create-temp-inplace))
	234
182	235	(defun tuareg-opam-flymake-init ()
183		(let ((fname (flymake-init-create-temp-buffer-copy
184		#'flymake-create-temp-inplace)))
	236	(let ((fname (tuareg-opam--flymake-proc-init-create-temp-buffer-copy
	237	#'tuareg-opam--proc-create-temp-inplace)))
185	238	(list "opam" (list "lint" fname))))
	239
	240	(defvaralias 'tuareg-opam--flymake-proc-allowed-file-name-masks
	241	(if (boundp 'flymake-proc-allowed-file-name-masks)
	242	'flymake-proc-allowed-file-name-masks
	243	'flymake-allowed-file-name-masks))
186	244
187	245	(defvar tuareg-opam--allowed-file-name-masks
188	246	'("[./]opam_?\\'" tuareg-opam-flymake-init)
189	247	"Flymake entry for OPAM files. See `flymake-allowed-file-name-masks'.")
	248
	249	(defvaralias 'tuareg-opam--flymake-proc-err-line-patterns
	250	(if (boundp 'flymake-proc-err-line-patterns)
	251	'flymake-proc-err-line-patterns
	252	'flymake-err-line-patterns))
190	253
191	254	(defvar tuareg-opam--err-line-patterns
192	255	'(("File \"\$[^\"]+\$\", line \$[0-9]+\$, \
193	256	characters \$[0-9]+\$-\$[0-9]+\$: +\$[^\n]*\$$"
194	257	1 2 3 5))
195		"Value of `flymake-err-line-patterns' for OPAM files.")
	258	"Value of `flymake-proc-err-line-patterns' for OPAM files.")
196	259
197	260	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
198	261	;;;; Skeleton

200	263	(define-skeleton tuareg-opam-insert-opam-form
201	264	"Insert a minimal opam file."
202	265	nil
203		"opam-version: \"1.2\"" > \n
	266	"opam-version: \"2.0\"" > \n
204	267	"maintainer: \"" _ "\"" > \n
205	268	"authors: [" _ "]" > \n
206	269	"tags: [" _ "]" > \n

210	273	"bug-reports: \"" _ "\"" > \n
211	274	"doc: \"" _ "\"" > \n
212	275	"build: [" > \n
213		"[ \"dune\" \"subst\" ] {pinned}" > \n
214		"[ \"dune\" \"build\" \"-p\" name \"-j\" jobs \"--profile\" \"release\" ]" > \n
	276	"[\"dune\" \"subst\" ] {pinned}" > \n
	277	"[\"dune\" \"build\" \"-p\" name \"-j\" jobs]" > \n
	278	"[\"dune\" \"build\" \"-p\" name \"-j\" jobs \"@doc\"] {with-doc}" > \n
	279	"[\"dune\" \"runtest\" \"-p\" name \"-j\" jobs] {with-test}" > \n
215	280	"]" > \n
216	281	"depends: [" > \n
217		"\"dune\" {build}" > \n
218		"]" > ?\n)
	282	"\"ocaml\" {>= \"4.02\"}" > \n
	283	"\"dune\"" > \n
	284	"]" > \n
	285	"synopsis: \"\"" > \n
	286	"description: \"\"\"" > \n
	287	"\"\"\"" > ?\n)
219	288
220	289	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
221	290
222	291	(defvar tuareg-opam-mode-map
223	292	(let ((map (make-sparse-keymap)))
224		(define-key map "\C-c.o" 'tuareg-opam-insert-opam-form)
	293	(define-key map "\C-c.o" #'tuareg-opam-insert-opam-form)
225	294	map)
226	295	"Keymap used in Tuareg-opam mode.")
227	296

230	299	tuareg-opam-mode-menu (list tuareg-opam-mode-map)
231	300	"Tuareg-opam mode menu."
232	301	'("OPAM"
233		["Skeleton" tuareg-opam-insert-opam-form t]))
234		(easy-menu-add tuareg-opam-mode-menu))
	302	["Skeleton" tuareg-opam-insert-opam-form t])))
235	303
236	304
237	305	;;;###autoload

244	312	(setq indent-tabs-mode nil)
245	313	(setq-local require-final-newline mode-require-final-newline)
246	314	(smie-setup tuareg-opam-smie-grammar #'tuareg-opam-smie-rules)
247		(push tuareg-opam--allowed-file-name-masks flymake-allowed-file-name-masks)
248		(setq-local flymake-err-line-patterns tuareg-opam--err-line-patterns)
	315
	316	;; Explicit variable declarations to avoid Emacs 24 warnings
	317	(defvar tuareg-opam--flymake-proc-allowed-file-name-masks)
	318	(defvar tuareg-opam--flymake-proc-err-line-patterns)
	319
	320	(push tuareg-opam--allowed-file-name-masks
	321	tuareg-opam--flymake-proc-allowed-file-name-masks)
	322	(setq-local tuareg-opam--flymake-proc-err-line-patterns
	323	tuareg-opam--err-line-patterns)
249	324	(when (and tuareg-opam-flymake buffer-file-name)
250	325	(flymake-mode t))
251	326	(tuareg-opam-build-menu)
252	327	(run-mode-hooks 'tuareg-opam-mode-hook))
253	328
	329	(defun tuareg-opam-config-env (&optional switch)
	330	"Get the opam environment for the given switch (or the default
	331	switch if none is provied) and return a list of lists of the
	332	form (n v) where n is the name of the environment variable and v
	333	its value (both being strings). If opam is not found or the
	334	switch is not installed, `nil' is returned."
	335	(let* ((switch (if switch (concat " --switch " switch)))
	336	(get-env (concat tuareg-opam " env --sexp" switch))
	337	(opam-env (tuareg--shell-command-to-string get-env)))
	338	(if opam-env
	339	(car (read-from-string opam-env)))))
	340
	341	(defcustom tuareg-opam-insinuate nil
	342	"By default, Tuareg will use the environment that Emacs was
	343	launched in. That environment may not contain an OCaml
	344	compiler (say, because Emacs was launched graphically and the
	345	path is set in ~/.bashrc) and will remain unchanged when one
	346	issue an \"opam switch\" in a shell. If this variable is set to
	347	t, Tuareg will try to use opam to set the right environment for
	348	`compile', `run-ocaml' and `merlin-mode' based on the current
	349	opam switch at the time the command is run (provided opam is
	350	found). You may also use `tuareg-opam-update-env' to set the
	351	environment for another compiler from within emacs (without
	352	changing the opam switch). Beware that setting it to t causes
	353	problems if you compile under tramp."
	354	:group 'tuareg :type 'boolean)
	355
	356	(defun tuareg--shell-command-to-string (command)
	357	"Similar to `shell-command-to-string', but returns nil when the
	358	process return code is not 0 (shell-command-to-string returns the
	359	error message as a string)."
	360	(let* ((return-value 0)
	361	(return-string
	362	(with-output-to-string
	363	(with-current-buffer standard-output
	364	(setq return-value
	365	(process-file shell-file-name nil '(t nil)
	366	nil shell-command-switch command))))))
	367	(if (= return-value 0) return-string nil)))
	368
	369	(defun tuareg-opam-installed-compilers ()
	370	(let* ((cmd1 (concat tuareg-opam " switch list -i -s"))
	371	(cmd2 (concat tuareg-opam " switch list -s")); opam2
	372	(cpl (or (tuareg--shell-command-to-string cmd1)
	373	(tuareg--shell-command-to-string cmd2))))
	374	(if cpl (split-string cpl "[ \f\t\n\r\v]+" t) '())))
	375
	376	(defun tuareg-opam-current-compiler ()
	377	(let* ((cmd (concat tuareg-opam " switch show -s"))
	378	(cpl (tuareg--shell-command-to-string cmd)))
	379	(when cpl
	380	(replace-regexp-in-string "[ \t\n]*" "" cpl))))
	381
	382	;;;###autoload
	383	(defun tuareg-opam-update-env (switch)
	384	"Update the environment to follow current OPAM switch configuration."
	385	(interactive
	386	(let* ((compl (tuareg-opam-installed-compilers))
	387	(current (tuareg-opam-current-compiler))
	388	(default (if current current "current"))
	389	(prompt (format "opam switch (default: %s): " default)))
	390	(list (completing-read prompt compl))))
	391	(let* ((switch (if (string= switch "") nil switch))
	392	(env (tuareg-opam-config-env switch)))
	393	(if env
	394	(dolist (v env)
	395	(setenv (car v) (cadr v))
	396	(when (string= (car v) "PATH")
	397	(setq exec-path (split-string (cadr v) path-separator))))
	398	(message "Switch %s does not exist (or opam not found)" switch))))
	399
	400	;; OPAM compilation
	401	(defun tuareg--compile-opam (&rest _)
	402	"Advice to update the OPAM environment to sync it with the OPAM
	403	switch before compiling."
	404	(let* ((env (tuareg-opam-config-env)))
	405	(when env
	406	(setq-local compilation-environment
	407	(mapcar (lambda(v) (concat (car v) "=" (cadr v)))
	408	(tuareg-opam-config-env))))))
254	409
255	410	;;;###autoload
256	411	(add-to-list 'auto-mode-alist '("[./]opam_?\\'" . tuareg-opam-mode))
257	412
258	413
259		(provide 'tuareg-opam-mode)
	414	(provide 'tuareg-opam)

-128

~~tuareg-site-file.el~~ less more

0		;;; tuareg-site-file.el --- Automatically extracted autoloads.
1		;;; Code:
2		(add-to-list 'load-path
3		(or (file-name-directory load-file-name) (car load-path)))
4
5		;;;### (autoloads nil "ocamldebug" "ocamldebug.el" (22960 18385 186574
6		;;;;;; 216000))
7		;;; Generated autoloads from ocamldebug.el
8
9		(autoload 'ocamldebug "ocamldebug" "\
10		Run ocamldebug on program FILE in buffer ocamldebug-FILE.
11		The directory containing FILE becomes the initial working directory
12		and source-file directory for ocamldebug. If you wish to change this, use
13		the ocamldebug commands `cd DIR' and `directory'.
14
15		\(fn PGM-PATH)" t nil)
16
17		(defalias 'camldebug 'ocamldebug)
18
19		;;;***
20
21		;;;### (autoloads nil "tuareg" "tuareg.el" (23451 62160 790210 240000))
22		;;; Generated autoloads from tuareg.el
23		(add-to-list 'auto-mode-alist '("\\.ml[ip]?\\'" . tuareg-mode))
24		(add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode))
25		(dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmi"
26		".annot" ".cmt" ".cmti"))
27		(add-to-list 'completion-ignored-extensions ext))
28
29		(autoload 'tuareg-mode "tuareg" "\
30		Major mode for editing OCaml code.
31
32		Dedicated to Emacs and XEmacs, version 21 and higher. Provides
33		automatic indentation and compilation interface. Performs font/color
34		highlighting using Font-Lock. It is designed for OCaml but handles
35		Caml Light as well.
36
37		The Font-Lock minor-mode is used according to your customization
38		options.
39
40		You have better byte-compile tuareg.el.
41
42		For customization purposes, you should use `tuareg-mode-hook'
43		\(run for every file) or `tuareg-load-hook' (run once) and not patch
44		the mode itself. You should add to your configuration file something like:
45		(add-hook 'tuareg-mode-hook
46		(lambda ()
47		... ; your customization code
48		))
49		For example you can change the indentation of some keywords, the
50		`electric' flags, Font-Lock colors... Every customizable variable is
51		documented, use `C-h-v' or look at the mode's source code.
52
53		`dot-emacs.el' is a sample customization file for standard changes.
54		You can append it to your `.emacs' or use it as a tutorial.
55
56		`M-x ocamldebug' FILE starts the OCaml debugger ocamldebug on the executable
57		FILE, with input and output in an Emacs buffer named ocamldebug-FILE.
58
59		A Tuareg Interactive Mode to evaluate expressions in a REPL (aka toplevel) is
60		included. Type `M-x tuareg-run-ocaml' or simply `M-x run-ocaml' or see
61		special-keys below.
62
63		Short cuts for the Tuareg mode:
64		\\{tuareg-mode-map}
65
66		Short cuts for interactions with the REPL:
67		\\{tuareg-interactive-mode-map}
68
69		\(fn)" t nil)
70
71		(autoload 'tuareg-run-ocaml "tuareg" "\
72		Run an OCaml REPL process. I/O via buffer `OCaml'.
73
74		\(fn)" t nil)
75
76		(defalias 'run-ocaml 'tuareg-run-ocaml)
77
78		(add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode))
79
80		(add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode))
81
82		;;;***
83
84		;;;### (autoloads nil "tuareg-jbuild" "tuareg-jbuild.el" (23450 52106
85		;;;;;; 385127 834000))
86		;;; Generated autoloads from tuareg-jbuild.el
87
88		(autoload 'tuareg-jbuild-mode "tuareg-jbuild" "\
89		Major mode to edit jbuild files.
90
91		\(fn)" t nil)
92
93		(add-to-list 'auto-mode-alist '("\$?:\\`\\\|/\$jbuild\$?:\\.inc\$?\\'" . tuareg-jbuild-mode))
94
95		;;;***
96
97		;;;### (autoloads nil "tuareg-menhir" "tuareg-menhir.el" (23072 32307
98		;;;;;; 345047 725000))
99		;;; Generated autoloads from tuareg-menhir.el
100
101		(add-to-list 'auto-mode-alist '("\\.mly\\'" . tuareg-menhir-mode))
102
103		(autoload 'tuareg-menhir-mode "tuareg-menhir" "\
104		Major mode to edit Menhir (and Ocamlyacc) files.
105
106		\(fn)" t nil)
107
108		;;;***
109
110		;;;### (autoloads nil "tuareg-opam" "tuareg-opam.el" (23451 62169
111		;;;;;; 386245 46000))
112		;;; Generated autoloads from tuareg-opam.el
113
114		(autoload 'tuareg-opam-mode "tuareg-opam" "\
115		Major mode to edit opam files.
116
117		\(fn)" t nil)
118
119		(add-to-list 'auto-mode-alist '("[./]opam_?\\'" . tuareg-opam-mode))
120
121		;;;***
122
123		;;;### (autoloads nil nil ("dot-emacs.el" "tuareg-mly.el") (22644
124		;;;;;; 5433 590766 76000))
125
126		;;;***
127

+806

-0

tuareg-tests.el less more

	0	;;; tests for tuareg.el -- lexical-binding: t --
	1
	2	(require 'tuareg)
	3	(require 'compile)
	4	(require 'ert)
	5
	6	(defconst tuareg-test-dir
	7	(file-name-directory (or load-file-name buffer-file-name)))
	8
	9	(defun tuareg-test--remove-indentation ()
	10	"Remove all indentation in the current buffer."
	11	(goto-char (point-min))
	12	(while (re-search-forward (rx bol (+ (in " \t"))) nil t)
	13	(let ((syntax (save-match-data (syntax-ppss))))
	14	(unless (or (nth 3 syntax) ; not in string literal
	15	(nth 4 syntax)) ; nor in comment
	16	(replace-match "")))))
	17
	18	(ert-deftest tuareg-indent-good ()
	19	"Check indentation that we do handle satisfactorily."
	20	(let ((file (expand-file-name "indent-test.ml" tuareg-test-dir))
	21	(text (lambda () (buffer-substring-no-properties
	22	(point-min) (point-max)))))
	23	(with-temp-buffer
	24	(insert-file-contents file)
	25	(tuareg-mode)
	26	(let ((orig (funcall text)))
	27	;; Remove the indentation and check that we get the original text.
	28	(tuareg-test--remove-indentation)
	29	(indent-region (point-min) (point-max))
	30	(should (equal (funcall text) orig))
	31	;; Indent again to verify idempotency.
	32	(indent-region (point-min) (point-max))
	33	(should (equal (funcall text) orig))))))
	34
	35	(ert-deftest tuareg-indent-bad ()
	36	"Check indentation that we do not yet handle satisfactorily."
	37	:expected-result :failed
	38	(let ((file (expand-file-name "indent-test-failed.ml" tuareg-test-dir))
	39	(text (lambda () (buffer-substring-no-properties
	40	(point-min) (point-max)))))
	41	(with-temp-buffer
	42	(insert-file-contents file)
	43	(tuareg-mode)
	44	(let ((orig (funcall text)))
	45	;; Remove the indentation and check that we get the original text.
	46	(tuareg-test--remove-indentation)
	47	(indent-region (point-min) (point-max))
	48	(should (equal (funcall text) orig))
	49	;; Indent again to verify idempotency.
	50	(indent-region (point-min) (point-max))
	51	(should (equal (funcall text) orig))))))
	52
	53	(defmacro tuareg--lets (&rest forms)
	54	"Execute FORMS in sequence, binding new vars as they occur.
	55	Every expression in FORMS can be any normal ELisp expression,
	56	with the added form (let VAR VAL) which will bind VAR to the value of VAL.
	57	Returns the value of the last FORM."
	58	(declare (indent 0) (debug (&rest [&or ("let" symbolp form) form])))
	59	(let ((exps '())
	60	(bindings '()))
	61	(dolist (form forms)
	62	(pcase form
	63	(`(let ,(and (pred symbolp) var) ,val)
	64	(push (list var (macroexp-progn (nreverse (cons val exps))))
	65	bindings)
	66	(setq exps '()))
	67	(_ (push form exps))))
	68	`(let* ,(nreverse bindings) . ,(nreverse exps))))
	69
	70	(ert-deftest tuareg-beginning-of-defun ()
	71	;; Check that `beginning-of-defun' works as expected: move backwards
	72	;; to the beginning of the current top-level definition (defun), or
	73	;; the previous one if already at the beginning; return t if one was
	74	;; found, nil if none.
	75	(with-temp-buffer
	76	(tuareg-mode)
	77	(tuareg--lets
	78	(insert "(* first line *)\n\n")
	79	(let p1 (point))
	80	(insert "type ty =\n"
	81	" \| Goo\n"
	82	" \| Baa of int\n\n")
	83	(let p2 (point))
	84	(insert "let a = ho hum\n"
	85	";;\n\n")
	86	(let p3 (point))
	87	(insert "let g u =\n"
	88	" while mo ma do\n"
	89	" we wo;\n")
	90	(let p4 (point))
	91	(insert " ze zo\n"
	92	" done\n")
	93
	94	;; Check without argument.
	95	(goto-char p4)
	96	(should (equal (beginning-of-defun) t))
	97	(should (equal (point) p3))
	98	(should (equal (beginning-of-defun) t))
	99	(should (equal (point) p2))
	100	(should (equal (beginning-of-defun) t))
	101	(should (equal (point) p1))
	102	(should (equal (beginning-of-defun) nil))
	103	(should (equal (point) (point-min)))
	104
	105	;; Check with positive argument.
	106	(goto-char p4)
	107	(should (equal (beginning-of-defun 1) t))
	108	(should (equal (point) p3))
	109	(goto-char p4)
	110	(should (equal (beginning-of-defun 2) t))
	111	(should (equal (point) p2))
	112	(goto-char p4)
	113	(should (equal (beginning-of-defun 3) t))
	114	(should (equal (point) p1))
	115	(goto-char p4)
	116	(should (equal (beginning-of-defun 4) nil))
	117	(should (equal (point) (point-min)))
	118
	119	;; Check with negative argument.
	120	(goto-char (point-min))
	121	(should (equal (beginning-of-defun -1) t))
	122	(should (equal (point) p1))
	123	(should (equal (beginning-of-defun -1) t))
	124	(should (equal (point) p2))
	125	(should (equal (beginning-of-defun -1) t))
	126	(should (equal (point) p3))
	127	(should (equal (beginning-of-defun -1) nil))
	128	(should (equal (point) (point-max)))
	129
	130	(goto-char (point-min))
	131	(should (equal (beginning-of-defun -2) t))
	132	(should (equal (point) p2))
	133	(goto-char (point-min))
	134	(should (equal (beginning-of-defun -3) t))
	135	(should (equal (point) p3))
	136	(goto-char (point-min))
	137	(should (equal (beginning-of-defun -4) nil))
	138	(should (equal (point) (point-max)))
	139
	140	;; We don't test with a zero argument as the behaviour for that
	141	;; case does not seem to be very well-defined.
	142	)))
	143
	144	(ert-deftest tuareg-chained-defun ()
	145	;; Check motion by defuns that are chained by "and".
	146	(with-temp-buffer
	147	(tuareg-mode)
	148	(tuareg--lets
	149	(insert "(* *)\n\n")
	150	(let p0 (point))
	151	(insert "type t1 =\n"
	152	" A\n")
	153	(let p1 (point))
	154	(insert "and t2 =\n"
	155	" B\n")
	156	(let p2a (point))
	157	(insert "\n")
	158	(let p2b (point))
	159	(insert "and t3 =\n"
	160	" C\n")
	161	(let p3a (point))
	162	(insert "\n")
	163	(let p3b (point))
	164	(insert "let f1 x =\n"
	165	" aa\n")
	166	(let p4 (point))
	167	(insert "and f2 x =\n"
	168	" bb\n")
	169	(let p5a (point))
	170	(insert "\n")
	171	(let p5b (point))
	172	(insert "and f3 x =\n"
	173	" let ff1 y =\n"
	174	" cc\n"
	175	" and ff2 y = (\n")
	176	(let p6 (point))
	177	(insert " qq ww) + dd\n"
	178	" and ff3 y =\n"
	179	" for i = 1 to 10 do\n"
	180	" ee;\n")
	181	(let p7 (point))
	182	(insert " ff;\n"
	183	" done\n")
	184	(let p8a (point))
	185	(insert "\n")
	186	(let p8b (point))
	187	(insert "exception E\n")
	188
	189	;; Walk backwards from the end.
	190	(goto-char (point-max))
	191	(beginning-of-defun)
	192	(should (equal (point) p8b))
	193	(beginning-of-defun)
	194	(should (equal (point) p5b))
	195	(beginning-of-defun)
	196	(should (equal (point) p4))
	197	(beginning-of-defun)
	198	(should (equal (point) p3b))
	199	(beginning-of-defun)
	200	(should (equal (point) p2b))
	201	(beginning-of-defun)
	202	(should (equal (point) p1))
	203	(beginning-of-defun)
	204	(should (equal (point) p0))
	205	(beginning-of-defun)
	206	(should (equal (point) (point-min)))
	207
	208	;; Walk forwards from the beginning.
	209	(end-of-defun)
	210	(should (equal (point) p1))
	211	(end-of-defun)
	212	(should (equal (point) p2a))
	213	(end-of-defun)
	214	(should (equal (point) p3a))
	215	(end-of-defun)
	216	(should (equal (point) p4))
	217	(end-of-defun)
	218	(should (equal (point) p5a))
	219	(end-of-defun)
	220	(should (equal (point) p8a))
	221	(end-of-defun)
	222	(should (equal (point) (point-max)))
	223
	224	;; Jumps from inside a defun.
	225	(goto-char p7)
	226	(beginning-of-defun)
	227	(should (equal (point) p5b))
	228
	229	(goto-char p6)
	230	(end-of-defun)
	231	(should (equal (point) p8a)))))
	232
	233	(ert-deftest tuareg-phrase-discovery-1 ()
	234	(with-temp-buffer
	235	(tuareg-mode)
	236	(tuareg--lets
	237	(insert "let a = 1 and b = 2 in a + b\n")
	238	(let p1 (point))
	239	(insert "let f x =\n"
	240	" x + 1\n")
	241	(let p2a (point))
	242	(insert "and g x =\n"
	243	" x * 2\n")
	244	(let p2b (point))
	245	(insert "type ta = A\n"
	246	" \| B of tb\n")
	247	(let p3a (point))
	248	(insert "and tb = C\n"
	249	" \| D of ta\n")
	250	(insert ";;\n")
	251	(let p3b (point))
	252
	253	(goto-char (point-min))
	254	(end-of-defun)
	255	(should (equal (point) p1))
	256	(end-of-defun)
	257	(should (equal (point) p2a))
	258	(end-of-defun)
	259	(should (equal (point) p2b))
	260	(end-of-defun)
	261	(should (equal (point) p3a))
	262	(end-of-defun)
	263	(should (equal (point) p3b))
	264
	265	(beginning-of-defun)
	266	(should (equal (point) p3a))
	267	(beginning-of-defun)
	268	(should (equal (point) p2b))
	269	(beginning-of-defun)
	270	(should (equal (point) p2a))
	271	(beginning-of-defun)
	272	(should (equal (point) p1))
	273	(beginning-of-defun)
	274	(should (equal (point) (point-min)))
	275
	276	(should (equal (tuareg-discover-phrase (point-min))
	277	(list (point-min) (1- p1) (1- p1))))
	278	(should (equal (tuareg-discover-phrase p1)
	279	(list p1 (1- p2b) (1- p2b))))
	280	(should (equal (tuareg-discover-phrase p2b)
	281	(list p2b (1- p3b) (1- p3b)))))))
	282
	283	(ert-deftest tuareg-phrase-discovery-2 ()
	284	(let ((lines
	285	'("(1 < 2) = false;;"
	286	"'a';;"
	287	"\"abc\" ^ \" \" ^ \"def\";;"
	288	"{\|with \\ special \" chars\|};;"
	289	"max 1 2;;"
	290	"if true then 1 else 2 ;;"
	291	"while false do print_endline \"a\" done ;;"
	292	"for i = 1 to 3 do print_int i done ;;"
	293	"open Stdlib.Printf;;"
	294	"begin print_char 'a'; print_char 'b'; end ;;"
	295	"match [1;2] with a :: _ -> a \| [] -> 3 ;;"
	296	"exception E of int * string ;;"
	297	"external myid : 'a -> 'a = \"%identity\";;"
	298	"class k = object method m = 1 end;;")))
	299
	300	(with-temp-buffer
	301	(tuareg-mode)
	302	(dolist (line lines)
	303	(insert line "\n"))
	304
	305	;; Check movement by defun.
	306	(goto-char (point-min))
	307	(let ((pos (point-min)))
	308	(dolist (line lines)
	309	(let ((next-pos (+ pos (length line) 1)))
	310	(ert-info ((prin1-to-string line) :prefix "line: ")
	311	(end-of-defun)
	312	(should (equal (point) next-pos))
	313	(setq pos next-pos))))
	314
	315	(dolist (line (reverse lines))
	316	(let ((prev-pos (- pos (length line) 1)))
	317	(ert-info ((prin1-to-string line) :prefix "line: ")
	318	(beginning-of-defun)
	319	(should (equal (point) prev-pos))
	320	(setq pos prev-pos)))))
	321
	322	;; Check phrase discovery.
	323	(let ((pos (point-min)))
	324	(dolist (line lines)
	325	(let ((next-pos (+ pos (length line) 1)))
	326	(ert-info ((prin1-to-string line) :prefix "line: ")
	327	(should (equal (tuareg-discover-phrase pos)
	328	(list pos (1- next-pos) (1- next-pos))))
	329	(setq pos next-pos))))))))
	330
	331	(ert-deftest tuareg-defun-separator ()
	332	;; Check correct handling of ";;"-separated defuns/phrases.
	333	(with-temp-buffer
	334	(tuareg-mode)
	335	(tuareg--lets
	336	(insert "let _ = tata 3 ;;\n")
	337	(let p1 (point))
	338	(insert "abc def ;;\n")
	339	(let p2 (point))
	340	(insert "let _ = tata 3\n"
	341	";;\n")
	342	(let p3 (point))
	343	(insert "ghi jkl\n"
	344	";;\n")
	345	(let p4 (point))
	346	(insert "type spell =\n"
	347	" \| Frotz\n"
	348	" \| Xyzzy\n"
	349	";;\n")
	350	(let p5 (point))
	351
	352	(goto-char (point-min))
	353	(end-of-defun)
	354	(should (equal (point) p1))
	355	(end-of-defun)
	356	(should (equal (point) p2))
	357	(end-of-defun)
	358	(should (equal (point) p3))
	359	(end-of-defun)
	360	(should (equal (point) p4))
	361	(end-of-defun)
	362	(should (equal (point) p5))
	363	(beginning-of-defun)
	364	(should (equal (point) p4))
	365	(beginning-of-defun)
	366	(should (equal (point) p3))
	367	(beginning-of-defun)
	368	(should (equal (point) p2))
	369	(beginning-of-defun)
	370	(should (equal (point) p1))
	371	(beginning-of-defun)
	372	(should (equal (point) (point-min)))
	373
	374	(should (equal (tuareg-discover-phrase (point-min))
	375	(list (point-min) (1- p1) (1- p1))))
	376	(should (equal (tuareg-discover-phrase p1)
	377	(list p1 (1- p2) (1- p2))))
	378	(should (equal (tuareg-discover-phrase (+ p1 2))
	379	(list p1 (1- p2) (1- p2))))
	380	(should (equal (tuareg-discover-phrase p2)
	381	(list p2 (1- p3) (1- p3))))
	382	(should (equal (tuareg-discover-phrase p3)
	383	(list p3 (1- p4) (1- p4))))
	384	(should (equal (tuareg-discover-phrase p4)
	385	(list p4 (1- p5) (1- p5))))
	386	)))
	387
	388	(ert-deftest tuareg-class-type ()
	389	(with-temp-buffer
	390	(tuareg-mode)
	391	(tuareg--lets
	392	(insert "class type my_class_type =\n"
	393	" object\n"
	394	" method meth_1 : int\n"
	395	" method meth_2 : unit\n"
	396	" end;;\n")
	397	(let p1 (point))
	398
	399	(goto-char (point-min))
	400	(end-of-defun)
	401	(should (equal (point) p1))
	402	(beginning-of-defun)
	403	(should (equal (point) (point-min)))
	404	(should (equal (tuareg-discover-phrase (point-min))
	405	(list (point-min) (1- p1) (1- p1)))))))
	406
	407	(defconst tuareg-test--compilation-messages
	408	'((("File \"file.ml\", line 4, characters 6-7:\n"
	409	"Error: This expression has type int\n"
	410	"This is not a function; it cannot be applied.\n")
	411	((1 error "file.ml" 4 4 6 6)))
	412	(("File \"file.ml\", line 3, characters 6-7:\n"
	413	"Warning 26: unused variable y.\n")
	414	((1 warning "file.ml" 3 3 6 6)))
	415
	416	(("File \"helloworld.ml\", line 2, characters 36-64:\n"
	417	"2 \| module rec A: sig type t += A end = struct type t += A = B.A end\n"
	418	" ^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n"
	419	"Error: Cannot safely evaluate the definition of the following cycle\n"
	420	" of recursively-defined modules: A -> B -> A.\n")
	421	((1 error "helloworld.ml" 2 2 36 63)))
	422	(("File \"helloworld.ml\", lines 4-7, characters 6-3:\n"
	423	"4 \| ......struct\n"
	424	"5 \| module F(X:sig end) = struct end\n"
	425	"6 \| let f () = B.value\n"
	426	"7 \| end\n"
	427	"Error: Cannot safely evaluate the definition of the following cycle\n"
	428	" of recursively-defined modules: A -> B -> A.\n")
	429	((1 error "helloworld.ml" 4 7 6 2)))
	430	(("File \"robustmatch.ml\", lines 33-37, characters 6-23:\n"
	431	" 9 \| ......match t1, t2, x with\n"
	432	"10 \| \| AB, AB, A -> ()\n"
	433	"11 \| \| MAB, _, A -> ()\n"
	434	"12 \| \| _, AB, B -> ()\n"
	435	"13 \| \| _, MAB, B -> ()\n"
	436	"Warning 8: this pattern-matching is not exhaustive.\n"
	437	"Here is an example of a case that is not matched:\n"
	438	"(AB, MAB, A)\n")
	439	((1 warning "robustmatch.ml" 33 37 6 22)))
	440	(("File \"robustmatch.ml\", lines 33-37, characters 6-23:\n"
	441	" 9 \| ......match t1, t2, x with\n"
	442	"10 \| \| AB, AB, A -> ()\n"
	443	"11 \| \| MAB, _, A -> ()\n"
	444	"12 \| \| _, AB, B -> ()\n"
	445	"13 \| \| _, MAB, B -> ()\n"
	446	"Warning 8 [partial-match]: this pattern-matching is not exhaustive.\n"
	447	"Here is an example of a case that is not matched:\n"
	448	"(AB, MAB, A)\n")
	449	((1 warning "robustmatch.ml" 33 37 6 22)))
	450	(("File \"main.ml\", line 13, characters 34-35:\n"
	451	"13 \| let f : M.t -> M.t = fun M.C -> y\n"
	452	" ^\n"
	453	"Error: This expression has type M/2.t but an expression was expected of type\n"
	454	" M/1.t\n"
	455	" File \"main.ml\", line 10, characters 2-41:\n"
	456	" Definition of module M/1\n"
	457	" File \"main.ml\", line 7, characters 0-32:\n"
	458	" Definition of module M/2\n")
	459	((1 error "main.ml" 13 13 34 34)
	460	(225 info "main.ml" 10 10 2 40)
	461	(308 info "main.ml" 7 7 0 31)))
	462	(("File \"alrt.ml\", line 25, characters 9-10:\n"
	463	"25 \| val x: t [@@ocaml.deprecated]\n"
	464	" ^\n"
	465	"Alert deprecated: t\n")
	466	((1 warning "alrt.ml" 25 25 9 9)))
	467	(("Fatal error: exception Bad.Disaster(\"oh no!\")\n"
	468	"Raised at file \"bad.ml\", line 5, characters 4-22\n"
	469	"Called from file \"worse.ml\" (inlined), line 9, characters 2-5\n"
	470	"Called from file \"worst.ml\", line 12, characters 8-18\n")
	471	((47 error "bad.ml" 5 5 4 21)
	472	(96 error "worse.ml" 9 9 2 4)
	473	(158 error "worst.ml" 12 12 8 17)))
	474	(("Fatal error: exception Bad.Disaster(\"oh no!\")\n"
	475	"Raised at Bad.f in file \"bad.ml\", line 5, characters 4-22\n"
	476	"Called from Bad.g in file \"worse.ml\" (inlined), line 9, characters 2-5\n"
	477	"Called from Bad in file \"worst.ml\", line 12, characters 8-18\n")
	478	((47 error "bad.ml" 5 5 4 21)
	479	(105 error "worse.ml" 9 9 2 4)
	480	(176 error "worst.ml" 12 12 8 17)))
	481	(("Fatal error: exception Hell\n"
	482	"Raised by primitive operation at Murky.depths in file \"inferno.ml\", line 399, characters 28-54\n"
	483	"Called from Nasty.f in file \"nasty.ml\", line 7, characters 13-40\n"
	484	"Re-raised at Smelly.f in file \"smelly.ml\", line 14, characters 12-19\n"
	485	"Called from Rubbish.g in file \"rubbish.ml\", line 17, characters 2-5\n")
	486	((29 error "inferno.ml" 399 399 28 53)
	487	(124 error "nasty.ml" 7 7 13 39)
	488	(189 error "smelly.ml" 14 14 12 18)
	489	(258 error "rubbish.ml" 17 17 2 4))))
	490	"Compilation message test data.
	491	Each element is (STRINGS ERRORS) where
	492
	493	STRINGS is a list of strings forming the message when concatenated
	494	ERRORS is a list of error descriptions, each being
	495
	496	(POS TYPE FILE LINE-START LINE-END COLUMN-START COLUMN-END)
	497
	498	where
	499
	500	POS is the position of the error in the message (1-based)
	501	TYPE is one of `error', `warning' or `info'
	502	FILE is the file name of the error
	503	LINE-START, LINE-END, COLUMN-START and COLUMN-END are the reported
	504	line and column numbers, start and end, for that error")
	505
	506	(defun tuareg-test--extract-message-info (string pos)
	507	"Parse STRING as a compilation message.
	508	Return (FILE TYPE START-LINE END-LINE START-COL END-COL)."
	509	(with-temp-buffer
	510	;; This function makes some assumptions about the compilation-mode
	511	;; internals and may need adjustment to work with future Emacs
	512	;; versions.
	513	(font-lock-mode -1)
	514	(let ((compilation-locs (make-hash-table)))
	515	(insert string)
	516	(compilation-parse-errors (point-min) (point-max))
	517	(let ((msg (get-text-property pos 'compilation-message)))
	518	(and msg
	519	(let* ((loc (compilation--message->loc msg))
	520	(end-loc (compilation--message->end-loc msg))
	521	(type (compilation--message->type msg))
	522	(start-line (compilation--loc->line loc))
	523	(start-col (compilation--loc->col loc))
	524	(end-line (compilation--loc->line end-loc))
	525	(end-col (compilation--loc->col end-loc))
	526	(fs (compilation--loc->file-struct loc))
	527	(file (caar fs)))
	528	(list file
	529	(pcase type
	530	(0 'info)
	531	(1 'warning)
	532	(2 'error))
	533	start-line end-line
	534	;; Emacs internally adds 1 to the end column so
	535	;; we compensate for that to get the actual
	536	;; number in the message.
	537	start-col (and end-col (1- end-col)))))))))
	538
	539	(defun tuareg-test--have-end-column-bug ()
	540	"Check for the compilation message end-column bug."
	541	(let ((compilation-error-regexp-alist
	542	`((,(rx bol
	543	(group (+ alnum)) ","
	544	(group (+ digit)) ","
	545	(group (+ digit)) ","
	546	(group (+ digit)) ","
	547	(+ digit) ";")
	548	1 (2 . 3) (4 . (lambda () 17))))))
	549	(pcase (tuareg-test--extract-message-info "abc,1,2,3,4; error\n" 1)
	550	(`(,_ ,_ ,_ ,_ ,_ 16) t)
	551	(`(,_ ,_ ,_ ,_ ,_ 17) nil)
	552	(x (error "%S" x)))))
	553
	554	(ert-deftest tuareg-compilation-message ()
	555	(let ((buggy-emacs-28 (and (equal emacs-major-version 28)
	556	(tuareg-test--have-end-column-bug))))
	557	(dolist (case tuareg-test--compilation-messages)
	558	(let ((str (apply #'concat (nth 0 case)))
	559	(errors (nth 1 case)))
	560	(ert-info (str :prefix "message: ")
	561	(pcase-dolist (`(,pos ,type ,file ,start-line ,end-line
	562	,start-col ,end-col)
	563	errors)
	564	;; Temporary hack to make the tests pass until the Emacs snapshot
	565	;; used in the CI has been updated to the version expected by
	566	;; the code (ie, where the compilation message column bug has been
	567	;; fixed). The bug was fixed in emacs/master
	568	;; aa5437493b1ca539409495ecdc54cf420ea110b9.
	569	(when buggy-emacs-28
	570	(setq end-col (1- end-col)))
	571	(let ((message-info (tuareg-test--extract-message-info str pos)))
	572	(when (< emacs-major-version 27)
	573	;; Prior to Emacs 27, a bug in compilation-mode caused the
	574	;; message type to be wrong in some cases (Emacs bug#34479).
	575	;; Pretend that the test passed anyway.
	576	(setq type (nth 1 message-info)))
	577	(should (equal message-info
	578	(list file type
	579	start-line end-line
	580	start-col end-col))))))))))
	581
	582	(defun tuareg-test--comment-region (text)
	583	(with-temp-buffer
	584	(tuareg-mode)
	585	(insert text)
	586	(comment-region (point-min) (point-max))
	587	(buffer-string)))
	588
	589	(ert-deftest tuareg-comment-region-style ()
	590	"Check that commenting out code works as expected. See issue #216."
	591	;; Non-indented code.
	592	(should (let ((comment-style 'indent))
	593	(equal (tuareg-test--comment-region
	594	"let f x =\n g x\n y\n")
	595	"(* let f x = )\n( g x )\n( y *)\n")))
	596	(should (let ((comment-style 'multi-line)
	597	(comment-continue " * "))
	598	(equal (tuareg-test--comment-region
	599	"let f x =\n g x\n y\n")
	600	"(* let f x =\n * g x\n * y *)\n")))
	601	(should (let ((comment-style 'multi-line))
	602	;; `comment-continue' should default to " * "
	603	(equal (tuareg-test--comment-region
	604	"let f x =\n g x\n y\n")
	605	"(* let f x =\n * g x\n * y *)\n")))
	606	(should (let ((comment-style 'multi-line)
	607	(comment-continue " "))
	608	(equal (tuareg-test--comment-region
	609	"let f x =\n g x\n y\n")
	610	"(* let f x =\n g x\n y *)\n")))
	611	;; Indented code.
	612	(should (let ((comment-style 'indent))
	613	(equal (tuareg-test--comment-region
	614	" epsilon\n tau\n")
	615	" (* epsilon )\n ( tau *)\n")))
	616	(should (let ((comment-style 'multi-line)
	617	(comment-continue " * "))
	618	(equal (tuareg-test--comment-region
	619	" epsilon\n tau\n")
	620	" (* epsilon\n * tau *)\n")))
	621	(should (let ((comment-style 'multi-line)
	622	(comment-continue " "))
	623	(equal (tuareg-test--comment-region
	624	" epsilon\n tau\n")
	625	" (* epsilon\n tau *)\n"))))
	626
	627	(defun tuareg-test--comment-uncomment-region (text)
	628	(equal text
	629	(with-temp-buffer
	630	(tuareg-mode)
	631	(insert text)
	632	(comment-region (point-min) (point-max))
	633	(uncomment-region (point-min) (point-max))
	634	(buffer-string))))
	635
	636	(ert-deftest tuareg-comment-uncomment-region ()
	637	"Check that commenting out code then uncommenting it leads to
	638	the original code."
	639	(should (let ((comment-style 'indent))
	640	(tuareg-test--comment-uncomment-region
	641	"let f x =\n g x\n y\n")))
	642	(should (let ((comment-style 'multi-line)
	643	(comment-continue " * "))
	644	(tuareg-test--comment-uncomment-region
	645	"let f x =\n g x\n y\n")))
	646	(should (let ((comment-style 'multi-line))
	647	(tuareg-test--comment-uncomment-region
	648	"let f x =\n g x\n y\n")))
	649	(should (let ((comment-style 'multi-line)
	650	(comment-continue " "))
	651	(tuareg-test--comment-uncomment-region
	652	"let f x =\n g x\n y\n"))))
	653
	654	(defun tuareg-test--do-at (text pos fun)
	655	"Call FUN in TEXT at POS and return the resulting text."
	656	(with-temp-buffer
	657	(tuareg-mode)
	658	(electric-indent-mode 1)
	659	(insert text)
	660	(goto-char pos)
	661	(funcall fun)
	662	(buffer-substring-no-properties (point-min) (point-max))))
	663
	664	(defun tuareg-test--line-start (text line)
	665	"Position of start of LINE (0-based) in TEXT."
	666	(let ((ofs 0))
	667	(while (and (> line 0)
	668	(let ((nl (string-match-p "\n" text ofs)))
	669	(setq ofs (1+ nl))
	670	(setq line (1- line)))))
	671	(1+ ofs)))
	672
	673	(defun tuareg-test--do-at-line (text line fun)
	674	"Call FUN in TEXT at start of LINE (0-based) and return the resulting text."
	675	(tuareg-test--do-at text (tuareg-test--line-start text line) fun))
	676
	677	(ert-deftest tuareg-indent-comment-text ()
	678	;; Indenting a line should use the indentation of the previous line's text.
	679	(should (equal (tuareg-test--do-at-line
	680	(concat " (** alpha\n"
	681	"beta\n")
	682	1 #'indent-for-tab-command)
	683	(concat " (** alpha\n"
	684	" beta\n")))
	685	;; Tab should indent even at the end of the line.
	686	(should (equal (tuareg-test--do-at
	687	(concat " (** alpha\n"
	688	"beta")
	689	17 #'indent-for-tab-command)
	690	(concat " (** alpha\n"
	691	" beta")))
	692	;; An interactive `newline' should indent the new line correctly
	693	;; in Emacs 28 and later.
	694	(when (>= emacs-major-version 28)
	695	(should (equal (tuareg-test--do-at
	696	"(** alpha"
	697	10 (lambda () (call-interactively #'newline)))
	698	(concat "(** alpha\n"
	699	" "))))
	700	;; The previous line's indentation should be respected and preserved.
	701	(should (equal (tuareg-test--do-at-line
	702	(concat " (* alpha\n"
	703	" beta\n"
	704	" gamma\n")
	705	2 #'indent-for-tab-command)
	706	(concat " (* alpha\n"
	707	" beta\n"
	708	" gamma\n")))
	709	;; Use the previous nonempty line for indentation.
	710	(should (equal (tuareg-test--do-at-line
	711	(concat " (* alpha\n"
	712	" beta\n"
	713	" \n"
	714	" gamma\n")
	715	3 #'indent-for-tab-command)
	716	(concat " (* alpha\n"
	717	" beta\n"
	718	" \n"
	719	" gamma\n")))
	720	;; Indent text after @-tags in doc comments by 2 more spaces.
	721	(should (equal (tuareg-test--do-at-line
	722	(concat " (** alpha\n"
	723	" @param beta\n"
	724	" gamma\n")
	725	2 #'indent-for-tab-command)
	726	(concat " (** alpha\n"
	727	" @param beta\n"
	728	" gamma\n")))
	729	;; An @-tag starts a new paragraph.
	730	(should (equal (tuareg-test--do-at-line
	731	(concat " (** alpha\n"
	732	" @param beta\n"
	733	" @return gamma\n")
	734	2 #'indent-for-tab-command)
	735	(concat " (** alpha\n"
	736	" @param beta\n"
	737	" @return gamma\n")))
	738	;; @-tags are not special in plain comments.
	739	(should (equal (tuareg-test--do-at-line
	740	(concat " (* alpha\n"
	741	" @param beta\n"
	742	" gamma\n")
	743	2 #'indent-for-tab-command)
	744	(concat " (* alpha\n"
	745	" @param beta\n"
	746	" gamma\n")))
	747	;; Filling one paragraph does not affect other paragraphs.
	748	(should (equal (tuareg-test--do-at-line
	749	(concat " (* alpha beta gamma\n"
	750	"delta epsilon\n"
	751	"\n"
	752	"zeta eta theta iota kappa *)\n")
	753	1 (lambda () (let ((fill-column 17))
	754	(funcall (local-key-binding (kbd "M-q"))))))
	755	(concat " (* alpha beta\n"
	756	" gamma delta\n"
	757	" epsilon\n"
	758	"\n"
	759	"zeta eta theta iota kappa *)\n")))
	760	;; Filling affects the preceding paragraph, not the succeeding.
	761	(should (equal (tuareg-test--do-at-line
	762	(concat " (* alpha beta gamma\n"
	763	"delta epsilon\n"
	764	"\n"
	765	"zeta eta theta iota kappa *)\n")
	766	2 (lambda () (let ((fill-column 17))
	767	(funcall (local-key-binding (kbd "M-q"))))))
	768	(concat " (* alpha beta\n"
	769	" gamma delta\n"
	770	" epsilon\n"
	771	"\n"
	772	"zeta eta theta iota kappa *)\n")))
	773
	774	;; A paragraph's indentation is determined by its first line.
	775	(should (equal (tuareg-test--do-at-line
	776	(concat " (* alpha\n"
	777	" beta\n"
	778	"\n"
	779	" gamma\n"
	780	"delta epsilon zeta eta *)\n")
	781	3 (lambda () (let ((fill-column 19))
	782	(funcall (local-key-binding (kbd "M-q"))))))
	783	(concat " (* alpha\n"
	784	" beta\n"
	785	"\n"
	786	" gamma delta\n"
	787	" epsilon zeta\n"
	788	" eta *)\n")))
	789	;; @-tags separate paragraphs in doc comments.
	790	(should (equal (tuareg-test--do-at-line
	791	(concat " (** alpha\n"
	792	" beta\n"
	793	" @param gamma delta epsilon\n"
	794	" @param zeta eta theta iota\n")
	795	4 (lambda () (let ((fill-column 25))
	796	(funcall (local-key-binding (kbd "M-q"))))))
	797	(concat " (** alpha\n"
	798	" beta\n"
	799	" @param gamma delta epsilon\n"
	800	" @param zeta eta\n"
	801	" theta iota\n")))
	802	)
	803
	804
	805	(provide 'tuareg-tests)

-5

~~tuareg.descr~~ less more

0		OCaml mode for GNU Emacs and XEmacs.
1
2		Tuareg handles automatic indentation of OCaml and Camllight codes.
3		Key parts of the code are highlighted using Font-Lock. Support to run
4		an interactive OCaml REPL and debugger is provided.

tuareg.el less more

Binary diff not shown

-12

~~tuareg.install~~ less more

0		share_root: [
1		"tuareg.el" {"emacs/site-lisp/tuareg.el"}
2		"ocamldebug.el" {"emacs/site-lisp/ocamldebug.el"}
3		"tuareg-site-file.el" {"emacs/site-lisp/tuareg-site-file.el"}
4		"tuareg-menhir.el" {"emacs/site-lisp/tuareg-menhir.el"}
5		"tuareg-opam.el" {"emacs/site-lisp/tuareg-opam.el"}
6		"?tuareg.elc" {"emacs/site-lisp/tuareg.elc"}
7		"?ocamldebug.elc" {"emacs/site-lisp/ocamldebug.elc"}
8		"?tuareg-site-file.elc" {"emacs/site-lisp/tuareg-site-file.elc"}
9		"?tuareg-menhir.elc" {"emacs/site-lisp/tuareg-menhir.elc"}
10		"?tuareg-opam.elc" {"emacs/site-lisp/tuareg-opam.elc"}
11		]

+11

-7

tuareg.opam less more

0		opam-version: "1.2"
	0	opam-version: "2.0"
1	1	maintainer: "Christophe.Troestler@umons.ac.be"
2	2	authors: [
3	3	"Albert Cohen <Albert.Cohen@prism.uvsq.fr>"

5	5	"Christophe Troestler <Christophe.Troestler@umons.ac.be>"
6	6	"Stefan Monnier <monnier@iro.umontreal.ca>"
7	7	]
	8	license: "GPL-2.0-or-later"
8	9	homepage: "https://github.com/ocaml/tuareg"
9	10	bug-reports: "https://github.com/ocaml/tuareg/issues"
10		dev-repo: "https://github.com/ocaml/tuareg.git"
	11	dev-repo: "git+https://github.com/ocaml/tuareg.git"
11	12	doc: "https://github.com/ocaml/tuareg"
12	13	build: [
13	14	[make "tuareg-site-file.el"]
14		[make "elc"] { os != "darwin" }
	15	[make "elc"] { os != "macos" }
15	16	]
16		depends: [
17		"conf-emacs"
18		]
	17	depends: ["ocaml" "conf-emacs"]
19	18	depopts: [
20		"caml-mode" # {>= "4.05"}
	19	"caml-mode" {>= "4.9"}
21	20	"merlin"
22	21	]
23	22	post-messages: [

28	27	or \"caml-mode\" (displaying types). See https://github.com/ocaml/tuareg
29	28	for customization tips."
30	29	]
	30	synopsis: "OCaml mode for GNU Emacs"
	31	description: """
	32	Tuareg handles automatic indentation of OCaml and Camllight codes.
	33	Key parts of the code are highlighted using Font-Lock. Support to run
	34	an interactive OCaml REPL and debugger is provided."""

5	5	\| sed 's/;; Package-Requires: \(.\)/\1/')
6	6	DIST_NAME = tuareg-$(VERSION)
7	7	TARBALL = $(DIST_NAME).tar.gz
8		OPAM_DIR = packages/tuareg/tuareg.$(VERSION)
	8	OPAM_FILE = packages/tuareg/tuareg.$(VERSION)/opam
9	9
10		SOURCES = tuareg.el ocamldebug.el tuareg-opam.el tuareg-jbuild.el \
11		tuareg-menhir.el
	10	SOURCES = tuareg.el ocamldebug.el tuareg-opam.el \
	11	tuareg-menhir.el tuareg-compat.el
12	12	ELS = $(SOURCES) tuareg-site-file.el
13	13	ELC = $(ELS:.el=.elc)
14	14
15	15	INSTALL_FILES = $(ELS) $(ELC)
16		INSTALL_DIR ?= $(shell opam config var share)/emacs/site-lisp
	16	INSTALL_DIR ?= $(shell opam var share)/emacs/site-lisp
17	17
18	18	DIST_FILES += $(ELS) Makefile README.md tuareg.install
19	19
20	20	EMACSFORMACOSX = /Applications/Emacs.app/Contents/MacOS/Emacs
21	21	EMACSMACPORTS = /Applications/MacPorts/Emacs.app/Contents/MacOS/Emacs
22		AQUAMACS = $(shell test -d /Applications \
23		&& find /Applications -type f \| grep 'Aquamacs$$')
	22	AQUAMACS = /Applications/Aquamacs.app/Contents/MacOS/Aquamacs
24	23	ifeq ($(wildcard $(EMACSFORMACOSX)),$(EMACSFORMACOSX))
25	24	EMACS ?= $(EMACSFORMACOSX)
26	25	else
27	26	ifeq ($(wildcard $(EMACSMACPORTS)),$(EMACSMACPORTS))
28	27	EMACS ?= $(EMACSMACPORTS)
29	28	else
30		ifneq ($(strip $(AQUAMACS)),)
31	29	ifeq ($(wildcard $(AQUAMACS)),$(AQUAMACS))
32	30	EMACS ?= $(AQUAMACS)
33	31	endif
34	32	endif
35	33	endif
36		endif
37	34	EMACS ?= emacs
38	35
39		#ENABLE_SMIE = --eval '(setq tuareg-use-smie t)'
40	36	RM ?= rm -f
41	37	CP ?= cp -f
42	38	LN = ln

44	40
45	41	INSTALL_RM_R = $(RM) -r
46	42	INSTALL_MKDIR = mkdir -p
47		INSTALL_CP = $(CP)
	43	INSTALL_CP = cp
48	44
49	45	all elc : $(ELC) tuareg-site-file.el
50	46
	47	elc-werror: WERROR=--eval '(setq byte-compile-error-on-warn t)'
	48	elc-werror: elc
	49
51	50	%.elc : %.el
52		$(EMACS) --batch -L . --no-init-file -f batch-byte-compile $<
53		@echo "Files byte-compiled using $(EMACS)"
	51	$(EMACS) --batch -L . --no-init-file $(WERROR) -f batch-byte-compile $<
54	52
55	53	install : $(INSTALL_FILES)
56	54	$(INSTALL_MKDIR) $(INSTALL_DIR)

64	62	.PHONY: refresh
65	63	refresh:
66	64
67		check : sample.ml.test
	65	.PHONY: check
	66	check:
	67	$(EMACS) -batch -Q -L . -l tuareg-tests -f ert-run-tests-batch-and-exit
68	68
69	69	%.test: % $(ELC) refresh
70	70	@echo ====Indent $*====

81	81	indent-test: indent-test.ml.test
82	82
83	83	tuareg-site-file.el: $(SOURCES)
84		(echo ";;; $@ --- Automatically extracted autoloads.";\
	84	(echo ";;; $@ --- Automatically extracted autoloads. -- lexical-binding: t; --";\
85	85	echo ";;; Code:";\
86	86	echo "(add-to-list 'load-path";\
87	87	echo " (or (file-name-directory load-file-name) (car load-path)))";\
88	88	echo "") >$@
89		$(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$@")' -f batch-update-autoloads "."
	89	$(EMACS) --batch --eval '(if (>= emacs-major-version 28) (make-directory-autoloads "." "'`pwd`'/$@") (setq generated-autoload-file "'`pwd`'/$@") (batch-update-autoloads))' "."
	90
	91	tuareg.install:
	92	echo "share_root: [" > $@
	93	for f in $(ELS); do \
	94	echo " \"$$f\" {\"emacs/site-lisp/$$f\"}" >> $@; \
	95	echo " \"?$${f}c\" {\"emacs/site-lisp/$${f}c\"}" >> $@; \
	96	done
	97	echo "]" >> $@
90	98
91	99	dist distrib: $(TARBALL)
92	100

102	110	echo "Make a symbolic link packages → OPAM repository/packages"; \
103	111	exit 1; \
104	112	fi
105		$(INSTALL_MKDIR) $(OPAM_DIR)
106		$(CP) -a $(wildcard .opam .descr) $(OPAM_DIR)
107		echo "archive: \"https://github.com/ocaml/tuareg/releases/download/$(VERSION)/$(TARBALL)\"" > $(OPAM_DIR)/url
108		echo "checksum: \"`md5sum $(TARBALL) \| cut -d ' ' -f 1`\"" \
109		>> $(OPAM_DIR)/url
	113	$(INSTALL_MKDIR) $(dir $(OPAM_FILE))
	114	$(CP) -a tuareg.opam $(OPAM_FILE)
	115	echo "url {" >> $(OPAM_FILE)
	116	echo " src: \"https://github.com/ocaml/tuareg/releases/download/$(VERSION)/$(TARBALL)\"" >> $(OPAM_FILE)
	117	echo " checksum: \"`md5sum $(TARBALL) \| cut -d ' ' -f 1`\"" \
	118	>> $(OPAM_FILE)
	119	echo "}" >> $(OPAM_FILE)
110	120
111	121	clean :
112	122	$(RM) $(ELC) "$(DIST_NAME).tar.gz" "$(DIST_NAME).tar"