pax_global_header00006660000000000000000000000064133470153510014514gustar00rootroot0000000000000052 comment=5796f08757a6d172d628834a40ba6379f318edf5 tuareg-2.2.0/000077500000000000000000000000001334701535100130045ustar00rootroot00000000000000tuareg-2.2.0/.gitignore000066400000000000000000000001171334701535100147730ustar00rootroot00000000000000*.elc *.test *-autoloads.el *-pkg.el *~ *.tar.gz packages /tuareg.*/ ChangeLog tuareg-2.2.0/.travis.yml000066400000000000000000000010561334701535100151170ustar00rootroot00000000000000# Inspired by http://sachachua.com/blog/2015/02/continuous-integration-code-coverage-emacs-packages-travis-coveralls/ language: emacs-lisp sudo: false env: matrix: - EVM_EMACS=emacs-24.3 - EVM_EMACS=emacs-24.4 - EVM_EMACS=emacs-24.5 - EVM_EMACS=emacs-25.1 before_install: - export PATH="$HOME/.evm/bin:$PATH" - git clone https://github.com/rejeep/evm.git $HOME/.evm - evm config path /tmp - evm install ${EVM_EMACS}-travis --use --skip script: - emacs --version - make elc - make indent-test notifications: email: true tuareg-2.2.0/CHANGES.md000066400000000000000000000066671334701535100144150ustar00rootroot000000000000002.2.0 2018- ----------- * New mode `tuareg-menhir` thanks to Stefan Monnier. Note that C-c C-c launches the compilation. * `tuareg-jbuilder`: C-c C-c launches the compilation. * Be more subtle in phrase detection. * Syntax highlighting improvements (`type nonrec`, `raise_notrace`, `with type`). * `tuareg-comment-dwim` is now bound to C-cC-; (fixes #149). * Rework electric functions (fixes issues #150 and #162). * Remove `tuareg-light`, you should now use `tuareg`. Note that the mode `tuareg-dune` which was in the development version of this package is now part of [Dune](https://github.com/ocaml/dune). 2.1.0 2017-11-10 ---------------- * Let M-q reformat strings (and use only SMIE). * Do not indent an expression after `;;` (issue #106). * New face `tuareg-font-double-colon-face` to highlight `;;`. * For `type … and …`, left-align `and` with `type`. * Fix indentation of some GADT type definitions. * Use `prettify-symbols-mode` to turn `+.` into `∔`,… and add a menu entry to toggle it. * Properly indent `type 'a foo = 'a bla = …` (issue #98). * Properly indent (issue #7): module … with module X = Z and type t := C.t * Support `let exception E in expr` (issue #102). * Improved highlighting of `val` and `module` in first class module expressions. * Warn if a file inside a `_build` is edited and propose to switch. * Add a custom face `tuareg-font-lock-label-face` for labels. * Add option `tuareg-match-patterns-aligned` to allow to choose between the two styles: function v.s. function | A | A | B -> ... | B -> ... | C -> ... | C -> ... " * Highlight attributes and extension nodes. * Disable by default and improve the compilation advice—see the new variable `tuareg-opam-insinuate` (issue #97). * New keybinding C-cC-w and function `tuareg-opam-update-env` to update the environment to an opam switch (offering completion). * Improved highlighting of quoted strings `{|…|}` (issue #89). * Move after `;;` when evaluating a phrase in the toploop (issue #96). * ocamldebug: - Add support for `completion-at-point`. - Highlight the right location even in presence of non-ascii chars (issue #80). - Make possible to pass argument to ocamldebug (say, paths with `-I`). - Make possible to pass argument to the program being debugged (issue #66). - Warn if SMIE is disabled. * New modes `tuareg-jbuild` and `tuareg-opam` with syntax highlighting, indentation, and skeletons. 2.0.10 ------ * New indentation config var for SMIE: tuareg-indent-align-with-first-arg. * Many indentation improvements. * Fixed point jumping in ocamldebug completion (by Darius Foo). * Improved (var: t) syntax highlighting. * Color all predefined exceptions with font-lock-builtin-face * Syntax highlight cppo preprocessor directives. 2.0.9 ----- * Do not activate Tuareg for .mll and .mly files. * Toplevel prompt is readonly. * Font-lock code completely rewritten (avoids several hangs). New faces `tuareg-font-lock-module-face', `tuareg-font-lock-constructor-face', and `tuareg-font-lock-line-number-face'. * Non-closed comment does not cause M-q to hang. * New variables `caml-types-build-dirs' and `caml-types-annot-dir' for a more versatile specification of .annot files. (Submitted back to caml-mode.) * Fix toplevel highlighting of output and errors. tuareg-2.2.0/COPYING000066400000000000000000000432121334701535100140410ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. tuareg-2.2.0/HISTORY000066400000000000000000000136661334701535100141040ustar00rootroot00000000000000Tuareg Mode is a thoroughly rewritten derivative of Caml Mode 0.9.x: -------------------------------------------------------------------- First version - By Xavier Leroy and Jerome Vouillon , 1993. Compilation interface - By Ian Zimmerman , 1996; Copyright (C) 1996 Ian Zimmerman, all rights reserved. First Font-Lock and XEmacs support - By Pierre Boulet , 1996. First OCaml and OLabl version - By Jacques Garrigue , 1996. New version for OCaml (Objective Caml) Extension to OCaml (and Labl) syntax (including literals and preserving compatibility with Camllight syntax) complete rewritting of Zimmerman's mode, especially comment detection and indentation, along with major improvement of indentation capabilities, new Font-Lock and Hilit19, compatibility over Emacs and XEmacs; By Albert Cohen , 1997. Tuareg Mode history: -------------------- 1.00 - January 8 1997 - First verion of Tuareg (previously known as Caml-Mode 0.9.2 -> 0.9.8). 1.10 - From March 17 1997 to March 20 1997 - to First release of Tuareg 1.12 Speed-up and fixes. 1.20 - From March 23 1997 to July 28 1997 - to Support for symbol fontifying, adaptation of Font-Lock interface, 1.27 Rewritting of a new Sym-Lock extension for Font-Lock (more powerful, polyvalent, and fitting dynamic customization). Suggestion and first adaptation by Chrstian Boos . Improved phrase detection. `C-M-h' and `C-c C-e' now detect both beginning and end of phrases ; `;;' is used, if present. Improved `tuareg-interactive' mode. Support for Font-Lock on toplevel inputs. Patchs for many phrase detection bugs. New option for `=' indentation, `match-string' optimized, and indentation of `;' sequences accelerated. 1.30 - April 14 1998 - Major improvement of syntax parsing code (including proper handling of multi-line strings and speed-up). Strong speed-up of parenthesis parsing. A few indentation and phrase-related commands bugs corrected. 1.31 - June 8 1998 - Lot of bugs corrected, new customization (more flexible and usable, with some examples). Minor Sym-Lock changes, indentation changes in some cases, simplified installation guidelines. 1.32 - June 26 1998 - Only with XEmacs: Correct string/comment hiliting. A few bugs removed, especially in literal/comment detection. New customization features. 1.33 - November 24 1998 - New support for OCaml 2.00 syntax (let module X=..., and {r with ...}). Indentation bug corrected for arrays, records and objects. 1.34 - December 15 1998 - Bugs corrected in OCaml 2.00 syntax, added new indentation options for parentheses and = symbols. 1.35 - January 13 1999 - Major improvement of interactive mode, thanks to contribution of Michel Quercia. Bug removal in phrase detection and comment indentation (paragraph and lines). 1.36 - January 22 1999 - Navigation support for OCaml manual, library, and buffer-dependent definitions (adapted from original code by Michel Quercia). New commands, and next-error in toplevel by Claude Marché. 1.37 - May 18 2000 - Many improvements and extended support for OCaml 3.00 (like label hiliting). Improved FSF Emacs compatibility thanks to Rémi Vanicat. Corrected bugs in string/comment recognition (the last ones?). 1.38 - September 19 2000 - Standard Customization interface, removal of most non-standard font-lock faces, string/comment hiliting for FSF Emacs eventually matches XEmacs performances; plus a lot of minor fixes. 1.40 - June 26 2002 - Major update: FSF Emacs 21 compatibility (lazy Font-Lock support), new indentation features (e.g., smart comment justification styles), robust hiliting for declarations, many bugs corrected. 1.41 - December 8 2003 - Indentation and hiliting features, many intermediate versions with minor bug fixes, support for caml-types. 1.42 - November 5 2004 - MetaOCaml support, many bug fixes, major rewrite of hiliting code, many improvements and bug fixes to the indentation code, refactoring of some deprecated code (by Stefan Monnier). 1.43 - November 21 2004 - Improved MetaOCaml support, phrase mark/evaluation fixes, many improvements to module indentation and marking, removed aggresive inlining after `=' and fixed related bugs. 1.44 - December 29 2004 - Major fontification improvements, largely by Stefan Monnier. Many bug fixes related with the improvements in 1.42 and 1.43. 1.45 - March 28 2005 - New symbol fontification, compatible with FSF Emacs, by Stefan Monnier. Initiation of a migration of the syntax cache to PPSS for comments and string. 1.46 - May 21 2006 - Integration of more language variants. A future version will modularize this support, to improve flexibility and minimize interference risks. Plus various bug fixes and new features. 1.46 - February 2010 - November 2010 - to Changes by Jane Street Capital, Sam setingold and Christophe 2.04 Troestler. The log of Sam's changes is written below. 2.05 - Cleanup; removal of ocamlspot.el (bundled with ocamlspot). Changes made by Sam Steingold * 2010-02-09 == Many indentation fixes. == Code cleaned up and updated to the modern Emacs Lisp; compilation warnings eliminated. * 2010-03-10 == Treat ">>>" just like ">>=" for indentation purposes. == `Jane style' indentation of `type' statements now requires `tuareg-type-indent'=0. == `until' & `unless' are only special in ls3, not general ocaml. == Other indentation fixes. * 2010-04-20 (1.99.2) == Many indentation fixes. == Better regression testing. == Restore reasonable behavior without Jane custom settings. * 2010-05-03 (2.0) == Many indentation fixes. == Prepare the first official release from Jane Street. tuareg-2.2.0/Makefile000066400000000000000000000067351334701535100144570ustar00rootroot00000000000000VERSION = $(shell grep ';; Version:' tuareg.el \ | sed 's/;; Version: *\([0-9.]*\).*/\1/') DESCRIPTION = $(shell grep ';;; tuareg.el ---' tuareg.el \ | sed 's/[^-]*--- *\([^.]*\).*/\1/') REQUIREMENTS = $(shell grep ';; Package-Requires:' tuareg.el \ | sed 's/;; Package-Requires: *\(.*\)/\1/') DIST_NAME = tuareg-$(VERSION) TARBALL = $(DIST_NAME).tar.gz OPAM_DIR = packages/tuareg/tuareg.$(VERSION) SOURCES = tuareg.el ocamldebug.el tuareg-opam.el tuareg-jbuild.el \ tuareg-menhir.el ELS = $(SOURCES) tuareg-site-file.el ELC = $(ELS:.el=.elc) INSTALL_FILES = $(ELS) $(ELC) INSTALL_DIR ?= $(shell opam config var share)/emacs/site-lisp DIST_FILES += $(ELS) Makefile README.md tuareg.install EMACSFORMACOSX = /Applications/Emacs.app/Contents/MacOS/Emacs EMACSMACPORTS = /Applications/MacPorts/Emacs.app/Contents/MacOS/Emacs AQUAMACS = $(shell test -d /Applications \ && find /Applications -type f | grep 'Aquamacs$$') ifeq ($(wildcard $(EMACSFORMACOSX)),$(EMACSFORMACOSX)) EMACS ?= $(EMACSFORMACOSX) else ifeq ($(wildcard $(EMACSMACPORTS)),$(EMACSMACPORTS)) EMACS ?= $(EMACSMACPORTS) else ifneq ($(strip $(AQUAMACS)),) ifeq ($(wildcard $(AQUAMACS)),$(AQUAMACS)) EMACS ?= $(AQUAMACS) endif endif endif endif EMACS ?= emacs #ENABLE_SMIE = --eval '(setq tuareg-use-smie t)' RM ?= rm -f CP ?= cp -f LN = ln DIFF = diff -u -B INSTALL_RM_R = $(RM) -r INSTALL_MKDIR = mkdir -p INSTALL_CP = $(CP) all elc : $(ELC) tuareg-site-file.el %.elc : %.el $(EMACS) --batch -L . --no-init-file -f batch-byte-compile $< @echo "Files byte-compiled using $(EMACS)" install : $(INSTALL_FILES) $(INSTALL_MKDIR) $(INSTALL_DIR) $(INSTALL_CP) $(INSTALL_FILES) $(INSTALL_DIR)/ $(POST_INSTALL_HOOK) uninstall : -test -d $(INSTALL_DIR) && \ $(INSTALL_RM_R) $(addprefix $(INSTALL_DIR)/, $(INSTALL_FILES)) .PHONY: refresh refresh: check : sample.ml.test %.test: % $(ELC) refresh @echo ====Indent $*==== -$(RM) $@ $(EMACS) --batch -q --no-site-file $(ENABLE_SMIE) \ --load tuareg-site-file.el $< \ --eval '(setq indent-tabs-mode nil)' \ --eval '(defun ask-user-about-lock (file opponent) nil)' \ --eval '(indent-region (point-min) (point-max) nil)' \ --eval '(indent-region (point-min) (point-max) nil)' \ --eval '(write-region (point-min) (point-max) "$@")' $(DIFF) $< $@ || true indent-test: indent-test.ml.test tuareg-site-file.el: $(SOURCES) (echo ";;; $@ --- Automatically extracted autoloads.";\ echo ";;; Code:";\ echo "(add-to-list 'load-path";\ echo " (or (file-name-directory load-file-name) (car load-path)))";\ echo " ") >$@ $(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$@")' -f batch-update-autoloads "." dist distrib: $(TARBALL) $(TARBALL): $(DIST_FILES) mkdir -p $(DIST_NAME) for f in $(DIST_FILES); do $(LN) $$f $(DIST_NAME); done echo '(define-package "tuareg" "$(VERSION)" "$(DESCRIPTION)" ' "'"'$(REQUIREMENTS))' > $(DIST_NAME)/tuareg-pkg.el tar acvf $@ $(DIST_NAME) $(RM) -r $(DIST_NAME) submit: $(TARBALL) @if [ ! -d packages/ ]; then \ echo "Make a symbolic link packages → OPAM repository/packages"; \ exit 1; \ fi $(INSTALL_MKDIR) $(OPAM_DIR) $(CP) -a $(wildcard *.opam *.descr) $(OPAM_DIR) echo "archive: \"https://github.com/ocaml/tuareg/releases/download/$(VERSION)/$(TARBALL)\"" > $(OPAM_DIR)/url echo "checksum: \"`md5sum $(TARBALL) | cut -d ' ' -f 1`\"" \ >> $(OPAM_DIR)/url clean : $(RM) $(ELC) "$(DIST_NAME).tar.gz" "$(DIST_NAME).tar" $(RM) -r tuareg.$(VERSION) .PHONY : all elc clean install uninstall check distrib dist submit tuareg-2.2.0/README.md000066400000000000000000000205641334701535100142720ustar00rootroot00000000000000[![MELPA](https://melpa.org/packages/tuareg-badge.svg)](https://melpa.org/#/tuareg) [![LGPL v2](https://img.shields.io/badge/licence-lgpl2-blue.svg)](COPYING) [![Build Status](https://travis-ci.org/ocaml/tuareg.svg?branch=master)](https://travis-ci.org/ocaml/tuareg) Tuareg: an Emacs OCaml mode =========================== This archive contains files to help editing [OCaml](http://ocaml.org/) code, to highlight important parts of the code, to run an OCaml [REPL](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop) (also called *toplevel*), and to run the OCaml debugger within Emacs. Contents -------- `README.md` — This file. `HISTORY` — Differences with previous versions. `tuareg.el` — A major mode for editing OCaml code in Emacs. `ocamldebug.el` — To run the OCaml debugger under Emacs. `sample.ml` — Sample file to check the indentation engine. Install ------- The easier way to install Tuareg is though the [Emacs package system](https://www.gnu.org/software/emacs/manual/html_node/emacs/Packages.html) and [Melpa](https://melpa.org/) — you first have to [configure the latter](https://melpa.org/#/getting-started). You can also install it using [OPAM](http://opam.ocaml.org/): opam install tuareg and follow the instructions given at the end of the `opam` installation. If you want to install from the Git checkout, just add to your [Init File][] the line: (load "path-to-git-checkout-dir/tuareg-site-file") If you want to byte compile the files, issue `make elc`. If you do this in Darwin, make sure that the version of Emacs displayed at the end of `make elc` is the sole that you use (the `.elc` files may not be compatible with other versions of Emacs installed on your system). Usage & Configuration --------------------- The Tuareg major mode is triggered by visiting a file with extension `.ml`, `.mli`, `.mly`, `.mll`, and `.mlp` or manually by M-x tuareg-mode. Start the OCaml REPL with M-x run-ocaml. To evaluate a phrase, simply type S-⟨return⟩ (shift and return). You can also evaluate a phrase in a different buffer by typing C-c C-e when the cursor is on it (it will start the OCaml REPL if needed). Run the OCaml debugger with M-x ocamldebug FILE. Tips & customization -------------------- - You can comment/uncomment a single line with `tuareg-comment-dwim` which is bound to C-cC-;. - By default, Tuareg will align the arguments of functions as follows: function_name arg1 arg2 This is what most OCaml programmers expect and is convenient if you use the following style: function_name (fun x -> do_something ) arg2 If you prefer the “lisp style” indentation in which arguments on the second line are aligned with the arguments on the first line as in function_name arg1 arg2 put `(setq tuareg-indent-align-with-first-arg t)` in your [Init File][]. In both cases, if there are no argument on the line following the function name, the indentation will be: function_name arg1 arg2 - To make easier to distinguish pattern-match cases containing several patterns, sub-patterns are slightly indented as in match x with | A | B -> ... | C -> ... If you prefer all pipes to be aligned as match x with | A | B -> ... | C -> ... use `(setq tuareg-match-patterns-aligned t)`. - Emacs ≥ 24.4 turned on [electric-indent-mode][] mode by default. If you do not like it, call `(electric-indent-mode 0)` in `tuareg-mode-hook`. [electric-indent-mode]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Indent-Convenience.html - You can turn on and off the rendering of certain sequences of characters as symbols (such as `∔` and `∧` instead of `+.`and `&&`), use `prettify-symbols-mode` or use the check box in the _Tuareg Options_ menu. To enable it by default when you start Tuareg, add the following to your [Init File][]: (add-hook 'tuareg-mode-hook (lambda() (when (functionp 'prettify-symbols-mode) (prettify-symbols-mode)))) If you want more symbols to be prettified (such as `->` being displayed as `→`) at the expense of modifying the indentation in incompatible ways with those not using that option, add `(setq tuareg-prettify-symbols-full t)` to your [Init File][]. - By default, constructors are highlighted with the default face because having too many colors is distracting. If you wish to customize the appearance of constructors, add to your [Init File][] the following code adapted to your tastes. (face-spec-set 'tuareg-font-lock-constructor-face '((((class color) (background light)) (:foreground "SaddleBrown")) (((class color) (background dark)) (:foreground "burlywood1")))) - To have a list of definitions in the buffer, use [imenu][]. It is available by right clicking in the buffer. You can also launch the `speedbar` and click on file to have a list of definitions. [imenu]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Imenu.html - If you wish to have a nice 🐫 as the mode name, add (add-hook 'tuareg-mode-hook #'(lambda() (setq mode-name "🐫"))) to your [Init File][]. Thanks to the work of Stefan Monnier, a new indentation engine based on [SMIE](https://www.gnu.org/software/emacs/manual/html_node/elisp/SMIE.html) was written. This changes the indentation somewhat w.r.t. the previous versions of `tuareg`. If the indentation does not correspond to what you expect, please submit a [motivated issue](https://github.com/ocaml/tuareg/issues/). The standard Emacs customization tool can be used to configure Tuareg options. It is available from the Options menu and Tuareg's Customize sub-menu. Note that, at the moment, both customization options pertaining to the SMIE indentation mode and the old one are present. You may also customize the appearance of OCaml code by twiddling the variables listed at the start of tuareg.el (preferably using `tuareg-mode-hook`, you should not patch the file directly). You should then add to your configuration file something like: (add-hook 'tuareg-mode-hook (lambda () ... ; your customization code )) For example: (add-hook 'tuareg-mode-hook ;; Turn on auto-fill minor mode. (lambda () (auto-fill-mode 1))) See [dot-emacs.el](dot-emacs.el) for some examples. [Init File]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Init-File.html Bugs ---- See the [Github project](https://github.com/ocaml/tuareg/issues). Thanks ------ Ian Zimmerman for the previous mode, compilation interface and debugger enhancement. Jacques Garrigue enhanced Zimmerman's mode along with an adaptation to OCaml (and Labl) syntax. Although this work was performed independently, his useful test file and comments were of great help. Michel Quercia for excellent suggestions, patches, and helpful emacs-lisp contributions (full, ready-to-work implementations, I should say), especially for Tuareg interactive mode, and browser capacities. Denis Barthou, Pierre Boulet, Jean-Christophe Filliatre and Rémi Vanicat for intensive testing, useful suggestions, and help. Ralf Treinen for maintaining the Debian GNU/Linux package. Every people who sent me bug reports, suggestions, comments and patches. Nothing would have improved since version 0.9.2 without their help. Special thanks to Eli Barzilay, Josh Berdine, Christian Boos, Carsten Clasohm, Yann Coscoy, Prakash Countcham, Alvarado Cuihtlauac, Erwan David, Gilles Défourneaux, Philippe Esperet, Gilles Falcon, Tim Freeman, Alain Frisch, Christian Lindig, Claude Marché, Charles Martin, Dave Mason, Stefan Monnier, Toby Moth, Jean-Yves Moyen, Alex Ott, Christopher Quinn, Ohad Rodeh, Rauli Ruohonen, Hendrik Tews, Christophe Troestler, Joseph Sudish, Mattias Waldau and John Whitley. Tuareg mode have been maintained by Albert Cohen until version 1.45. Jane Street took over maintenance based on Albert Cohen's version 1.46 (later retracted by him), and released its first version as 2.0. Reporting --------- The official Tuareg home page is located at: . Bug reports & patches: use the tracker: . tuareg-2.2.0/dot-emacs.el000066400000000000000000000025271334701535100152100ustar00rootroot00000000000000(require 'tuareg) ;; See README (setq tuareg-indent-align-with-first-arg nil) (add-hook 'tuareg-mode-hook (lambda() (setq show-trailing-whitespace t) (setq indicate-empty-lines t) ;; Enable the representation of some keywords using fonts (when (functionp 'prettify-symbols-mode) (prettify-symbols-mode)) (when (functionp 'flyspell-prog-mode) (flyspell-prog-mode)) ;; See README ;;(setq tuareg-match-patterns-aligned t) ;;(electric-indent-mode 0) )) ;; Easy keys to navigate errors after compilation: (define-key tuareg-mode-map [(f12)] 'next-error) (define-key tuareg-mode-map [(shift f12)] 'previous-error) ;; Use Merlin if available (when (require 'merlin nil t) (setq merlin-command 'opam) (add-to-list 'auto-mode-alist '("/\\.merlin\\'" . conf-mode)) (when (functionp 'merlin-document) (define-key tuareg-mode-map (kbd "\C-c\C-h") 'merlin-document)) ;; Run Merlin if a .merlin file in the parent dirs is detected (add-hook 'tuareg-mode-hook (lambda() (let ((fn (buffer-file-name))) (if (and fn (locate-dominating-file fn ".merlin")) (merlin-mode)))))) ;; Choose modes for related config. files (setq auto-mode-alist (append '(("_oasis\\'" . conf-mode) ("_tags\\'" . conf-mode) ("_log\\'" . conf-mode)) auto-mode-alist)) tuareg-2.2.0/indent-test.ml000066400000000000000000000502211334701535100155740ustar00rootroot00000000000000(* indent-test.ml --- Sample file for regression testing. -*- mode: tuareg; indent-tabs-mode:nil -*- * * The code in here has the following property: * - the indentation is acceptable (maybe not perfect for everyone, * but at least correct for some users). * - the indentation code does find this indentation. * We use this for regression testing: "make indent-test" should normally * show no changes, and if it does show changes it should be improvements. * * This is in contrast to sample.ml which contains indentation layouts * which the indentation code doesn't know how to find, so it's normal * for "make sample.ml.test" to show changes which are regressions. *) let server_comments request t = let module M = N in let class M = N in let m M = N in let module M = N in let open Grep.Server in let x = 5 in let modue x y = 5 in let open M in t >>= Grep.server_comments lazy parser every module Make_comp(C : Comparitor) : Comparitor_intf (* issue #7 *) with type t := C.t and module X = Z = struct type t = C.t let ret = C.comp end type 'a foo = 'a option = (* Issue #98 *) | None | Some of 'a let qs1 = {| quoted string |} (* (issue #24) *) let qs2 = {eof| other quoted string |noteof} |eof} (* ocp-indent does it as follows: let test1 = with_connection (fun conn -> do_something conn x; ... ) toto *) let test1 = with_connection (fun conn -> do_something conn x; ... ) let x = match y with (* Issue #71 *) | A | B | C -> do_something () let x = begin match y with | A -> 1 (* Issue #73 *) end let command = (* Issue #130 *) match x with A -> a | B -> b let x = let open M in let x = 5 in x + x ;; let () = let z = function t -> a in foo z let () = foo(function t -> a) ;; let () = begin (begin end) end ;; ;; (* http://caml.inria.fr/mantis/view.php?id=4247 *) let x = { Foo. a = b; c = d; e = {Bar. f = 1; g = 2; }; h = { Quux. i = 3; j = 4; }; } ;; (* http://caml.inria.fr/mantis/view.php?id=4249 *) let x = { a = b; c = d; } ;; (* http://caml.inria.fr/mantis/view.php?id=4255 (¡seems unrelated!) *) let x = { foo: [ `Foo of int | `Bar of string ]; } let s = { a with b = 1; } ;; let a = { M. foo = foo; bar = bar; } let a = { t with M. foo = foo; bar = bar; } let a = { t with M. foo = foo; bar = bar; } type t = [ `Foo of int | `Bar of string ] type t = | A | B | C with sexp type t = A | B | C with sexp type t = | A | B | C type t = [ | `A | `B | `C ] type t = [ (* Comment. *) | `A | `B | `C ] type t = a and typey = 4 and x = b type t = | A and u = | B type _ gadt = | A : int -> int gadt | B : unit gadt | C : float -> float gadt module M = struct type t = | A | B | C with sexp type s = [ | `A | `B | `C ] type u = | D | E with sexp end module N = struct type u = | D | E with sexp end type m = | T with sexp ;; (* http://caml.inria.fr/mantis/view.php?id=4334 *) type foo = a -> b -> c -> d val f : a:a -> b:b -> c:c type bar = a -> b -> c -> d -> e -> f type baz = a -> b -> c -> d -> e -> f val quux : a -> b -> c -> d -> e -> f type t : a:b -> c:d -> e:f -> g val f : a:b -> c:d -> e:f -> g type t = { foo : (a -> b -> c -> d); } type t = { foo : ( a -> b -> c -> d); } type t = { foo : a -> b -> c -> d; bar : a -> b -> c; } type t = { foo : a -> b -> c -> d; bar : a -> b -> c; } type t = { a : B.t; c : D.t; e : F.t; g : H.t I.t; j : K.t L.t; m : N.t O.t; p : ((q:R.t -> s:T.U.t -> v:(W.t -> X.t option) -> y:(Z.t -> A.t -> B.t C.D.t E.t) -> f:(G.t -> H.t I.t option) -> j:(K.t -> L.t M.t option) -> n:(O.t -> p option) -> q:R.t -> s:(string -> unit) -> T.t ) -> U.t -> V.W.t -> X.t); y : Z.t A.t; b : C.t D.t E.t; f : (G.t -> H.t -> I.t J.t); } with sexp_of (* FIXME: If you use `prettify-symbols-mode, the indentation changes :-( *) type 'a v = id:O.t -> ssss:Ssss.t -> dddd:ddd.t -> t:S_m.t -> mmm:Safe_float.t -> qqq:int -> c:C.t -> uuuu:string option -> aaaaaa:Aaaaaa.t -> a:A.t -> rrrrr:Rrrrr.t -> time:Time.t -> typ:[ `L_p of Safe_float.t ] -> bazonk:present option -> o_p_e:O_m.t option -> only_hjkl:present option -> show_junk:int option -> d_p_o: Safe_float.t option -> asdf:present option -> generic:Sexp.t list -> 'a type 'a v = id:O.t -> ssss:Ssss.t -> dddd:ddd.t -> t:S_m.t -> mmm:Safe_float.t -> qqq:int -> c:C.t -> uuuu:string option -> aaaaaa:Aaaaaa.t -> a:A.t -> rrrrr:Rrrrr.t -> time:Time.t -> typ:[ `L_p of Safe_float.t ] -> bazonk:present option -> o_p_e:O_m.t option -> only_hjkl:present option -> show_junk:int option -> d_p_o: Safe_float.t option -> asdf:present option -> generic:Sexp.t list -> 'a ;; (* Not in mantis. *) let bar x = if y then x else z let zot x = quux ~f:(if x then y else z) let zot x = quux ~f:(if x then y else z) let () = if foo then bar else if foo1 then zot else bazonk let () = if foo then bar else if foo1 then zot else bazonk let _ = if until then _ let () = if a then ( b ) else ( c ) let rec count_append l1 l2 count = (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *) match l1 with | [] -> l2 | [x1] -> x1 :: l2 | [x1; x2] -> x1 :: x2 :: l2 | [x1; x2; x3] -> x1 :: x2 :: x3 :: l2 | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2 | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> x1 :: x2 :: x3 :: x4 :: x5 :: (if count > 1000 then slow_append tl l2 else count_append tl l2 (count + 1)) (* New in OCaml-4.02. *) | exception Not_Found -> l2 let x = match x with | Foo of < tag : t; (* FIXME *) md : t; is_me : t; > ;; let x = match x with | Foo of < tag : t; (* FIXME *) md : t; is_me : t; > ;; let foo = ( if a then b else c ) let quux list = List.map list ~f:(fun item -> print_item item ) let foo x = function | Some _ -> true | None -> false let bar x = fun u -> match u with | Some _ -> true | None -> false let zot u = match u with | Some _ -> true | None -> false let () = match x with Foo -> 1 | Bar -> 2 let () = match x with Foo -> 1 | Bar -> 2 let r x = try f x; g x; y x; with e -> raise e let g x = try let a = b in f x; g x; y x; with e -> raise e let h x = try ff a b c d; gg 1 2 3 4; with e -> raise e let () = try _ with Bar -> () let () = (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *) try () with | e -> let x = z in yyyyy (a b) let f = function A -> 1 | B -> 2 let d x = function (* FIXME: Should we leave it like this or align "|" with "match"? I chose with "match" because it looks otherwise odd and is more consistent with the "try" alignments above. *) | A -> (match x with | X -> false | Y -> true | Z -> false) | B -> false let a f = function | A -> 1 | B -> 2 | C -> (function | X -> a | Y -> b) 12 | D -> (match z with | 4 -> 3 | 5 -> 7) let x = foo ~f:(fun _ -> 0 (* Comment. *) ) let f = function x -> y let f x = (let y = x in f x; g y; h z) let f x = (let y = x in f x); g y; h z let g y = a b; c d; e f; (* Comment. *) g h; i j let () = (let a = 1 in let b = 2 in ( a, b)) let () = ((a b c d e, f g h), ( i j k l, m n o p)) let () = if a then let b = P.s ~b ~a ~m in a +. e *. b, b -. e *. b else q.a -. s *. z, q.b +. s *. z let () = (* Comment. *) (let x = 3 in x + 5) let foo = 1 and bar = 2 and zot = 3 in let quux = 4 in foo + bar + zot + quux (* Indent comment to following code. *) let () = try (* foo! bar *) let a = f g c d in a b with _ -> () let () = try f x; with _ -> () let () = (try f x; with _ -> ()) let () = foo (sprintf ("a: %s" ^ " b: %s") a b) let () = try f a with A () -> () | B () -> () | C () -> () let f errors input = let ( @@ ) string bool = if not bool then errors := string :: !errors in input @@ false let x = if mode = foo then bar; conn >>| fun x -> x + 1 >>| fun x -> x + 1 >>| fun x -> x + 1 let () = match _ with | foo -> bar >>| function _ -> _ let () = a >>= fun () -> b >>| fun () -> Deferred.all let x = v >>= fun x -> y >>= fun z -> w >>= fun q -> r let x = v 1 2 3 4 5 6 >>= fun x -> y+1 >>= (* foo! *) fun z -> f 1 2 3 4 5 6 >>= fun y -> w*3 >>= fun q -> r (* This does not work, see comment in tuareg-compute-arrow-indent. * Workaround: wrap code in parens. *) (* let () = * match * a 1 2 3 * 4 5 6 >>= fun a -> * b >>= fun b -> * c * with * | A -> _ *) let () = match let a = a in let b = b in c with | A -> _ let () = match (a >>= fun a -> b >>= fun b -> c) with A -> _ let f t = let (a, b) = to_open in let c = g t a b in () let () = begin foo bar end >>= fun () -> begin foo bar end >>= fun () -> () let () = ( foo bar ) >>= fun () -> ( foo bar ) >>= fun () -> () let () = match e with | `T d -> notify `O `T d; cancel t u ~now let () = let a = 1 and b = 2 and c = 3 in a + b + c let _ = foo bar || snoo blue let _ = ( foo bar || snoo blue ) let _ = (foo bar || snoo blue) let () = Config.load () >>> fun config -> let quux = config.Config.bazonk.Config.Bazonk.quux in load_quux ~input quux config >>> fun quux -> let da = Poo.Snapshot.merge quux in load_foobar config ~input >>> fun foobar -> whatever foobar let () = a >>> fun () -> b let () = a >>= function | b -> c | d -> e >>= f let () = foo >>> fun bar -> baz >>> fun zot -> quux let () = Config.load () >>> fun config -> let quux = x in x >>= fun quux -> x let () = Config.load () >>= fun config -> let quux = x in x >>= fun quux -> x let () = Hashtbl.iter times ~f:(fun ~key:time ~data:azot -> Clock.at time >>> fun () -> Db.iter t.db ~f:(fun dbo -> if S.mem azot (Dbo.azo dbo) then Dbo.dont dbo)) let () = f 1 |! (fun x -> g x x) |! (fun y -> h y y) let () = (let a,b = match c with | D -> e,f | G -> h,i in let j = a + b in j * j), 12 module type M = M2 with type t1 = int and type t2 = int and module S = M3 with type t2 = int with type t3 = int let () = try match () with | () -> () with _ -> () let () = try () with _ -> () let () = ( try () with _ -> ()) let x = foo ~bar @ snoo let x = foo ~bar:snoo @ snoo let () = IO.println out (tagL "ol" (List.map ~f:(tag ~a:[] "li") ( (List.map results ~f:(fun (what,_) -> tag "a" ~a:[("href","#" ^ what)] (what_title what))) @ [tag "a" ~a:[("href","#" ^ message_id)] message_title; tag "a" ~a:[("href","#" ^ legend_id)] legend_title]))) let x = let y = (a ^ b ^ c) in f ~a:b ?c:d ?e:f ~g:(h i j) ~k:(l m) (n o p) let () = foobar (fun () -> step1 >>= fun () -> step2) let w f = List.map f ~f:(fun (a, b) -> L.r a >>= function | Ok s -> `Fst (b, s) | Error e -> `Snd (b, a, e)) class c (a : b) = object inherit d method m = 1 end let f = { a = 1; } let f a = { a = a; } let f a b = { a = a; b = b; } let () = for i = 10 to 17 do printf "%d" i; done let a = B.c d ~e:f [ "g"; "h"; ] let () = f a ~b:c ~d ~e:g u ~q:[ "a"; "b"; ] let a = match b with | Some c -> Some { d = c; e = e } | None -> { d = c; e = e } let a = { b = ( let z = f u in z + z; ); c = (let a = b in { z = z; y = h; }); } let () = { A. b = C.d e ~f:(fun g -> (h.I.j.K.l, m)) |! begin fun n -> match O.p n with | `Q r -> r | `S _k -> assert false end; t = u ~v:w ~x:(Y.z a); b = c ~d:e ~f:(G.h i); j = K.l (fun m -> (N.o p m).R.S.t); u = V.w (fun x -> (Y.x a x).R.S.t); v = V.w (fun d -> (D.g i d).R.S.z); } let x = [(W.background `Blue (W.hbox [ x ])); ] let c f = if S.is_file f then S.load f C.t |! fun x -> c := Some x else C.s C.default |! S.save f |! fun () -> c := None let c f = if S.is_file f then ( S.load f C.t |! fun x -> c := Some x ) else ( C.s C.default |! S.save f |! fun () -> c := None) let foo x = f1 x >= f2 x && f3 (f4 x) let foo x = (>=) (f1 x) (f2 x) && f3 (f4 x) let a = foo (fun () -> a) let a = foo ~f:(fun () -> a) let a = foo (fun () -> a ) let a = foo ~f:(fun () -> a ) let () = (* Comment. *) bar a b c d; foo ~size (* Comment. *) ~min:foo ?reduce ?override () let foo = (* Comment. *) List.map z ~f:(fun m -> M.q m |! T.u ~pr ~verbose:false ~p:H.P.US ~is_bar:false) |! List.sort ~cmp:(fun a b -> compare (I.r a.T.s) (I.r b.T.s)) let check = a lsr 30 >= 3 && b lsr 20 >= 1 && c * 10 > f let () = snoo ~f:(fun foo -> foo = bar && snoo) let () = snoo ~f:(fun foo -> foo + bar && snoo) let () = snoo ~f:(fun foo -> foo && snoo) let variants a = match String.split a ~on:'-' with | [ s1; s2; s3 ] -> let a0 = String.concat ~sep:"" [ s1; s2] in let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *) List.map [ a0; a1; a] ~f:(fun a_s -> lookup a_s) |! List.flatten | _ -> failwith "bad" let f a1 a2 a3 b1 b2 b3 d1 d2 d3 = { aa = func1 a1 a2 a3; bb = func2 b1 b2 b3; (* FIXME: Here it is reasonable to have '|' aligned with 'match' *) cc = (match c with | A -> 1 | B -> 2); dd = func3 d1 d2 d3; } let fv = map3 a b c ~f:(fun x y z -> match x y z with | `No) (* https://forge.ocamlcore.org/tracker/index.php?func=detail&aid=644&group_id=43&atid=255 *) let b = match z with | 0 -> fun x -> x | 1 -> fun x -> 1 module type X = struct val f : float -> float (** This comment should be under "val", like other doc comments and not aligned to the left margin. *) end let test () = (* bug#927 *) if a then if b then x else if c then y else z else something let f x = if x = 1 then print "hello"; print "there"; print "everywhere" let f x = if print "hello"; x = 1 then print "hello"; print "there" let f x = if x = 1 then let y = 2 in print "hello"; print "there" else print "toto" let f x = match x with | 1 -> let x = 2 in if x = 1 then print "hello" | 2 -> print "there" let f x = if x = 1 then match x with | 1 -> print "hello" | 2 -> print "there" else print "toto" let f x = x + 4 + x + 5 + x + 6 let splitting_long_expression = quad.{band, i3} <- quad.{band, i3} +. g +. area_12 *. (P.potential x13 y13 +. P.potential x23 y23) let () = (* Beware of lexing ".;" as a single token! *) A.Axes.box vp; A.fx vp (E.on_ray u0) 0. 2000.; A.Viewport.set_color vp A.Color.green let f x = 1 and g y = 2 let x = let module M = struct end in 0 let x = try a with Not_found -> b let x = try a with Not_found -> b | _ -> c let x = try a with Not_found -> if a then b | flag when String.is_prefix flag ~prefix:"-" -> a | _ -> c let x = "toto try \ tata" let optional_sci_float = do_something ~a:1e-7 ~b:(fun x -> x + 1) let () = f x ~tol:1.0 more arguments; f x ~tol:1. more arguments let array_args = fold s multi_sms.(0).message_number folder more_args (* FIXME *) let () = match var with | <:expr< $lid:f$ >> -> KO | <:expr< $lid:f$ >> when f x -> KO | y when f y -> OK | long_pattern when f long_pattern -> (* Should be more indented than the clause body *) z type t = { mutable a: float; b : int; } (* [struct] and [sig] must be treated the same way. *) module Base64 : sig val f : int -> int end external f : int -> unit (* Treated as [val]. *) = "f_stub" let () = g a.[k] x (* aligned with [a], despite the dot *) let () = g a.[k] 1.0 x (* aligned with [a], despite the dots *) (* OOP elements (from Marc Simpson ). *) class useless = object val n = 10 method incremented () = succ n method add_option = function | Some x -> Some(n + x) | None -> None end class useless' = object(self) val n = 10 method incremented () = succ n method add_option = function | Some x -> Some(n + x) | None -> None end class useless' = object(self) val n = 10 initializer print_endline "Initialised." method incremented () = succ n method private add x = n + x method add_option = function | Some x -> Some(self#add x) | None -> None end (* Signatures with labeled arguments *) val f : x : int -> int -> int val f : ?x : int -> int -> int let subscribe_impl dir topic ~aborted = return ( match Directory.subscribe dir topic with | None -> Error () | Some pipe -> whenever (aborted >>| fun () -> Pipe.close_read pipe); Ok pipe ) next_argument (* should be indented correctly, given the braces *) let x = List.map (function x -> blabla blabla blabla) l let command = Command.Spec.( empty +> flag "-hello" (optional_with_default "Hello" string) ~doc:" The 'hello' of 'hello world'" +> flag "-world" (optional_with_default "World" string) ~doc:" The 'world' of 'hello world'" ) tuareg-2.2.0/ocamldebug.el000066400000000000000000001001461334701535100154320ustar00rootroot00000000000000;;; ocamldebug.el --- Run ocamldebug / camldebug under Emacs. ;; Derived from gdb.el. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Copying is covered by the GNU General Public License. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; History: ;; ;;itz 04-06-96 I pondered basing this on gud. The potential advantages ;;were: automatic bugfix , keymaps and menus propagation. ;;Disadvantages: gud is not so clean itself, there is little common ;;functionality it abstracts (most of the stuff is done in the ;;debugger specific parts anyway), and, most seriously, gud sees it ;;fit to add C-x C-a bindings to the _global_ map, so there would be a ;;conflict between ocamldebug and gdb, for instance. While it's OK to ;;assume that a sane person doesn't use gdb and dbx at the same time, ;;it's not so OK (IMHO) for gdb and ocamldebug. ;;Albert Cohen 04-97: Patch for Tuareg support. ;;Albert Cohen 05-98: A few patches and OCaml customization. ;;Albert Cohen 09-98: XEmacs support and some improvements. ;;Erwan Jahier and Albert Cohen 11-05: support for ocamldebug 3.09. ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (require 'comint) (require 'shell) (require 'tuareg (expand-file-name "tuareg" (file-name-directory (or load-file-name byte-compile-current-file)))) (require 'derived) ;;; Variables. (defvar ocamldebug-last-frame) (defvar ocamldebug-delete-prompt-marker) (defvar ocamldebug-filter-accumulator nil) (defvar ocamldebug-last-frame-displayed-p) (defvar ocamldebug-filter-function) (defvar ocamldebug-kill-output) (defvar ocamldebug-current-buffer nil) (defvar ocamldebug-goto-position) (defvar ocamldebug-goto-output) (defvar ocamldebug-delete-file) (defvar ocamldebug-delete-position) (defvar ocamldebug-delete-output) (defvar ocamldebug-complete-list) (defvar ocamldebug-prompt-pattern "^(\\(ocd\\|cdb\\)) *" "A regexp to recognize the prompt for ocamldebug.") (defvar ocamldebug-overlay-event nil "Overlay for displaying the current event.") (defvar ocamldebug-overlay-under nil "Overlay for displaying the current event.") (defvar ocamldebug-event-marker nil "Marker for displaying the current event.") (defvar ocamldebug-track-frame t "*If non-nil, always display current frame position in another window.") (cond ((and (fboundp 'make-overlay) window-system) (make-face 'ocamldebug-event) (make-face 'ocamldebug-underline) (unless (face-differs-from-default-p 'ocamldebug-event) (invert-face 'ocamldebug-event)) (unless (face-differs-from-default-p 'ocamldebug-underline) (set-face-underline 'ocamldebug-underline t)) (setq ocamldebug-overlay-event (make-overlay 1 1)) (overlay-put ocamldebug-overlay-event 'face 'ocamldebug-event) (setq ocamldebug-overlay-under (make-overlay 1 1)) (overlay-put ocamldebug-overlay-under 'face 'ocamldebug-underline)) (t (setq ocamldebug-event-marker (make-marker)) (setq overlay-arrow-string "=>"))) ;;; OCamldebug mode. (defvar ocamldebug-prefix-map (make-sparse-keymap) "Keymap bound to prefix keys in `ocamldebug-mode' and `tuareg-mode'.") (define-key tuareg-mode-map "\C-x\C-a" ocamldebug-prefix-map) (defvar ocamldebug-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c" ocamldebug-prefix-map) (define-key map "\C-l" 'ocamldebug-refresh) ;; This is already the default anyway! ;;(define-key map "\t" 'comint-dynamic-complete) (define-key map "\M-?" ;; FIXME: This binding is wrong since comint-dynamic-list-completions ;; is a function, not a command. 'comint-dynamic-list-completions) map)) (define-derived-mode ocamldebug-mode comint-mode "OCaml-Debugger" "Major mode for interacting with an ocamldebug process. The following commands are available: \\{ocamldebug-mode-map} \\[ocamldebug-display-frame] displays in the other window the last line referred to in the ocamldebug buffer. \\[ocamldebug-step], \\[ocamldebug-back] and \\[ocamldebug-next], in the ocamldebug window, call ocamldebug to step, backstep or next and then update the other window with the current file and position. If you are in a source file, you may select a point to break at, by doing \\[ocamldebug-break]. Commands: Many commands are inherited from comint mode. Additionally we have: \\[ocamldebug-display-frame] display frames file in other window \\[ocamldebug-step] advance one line in program C-x SPACE sets break point at current line." (setq-local ocamldebug-last-frame nil) (setq-local ocamldebug-delete-prompt-marker (make-marker)) (setq-local ocamldebug-filter-accumulator "") (setq-local ocamldebug-filter-function #'ocamldebug-marker-filter) (setq-local comint-prompt-regexp ocamldebug-prompt-pattern) (setq-local comint-dynamic-complete-functions (cons (if (boundp 'completion-at-point-functions) #'ocamldebug-capf #'ocamldebug-complete) comint-dynamic-complete-functions)) (setq-local comint-prompt-read-only t) (setq-local paragraph-start comint-prompt-regexp) (setq-local ocamldebug-last-frame-displayed-p t) (setq-local shell-dirtrackp t) (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)) ;;; Keymaps. (defun ocamldebug-numeric-arg (arg) (and arg (prefix-numeric-value arg))) (defmacro def-ocamldebug (name key &optional doc args) "Define ocamldebug-NAME to be a command sending NAME ARGS and bound to KEY, with optional doc string DOC. Certain %-escapes in ARGS are interpreted specially if present. These are: %m module name of current module. %d directory of current source file. %c number of current character position %e text of the OCaml variable surrounding point. The `current' source file is the file of the current buffer (if we're in an OCaml buffer) or the source file current at the last break or step (if we're in the ocamldebug buffer), and the `current' module name is the filename stripped of any *.ml* suffixes (this assumes the usual correspondence between module and file naming is observed). The `current' position is that of the current buffer (if we're in a source file) or the position of the last break or step (if we're in the ocamldebug buffer). If a numeric is present, it overrides any ARGS flags and its string representation is simply concatenated with the COMMAND." (let* ((fun (intern (format "ocamldebug-%s" name)))) `(progn ,(if doc `(defun ,fun (arg) ,doc (interactive "P") (ocamldebug-call ,name ,args (ocamldebug-numeric-arg arg)))) (define-key ocamldebug-prefix-map ,key ',fun)))) (def-ocamldebug "step" "\C-s" "Step one source line with display.") (def-ocamldebug "run" "\C-r" "Run the program.") (def-ocamldebug "reverse" "\C-v" "Run the program in reverse.") (def-ocamldebug "last" "\C-l" "Go to latest time in execution history.") (def-ocamldebug "backtrace" "\C-t" "Print the call stack.") (def-ocamldebug "open" "\C-o" "Open the current module." "%m") (def-ocamldebug "close" "\C-c" "Close the current module." "%m") (def-ocamldebug "finish" "\C-f" "Finish executing current function.") (def-ocamldebug "print" "\C-p" "Print value of symbol at point." "%e") (def-ocamldebug "next" "\C-n" "Step one source line (skip functions)") (def-ocamldebug "up" "<" "Go up N stack frames (numeric arg) with display") (def-ocamldebug "down" ">" "Go down N stack frames (numeric arg) with display") (def-ocamldebug "break" "\C-b" "Set breakpoint at current line." "@ \"%m\" # %c") (defun ocamldebug-kill-filter (string) ;gob up stupid questions :-) (setq ocamldebug-filter-accumulator (concat ocamldebug-filter-accumulator string)) (when (string-match "\\(.* \\)(y or n) " ocamldebug-filter-accumulator) (setq ocamldebug-kill-output (cons t (match-string 1 ocamldebug-filter-accumulator))) (setq ocamldebug-filter-accumulator "")) (if (string-match comint-prompt-regexp ocamldebug-filter-accumulator) (let ((output (substring ocamldebug-filter-accumulator (match-beginning 0)))) (setq ocamldebug-kill-output (cons nil (substring ocamldebug-filter-accumulator 0 (1- (match-beginning 0))))) (setq ocamldebug-filter-accumulator "") output) "")) (def-ocamldebug "kill" "\C-k") (defun ocamldebug-kill () "Kill the program." (interactive) (let ((ocamldebug-kill-output)) (with-current-buffer ocamldebug-current-buffer (let ((proc (get-buffer-process (current-buffer))) (ocamldebug-filter-function #'ocamldebug-kill-filter)) (ocamldebug-call "kill") (while (not (and ocamldebug-kill-output (zerop (length ocamldebug-filter-accumulator)))) (accept-process-output proc)))) (if (not (car ocamldebug-kill-output)) (error (cdr ocamldebug-kill-output)) (sit-for 0 300) (ocamldebug-call-1 (if (y-or-n-p (cdr ocamldebug-kill-output)) "y" "n"))))) ;;FIXME: ocamldebug doesn't output the Hide marker on kill (defun ocamldebug-goto-filter (string) ;accumulate onto previous output (setq ocamldebug-filter-accumulator (concat ocamldebug-filter-accumulator string)) (when (or (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+" ocamldebug-goto-position "-[0-9]+[ \t]*\\(before\\).*\n") ocamldebug-filter-accumulator) (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+-" ocamldebug-goto-position "[ \t]*\\(after\\).*\n") ocamldebug-filter-accumulator)) (setq ocamldebug-goto-output (match-string 2 ocamldebug-filter-accumulator)) (setq ocamldebug-filter-accumulator (substring ocamldebug-filter-accumulator (1- (match-end 0))))) (when (string-match comint-prompt-regexp ocamldebug-filter-accumulator) (setq ocamldebug-goto-output (or ocamldebug-goto-output 'fail)) (setq ocamldebug-filter-accumulator "")) (when (string-match "\n\\(.*\\)\\'" ocamldebug-filter-accumulator) (setq ocamldebug-filter-accumulator (match-string 1 ocamldebug-filter-accumulator))) "") (def-ocamldebug "goto" "\C-g") (defun ocamldebug-goto (&optional time) "Go to the execution time TIME. Without TIME, the command behaves as follows: In the ocamldebug buffer, if the point at buffer end, goto time 0\; otherwise, try to obtain the time from context around point. In an OCaml buffer, try to find the time associated in execution history with the current point location. With a negative TIME, move that many lines backward in the ocamldebug buffer, then try to obtain the time from context around point." (interactive "P") (cond (time (let ((ntime (ocamldebug-numeric-arg time))) (if (>= ntime 0) (ocamldebug-call "goto" nil ntime) (save-selected-window (select-window (get-buffer-window ocamldebug-current-buffer)) (save-excursion (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ " nil t (- 1 ntime)) (ocamldebug-goto nil) (error "I don't have %d times in my history" (- 1 ntime)))))))) ((eq (current-buffer) ocamldebug-current-buffer) (let ((time (cond ((eobp) 0) ((save-excursion (beginning-of-line 1) (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ ")) (string-to-number (match-string 1))) ((string-to-number (ocamldebug-format-command "%e")))))) (ocamldebug-call "goto" nil time))) (t (let ((module (ocamldebug-module-name (buffer-file-name))) (ocamldebug-goto-position (int-to-string (1- (point)))) (ocamldebug-goto-output) (address)) ;get a list of all events in the current module (with-current-buffer ocamldebug-current-buffer (let* ((proc (get-buffer-process (current-buffer))) (ocamldebug-filter-function #'ocamldebug-goto-filter)) (ocamldebug-call-1 (concat "info events " module)) (while (not (and ocamldebug-goto-output (zerop (length ocamldebug-filter-accumulator)))) (accept-process-output proc)) (setq address (unless (eq ocamldebug-goto-output 'fail) (re-search-backward (concat "^Time : \\([0-9]+\\) - pc : " ocamldebug-goto-output " - module " module "$") nil t) (match-string 1))))) (if address (ocamldebug-call "goto" nil (string-to-number address)) (error "No time at %s at %s" module ocamldebug-goto-position)))))) (defun ocamldebug-delete-filter (string) (setq ocamldebug-filter-accumulator (concat ocamldebug-filter-accumulator string)) (when (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in " (regexp-quote ocamldebug-delete-file) ", character " ocamldebug-delete-position "\n") ocamldebug-filter-accumulator) (setq ocamldebug-delete-output (match-string 2 ocamldebug-filter-accumulator)) (setq ocamldebug-filter-accumulator (substring ocamldebug-filter-accumulator (1- (match-end 0))))) (when (string-match comint-prompt-regexp ocamldebug-filter-accumulator) (setq ocamldebug-delete-output (or ocamldebug-delete-output 'fail)) (setq ocamldebug-filter-accumulator "")) (if (string-match "\n\\(.*\\)\\'" ocamldebug-filter-accumulator) (setq ocamldebug-filter-accumulator (match-string 1 ocamldebug-filter-accumulator))) "") (def-ocamldebug "delete" "\C-d") (defun ocamldebug-delete (&optional arg) "Delete the breakpoint numbered ARG. Without ARG, the command behaves as follows: In the ocamldebug buffer, try to obtain the time from context around point. In an OCaml buffer, try to find the breakpoint associated with the current point location. With a negative ARG, look for the -ARGth breakpoint pattern in the ocamldebug buffer, then try to obtain the breakpoint info from context around point." (interactive "P") (cond (arg (let ((narg (ocamldebug-numeric-arg arg))) (if (> narg 0) (ocamldebug-call "delete" nil narg) (with-current-buffer ocamldebug-current-buffer (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file " nil t (- 1 narg)) (ocamldebug-delete nil) (error "I don't have %d breakpoints in my history" (- 1 narg))))))) ((eq (current-buffer) ocamldebug-current-buffer) (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ") (arg (cond ((eobp) (save-excursion (re-search-backward bpline nil t)) (string-to-number (match-string 1))) ((save-excursion (beginning-of-line 1) (looking-at bpline)) (string-to-number (match-string 1))) ((string-to-number (ocamldebug-format-command "%e")))))) (ocamldebug-call "delete" nil arg))) (t (let ((ocamldebug-delete-file (concat (ocamldebug-format-command "%m") ".ml")) (ocamldebug-delete-position (ocamldebug-format-command "%c"))) (with-current-buffer ocamldebug-current-buffer (let ((proc (get-buffer-process (current-buffer))) (ocamldebug-filter-function #'ocamldebug-delete-filter) (ocamldebug-delete-output)) (ocamldebug-call-1 "info break") (while (not (and ocamldebug-delete-output (zerop (length ocamldebug-filter-accumulator)))) (accept-process-output proc)) (if (eq ocamldebug-delete-output 'fail) (error "No breakpoint in %s at %s" ocamldebug-delete-file ocamldebug-delete-position) (ocamldebug-call "delete" nil (string-to-number ocamldebug-delete-output))))))))) (defun ocamldebug-complete-filter (string) (setq ocamldebug-filter-accumulator (concat ocamldebug-filter-accumulator string)) (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n" ocamldebug-filter-accumulator) (setq ocamldebug-complete-list (cons (match-string 2 ocamldebug-filter-accumulator) ocamldebug-complete-list)) (setq ocamldebug-filter-accumulator (substring ocamldebug-filter-accumulator (1- (match-end 0))))) (when (string-match comint-prompt-regexp ocamldebug-filter-accumulator) (setq ocamldebug-complete-list (or ocamldebug-complete-list 'fail)) (setq ocamldebug-filter-accumulator "")) (if (string-match "\n\\(.*\\)\\'" ocamldebug-filter-accumulator) (setq ocamldebug-filter-accumulator (match-string 1 ocamldebug-filter-accumulator))) "") (defun ocamldebug-complete () "Perform completion on the ocamldebug command preceding point." (interactive) (let* ((capf-data (ocamldebug-capf)) (command-word (buffer-substring (nth 0 capf-data) (nth 1 capf-data)))) (completion-in-region (nth 0 capf-data) (nth 1 capf-data) (sort (all-completions command-word (nth 2 capf-data)) #'string-lessp)))) (when (fboundp 'completion-at-point) (make-obsolete 'ocamldebug-complete 'completion-at-point "24.1")) (defun ocamldebug-capf () ;; FIXME: Use an `end' after point when applicable. (let* ((end (point)) (cmd-start (save-excursion (beginning-of-line) (if (looking-at comint-prompt-regexp) (match-end 0) (point)))) (start (save-excursion (skip-chars-backward "^ \n" cmd-start) (point)))) `(,start ,end ,(completion-table-dynamic (apply-partially #'ocamldebug--get-completions (buffer-substring cmd-start start)))))) (defun ocamldebug--get-completions (command-prefix str) ;; FIXME: Add some caching? (let ((ocamldebug-complete-list nil)) ;; itz 04-21-96 If we are trying to complete a word of nonzero ;; length, chop off the last character. This is a nasty hack, but it ;; works - in general, not just for this set of words: the completion ;; code will weed out false matches - and it avoids further ;; mucking with ocamldebug's lexer. ;; FIXME: Which problem is this trying to fix/avoid/circumvent? (when (> (length str) 0) (setq str (substring str 0 (1- (length str))))) (let ((ocamldebug-filter-function #'ocamldebug-complete-filter)) (ocamldebug-call-1 (concat "complete " command-prefix str)) (set-marker ocamldebug-delete-prompt-marker nil) (while (not (and ocamldebug-complete-list (zerop (length ocamldebug-filter-accumulator)))) (accept-process-output (get-buffer-process (current-buffer))))) (if (eq ocamldebug-complete-list 'fail) nil ocamldebug-complete-list))) (define-key tuareg-mode-map "\C-x " 'ocamldebug-break) (defvar ocamldebug-command-name "ocamldebug" "Pathname for executing the OCaml debugger.") (defvar ocamldebug-debuggee-args "" "Default arguments to the program being debugged (space separated and possibly quoted as they would be passed on the command line).") ;;;###autoload (defun ocamldebug (pgm-path) "Run ocamldebug on program FILE in buffer *ocamldebug-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for ocamldebug. If you wish to change this, use the ocamldebug commands `cd DIR' and `directory'." (interactive "fRun ocamldebug on file: ") (setq pgm-path (expand-file-name pgm-path)) (let* ((file (file-name-nondirectory pgm-path)) (name (concat "ocamldebug-" file)) (buffer-name (concat "*" name "*"))) (pop-to-buffer buffer-name) (unless (comint-check-proc buffer-name) (setq default-directory (file-name-directory pgm-path)) (setq ocamldebug-debuggee-args (read-from-minibuffer (format "Args for %s: " file) ocamldebug-debuggee-args)) (setq ocamldebug-command-name (read-from-minibuffer "OCaml debugger to run: " ocamldebug-command-name)) (message "Current directory is %s" default-directory) (let* ((args (tuareg--split-args ocamldebug-debuggee-args)) (cmdlist (tuareg--split-args ocamldebug-command-name)) (cmdlist (mapcar #'substitute-in-file-name cmdlist))) (apply #'make-comint name (car cmdlist) nil "-emacs" "-cd" default-directory (append (cdr cmdlist) (cons pgm-path args))) (set-process-filter (get-buffer-process (current-buffer)) 'ocamldebug-filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'ocamldebug-sentinel) (ocamldebug-mode))) (ocamldebug-set-buffer))) ;;;###autoload (defalias 'camldebug 'ocamldebug) (defun ocamldebug-set-buffer () (if (eq major-mode 'ocamldebug-mode) (setq ocamldebug-current-buffer (current-buffer)) (save-selected-window (pop-to-buffer ocamldebug-current-buffer)))) ;;; Filter and sentinel. (defun ocamldebug-marker-filter (string) (setq ocamldebug-filter-accumulator (concat ocamldebug-filter-accumulator string)) (let ((output "") (begin)) ;; Process all the complete markers in this chunk. (while (setq begin (string-match "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n" ocamldebug-filter-accumulator)) (setq ocamldebug-last-frame (unless (char-equal ?H (aref ocamldebug-filter-accumulator (1+ (1+ begin)))) (let ((isbefore (string= "before" (match-string 5 ocamldebug-filter-accumulator))) (startpos (string-to-number (match-string 3 ocamldebug-filter-accumulator))) (endpos (string-to-number (match-string 4 ocamldebug-filter-accumulator)))) (list (match-string 2 ocamldebug-filter-accumulator) (if isbefore startpos endpos) isbefore startpos endpos ))) output (concat output (substring ocamldebug-filter-accumulator 0 begin)) ;; Set the accumulator to the remaining text. ocamldebug-filter-accumulator (substring ocamldebug-filter-accumulator (match-end 0)) ocamldebug-last-frame-displayed-p nil)) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; ocamldebug-filter-accumulator until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "\032.*\\'" ocamldebug-filter-accumulator) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring ocamldebug-filter-accumulator 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq ocamldebug-filter-accumulator (substring ocamldebug-filter-accumulator (match-beginning 0)))) (setq output (concat output ocamldebug-filter-accumulator) ocamldebug-filter-accumulator "")) output)) (defun ocamldebug-filter (proc string) (when (buffer-name (process-buffer proc)) (let ((process-window)) (with-current-buffer (process-buffer proc) ;; If we have been so requested, delete the debugger prompt. (when (marker-buffer ocamldebug-delete-prompt-marker) (delete-region (process-mark proc) ocamldebug-delete-prompt-marker) (set-marker ocamldebug-delete-prompt-marker nil)) (let ((output (funcall ocamldebug-filter-function string))) ;; Don't display the specified file unless ;; (1) point is at or after the position where output appears ;; and (2) this buffer is on the screen. (setq process-window (and ocamldebug-track-frame (not ocamldebug-last-frame-displayed-p) (>= (point) (process-mark proc)) (get-buffer-window (current-buffer)))) ;; Insert the text, moving the process-marker. (comint-output-filter proc output))) (when process-window (save-selected-window (select-window process-window) (ocamldebug-display-frame)))))) (defun ocamldebug-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed ;; Stop displaying an arrow in a source file. (ocamldebug-remove-current-event) (set-process-buffer proc nil)) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (ocamldebug-remove-current-event) ;; Fix the mode line. (setq mode-line-process (concat ": " (symbol-name (process-status proc)))) (let* ((obuf (current-buffer))) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer (unwind-protect (progn ;; Write something in *compilation* and hack its mode line, (set-buffer (process-buffer proc)) ;; Force mode line redisplay soon (set-buffer-modified-p (buffer-modified-p)) (if (eobp) (insert ?\n mode-name " " msg) (save-excursion (goto-char (point-max)) (insert ?\n mode-name " " msg))) ;; If buffer and mode line will show that the process ;; is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc)) ;; Restore old buffer, but don't restore old point ;; if obuf is the cdb buffer. (set-buffer obuf)))))) (defun ocamldebug-refresh (&optional arg) "Fix up a possibly garbled display, and redraw the mark." (interactive "P") (ocamldebug-display-frame) (recenter arg)) (defun ocamldebug-display-frame () "Find, obey and delete the last filename-and-line marker from OCaml debugger. The marker looks like \\032\\032FILENAME:CHARACTER\\n. Obeying it means displaying in another window the specified file and line." (interactive) (ocamldebug-set-buffer) (if (not ocamldebug-last-frame) (ocamldebug-remove-current-event) (ocamldebug-display-line (nth 0 ocamldebug-last-frame) (nth 3 ocamldebug-last-frame) (nth 4 ocamldebug-last-frame) (nth 2 ocamldebug-last-frame))) (setq ocamldebug-last-frame-displayed-p t)) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its character CHARACTER is visible. ;; Put the mark on this character in that buffer. (defun ocamldebug-display-line (true-file schar echar kind) (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen (pop-up-windows t) (buffer (find-file-noselect true-file)) (window (display-buffer buffer t)) (spos) (epos) (pos)) (with-current-buffer buffer (save-restriction (widen) (setq spos (if (fboundp 'filepos-to-bufferpos) (filepos-to-bufferpos schar 'approximate) (+ (point-min) schar))) (setq epos (if (fboundp 'filepos-to-bufferpos) (filepos-to-bufferpos echar 'approximate) (+ (point-min) echar))) (setq pos (if kind spos epos)) (ocamldebug-set-current-event spos epos pos (current-buffer) kind)) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) (set-window-point window pos))) ;;; Events. (defun ocamldebug-remove-current-event () (if (and (fboundp 'make-overlay) window-system) (progn (delete-overlay ocamldebug-overlay-event) (delete-overlay ocamldebug-overlay-under)) (setq overlay-arrow-position nil))) (defun ocamldebug-set-current-event (spos epos pos buffer before) (if window-system (if before (progn (move-overlay ocamldebug-overlay-event spos (1+ spos) buffer) (move-overlay ocamldebug-overlay-under (+ spos 1) epos buffer)) (move-overlay ocamldebug-overlay-event (1- epos) epos buffer) (move-overlay ocamldebug-overlay-under spos (- epos 1) buffer)) (with-current-buffer buffer (goto-char pos) (beginning-of-line) (move-marker ocamldebug-event-marker (point)) (setq overlay-arrow-position ocamldebug-event-marker)))) ;;; Miscellaneous. (defun ocamldebug-module-name (filename) (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) ;; The ocamldebug-call function must do the right thing whether its ;; invoking keystroke is from the ocamldebug buffer itself (via ;; major-mode binding) or an OCaml buffer. In the former case, we want ;; to supply data from ocamldebug-last-frame. Here's how we do it: (defun ocamldebug-format-command (str) (let* ((insource (not (eq (current-buffer) ocamldebug-current-buffer))) (frame (if insource nil ocamldebug-last-frame)) (result "")) (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str)) (let* ((key (aref str (match-beginning 2))) (cmd (match-string 1 str)) (end (match-end 0)) (subst (case key (?m (ocamldebug-module-name (if insource buffer-file-name (nth 0 frame)))) (?d (file-name-directory (if insource buffer-file-name (nth 0 frame)))) (?c (int-to-string ;; FIXME: Should this be (- (point) (point-min))? ;; What happens with multibyte chars? (if insource (1- (point)) (nth 1 frame)))) (?e (save-excursion (skip-chars-backward "_0-9A-Za-z\277-\377") (looking-at "[_0-9A-Za-z\277-\377]*") (match-string 0)))))) (setq str (substring str end)) (setq result (concat result cmd subst)))) ;; There might be text left in STR when the loop ends. (concat result str))) (defun ocamldebug-call (command &optional fmt arg) "Invoke ocamldebug COMMAND displaying source in other window. Certain %-escapes in FMT are interpreted specially if present. These are: %m module name of current module. %d directory of current source file. %c number of current character position %e text of the OCaml variable surrounding point. The `current' source file is the file of the current buffer (if we're in an OCaml buffer) or the source file current at the last break or step (if we're in the ocamldebug buffer), and the `current' module name is the filename stripped of any *.ml* suffixes (this assumes the usual correspondence between module and file naming is observed). The `current' position is that of the current buffer (if we're in a source file) or the position of the last break or step (if we're in the ocamldebug buffer). If ARG is present, it overrides any FMT flags and its string representation is simply concatenated with the COMMAND." ;; Make sure debugger buffer is displayed in a window. (ocamldebug-set-buffer) (message "Command: %s" (ocamldebug-call-1 command fmt arg))) (defun ocamldebug-call-1 (command &optional fmt arg) ;; Record info on the last prompt in the buffer and its position. (with-current-buffer ocamldebug-current-buffer (save-excursion (goto-char (process-mark (get-buffer-process ocamldebug-current-buffer))) (beginning-of-line) (when (looking-at comint-prompt-regexp) (set-marker ocamldebug-delete-prompt-marker (point))))) (let ((cmd (cond (arg (concat command " " (int-to-string arg))) (fmt (ocamldebug-format-command (concat command " " fmt))) (command)))) (process-send-string (get-buffer-process ocamldebug-current-buffer) (concat cmd "\n")) cmd)) (provide 'ocamldebug) ;;; ocamldebug.el ends here tuareg-2.2.0/sample.ml000066400000000000000000000462301334701535100146240ustar00rootroot00000000000000(* Sample file indented as we want it to be. -*- tuareg -*- *) let server_comments request t = let module M = N in let class M = N in let m M = N in let module M = N in let open Grep.Server in let x = 5 in let modue x y = 5 in let open M in t >>= Grep.server_comments lazy parser every let qs1 = {| quoted string |} (* (issue #24) *) let qs2 = {eof| other quoted string |noteof} |eof} (* ocp-indent does it as follows: let test1 = with_connection (fun conn -> do_something conn x; ... ) toto *) let test1 = with_connection (fun conn -> do_something conn x; ... ) toto let x = match y with (* Issue #71 *) | A | B -> do_something () let x = match y, z with | A, (B | C) | X, Y -> do_something() (* Issue #78 *) let x = begin match y with | A -> 1 (* Issue #73 *) end (* The two "let"s below are indented under the assumption that tuareg-indent-align-with-first-arg is nil! *) let x = List.map (fun x -> 5) my list let x = logf `Info "User %s has %i new messages" ba (Uid.to_string uid) (List.length new_messages) let x = let open M in let x = 5 in x + x ;; (* FIXME: MAJOR "function" sends SMIE into a loop (fine with "fun"). Use M-q to test. *) let () = let z = function t -> a in foo z let () = foo(function t -> a) ;; (* FIXME: MAJOR: M-q on the "(" raises 'Scan error: "Unbalanced parentheses"'. It is fine if both () are on the same line. *) let () = begin (begin end) end ;; ;; (* http://caml.inria.fr/mantis/view.php?id=4247 *) let x = { Foo. a = b; c = d; e = {Bar. f = 1; g = 2; }; h = { Quux. i = 3; j = 4; }; } ;; (* http://caml.inria.fr/mantis/view.php?id=4249 *) let x = { a = b; c = d; } ;; (* http://caml.inria.fr/mantis/view.php?id=4255 *) { foo: [ `Foo of int | `Bar of string ]; } let s = { a with b = 1; } ;; let a = { M. foo = foo; bar = bar; } let a = { t with M. foo = foo; bar = bar; } let a = { t with M. foo = foo; bar = bar; } type t = [ `Foo of int | `Bar of string ] type t = | A | B (* issue #76 *) | C with sexp type t = | A | B | C type t = [ | `A | `B | `C ] type t = [ (* Comment. *) | `A | `B | `C ] type t = a and typey = 4 and x = b module M = struct type t = | A | B | C with sexp type s = [ | `A | `B | `C ] type u = | D | E with sexp end module N = struct type u = | D | E with sexp end type m = | T with sexp let f = function | A -> 1 | B | C -> 2 ;; (* http://caml.inria.fr/mantis/view.php?id=4334 *) type foo = a -> b -> c -> d val f : a:a -> b:b -> c:c type bar = a -> b -> c -> d -> e -> f type baz = a -> b -> c -> d -> e -> f val quux : a -> b -> c -> d -> e -> f type t : a:b -> c:d -> e:f -> g val f : a:b -> c:d -> e:f -> g type t = { foo : (a -> b -> c -> d); } type t = { foo : ( a -> b -> c -> d); } type t = { foo : a -> b -> c -> d; bar : a -> b -> c; } type t = { foo : a -> b -> c -> d; bar : a -> b -> c; } type t = { a : B.t; c : D.t; e : F.t; g : H.t I.t; j : K.t L.t; m : N.t O.t; p : ((q:R.t -> s:T.U.t -> v:(W.t -> X.t option) -> y:(Z.t -> A.t -> B.t C.D.t E.t) -> f:(G.t -> H.t I.t option) -> j:(K.t -> L.t M.t option) -> n:(O.t -> p option) -> q:R.t -> s:(string -> unit) -> T.t ) -> U.t -> V.W.t -> X.t); y : Z.t A.t; b : C.t D.t E.t; f : (G.t -> H.t -> I.t J.t); } with sexp_of type 'a v = id:O.t -> ssss:Ssss.t -> dddd:ddd.t -> t:S_m.t -> mmm:Safe_float.t -> qqq:int -> c:C.t -> uuuu:string option -> aaaaaa:Aaaaaa.t -> a:A.t -> rrrrr:Rrrrr.t -> time:Time.t -> typ:[ `L_p of Safe_float.t ] -> bazonk:present option -> o_p_e:O_m.t option -> only_hjkl:present option -> show_junk:int option -> d_p_o: Safe_float.t option -> asdf:present option -> generic:Sexp.t list -> 'a type 'a v = id:O.t -> ssss:Ssss.t -> dddd:ddd.t -> t:S_m.t -> mmm:Safe_float.t -> qqq:int -> c:C.t -> uuuu:string option -> aaaaaa:Aaaaaa.t -> a:A.t -> rrrrr:Rrrrr.t -> time:Time.t -> typ:[ `L_p of Safe_float.t ] -> bazonk:present option -> o_p_e:O_m.t option -> only_hjkl:present option -> show_junk:int option -> d_p_o: Safe_float.t option -> asdf:present option -> generic:Sexp.t list -> 'a ;; (* Not in mantis. *) let bar x = if y then x else z let zot x = quux ~f:(if x then y else z) let zot x = quux ~f:(if x then y else z) let () = if foo then bar else if foo1 then zot else bazonk let () = if foo then bar else if foo1 then zot else bazonk let _ = if until then _ let () = if a then ( b ) else ( c ) let rec count_append l1 l2 count = (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *) match l1 with | [] -> l2 | [x1] -> x1 :: l2 | [x1; x2] -> x1 :: x2 :: l2 | [x1; x2; x3] -> x1 :: x2 :: x3 :: l2 | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2 | x1 :: x2 :: x3 :: x4 :: x5 :: tl -> x1 :: x2 :: x3 :: x4 :: x5 :: (if count > 1000 then slow_append tl l2 else count_append tl l2 (count + 1)) (* New in OCaml-4.02. *) | exception Not_Found -> l2 let x = match x with | Foo of < tag : t; (* FIXME *) md : t; is_me : t; > ;; let x = match x with | Foo of < tag : t; (* FIXME *) md : t; is_me : t; > ;; let foo = ( if a then b else c ) let quux list = List.map list ~f:(fun item -> print_item item ) let foo x = function | Some _ -> true | None -> false let bar x = fun u -> match u with | Some _ -> true | None -> false let zot u = match u with | Some _ -> true | None -> false let () = match x with Foo -> 1 | Bar -> 2 let () = match x with Foo -> 1 | Bar -> 2 let r x = try f x; g x; y x; with e -> raise e let g x = try let a = b in f x; g x; y x; with e -> raise e let h x = try ff a b c d; gg 1 2 3 4; with e -> raise e let () = try _ with Bar -> () let () = (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *) try () with | e -> let x = z in yyyyy (a b) let d x = function (* FIXME: Should we leave it like this or align "|" with "match"? I chose with "match" because it looks otherwise odd and is more consistent with the "try" alignments above. *) | A -> (match x with | X -> false | Y -> true | Z -> false) | B -> false let a f = function | A -> 1 | B -> 2 | C -> (function | X -> a | Y -> b) 12 | D -> (match z with | 4 -> 3 | 5 -> 7) let x = foo ~f:(fun _ -> 0 (* Comment. *) ) let f x = (let y = x in f x; g y; h z) let f x = (let y = x in f x); g y; h z let g y = a b; c d; e f; (* Comment. *) g h; i j let () = (let a = 1 in let b = 2 in ( a, b)) let () = ((a b c d e, f g h), ( i j k l, m n o p)) let () = if a then let b = P.s ~b ~a ~m in a +. e *. b, b -. e *. b else q.a -. s *. z, q.b +. s *. z let () = (* Comment. *) (let x = 3 in x + 5) let x = let foo = 1 and bar = 2 and zot = 3 in let quux = 4 in foo + bar + zot + quux (* Indent comment to following code. *) let () = try (* foo! bar *) let a = f g c d in a b with _ -> () let () = try f x; with _ -> () let () = (try f x; with _ -> ()) let () = foo (sprintf ("a: %s" ^ " b: %s") a b) let () = try f a with A () -> () | B () -> () | C () -> () let f errors input = let ( @@ ) string bool = if not bool then errors := string :: !errors in input @@ false let x = if mode = foo then bar; conn >>| fun x -> x + 1 >>| fun x -> x + 1 >>| fun x -> x + 1 let () = match _ with | foo -> bar >>| function _ -> _ let () = a >>= fun () -> b >>| fun () -> Deferred.all let x = v >>= fun x -> y >>= fun z -> w >>= fun q -> r let x = v 1 2 3 4 5 6 >>= fun x -> y+1 >>= (* foo! *) fun z -> f 1 2 3 4 5 6 >>= fun y -> w*3 >>= fun q -> r (* This does not work, see comment in tuareg-compute-arrow-indent. * Workaround: wrap code in parens. *) (* let () = * match * a 1 2 3 * 4 5 6 >>= fun a -> * b >>= fun b -> * c * with * | A -> _ *) let () = match let a = a in let b = b in c with | A -> _ let () = match (a >>= fun a -> b >>= fun b -> c) with A -> _ let f t = let (a, b) = to_open in let c = g t a b in () let () = begin foo bar end >>= fun () -> begin foo bar end >>= fun () -> () let () = ( foo bar ) >>= fun () -> ( foo bar ) >>= fun () -> () let () = match e with | `T d -> notify `O `T d; cancel t u ~now let () = let a = 1 and b = 2 and c = 3 in a + b + c let _ = foo bar || snoo blue let _ = ( foo bar || snoo blue ) let _ = (foo bar || snoo blue) let () = Config.load () >>> fun config -> let quux = config.Config.bazonk.Config.Bazonk.quux in load_quux ~input quux config >>> fun quux -> let da = Poo.Snapshot.merge quux in load_foobar config ~input >>> fun foobar -> whatever foobar let () = a >>> fun () -> b let () = a >>= function | b -> c | d -> e >>= f let () = foo >>> fun bar -> baz >>> fun zot -> quux let () = Config.load () >>> fun config -> let quux = x in x >>= fun quux -> x let () = Config.load () >>= fun config -> let quux = x in x >>= fun quux -> x let () = Hashtbl.iter times ~f:(fun ~key:time ~data:azot -> Clock.at time >>> fun () -> Db.iter t.db ~f:(fun dbo -> if S.mem azot (Dbo.azo dbo) then Dbo.dont dbo)) let () = f 1 |! (fun x -> g x x) |! (fun y -> h y y) let () = (let a,b = match c with | D -> e,f | G -> h,i in let j = a + b in j * j), 12 module type M = M2 with type t1 = int and type t2 = int and module S = M3 with type t2 = int with type t3 = int let () = try match () with | () -> () with _ -> () let () = try () with _ -> () let () = ( try () with _ -> ()) let x = foo ~bar @ snoo let x = foo ~bar:snoo @ snoo let () = tagL "ol" (List.map ~f:(tag ~a:[] "li") ( (List.map results ~f:(fun (what,_) -> tag "a" ~a:[("href","#" ^ what)] (what_title what))) @ [tag "a" ~a:[("href","#" ^ message_id)] message_title; tag "a" ~a:[("href","#" ^ legend_id)] legend_title])) |> IO.println out let x = let y = (a ^ b ^ c) in f ~a:b ?c:d ?e:f ~g:(h i j) ~k:(l m) (n o p) let () = foobar (fun () -> step1 >>= fun () -> step2) let w f = List.map f ~f:(fun (a, b) -> L.r a >>= function | Ok s -> `Fst (b, s) | Error e -> `Snd (b, a, e)) class c (a : b) = object inherit d method m = 1 end let f = { a = 1; } let f a = { a = a; } let f a b = { a = a; b = b; } let () = for i = 10 to 17 do printf "%d" i; done let a = B.c d ~e:f [ "g"; "h"; ] let () = f a ~b:c ~d ~e:g u ~q:[ "a"; "b"; ] let a = match b with | Some c -> Some { d = c; e = e } | None -> { d = c; e = e } let a = { b = ( let z = f u in z + z; ); c = (let a = b in { z = z; y = h; }); } let () = { A. b = C.d e ~f:(fun g -> (h.I.j.K.l, m)) |! begin fun n -> match O.p n with | `Q r -> r | `S _k -> assert false end; t = u ~v:w ~x:(Y.z a); b = c ~d:e ~f:(G.h i); j = K.l (fun m -> (N.o p m).R.S.t); u = V.w (fun x -> (Y.x a x).R.S.t); v = V.w (fun d -> (D.g i d).R.S.z); } let x = [(W.background `Blue (W.hbox [ x ])); ] let c f = if S.is_file f then S.load f C.t |! fun x -> c := Some x else C.s C.default |! S.save f |! fun () -> c := None let c f = if S.is_file f then ( S.load f C.t |! fun x -> c := Some x ) else ( C.s C.default |! S.save f |! fun () -> c := None) let foo x = f1 x >= f2 x && f3 (f4 x) let foo x = (>=) (f1 x) (f2 x) && f3 (f4 x) let a = foo (fun () -> a) let a = foo ~f:(fun () -> a) let a = foo (fun () -> a ) let a = foo ~f:(fun () -> a ) let () = (* Comment. *) bar a b c d; foo ~size (* Comment. *) ~min:foo ?reduce ?override () let foo = (* Comment. *) List.map z ~f:(fun m -> M.q m |! T.u ~pr ~verbose:false ~p:H.P.US ~is_bar:false) |! List.sort ~cmp:(fun a b -> compare (I.r a.T.s) (I.r b.T.s)) let check = a lsr 30 >= 3 && b lsr 20 >= 1 && c * 10 > f let () = snoo ~f:(fun foo -> foo = bar && snoo) let () = snoo ~f:(fun foo -> foo + bar && snoo) let () = snoo ~f:(fun foo -> foo && snoo) let variants a = match String.split a ~on:'-' with | [ s1; s2; s3 ] -> let a0 = String.concat ~sep:"" [ s1; s2] in let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *) List.map [ a0; a1; a] ~f:(fun a_s -> lookup a_s) |! List.flatten | _ -> failwith "bad" let f a1 a2 a3 b1 b2 b3 d1 d2 d3 = { aa = func1 a1 a2 a3; bb = func2 b1 b2 b3; (* FIXME: Here it is reasonable to have '|' aligned with 'match' *) cc = (match c with | A -> 1 | B -> 2); dd = func3 d1 d2 d3; } let fv = map3 a b c ~f:(fun x y z -> match x y z with | `No) (* https://forge.ocamlcore.org/tracker/index.php?func=detail&aid=644&group_id=43&atid=255 *) let b = match z with | 0 -> fun x -> x | 1 -> fun x -> 1 module type X = struct val f : float -> float (** This comment should be under "val", like other doc comments and not aligned to the left margin. *) end let test () = (* bug#927 *) if a then if b then x else if c then y else z else something let f x = if x = 1 then print "hello"; print "there"; print "everywhere" let f x = if print "hello"; x = 1 then print "hello"; print "there" let f x = if x = 1 then let y = 2 in print "hello"; print "there" else print "toto" let f x = match x with | 1 -> let x = 2 in if x = 1 then print "hello" | 2 -> print "there" let f x = if x = 1 then match x with | 1 -> print "hello" | 2 -> print "there" else print "toto" let f x = x + 4 + x + 5 + x + 6 let splitting_long_expression = quad.{band, i3} <- quad.{band, i3} +. g +. area_12 *. (P.potential x13 y13 +. P.potential x23 y23) let () = (* Beware of lexing ".;" as a single token! *) A.Axes.box vp; A.fx vp (E.on_ray u0) 0. 2000.; A.Viewport.set_color vp A.Color.green let f x = 1 and g y = 2 let x = let module M = struct end in 0 let x = try a with Not_found -> b let x = try a with Not_found -> b | _ -> c let x = try a with Not_found -> if a then b | flag when String.is_prefix flag ~prefix:"-" -> a | _ -> c let x = "toto try \ tata" let optional_sci_float = do_something ~a:1e-7 ~b:(fun x -> x + 1) let () = f x ~tol:1.0 more arguments; f x ~tol:1. more arguments let array_args = fold s multi_sms.(0).message_number folder more_args (* FIXME *) let () = match var with | <:expr< $lid:f$ >> -> KO | <:expr< $lid:f$ >> when f x -> KO | y when f y -> OK | long_pattern when f long_pattern -> (* Should be more indented than the clause body *) z type t = { mutable a: float; b : int; } (* [struct] and [sig] must be treated the same way. *) module Base64 : sig val f : int -> int end external f : int -> unit (* Treated as [val]. *) = "f_stub" let () = g a.[k] x (* aligned with [a], despite the dot *) let () = g a.[k] 1.0 x (* aligned with [a], despite the dots *) (* OOP elements (from Marc Simpson ). *) class useless = object val n = 10 method incremented () = succ n method add_option = function | Some x -> Some(n + x) | None -> None end class useless' = object(self) val n = 10 method incremented () = succ n method add_option = function | Some x -> Some(n + x) | None -> None end class useless' = object(self) val n = 10 initializer print_endline "Initialised." method incremented () = succ n method private add x = n + x method add_option = function | Some x -> Some(self#add x) | None -> None end (* Signatures with labeled arguments *) val f : x : int -> int -> int val f : ?x: int -> int -> int let subscribe_impl dir topic ~aborted = return ( match Directory.subscribe dir topic with | None -> Error () | Some pipe -> whenever (aborted >>| fun () -> Pipe.close_read pipe); Ok pipe ) next_argument (* should be indented correctly, given the braces *) let _ = List.map (function x -> blabla (* FIXME: indentation afer "(function" *) blabla blabla) l let command = Command.Spec.( empty +> flag "-hello" (optional_with_default "Hello" string) ~doc:" The 'hello' of 'hello world'" +> flag "-world" (optional_with_default "World" string) ~doc:" The 'world' of 'hello world'" ) tuareg-2.2.0/tuareg-jbuild.el000066400000000000000000000446021334701535100160720ustar00rootroot00000000000000;;; tuareg-jbuild.el --- Mode for editing jbuild files -*- coding: utf-8 -*- ;; Copyright (C) 2017- Christophe Troestler ;; This file is not part of GNU Emacs. ;; Permission to use, copy, modify, and distribute this software for ;; any purpose with or without fee is hereby granted, provided that ;; the above copyright notice and this permission notice appear in ;; all copies. ;; ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL ;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED ;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE ;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR ;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM ;; LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (require 'scheme) (defvar tuareg-jbuild-mode-hook nil "Hooks for the `tuareg-jbuild-mode'.") (defvar tuareg-jbuild-flymake nil "If t, check your jbuild file with flymake.") (defvar tuareg-jbuild-temporary-file-directory (expand-file-name "Tuareg-jbuild" temporary-file-directory) "Directory where to duplicate the files for flymake.") (defvar tuareg-jbuild-program (expand-file-name "jbuild-lint" tuareg-jbuild-temporary-file-directory) "Script to use to check the jbuild file.") (defgroup tuareg-jbuild nil "Support for Jbuilder files." :group 'languages) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Syntax highlighting (defface tuareg-jbuild-error-face '((t (:foreground "yellow" :background "red" :bold t))) "Face for errors (e.g. obsolete constructs).") (defvar tuareg-jbuild-error-face 'tuareg-jbuild-error-face "Face for errors (e.g. obsolete constructs).") (defconst tuareg-jbuild-keywords-regex (eval-when-compile (concat (regexp-opt '("jbuild_version" "library" "executable" "executables" "rule" "ocamllex" "ocamlyacc" "menhir" "alias" "install" "copy_files" "copy_files#" "include" "documentation") ) "\\(?:\\_>\\|[[:space:]]\\)")) "Keywords in jbuild files.") (defconst tuareg-jbuild-fields-regex (eval-when-compile (regexp-opt '("name" "public_name" "synopsis" "modules" "libraries" "wrapped" "inline_tests" "inline_tests.backend" "preprocess" "preprocessor_deps" "optional" "c_names" "cxx_names" "install_c_headers" "modes" "no_dynlink" "kind" "ppx_runtime_libraries" "virtual_deps" "js_of_ocaml" "flags" "ocamlc_flags" "ocamlopt_flags" "library_flags" "c_flags" "cxx_flags" "c_library_flags" "self_build_stubs_archive" "modules_without_implementation" ;; + for "executable" and "executables": "package" "link_flags" "modes" "names" "public_names" ;; + for "rule": "targets" "action" "deps" "mode" ;; + for "menhir": "merge_into" ;; + for "install" "section" "files" "lib" "libexec" "bin" "sbin" "toplevel" "share" "share_root" "etc" "doc" "stublibs" "man" "misc" ;; for "documentation": "mld_files") 'symbols)) "Field names allowed in jbuild files.") (defvar tuareg-jbuild-builtin-regex (eval-when-compile (concat (regexp-opt '(;; Actions "run" "chdir" "setenv" "with-stdout-to" "with-stderr-to" "with-outputs-to" "ignore-stdout" "ignore-stderr" "ignore-outputs" "progn" "echo" "write-file" "cat" "copy" "copy#" "system" "bash" "diff" "diff?" ;; inline_tests and inline_tests.backend ;; FIXME: "flags" is already a field and we do not have enough ;; context to distinguishing both. "backend" "generate_runner" "runner_libraries" "flags" "extends" ;; Dependency specification "file" "alias" "alias_rec" "glob_files" "files_recursively_in" "universe" "package") t) "\\(?:\\_>\\|[[:space:]]\\)")) "Builtin sub-fields in jbuild") (defvar tuareg-jbuild-var-kind-regex (eval-when-compile (regexp-opt '("path" "path-no-dep" "exe" "bin" "lib" "libexec" "lib-available" "version" "read" "read-lines" "read-strings") 'words)) "Optional prefix to variable names.") (defvar tuareg-jbuild-var-regex (concat "\\(!?\\)\\(\\(?:" tuareg-jbuild-var-kind-regex ":\\)?\\)\\([a-zA-Z][a-zA-Z0-9_.-]*\\|[<@^]\\)" "\\(\\(?::[a-zA-Z][a-zA-Z0-9_.-]*\\)?\\)")) (defmacro tuareg-jbuild--field-vals (field &rest vals) `(list (concat "(" ,field "[[:space:]]+" ,(regexp-opt vals t)) 1 font-lock-constant-face)) (defvar tuareg-jbuild-font-lock-keywords `((,tuareg-jbuild-keywords-regex . font-lock-keyword-face) (,(concat "(" tuareg-jbuild-fields-regex) 1 font-lock-function-name-face) ("\\(true\\|false\\)" 1 font-lock-constant-face) ("(\\(select\\)[[:space:]]+[^[:space:]]+[[:space:]]+\\(from\\)\\>" (1 font-lock-constant-face) (2 font-lock-constant-face)) ,(eval-when-compile (tuareg-jbuild--field-vals "kind" "normal" "ppx_rewriter" "ppx_deriver")) ,(eval-when-compile (tuareg-jbuild--field-vals "mode" "standard" "fallback" "promote" "promote-until-clean")) (,(concat "(" tuareg-jbuild-builtin-regex) 1 font-lock-builtin-face) ("(preprocess[[:space:]]+(\\(pps\\)" 1 font-lock-builtin-face) (,(eval-when-compile (concat "(" (regexp-opt '("fallback") t))) 1 tuareg-jbuild-error-face) (,(concat "${" tuareg-jbuild-var-regex "}") (1 tuareg-jbuild-error-face) (2 font-lock-builtin-face) (4 font-lock-variable-name-face) (5 font-lock-variable-name-face)) (,(concat "$(" tuareg-jbuild-var-regex ")") (1 tuareg-jbuild-error-face) (2 font-lock-builtin-face) (4 font-lock-variable-name-face) (5 font-lock-variable-name-face)) ("\\(:[a-zA-Z]+\\)\\b" 1 font-lock-builtin-face))) (defvar tuareg-jbuild-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\; "< b" table) (modify-syntax-entry ?\n "> b" table) (modify-syntax-entry ?\( "()" table) (modify-syntax-entry ?\) ")(" table) (modify-syntax-entry ?\{ "(}" table) (modify-syntax-entry ?\} "){" table) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) table) "Tuareg-jbuild syntax table.") ;; (defun tuareg-jbuild-syntax-propertize (start end) ;; (funcall ;; (syntax-propertize-rules)) ;; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; SMIE (require 'smie) (defvar tuareg-jbuild-smie-grammar (when (fboundp 'smie-prec2->grammar) (smie-prec2->grammar (smie-bnf->prec2 '())))) (defun tuareg-jbuild-smie-rules (kind token) (cond ((eq kind :close-all) '(column . 0)) ((and (eq kind :after) (equal token ")")) (save-excursion (goto-char (cadr (smie-indent--parent))) (if (looking-at-p tuareg-jbuild-keywords-regex) '(column . 0) 1))) ((eq kind :before) (if (smie-rule-parent-p "(") (save-excursion (goto-char (cadr (smie-indent--parent))) (cond ((looking-at-p tuareg-jbuild-keywords-regex) 1) ((looking-at-p tuareg-jbuild-fields-regex) (smie-rule-parent 0)) ((smie-rule-sibling-p) (cons 'column (current-column))) (t (cons 'column (current-column))))) '(column . 0))) (t 1))) (defun verbose-tuareg-jbuild-smie-rules (kind token) (let ((value (tuareg-jbuild-smie-rules kind token))) (message "%s '%s'; sibling-p:%s parent:%s hanging:%s = %s" kind token (ignore-errors (smie-rule-sibling-p)) (ignore-errors smie--parent) (ignore-errors (smie-rule-hanging-p)) value) value)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Linting (require 'flymake) (defun tuareg-jbuild-create-lint-script () "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." (unless (file-exists-p tuareg-jbuild-program) (let ((dir (file-name-directory tuareg-jbuild-program)) (pgm "#!/usr/bin/env ocaml ;; #load \"unix.cma\";; #load \"str.cma\";; open Printf let filename = Sys.argv.(1) let root = try Some(Sys.argv.(2)) with _ -> None let read_all fh = let buf = Buffer.create 1024 in let b = Bytes.create 1024 in let len = ref 0 in while len := input fh b 0 1024; !len > 0 do Buffer.add_subbytes buf b 0 !len done; Buffer.contents buf let errors = let root = match root with | None | Some \"\" -> \"\" | Some r -> \"--root=\" ^ Filename.quote r in let cmd = sprintf \"jbuilder external-lib-deps %s %s\" root (Filename.quote (Filename.basename filename)) in let env = Unix.environment() in let (_,_,fh) as p = Unix.open_process_full cmd env in let out = read_all fh in match Unix.close_process_full p with | Unix.WEXITED (0|1) -> (* jbuilder will normally exit with 1 as it will not be able to perform the requested action. *) out | Unix.WEXITED 127 -> printf \"jbuilder not found in path.\\n\"; exit 1 | Unix.WEXITED n -> printf \"jbuilder exited with status %d.\\n\" n; exit 1 | Unix.WSIGNALED n -> printf \"jbuilder was killed by signal %d.\\n\" n; exit 1 | Unix.WSTOPPED n -> printf \"jbuilder was stopped by signal %d\\n.\" n; exit 1 let () = let re = \"\\\\(:?\\\\)[\\r\\n]+\\\\([a-zA-Z]+\\\\)\" in let errors = Str.global_substitute (Str.regexp re) (fun s -> let colon = Str.matched_group 1 s = \":\" in let f = Str.matched_group 2 s in if f = \"File\" then \"\\n File\" else if colon then \": \" ^ f else \", \" ^ f) errors in print_string errors")) (make-directory dir t) (append-to-file pgm nil tuareg-jbuild-program) (set-file-modes tuareg-jbuild-program #o777) ))) (defun tuareg-jbuild--temp-name (absolute-path) "Full path of the copy of the filename in `tuareg-jbuild-temporary-file-directory'." (let ((slash-pos (string-match "/" absolute-path))) (file-truename (expand-file-name (substring absolute-path (1+ slash-pos)) tuareg-jbuild-temporary-file-directory)))) (defun tuareg-jbuild-flymake-create-temp (filename _prefix) ;; based on `flymake-create-temp-with-folder-structure'. (unless (stringp filename) (error "Invalid filename")) (tuareg-jbuild--temp-name filename)) (defun tuareg-jbuild--opam-files (dir) "Return all opam files in the directory DIR." (let ((files nil)) (dolist (f (directory-files-and-attributes dir t ".*\\.opam\\'")) (when (null (cadr f)) (push (car f) files))) files)) (defun tuareg-jbuild--root (filename) "Return the root and copy the necessary context files for jbuild." ;; FIXME: the root depends on jbuild-workspace. If none is found, ;; assume the commands are issued from the dir where opam files are found. (let* ((dir (locate-dominating-file (file-name-directory filename) #'tuareg-jbuild--opam-files))) (when dir (setq dir (expand-file-name dir)); In case it is ~/... (make-directory (tuareg-jbuild--temp-name dir) t) (dolist (f (tuareg-jbuild--opam-files dir)) (copy-file f (tuareg-jbuild--temp-name f) t))) dir)) (defun tuareg-jbuild--delete-opam-files (dir) "Delete all opam files in the directory DIR." (dolist (f (tuareg-jbuild--opam-files dir)) (flymake-safe-delete-file f))) (defun tuareg-jbuild-flymake-cleanup () "Attempt to delete temp dir created by `tuareg-jbuild-flymake-create-temp', do not fail on error." (let ((dir (file-name-directory flymake-temp-source-file-name)) (temp-dir (concat (directory-file-name tuareg-jbuild-temporary-file-directory) "/"))) (flymake-log 3 "Clean up %s" flymake-temp-source-file-name) (flymake-safe-delete-file flymake-temp-source-file-name) (condition-case nil (delete-directory (expand-file-name "_build" dir) t) (error nil)) ;; Also delete parent dirs if empty or only contain opam files (while (and (not (string-equal dir temp-dir)) (> (length dir) 0)) (condition-case nil (progn (tuareg-jbuild--delete-opam-files dir) (delete-directory dir) (setq dir (file-name-directory (directory-file-name dir)))) (error ; then top the loop (setq dir "")))))) (defun tuareg-jbuild-flymake-init () (tuareg-jbuild-create-lint-script) (let ((fname (flymake-init-create-temp-buffer-copy 'tuareg-jbuild-flymake-create-temp)) (root (or (tuareg-jbuild--root buffer-file-name) ""))) (list tuareg-jbuild-program (list fname root)))) (defvar tuareg-jbuild--allowed-file-name-masks '("\\(?:\\`\\|/\\)jbuild\\'" tuareg-jbuild-flymake-init tuareg-jbuild-flymake-cleanup) "Flymake entry for jbuild files. See `flymake-allowed-file-name-masks'.") (defvar tuareg-jbuild--err-line-patterns ;; Beware that the path from the root will be reported by jbuild ;; but flymake requires it to match the file name. '(("File \"[^\"]*\\(jbuild\\)\", line \\([0-9]+\\), \ characters \\([0-9]+\\)-\\([0-9]+\\): +\\([^\n]*\\)$" 1 2 3 5)) "Value of `flymake-err-line-patterns' for jbuild files.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Skeletons ;; See Info node "Autotype". (define-skeleton tuareg-jbuild-insert-version-form "Insert the jbuild version." nil "(jbuild_version 1" _ ")" > ?\n) (define-skeleton tuareg-jbuild-insert-library-form "Insert a library stanza." nil "(library" > \n "((name " _ ")" > \n "(public_name " _ ")" > \n "(libraries (" _ "))" > \n "(synopsis \"" _ "\")))" > ?\n) (define-skeleton tuareg-jbuild-insert-executable-form "Insert an executable stanza." nil "(executable" > \n "((name " _ ")" > \n "(public_name " _ ")" > \n "(modules (" _ "))" > \n "(libraries (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-executables-form "Insert an executables stanza." nil "(executables" > \n "((names (" _ "))" > \n "(public_names (" _ "))" > \n "(libraries (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-rule-form "Insert a rule stanza." nil "(rule" > \n "((targets (" _ "))" > \n "(deps (" _ "))" > \n "(action (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-ocamllex-form "Insert an ocamllex stanza." nil "(ocamllex (" _ "))" > ?\n) (define-skeleton tuareg-jbuild-insert-ocamlyacc-form "Insert an ocamlyacc stanza." nil "(ocamlyacc (" _ "))" > ?\n) (define-skeleton tuareg-jbuild-insert-menhir-form "Insert a menhir stanza." nil "(menhir" > \n "((modules (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-alias-form "Insert an alias stanza." nil "(alias" > \n "((name " _ ")" > \n "(deps (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-install-form "Insert an install stanza." nil "(install" > \n "((section " _ ")" > \n "(files (" _ "))))" > ?\n) (define-skeleton tuareg-jbuild-insert-copyfiles-form "Insert a copy_files stanza." nil "(copy_files " _ ")" > ?\n) (define-skeleton tuareg-jbuild-insert-documentation-form "Insert a documentation stanza." nil "(documentation" > \n "((package" _ ")" > \n "(mld_files :standard)))" > ?\n) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar tuareg-jbuild-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'compile) (define-key map "\C-c.v" 'tuareg-jbuild-insert-version-form) (define-key map "\C-c.l" 'tuareg-jbuild-insert-library-form) (define-key map "\C-c.e" 'tuareg-jbuild-insert-executable-form) (define-key map "\C-c.x" 'tuareg-jbuild-insert-executables-form) (define-key map "\C-c.r" 'tuareg-jbuild-insert-rule-form) (define-key map "\C-c.p" 'tuareg-jbuild-insert-ocamllex-form) (define-key map "\C-c.y" 'tuareg-jbuild-insert-ocamlyacc-form) (define-key map "\C-c.m" 'tuareg-jbuild-insert-menhir-form) (define-key map "\C-c.a" 'tuareg-jbuild-insert-alias-form) (define-key map "\C-c.i" 'tuareg-jbuild-insert-install-form) (define-key map "\C-c.c" 'tuareg-jbuild-insert-copyfiles-form) (define-key map "\C-c.d" 'tuareg-jbuild-insert-documentation-form) map) "Keymap used in Tuareg-jbuild mode.") (defun tuareg-jbuild-build-menu () (easy-menu-define tuareg-jbuild-mode-menu (list tuareg-jbuild-mode-map) "Tuareg-jbuild mode menu." '("Jbuild" ("Stanzas" ["version" tuareg-jbuild-insert-version-form t] ["library" tuareg-jbuild-insert-library-form t] ["executable" tuareg-jbuild-insert-executable-form t] ["executables" tuareg-jbuild-insert-executables-form t] ["rule" tuareg-jbuild-insert-rule-form t] ["ocamllex" tuareg-jbuild-insert-ocamllex-form t] ["ocamlyacc" tuareg-jbuild-insert-ocamlyacc-form t] ["menhir" tuareg-jbuild-insert-menhir-form t] ["alias" tuareg-jbuild-insert-alias-form t] ["install" tuareg-jbuild-insert-install-form t] ["copy_files" tuareg-jbuild-insert-copyfiles-form t] ))) (easy-menu-add tuareg-jbuild-mode-menu)) ;;;###autoload (define-derived-mode tuareg-jbuild-mode prog-mode "Tuareg-jbuild" "Major mode to edit jbuild files." (setq-local font-lock-defaults '(tuareg-jbuild-font-lock-keywords)) (setq-local comment-start ";") (setq-local comment-end "") (setq indent-tabs-mode nil) ;(setq-local syntax-propertize-function #'tuareg-jbuild-syntax-propertize) (setq-local require-final-newline mode-require-final-newline) (push tuareg-jbuild--allowed-file-name-masks flymake-allowed-file-name-masks) (smie-setup tuareg-jbuild-smie-grammar #'tuareg-jbuild-smie-rules) (setq-local flymake-err-line-patterns tuareg-jbuild--err-line-patterns) (when (and tuareg-jbuild-flymake buffer-file-name) (flymake-mode t)) (tuareg-jbuild-build-menu) (run-mode-hooks 'tuareg-jbuild-mode-hook)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\(?:\\`\\|/\\)jbuild\\(?:\\.inc\\)?\\'" . tuareg-jbuild-mode)) (provide 'tuareg-jbuild-mode) tuareg-2.2.0/tuareg-menhir.el000066400000000000000000000102661334701535100161020ustar00rootroot00000000000000;;; tuareg-menhir.el --- Support for Menhir (and Ocamlyacc) source code -*- lexical-binding: t; -*- ;; Copyright (C) 2017 Free Software Foundation, Inc ;; Author: Stefan Monnier ;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Major mode to edit Menhir (and Ocamlyacc) source files. ;; Currently provides: ;; - Font-lock highlighting ;; - Automatic indentation ;; - Imenu ;;; Code: (require 'cl-lib) (require 'tuareg) (defgroup tuareg-menhir () "Major mode to edit Menhir source files." :group 'tuareg) (defvar tuareg-menhir-mode-syntax-table (let ((st (make-syntax-table tuareg-mode-syntax-table))) ;; Menhir comments are hellish: can be C, C++, or OCaml style! ;; FIXME: C/C++ style comments aren't allowed inside the OCaml part of the code. (modify-syntax-entry ?/ ". 124b" st) (modify-syntax-entry ?\n "> b" st) st)) (defun tuareg-menhir--in-ocaml-p () "Return non-nil if point is within OCaml code." (let ((pos (car (nth 9 (syntax-ppss))))) (and pos (eq ?\{ (char-after pos))))) (defconst tuareg-menhir--keywords '("parameter" "token" "nonassoc" "left" "right" "type" "start" "on_error_reduce")) ;;;; Indentation (defcustom tuareg-menhir-basic-indent 2 "Default basic indentation step for Menhir files." :type 'integer) (defcustom tuareg-menhir-rule-indent tuareg-menhir-basic-indent "Indentation column of rules." :type 'integer) (defcustom tuareg-menhir-action-indent tuareg-menhir-basic-indent "Indentation action w.r.t rules." :type 'integer) (defun tuareg-menhir--indent-column () (save-excursion (beginning-of-line) (skip-chars-forward " \t") (cond ((looking-at "\\(?:\\sw\\|\\s_\\)+:") 0) ((looking-at "|") tuareg-menhir-rule-indent) ((looking-at "{") (+ tuareg-menhir-rule-indent tuareg-menhir-action-indent)) (t 0)))) (defun tuareg-menhir--indent-ocaml () (let ((smie-rules-function #'tuareg-smie-rules) (smie-grammar tuareg-smie-grammar) (smie-forward-token-function #'tuareg-smie-forward-token) (smie-backward-token-function #'tuareg-smie-backward-token)) (smie-indent-line))) (defun tuareg-menhir--indent (&optional _) (if (save-excursion (beginning-of-line) (tuareg-menhir--in-ocaml-p)) (tuareg-menhir--indent-ocaml) (let ((col (tuareg-menhir--indent-column))) (if (save-excursion (skip-chars-backward " \t") (bolp)) (indent-line-to col) (save-excursion (indent-line-to col)))))) ;;;; Font-lock (defvar tuareg-menhir-font-lock-keywords `(("^\\(\\(?:\\sw\\|\\s_\\)+\\):" (1 font-lock-function-name-face)) (,(concat "^%\\(?:%\\|" (regexp-opt tuareg-menhir--keywords) "\\_>\\)") (0 font-lock-builtin-face)) ("%\\(?:prec\\|public\\|inline\\)\\_>" (0 (unless (tuareg-menhir--in-ocaml-p) font-lock-builtin-face))))) ;;;; Imenu (defvar tuareg-menhir-imenu-generic-expression '((nil "^\\(\\(?:\\sw\\|\\s_\\)+\\):" 1))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.mly\\'" . tuareg-menhir-mode)) ;;;###autoload (define-derived-mode tuareg-menhir-mode prog-mode "Menhir" "Major mode to edit Menhir (and Ocamlyacc) files." (setq-local indent-line-function #'tuareg-menhir--indent) (setq-local comment-start "/* ") (setq-local comment-end " */") (setq-local comment-start-skip "\\(?:[(/]\\*+\\|//+\\)[ \t]*") (setq-local comment-end-skip "[ \t]*\\(?:\\*+[/)]\\)?") (setq-local font-lock-defaults '(tuareg-menhir-font-lock-keywords)) (setq-local imenu-generic-expression tuareg-menhir-imenu-generic-expression) ) (provide 'tuareg-menhir) ;;; tuareg-menhir.el ends here tuareg-2.2.0/tuareg-opam.el000066400000000000000000000212521334701535100155510ustar00rootroot00000000000000;;; tuareg-opam.el --- Mode for editing opam files -*- coding: utf-8 -*- ;; Copyright (C) 2017- Christophe Troestler ;; This file is not part of GNU Emacs. ;; Permission to use, copy, modify, and distribute this software for ;; any purpose with or without fee is hereby granted, provided that ;; the above copyright notice and this permission notice appear in ;; all copies. ;; ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL ;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED ;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE ;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR ;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM ;; LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (defvar tuareg-opam-mode-hook nil) (defvar tuareg-opam-indent-basic 2 "The default amount of indentation.") (defvar tuareg-opam-flymake nil "It t, use flymake to lint OPAM files.") (defvar tuareg-opam-mode-map (let ((map (make-keymap))) (define-key map "\C-j" 'newline-and-indent) map) "Keymap for tuareg-opam mode") (defgroup tuareg-opam nil "Support for the OPAM files." :group 'languages) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Syntax highlighting (defface tuareg-opam-error-face '((t (:foreground "yellow" :background "red" :bold t))) "Face for constructs considered as errors (e.g. deprecated constructs)." :group 'tuareg-opam) (defvar tuareg-opam-error-face 'tuareg-opam-error-face "Face for constructs considered as errors (e.g. deprecated constructs).") (defconst tuareg-opam-keywords '("opam-version" "name" "version" "maintainer" "authors" "license" "homepage" "doc" "bug-reports" "dev-repo" "tags" "patches" "substs" "build" "install" "build-doc" "remove" "depends" "depopts" "conflicts" "depexts" "messages" "post-messages" "available" "flags") "Kewords in OPAM files.") (defconst tuareg-opam-keywords-regex (regexp-opt tuareg-opam-keywords 'symbols)) (defconst tuareg-opam-variables-regex (regexp-opt '("user" "group" "make" "os" "root" "prefix" "lib" "bin" "sbin" "doc" "stublibs" "toplevel" "man" "share" "etc" "name" "pinned" "ocaml-version" "opam-version" "compiler" "preinstalled" "switch" "jobs" "ocaml-native" "ocaml-native-tools" "ocaml-native-dynlink" "arch") 'symbols) "Variables declared in OPAM.") (defconst tuareg-opam-pkg-variables-regex (regexp-opt '("name" "version" "depends" "installed" "enable" "pinned" "bin" "sbin" "lib" "man" "doc" "share" "etc" "build" "hash") 'symbols) "Package variables in OPAM.") (defconst tuareg-opam-deprecated-regex (eval-when-compile (regexp-opt '("build-test") 'symbols))) (defvar tuareg-opam-font-lock-keywords `((,tuareg-opam-deprecated-regex . tuareg-opam-error-face) (,(concat tuareg-opam-keywords-regex ":") 1 font-lock-keyword-face) (,(regexp-opt '("build" "test" "doc" "pinned" "true" "false") 'words) . font-lock-constant-face) (,tuareg-opam-variables-regex . font-lock-variable-name-face) (,(concat "%{" tuareg-opam-variables-regex "}%") (1 font-lock-variable-name-face t)) (,(concat "%{\\([a-zA-Z_][a-zA-Z0-9_+-]*\\):" tuareg-opam-pkg-variables-regex "}%") (1 font-lock-constant-face t) (2 font-lock-variable-name-face t))) "Highlighting for OPAM files") (defvar tuareg-opam-prettify-symbols `(("&" . ,(decode-char 'ucs 8743)); 'LOGICAL AND' (U+2227) ("|" . ,(decode-char 'ucs 8744)); 'LOGICAL OR' (U+2228) ("<=" . ,(decode-char 'ucs 8804)) (">=" . ,(decode-char 'ucs 8805)) ("!=" . ,(decode-char 'ucs 8800))) "Alist of symbol prettifications for OPAM files. See `prettify-symbols-alist' for more information.") (defvar tuareg-opam-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?# "< b" table) (modify-syntax-entry ?\n "> b" table) (modify-syntax-entry ?\( "()" table) (modify-syntax-entry ?\) ")(" table) (modify-syntax-entry ?\{ "(}" table) (modify-syntax-entry ?\} "){" table) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) table) "Tuareg-opam syntax table.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SMIE (require 'smie) (defvar tuareg-opam-smie-grammar (let* ((decl-of-kw (lambda(kw) `(decls ,kw ":" list))) (bnfprec2 (smie-bnf->prec2 `((decls . ,(mapcar decl-of-kw tuareg-opam-keywords) ) (list ("[" list "]") (value)) (value (string "{" filter "}") (string)) (string) (filter))))) (smie-prec2->grammar (smie-merge-prec2s bnfprec2 (smie-precs->prec2 '((right "&" "|") (left "=" "!=" ">" ">=" "<" "<="))) )))) (defun tuareg-opam-smie-rules (kind token) (cond ((and (eq kind :before) (member token tuareg-opam-keywords)) 0) ((and (eq kind :before) (equal token "[") (smie-rule-hanging-p)) 0) ((and (eq kind :before) (equal token "{")) 0) (t tuareg-opam-indent-basic))) (defvar tuareg-opam-smie-verbose-p t "Emit context information about the current syntax state.") (defmacro tuareg-opam-smie-debug (message &rest format-args) `(progn (when tuareg-opam-smie-verbose-p (message (format ,message ,@format-args))) nil)) (defun verbose-tuareg-opam-smie-rules (kind token) (let ((value (tuareg-opam-smie-rules kind token))) (tuareg-opam-smie-debug "%s '%s'; sibling-p:%s parent:%s prev-is-[:%s hanging:%s = %s" kind token (ignore-errors (smie-rule-sibling-p)) (ignore-errors smie--parent) (ignore-errors (smie-rule-prev-p "[")) (ignore-errors (smie-rule-hanging-p)) value) value)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Linting (require 'flymake) (defun tuareg-opam-flymake-init () (let ((fname (flymake-init-create-temp-buffer-copy #'flymake-create-temp-inplace))) (list "opam" (list "lint" fname)))) (defvar tuareg-opam--allowed-file-name-masks '("[./]opam_?\\'" tuareg-opam-flymake-init) "Flymake entry for OPAM files. See `flymake-allowed-file-name-masks'.") (defvar tuareg-opam--err-line-patterns '(("File \"\\([^\"]+\\)\", line \\([0-9]+\\), \ characters \\([0-9]+\\)-\\([0-9]+\\): +\\([^\n]*\\)$" 1 2 3 5)) "Value of `flymake-err-line-patterns' for OPAM files.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Skeleton (define-skeleton tuareg-opam-insert-opam-form "Insert a minimal opam file." nil "opam-version: \"1.2\"" > \n "maintainer: \"" _ "\"" > \n "authors: [" _ "]" > \n "tags: [" _ "]" > \n "license: \"" _ "\"" > \n "homepage: \"" _ "\"" > \n "dev-repo: \"" _ "\"" > \n "bug-reports: \"" _ "\"" > \n "doc: \"" _ "\"" > \n "build: [" > \n "[ \"dune\" \"subst\" ] {pinned}" > \n "[ \"dune\" \"build\" \"-p\" name \"-j\" jobs \"--profile\" \"release\" ]" > \n "]" > \n "depends: [" > \n "\"dune\" {build}" > \n "]" > ?\n) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar tuareg-opam-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c.o" 'tuareg-opam-insert-opam-form) map) "Keymap used in Tuareg-opam mode.") (defun tuareg-opam-build-menu () (easy-menu-define tuareg-opam-mode-menu (list tuareg-opam-mode-map) "Tuareg-opam mode menu." '("OPAM" ["Skeleton" tuareg-opam-insert-opam-form t])) (easy-menu-add tuareg-opam-mode-menu)) ;;;###autoload (define-derived-mode tuareg-opam-mode prog-mode "Tuareg-opam" "Major mode to edit opam files." (setq font-lock-defaults '(tuareg-opam-font-lock-keywords)) (setq-local comment-start "#") (setq-local comment-end "") (setq-local prettify-symbols-alist tuareg-opam-prettify-symbols) (setq indent-tabs-mode nil) (setq-local require-final-newline mode-require-final-newline) (smie-setup tuareg-opam-smie-grammar #'tuareg-opam-smie-rules) (push tuareg-opam--allowed-file-name-masks flymake-allowed-file-name-masks) (setq-local flymake-err-line-patterns tuareg-opam--err-line-patterns) (when (and tuareg-opam-flymake buffer-file-name) (flymake-mode t)) (tuareg-opam-build-menu) (run-mode-hooks 'tuareg-opam-mode-hook)) ;;;###autoload (add-to-list 'auto-mode-alist '("[./]opam_?\\'" . tuareg-opam-mode)) (provide 'tuareg-opam-mode) tuareg-2.2.0/tuareg-site-file.el000066400000000000000000000075461334701535100165100ustar00rootroot00000000000000;;; tuareg-site-file.el --- Automatically extracted autoloads. ;;; Code: (add-to-list 'load-path (or (file-name-directory load-file-name) (car load-path))) ;;;### (autoloads nil "ocamldebug" "ocamldebug.el" (22960 18385 186574 ;;;;;; 216000)) ;;; Generated autoloads from ocamldebug.el (autoload 'ocamldebug "ocamldebug" "\ Run ocamldebug on program FILE in buffer *ocamldebug-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for ocamldebug. If you wish to change this, use the ocamldebug commands `cd DIR' and `directory'. \(fn PGM-PATH)" t nil) (defalias 'camldebug 'ocamldebug) ;;;*** ;;;### (autoloads nil "tuareg" "tuareg.el" (23451 62160 790210 240000)) ;;; Generated autoloads from tuareg.el (add-to-list 'auto-mode-alist '("\\.ml[ip]?\\'" . tuareg-mode)) (add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode)) (dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmi" ".annot" ".cmt" ".cmti")) (add-to-list 'completion-ignored-extensions ext)) (autoload 'tuareg-mode "tuareg" "\ Major mode for editing OCaml code. Dedicated to Emacs and XEmacs, version 21 and higher. Provides automatic indentation and compilation interface. Performs font/color highlighting using Font-Lock. It is designed for OCaml but handles Caml Light as well. The Font-Lock minor-mode is used according to your customization options. You have better byte-compile tuareg.el. For customization purposes, you should use `tuareg-mode-hook' \(run for every file) or `tuareg-load-hook' (run once) and not patch the mode itself. You should add to your configuration file something like: (add-hook 'tuareg-mode-hook (lambda () ... ; your customization code )) For example you can change the indentation of some keywords, the `electric' flags, Font-Lock colors... Every customizable variable is documented, use `C-h-v' or look at the mode's source code. `dot-emacs.el' is a sample customization file for standard changes. You can append it to your `.emacs' or use it as a tutorial. `M-x ocamldebug' FILE starts the OCaml debugger ocamldebug on the executable FILE, with input and output in an Emacs buffer named *ocamldebug-FILE*. A Tuareg Interactive Mode to evaluate expressions in a REPL (aka toplevel) is included. Type `M-x tuareg-run-ocaml' or simply `M-x run-ocaml' or see special-keys below. Short cuts for the Tuareg mode: \\{tuareg-mode-map} Short cuts for interactions with the REPL: \\{tuareg-interactive-mode-map} \(fn)" t nil) (autoload 'tuareg-run-ocaml "tuareg" "\ Run an OCaml REPL process. I/O via buffer `*OCaml*'. \(fn)" t nil) (defalias 'run-ocaml 'tuareg-run-ocaml) (add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode)) (add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode)) ;;;*** ;;;### (autoloads nil "tuareg-jbuild" "tuareg-jbuild.el" (23450 52106 ;;;;;; 385127 834000)) ;;; Generated autoloads from tuareg-jbuild.el (autoload 'tuareg-jbuild-mode "tuareg-jbuild" "\ Major mode to edit jbuild files. \(fn)" t nil) (add-to-list 'auto-mode-alist '("\\(?:\\`\\|/\\)jbuild\\(?:\\.inc\\)?\\'" . tuareg-jbuild-mode)) ;;;*** ;;;### (autoloads nil "tuareg-menhir" "tuareg-menhir.el" (23072 32307 ;;;;;; 345047 725000)) ;;; Generated autoloads from tuareg-menhir.el (add-to-list 'auto-mode-alist '("\\.mly\\'" . tuareg-menhir-mode)) (autoload 'tuareg-menhir-mode "tuareg-menhir" "\ Major mode to edit Menhir (and Ocamlyacc) files. \(fn)" t nil) ;;;*** ;;;### (autoloads nil "tuareg-opam" "tuareg-opam.el" (23451 62169 ;;;;;; 386245 46000)) ;;; Generated autoloads from tuareg-opam.el (autoload 'tuareg-opam-mode "tuareg-opam" "\ Major mode to edit opam files. \(fn)" t nil) (add-to-list 'auto-mode-alist '("[./]opam_?\\'" . tuareg-opam-mode)) ;;;*** ;;;### (autoloads nil nil ("dot-emacs.el" "tuareg-mly.el") (22644 ;;;;;; 5433 590766 76000)) ;;;*** tuareg-2.2.0/tuareg.descr000066400000000000000000000003441334701535100153160ustar00rootroot00000000000000OCaml mode for GNU Emacs and XEmacs. Tuareg handles automatic indentation of OCaml and Camllight codes. Key parts of the code are highlighted using Font-Lock. Support to run an interactive OCaml REPL and debugger is provided. tuareg-2.2.0/tuareg.el000066400000000000000000004314261334701535100146270ustar00rootroot00000000000000;;; tuareg.el --- OCaml mode for Emacs. -*- coding: utf-8 -*- ;; Copyright (C) 1997-2006 Albert Cohen, all rights reserved. ;; Copyright (C) 2009-2010 Jane Street Holding, LLC. ;; Licensed under the GNU General Public License. ;; Author: Albert Cohen ;; Sam Steingold ;; Christophe Troestler ;; Till Varoquaux ;; Sean McLaughlin ;; Stefan Monnier ;; Created: 8 Jan 1997 ;; Version: 2.2.0 ;; Package-Requires: ((caml "3.12.0.1")) ;; Keywords: ocaml languages ;; URL: https://github.com/ocaml/tuareg ;; EmacsWiki: TuaregMode ;;; Commentary: ;; Description: ;; Tuareg helps editing OCaml code, to highlight important parts of ;; the code, to run an OCaml REPL, and to run the OCaml debugger ;; within Emacs. ;; Installation: ;; If you have permissions to the local `site-lisp' directory, you ;; only have to copy `tuareg.el', `ocamldebug.el' ;; and `tuareg-site-file.el'. Otherwise, copy the previous files ;; to a local directory and add the following line to your `.emacs': ;; ;; (add-to-list 'load-path "DIR") ;;; Usage: ;; Tuareg allows you to run batch OCaml compilations from Emacs (using ;; M-x compile) and browse the errors (C-x `). Typing C-x ` sets the ;; point at the beginning of the erroneous program fragment, and the ;; mark at the end. Under Emacs, the program fragment is temporarily ;; hilighted. ;; ;; M-x tuareg-run-ocaml (or simply `run-ocaml') starts an OCaml ;; REPL (aka toplevel) with input and output in an Emacs buffer named ;; `*OCaml*. This gives you the full power of Emacs to edit ;; the input to the OCaml REPL. This mode is based on comint so ;; you get all the usual comint features, including command history. A ;; hook named `tuareg-interactive-mode-hook' may be used for ;; customization. ;; ;; Typing C-c C-e in a buffer in tuareg mode sends the current phrase ;; (containing the point) to the OCaml REPL, and evaluates it. If ;; you type one of these commands before M-x tuareg-run-ocaml, the ;; REPL will be started automatically. ;; ;; M-x ocamldebug FILE starts the OCaml debugger ocamldebug on the ;; executable FILE, with input and output in an Emacs buffer named ;; *ocamldebug-FILE*. It is similar to April 1996 version, with minor ;; changes to support XEmacs, Tuareg and OCaml. Furthermore, package ;; `thingatpt' is not required any more. ;; This file is *NOT* part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;;; Code: (eval-when-compile (require 'cl)) (require 'easymenu) (defconst tuareg-mode-revision (eval-when-compile (with-temp-buffer (if (file-directory-p ".git") (progn (insert "git: ") (call-process "git" nil t nil "log" "--pretty=%h" "-1"))) (unless (zerop (buffer-size)) (buffer-substring-no-properties (point-min) (1- (point-max)))))) "Tuareg revision from the control system used.") (defconst tuareg-mode-version (let ((version "Tuareg Version 2.2.0")) (if (null tuareg-mode-revision) version (concat version " (" tuareg-mode-revision ")") )) " Copyright (C) 1997-2006 Albert Cohen, all rights reserved. Copyright (C) 2009-2010 Jane Street Holding, LLC. Copyright (C) 2011- Stefan Monnier & Christophe Troestler Copying is covered by the GNU General Public License. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Compatibility functions (defun tuareg-editing-ls3 () "Tell whether we are editing Lucid Synchrone syntax." (string-match-p "\\.ls\\'" (or buffer-file-name (buffer-name)))) (defun tuareg-editing-ocamllex () "Tell whether we are editing OCamlLex syntax." (string-match-p "\\.mll\\'" (or buffer-file-name (buffer-name)))) (defalias 'tuareg-match-string (if (fboundp 'match-string-no-properties) 'match-string-no-properties 'match-string)) (or (fboundp 'read-shell-command) (defun read-shell-command (prompt &optional initial-input history) "Read a string from the minibuffer, using `shell-command-history'." (read-from-minibuffer prompt initial-input nil nil (or history 'shell-command-history)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Import types and help features (defvar tuareg-with-caml-mode-p (and (require 'caml-types nil t) (require 'caml-help nil t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User customizable variables (require 'smie nil 'noerror) ;; Use the standard `customize' interface or `tuareg-mode-hook' to ;; Configure these variables (require 'custom) (defgroup tuareg nil "Support for the OCaml language." :group 'languages) ;; Indentation defaults (defcustom tuareg-default-indent 2 "*Default indentation. Global indentation variable (large values may lead to indentation overflows). When no governing keyword is found, this value is used to indent the line if it has to." :group 'tuareg :type 'integer) (defcustom tuareg-support-camllight nil "*If true, handle Caml Light character syntax (incompatible with labels)." :group 'tuareg :type 'boolean :set (lambda (var val) (set-default var val) (when (boundp 'tuareg-mode-syntax-table) (modify-syntax-entry ?` (if val "\"" ".") tuareg-mode-syntax-table)))) (defcustom tuareg-support-metaocaml nil "*If true, handle MetaOCaml syntax." :group 'tuareg :type 'boolean :set (lambda (var val) (set-default var val) (ignore-errors (dolist (buf (buffer-list)) (with-current-buffer buf (when (derived-mode-p 'tuareg-mode 'tuareg-interactive-mode) (tuareg-install-font-lock))))))) (defcustom tuareg-in-indent 0 ; tuareg-default-indent "*How many spaces to indent from a `in' keyword. Upstream recommends 0, and this is what we default to since 2.0.1 instead of the historical `tuareg-default-indent'." :group 'tuareg :type 'integer) (defcustom tuareg-with-indent 0 "*How many spaces to indent from a `with' keyword. The examples at show the '|' is aligned with 'match', thus 0 is the default value." :group 'tuareg :type 'integer) (defcustom tuareg-match-clause-indent 1 "*How many spaces to indent a clause of match after a pattern `| ... ->' or `... ->' (pattern without preceding `|' in the first clause of a matching). To respect the default is 1.") (defcustom tuareg-match-when-indent (+ 4 tuareg-match-clause-indent) "*How many spaces from `|' to indent `when' in a pattern match | patt when cond -> clause") (defcustom tuareg-match-patterns-aligned nil "Non-nil means that the pipes for multiple patterns of a single case are aligned instead of being slightly shifted to spot the multiple patterns better. function v.s. function | A | A | B -> ... | B -> ... | C -> ... | C -> ... " :group 'tuareg :type 'boolean) ;; Tuareg-Interactive ;; Configure via `tuareg-mode-hook' ;; Automatic indentation (make-obsolete-variable 'tuareg-use-abbrev-mode "Use `electric-indent-mode' instead." "2.2.0") (defcustom tuareg-electric-indent nil "Whether to automatically indent the line after typing one of the words in `tuareg-electric-indent-keywords'. Lines starting with `|', `)', `]`, and `}' are always indented when the `electric-indent-mode' is turned on." :group 'tuareg :type 'boolean) (defcustom tuareg-electric-close-vector t "*Non-nil means electrically insert `|' before a vector-closing `]' or `>' before an object-closing `}'. Many people find electric keys irritating, so you can disable them by setting this variable to nil. You should probably have this on, though, if you also have `tuareg-electric-indent' on." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-scroll-to-bottom-on-output nil "*Controls when to scroll to the bottom of the interactive buffer upon evaluating an expression. See `comint-scroll-to-bottom-on-output' for details." :group 'tuareg :type 'boolean :set (lambda (var val) (set-default var val) (when (boundp 'comint-scroll-to-bottom-on-output) (dolist (buf (buffer-list)) (with-current-buffer buf (when (derived-mode-p 'tuareg-interactive-mode) (setq-local comint-scroll-to-bottom-on-output val))))))) (defcustom tuareg-skip-after-eval-phrase t "*Non-nil means skip to the end of the phrase after evaluation in the OCaml REPL." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-read-only-input nil "*Non-nil means input sent to the OCaml REPL is read-only." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-echo-phrase t "*Non-nil means echo phrases in the REPL buffer when sending them to the OCaml REPL." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-input-font-lock t "*Non nil means Font-Lock for REPL input phrases." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-output-font-lock t "*Non nil means Font-Lock for REPL output messages." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-error-font-lock t "*Non nil means Font-Lock for REPL error messages." :group 'tuareg :type 'boolean) (defcustom tuareg-display-buffer-on-eval t "*Non nil means pop up the OCaml REPL when evaluating code." :group 'tuareg :type 'boolean) (defcustom tuareg-manual-url "http://caml.inria.fr/pub/docs/manual-ocaml/" "*URL to the OCaml reference manual." :group 'tuareg :type 'string) (defcustom tuareg-browser 'browse-url "*Name of function that displays the OCaml reference manual. Valid names are `browse-url', `browse-url-firefox', etc." :group 'tuareg) (defcustom tuareg-library-path "/usr/local/lib/ocaml/" "*Path to the OCaml library." :group 'tuareg :type 'string) (defvar tuareg-options-list `(["Prettify symbols" prettify-symbols-mode :style toggle :selected prettify-symbols-mode :active t]) "*List of menu-configurable Tuareg options.") (defvar tuareg-interactive-options-list '(("Skip phrase after evaluation" . 'tuareg-skip-after-eval-phrase) ("Echo phrase in interactive buffer" . 'tuareg-interactive-echo-phrase) "---" ("Font-lock interactive input" . 'tuareg-interactive-input-font-lock) ("Font-lock interactive output" . 'tuareg-interactive-output-font-lock) ("Font-lock interactive error" . 'tuareg-interactive-error-font-lock) "---" ("Read only input" . 'tuareg-interactive-read-only-input)) "*List of menu-configurable Tuareg options.") (defvar tuareg-interactive-program "ocaml" "*Default program name for invoking an OCaml REPL (aka toplevel) from Emacs.") ;; Could be interesting to have this variable buffer-local ;; (e.g., ocaml vs. metaocaml buffers) ;; (make-variable-buffer-local 'tuareg-interactive-program) (defcustom tuareg-opam-insinuate nil "By default, Tuareg will use the environment that Emacs was launched in. That environment may not contain an OCaml compiler (say, because Emacs was launched graphically and the path is set in ~/.bashrc) and will remain unchanged when one issue an \"opam switch\" in a shell. If this variable is set to t, Tuareg will try to use opam to set the right environment for `compile', `run-ocaml' and `merlin-mode' based on the current opam switch at the time the command is run (provided opam is found). You may also use `tuareg-opam-update-env' to set the environment for another compiler from within emacs (without changing the opam switch). Beware that setting it to t causes problems if you compile under tramp." :group 'tuareg :type 'boolean) (defgroup tuareg-faces nil "Special faces for the Tuareg mode." :group 'tuareg) (defconst tuareg-faces-inherit-p (and (boundp 'face-attribute-name-alist) (assq :inherit face-attribute-name-alist))) (defface tuareg-font-lock-governing-face '((((class color) (type tty)) (:bold t)) (((background light)) (:foreground "black" :bold t)) (t (:foreground "wheat" :bold t))) "Face description for governing/leading keywords." :group 'tuareg-faces) (defvar tuareg-font-lock-governing-face 'tuareg-font-lock-governing-face) (defface tuareg-font-lock-multistage-face '((((background light)) (:foreground "darkblue" :background "lightgray" :bold t)) (t (:foreground "steelblue" :background "darkgray" :bold t))) "Face description for MetaOCaml staging operators." :group 'tuareg-faces) (defvar tuareg-font-lock-multistage-face 'tuareg-font-lock-multistage-face) (defface tuareg-font-lock-line-number-face '((((background light)) (:foreground "dark gray")) (t (:foreground "gray60"))) "Face description for line numbering directives." :group 'tuareg-faces) (defvar tuareg-font-lock-line-number-face 'tuareg-font-lock-line-number-face) (defface tuareg-font-lock-operator-face '((((background light)) (:foreground "brown")) (t (:foreground "khaki"))) "Face description for all operators." :group 'tuareg-faces) (defvar tuareg-font-lock-operator-face 'tuareg-font-lock-operator-face) (defface tuareg-font-lock-module-face '((t (:inherit font-lock-type-face))); backward compatibility "Face description for modules and module paths." :group 'tuareg-faces) (defvar tuareg-font-lock-module-face 'tuareg-font-lock-module-face) (defface tuareg-font-lock-constructor-face '((t (:inherit default))) "Face description for constructors of (polymorphic) variants and exceptions." :group 'tuareg-faces) (defvar tuareg-font-lock-constructor-face 'tuareg-font-lock-constructor-face) (defface tuareg-font-lock-label-face '((t (:inherit font-lock-constant-face keep))) "Face description for labels." :group 'tuareg-faces) (defvar tuareg-font-lock-label-face 'tuareg-font-lock-label-face) (defface tuareg-font-double-colon-face '((t (:foreground "OrangeRed"))) "Face description for ;; which is not needed in standard code." :group 'tuareg-faces) (defvar tuareg-font-double-colon-face 'tuareg-font-double-colon-face) (defface tuareg-font-lock-error-face '((t (:foreground "yellow" :background "red" :bold t))) "Face description for all errors reported to the source." :group 'tuareg-faces) (defvar tuareg-font-lock-error-face 'tuareg-font-lock-error-face) (defface tuareg-font-lock-interactive-output-face '((((background light)) (:foreground "blue4")) (t (:foreground "grey"))) "Face description for all outputs in the REPL." :group 'tuareg-faces) (defvar tuareg-font-lock-interactive-output-face 'tuareg-font-lock-interactive-output-face) (defface tuareg-font-lock-interactive-error-face (if tuareg-faces-inherit-p '((t :inherit font-lock-warning-face)) '((((background light)) (:foreground "red3")) (t (:foreground "red2")))) "Face description for all REPL errors." :group 'tuareg-faces) (defvar tuareg-font-lock-interactive-error-face 'tuareg-font-lock-interactive-error-face) (defface tuareg-font-lock-interactive-directive-face '((((background light)) (:foreground "slate gray")) (t (:foreground "light slate gray"))) "Face description for all REPL directives such as #load." :group 'tuareg-faces) (defvar tuareg-font-lock-interactive-directive-face 'tuareg-font-lock-interactive-directive-face) (defface tuareg-font-lock-attribute-face (if tuareg-faces-inherit-p '((t :inherit font-lock-preprocessor-face)) '((((background light)) (:foreground "DodgerBlue2")) (t (:foreground "LightSteelBlue")))) "Face description for OCaml attribute annotations." :group 'tuareg-faces) (defvar tuareg-font-lock-attribute-face 'tuareg-font-lock-attribute-face) (defface tuareg-font-lock-infix-extension-node-face (if tuareg-faces-inherit-p '((t :inherit font-lock-preprocessor-face)) '((((background light)) (:foreground "Orchid")) (((background dark)) (:foreground "LightSteelBlue")) (t (:foreground "LightSteelBlue")))) "Face description for OCaml the infix extension node." :group 'tuareg-faces) (defvar tuareg-font-lock-infix-extension-node-face 'tuareg-font-lock-infix-extension-node-face) (defface tuareg-font-lock-extension-node-face (if tuareg-faces-inherit-p '((t :inherit tuareg-font-lock-infix-extension-node-face :background "gray92")) '((((background light)) (:foreground "Orchid" :background "gray92")) (((background dark)) (:foreground "LightSteelBlue" :background "gray92")) (t (:foreground "LightSteelBlue")))) "Face description for OCaml extension nodes." :group 'tuareg-faces) (defvar tuareg-font-lock-extension-node-face 'tuareg-font-lock-extension-node-face) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support definitions ;; This function is different from the standard in that it does NOT signal ;; errors at beginning-of-buffer. (defun tuareg-backward-char (&optional step) (if step (goto-char (- (point) step)) (goto-char (1- (point))))) (defun tuareg-in-indentation-p () "Return non-nil if all chars between beginning of line and point are blanks." (save-excursion (skip-chars-backward " \t") (bolp))) (defun tuareg-in-literal-or-comment-p (&optional pos) "Return non-nil if point is inside an OCaml literal or comment." (nth 8 (syntax-ppss pos))) (defun tuareg-backward-up-list () ;; FIXME: not clear if moving out of a string/comment should count as 1 or no. (condition-case nil (backward-up-list) (scan-error (goto-char (point-min))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font-lock in Emacs ;; Originally by Stefan Monnier (defcustom tuareg-font-lock-symbols nil "*Display fun and -> and such using symbols in fonts. This may sound like a neat trick, but note that it can change the alignment and can thus lead to surprises. On recent Emacs >= 24.4, use `prettify-symbols-mode'." :group 'tuareg :type 'boolean) (when (fboundp 'prettify-symbols-mode) (make-obsolete-variable 'tuareg-font-lock-symbols 'prettify-symbols-mode "Emacs-24.4")) (defcustom tuareg-prettify-symbols-full nil "It t, add fun and -> and such to be prettified with symbols. This may sound like a neat trick, but note that it can change the alignment and can thus lead to surprises. By default, only symbols that do not perturb in essential ways the alignment are used. See `tuareg-prettify-symbols-basic-alist' and `tuareg-prettify-symbols-extra-alist'." :group 'tuareg :type 'boolean) (defvar tuareg-prettify-symbols-basic-alist (cond ((fboundp 'decode-char) ;; use a unicode font. `(("sqrt" . ,(decode-char 'ucs 8730)) ("&&" . ,(decode-char 'ucs 8743)); 'LOGICAL AND' (U+2227) ("||" . ,(decode-char 'ucs 8744)); 'LOGICAL OR' (U+2228) ("+." . ,(decode-char 'ucs 8724));DOT PLUS (U+2214) ("-." . ,(decode-char 'ucs 8760));DOT MINUS (U+2238) ;;("*." . ,(decode-char 'ucs 215)) ("*." . ,(decode-char 'ucs 8729)); BULLET OPERATOR ("/." . ,(decode-char 'ucs 247)) ("<-" . ,(decode-char 'ucs 8592)) ("<=" . ,(decode-char 'ucs 8804)) (">=" . ,(decode-char 'ucs 8805)) ("<>" . ,(decode-char 'ucs 8800)) ("==" . ,(decode-char 'ucs 8801)) ("!=" . ,(decode-char 'ucs 8802)) ("<=>" . ,(decode-char 'ucs 8660)) ("infinity" . ,(decode-char 'ucs 8734)) ;; Some greek letters for type parameters. ("'a" . ,(decode-char 'ucs 945)) ("'b" . ,(decode-char 'ucs 946)) ("'c" . ,(decode-char 'ucs 947)) ("'d" . ,(decode-char 'ucs 948)) ("'e" . ,(decode-char 'ucs 949)) ("'f" . ,(decode-char 'ucs 966)) ("'i" . ,(decode-char 'ucs 953)) ("'k" . ,(decode-char 'ucs 954)) ("'m" . ,(decode-char 'ucs 956)) ("'n" . ,(decode-char 'ucs 957)) ("'o" . ,(decode-char 'ucs 969)) ("'p" . ,(decode-char 'ucs 960)) ("'r" . ,(decode-char 'ucs 961)) ("'s" . ,(decode-char 'ucs 963)) ("'t" . ,(decode-char 'ucs 964)) ("'x" . ,(decode-char 'ucs 958)))) ((and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'symbol)) `(("sqrt" . ,(make-char 'symbol 214)) ("&&" . ,(make-char 'symbol 217)) ("||" . ,(make-char 'symbol 218)) ("*." . ,(make-char 'symbol 183)) ("/." . ,(make-char 'symbol 184)) ("<=" . ,(make-char 'symbol 163)) ("<-" . ,(make-char 'symbol 172)) (">=" . ,(make-char 'symbol 179)) ("<>" . ,(make-char 'symbol 185)) ("==" . ,(make-char 'symbol 186)) ("<=>" . ,(make-char 'symbol 219)) ("=>" . ,(make-char 'symbol 222)) ("infinity" . ,(make-char 'symbol 165)) ;; Some greek letters for type parameters. ("'a" . ,(make-char 'symbol 97)) ("'b" . ,(make-char 'symbol 98)) ("'c" . ,(make-char 'symbol 103)) ; sic! 99 is chi, 103 is gamma ("'d" . ,(make-char 'symbol 100)) ("'e" . ,(make-char 'symbol 101)) ("'f" . ,(make-char 'symbol 102)) ("'i" . ,(make-char 'symbol 105)) ("'k" . ,(make-char 'symbol 107)) ("'m" . ,(make-char 'symbol 109)) ("'n" . ,(make-char 'symbol 110)) ("'o" . ,(make-char 'symbol 111)) ("'p" . ,(make-char 'symbol 112)) ("'r" . ,(make-char 'symbol 114)) ("'s" . ,(make-char 'symbol 115)) ("'t" . ,(make-char 'symbol 116)) ("'x" . ,(make-char 'symbol 120)))))) (defvar tuareg-prettify-symbols-extra-alist (cond ((fboundp 'decode-char) ;; use a unicode font. `(("fun" . ,(decode-char 'ucs 955)) ("not" . ,(decode-char 'ucs 172)) ;;("or" . ,(decode-char 'ucs 8744)); should not be used as || ("[|" . ,(decode-char 'ucs 12314)) ;; 〚 ("|]" . ,(decode-char 'ucs 12315)) ;; 〛 ("->" . ,(decode-char 'ucs 8594)) (":=" . ,(decode-char 'ucs 8656)))) ((and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'symbol)) `(("fun" . ,(make-char 'symbol 108)) ("not" . ,(make-char 'symbol 216)) ;;("or" . ,(make-char 'symbol 218)) ("->" . ,(make-char 'symbol 174)) (":=" . ,(make-char 'symbol 220)))))) (defun tuareg--prettify-symbols-compose-p (start end _match) "Return true iff the symbol MATCH should be composed. See `prettify-symbols-compose-predicate'." ;; Refine `prettify-symbols-default-compose-p' so as not to compose ;; symbols for errors,... (and (prettify-symbols-default-compose-p start end _match) (not (memq (get-text-property start 'face) '(tuareg-font-lock-error-face tuareg-font-lock-interactive-output-face tuareg-font-lock-interactive-error-face))))) (defun tuareg-font-lock-compose-symbol (alist) "Compose a sequence of ascii chars into a symbol. Regexp match data 0 points to the chars." ;; Check that the chars should really be composed into a symbol. (let* ((mbegin (match-beginning 0)) (mend (match-end 0)) (syntax (char-syntax (char-after mbegin)))) (if (or (eq (char-syntax (or (char-before mbegin) ?\ )) syntax) (eq (char-syntax (or (char-after mend) ?\ )) syntax) (memq (get-text-property mbegin 'face) '(tuareg-doc-face font-lock-string-face font-lock-comment-face tuareg-font-lock-error-face tuareg-font-lock-interactive-output-face tuareg-font-lock-interactive-error-face))) ;; No composition for you. Let's actually remove any composition ;; we may have added earlier and which is now incorrect. (remove-text-properties mbegin mend '(composition)) ;; That's a symbol alright, so add the composition. (compose-region mbegin mend (cdr (assoc (match-string 0) alist))))) ;; Return nil because we're not adding any face property. nil) (defun tuareg-font-lock-symbols-keywords () (when (fboundp 'compose-region) (let ((alist (if tuareg-prettify-symbols-full (append tuareg-prettify-symbols-basic-alist tuareg-prettify-symbols-extra-alist) tuareg-prettify-symbols-basic-alist))) (dolist (x alist) (when (and (if (fboundp 'char-displayable-p) (char-displayable-p (cdr x)) t) (not (assoc (car x) alist))) ; not yet in alist. (push x alist))) (when alist `((,(regexp-opt (mapcar 'car alist) t) (0 (tuareg-font-lock-compose-symbol ',alist)))))))) (defvar tuareg-mode-syntax-table (let ((st (make-syntax-table))) (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?. "'" st) ;Make qualified names a single symbol. (modify-syntax-entry ?# "_" st) ;Make name#method a single symbol (modify-syntax-entry ?? ". p" st) (modify-syntax-entry ?~ ". p" st) ;; See http://caml.inria.fr/pub/docs/manual-ocaml/lex.html. (dolist (c '(?! ?$ ?% ?& ?+ ?- ?/ ?: ?< ?= ?> ?@ ?^ ?|)) (modify-syntax-entry c "." st)) (modify-syntax-entry ?' "_" st) ; ' is part of symbols (for primes). (modify-syntax-entry ;; ` is punctuation or character delimiter (Caml Light compatibility). ?` (if tuareg-support-camllight "\"" ".") st) (modify-syntax-entry ?\" "\"" st) ; " is a string delimiter (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?* ". 23" st) (condition-case nil (progn (modify-syntax-entry ?\( "()1n" st) (modify-syntax-entry ?\) ")(4n" st)) (error ;XEmacs signals an error instead of ignoring `n'. (modify-syntax-entry ?\( "()1" st) (modify-syntax-entry ?\) ")(4" st))) st) "Syntax table in use in Tuareg mode buffers.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font-Lock (defvar tuareg-doc-face 'font-lock-doc-face) (defconst tuareg-font-lock-syntactic-keywords ;; Char constants start with ' but ' can also appear in identifiers. ;; Beware not to match things like '*)hel' or '"hel' since the first ' ;; might be inside a string or comment. ;; Note: for compatibility with Emacs<23, we use "\\<" rather than "\\_<", ;; which depends on tuareg-font-lock-syntax turning all "_" into "w". '(("\\<\\('\\)\\([^'\\\n]\\|\\\\.[^\\'\n \")]*\\)\\('\\)" (1 '(7)) (3 '(7))))) (defvar syntax-propertize-function) (when (eval-when-compile (fboundp 'syntax-propertize-rules)) (defun tuareg-syntax-propertize (start end) (goto-char start) (tuareg--syntax-quotation end) (funcall (syntax-propertize-rules ;; When we see a '"', knowing whether it's a literal char (as opposed to ;; the end of a string followed by the beginning of a literal char) ;; requires checking syntax-ppss as in: ;; ("\\_<\\('\"'\\)" ;; (1 (unless (nth 3 (save-excursion (syntax-ppss (match-beginning 0)))) ;; (string-to-syntax "\"")))) ;; Not sure if it's worth the trouble since adding a space between the ;; string and the literal char is easy enough and is the usual ;; style anyway. ;; For all other cases we don't need to check syntax-ppss because, if the ;; first quote is within a string (or comment), the whole match is within ;; the string (or comment), so the syntax-properties don't hurt. ;; ;; Note: we can't just use "\\<" here because syntax-propertize is also ;; used outside of font-lock. ("\\_<\\('\\)\\(?:[^'\\\n]\\|\\\\.[^\\'\n \")]*\\)\\('\\)" (1 "\"") (2 "\"")) ("\\({\\)[a-z_]*|" (1 (prog1 "|" (tuareg--syntax-quotation end)))) ) (point) end))) (defun tuareg--syntax-quotation (end) (let ((ppss (syntax-ppss))) (when (eq t (nth 3 ppss)) (ecase (char-after (nth 8 ppss)) (?< ;; We're indeed inside a quotation. (when (re-search-forward ">>" end 'move) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "|")))) (?\{ ;; We're inside a quoted string ;; http://caml.inria.fr/pub/docs/manual-ocaml/extn.html#sec244 (let ((id (save-excursion (goto-char (1+ (nth 8 ppss))) (buffer-substring (point) (progn (skip-chars-forward "a-z_") (point)))))) (when (search-forward (concat "|" id "}") end 'move) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "|"))))))))) (defun tuareg-font-lock-syntactic-face-function (state) (if (nth 3 state) font-lock-string-face (let ((start (nth 8 state))) (if (and (> (point-max) (+ start 2)) (eq (char-after (+ start 2)) ?*) (not (eq (char-after (+ start 3)) ?*))) ;; This is a documentation comment tuareg-doc-face font-lock-comment-face)))) ;; Initially empty, set in `tuareg-install-font-lock' (defvar tuareg-font-lock-keywords () "Font-Lock patterns for Tuareg mode.") (defconst tuareg-font-lock-syntax ;; Note: as a general rule, changing syntax-table during font-lock ;; is a potential problem for syntax-ppss. `((?_ . "w") (?' . "w")) "Syntax changes for Font-Lock.") (defconst tuareg--whitespace-re ;; QUESTION: Why not just "[ \t\n]*"? ;; It used to be " *[\t\n]? *" but this is inefficient since it can match ;; N spaces in N+1 different ways :-( " *\\(?:[\t\n] *\\)?") (defun tuareg-install-font-lock () (let* ((id "\\<[A-Za-z_][A-Za-z0-9_']*\\>") (lid "\\<[a-z_][A-Za-z0-9_']*\\>") (uid "\\<[A-Z][A-Za-z0-9_']*\\>") (attr-id1 "\\<[A-Za-z_][A-Za-z0-9_']*\\>") (attr-id (concat attr-id1 "\\(?:\\." attr-id1 "\\)*")) (maybe-infix-attr (concat "\\(?:%" attr-id "\\)?")); at most 1 ;; Matches braces balanced on max 3 levels. (balanced-braces (let ((b "\\(?:[^()]\\|(") (e ")\\)*")) (concat b b b "[^()]*" e e e))) (balanced-braces-no-string (let ((b "\\(?:[^()\"]\\|(") (e ")\\)*")) (concat b b b "[^()\"]*" e e e))) (balanced-braces-no-end-operator ; non-empty (let* ((b "\\(?:[^()]\\|(") (e ")\\)*") (braces (concat b b "[^()]*" e e)) (end-op (concat "\\(?:[^()!$%&*+-./:<=>?@^|~]\\|(" braces ")\\)"))) (concat "\\(?:[^()!$%&*+-./:<=>?@^|~]" ;; Operator not starting with ~ "\\|[!$%&*+-./:<=>?@^|][!$%&*+-./:<=>?@^|~]*" end-op ;; Operator or label starting with ~ "\\|~\\(?:[!$%&*+-./:<=>?@^|~]+" end-op "\\|[a-z][a-zA-Z0-9]*[: ]\\)" "\\|(" braces e))) (balanced-brackets (let ((b "\\(?:[^][]\\|\\[") (e "\\]\\)*")) (concat b b b "[^][]*" e e e))) (maybe-infix-ext (concat "\\(?:\\[@" attr-id balanced-brackets "\\]\\)*")) (maybe-infix-attr+ext (concat maybe-infix-attr maybe-infix-ext)) (tuple (concat "(" balanced-braces ")")); much more than tuple! ;; FIXME: module paths with functor applications (module-path (concat uid "\\(?:\\." uid "\\)*")) (typeconstr (concat "\\(?:" module-path "\\.\\)?" lid)) (constructor (concat "\\(?:\\(?:" module-path "\\.\\)?" uid "\\|`" id "\\)")) (extended-module-name (concat uid "\\(?: *([ A-Z]" balanced-braces ")\\)*")) (extended-module-path (concat extended-module-name "\\(?: *\\. *" extended-module-name "\\)*")) (modtype-path (concat "\\(?:" extended-module-path "\\.\\)*" id)) (typevar "'[A-Za-z_][A-Za-z0-9_']*\\>") (typeparam (concat "[+-]?" typevar)) (typeparams (concat "\\(?:" typeparam "\\|( *" typeparam " *\\(?:, *" typeparam " *\\)*)\\)")) (typedef (concat "\\(?:" typeparams " *\\)?" lid)) ;; Define 2 groups: possible path, variables (let-ls3 (regexp-opt '("clock" "node" "static" "present" "automaton" "where" "match" "with" "do" "done" "unless" "until" "reset" "every"))) (let-binding (concat "\\<\\(?:let" maybe-infix-attr+ext "\\(?: +" (if (tuareg-editing-ls3) let-ls3 "rec") "\\)?\\|and\\) +")) ;; group of variables (gvars (concat "\\(\\(?:" tuareg--whitespace-re "\\(?:" lid "\\|()\\|" tuple ; = any balanced (...) "\\|[~?]\\(?:" lid "\\(?::\\(?:" lid "\\|(" balanced-braces ")\\)\\)?" "\\|(" balanced-braces ")\\)" "\\)\\)+\\)")) ;; group for possible class param (class-gparams (concat "\\\\(?: +type\\>\\)?\\(?: +virtual\\>\\)?" "\\( *\\[ *" typevar " *\\(?:, *" typevar " *\\)*\\]\\)?"))) (setq tuareg-font-lock-keywords `(("^#[0-9]+ *\\(?:\"[^\"]+\"\\)?" 0 tuareg-font-lock-line-number-face t) (,(concat "^# +\\(#" lid "\\)") 1 tuareg-font-lock-interactive-directive-face) (,(concat "^# +#show\\(?:_module\\)? +\\(" uid "\\)") 1 tuareg-font-lock-module-face) (";;+" 0 tuareg-font-double-colon-face) ;; Attributes (`keep' to highlight except strings & chars) (,(concat "\\[@\\(?:@@?\\)?" attr-id balanced-brackets "\\]") 0 tuareg-font-lock-attribute-face keep) ;; Extension nodes. (,(concat "\\(\\[%%?" attr-id "\\)" balanced-brackets "\\(\\]\\)") (1 tuareg-font-lock-extension-node-face) (2 tuareg-font-lock-extension-node-face)) (,(concat "\\(?:\\<" (regexp-opt '("let" "begin" "module" "val" "val!" "fun" "function" "match")) "\\|;\\)\\(" maybe-infix-attr "\\)") 1 tuareg-font-lock-infix-extension-node-face) ;; cppo (,(concat "^ *#" (regexp-opt '("define" "undef" "if" "ifdef" "ifndef" "else" "elif" "endif" "include" "warning" "error" "ext" "endext") 'words)) . font-lock-preprocessor-face) ("\\<\\(false\\|true\\)\\>" . font-lock-constant-face) (,(regexp-opt '("true" "false" "__LOC__" "__FILE__" "__LINE__" "__MODULE__" "__POS__" "__LOC_OF__" "__LINE_OF__" "__POS_OF__") 'words) . font-lock-constant-face) ;; "type" to introduce a local abstract type considered a keyword (,(concat "( *\\(type\\) +\\(" lid " *\\)+)") (1 font-lock-keyword-face) (2 font-lock-type-face)) (":[\n]? *\\(\\\\)" (1 font-lock-keyword-face)) ;; First class modules. In these contexts, "val" and "module" ;; are not considered as "governing" (main structure of the code). (,(concat "( *\\(module\\) +\\(" module-path "\\) *: +\\(" balanced-braces-no-string "\\))") (1 font-lock-keyword-face) (2 tuareg-font-lock-module-face) (3 tuareg-font-lock-module-face)) (,(concat "( *\\(val\\) +\\(" balanced-braces-no-end-operator "\\): +\\(" balanced-braces-no-string "\\))") (1 font-lock-keyword-face) (2 tuareg-font-lock-module-face) (3 tuareg-font-lock-module-face)) ("\\" . tuareg-font-lock-governing-face) (,(concat "\\") . tuareg-font-lock-governing-face))) (,(let ((kwd '("as" "do" "done" "downto" "else" "for" "if" "then" "to" "try" "when" "while" "match" "new" "lazy" "assert" "fun" "function" "exception"))) (if (tuareg-editing-ls3) (progn (push "reset" kwd) (push "merge" kwd) (push "emit" kwd) (push "period" kwd))) (regexp-opt kwd 'words)) . font-lock-keyword-face) ;; with type: "with" treated as a governing keyword (,(concat "\\<\\(\\(?:with\\|and\\) +type\\(?: +nonrec\\)?\\>\\) *" "\\(" typeconstr "\\)?") (1 tuareg-font-lock-governing-face keep) (2 font-lock-type-face keep t)) (,(concat "\\<\\(\\(?:with\\|and\\) +module\\>\\) *\\(?:\\(" module-path "\\) *\\)?\\(?:= *\\(" extended-module-path "\\)\\)?") (1 tuareg-font-lock-governing-face keep) (2 tuareg-font-lock-module-face keep t) (3 tuareg-font-lock-module-face keep t)) ;; "module type of" module-expr (here "of" is a governing keyword) ("\\" 0 tuareg-font-lock-governing-face keep) (,(concat "\\" "\\|virtual\\(?: +mutable\\)?\\>\\)\\|val!" maybe-infix-attr+ext "\\)\\( *" lid "\\)?") (1 tuareg-font-lock-governing-face keep) (2 font-lock-variable-name-face nil t)) ("\\\\(?: +type\\>\\)?\\( +virtual\\>\\)?" 1 tuareg-font-lock-governing-face nil t) ;; "private" treated as governing keyword (,(concat "\\\\)?") 1 tuareg-font-lock-governing-face keep t) ;; Other uses of "with", "mutable", "private", "virtual" (,(regexp-opt '("of" "with" "mutable" "private" "virtual") 'words) . font-lock-keyword-face) ;;; labels (,(concat "\\([?~]" lid "\\)" tuareg--whitespace-re ":[^:>=]") 1 tuareg-font-lock-label-face keep) ;;; label in a type signature (,(concat "\\(?:->\\|:[^:>=]\\)" tuareg--whitespace-re "\\(" lid "\\)[ \t]*:[^:>=]") 1 tuareg-font-lock-label-face keep) ;; Polymorphic variants (take precedence on builtin names) (,(concat "`" id) . tuareg-font-lock-constructor-face) (,(concat "\\ *\\)\\(" module-path "\\)?") (1 tuareg-font-lock-governing-face) (2 tuareg-font-lock-module-face keep t)) (,(regexp-opt '("failwith" "failwithf" "exit" "at_exit" "invalid_arg" "parser" "raise" "raise_notrace" "ref" "ignore" "Match_failure" "Assert_failure" "Invalid_argument" "Failure" "Not_found" "Out_of_memory" "Stack_overflow" "Sys_error" "End_of_file" "Division_by_zero" "Sys_blocked_io" "Undefined_recursive_module") 'words) . font-lock-builtin-face) ;; module paths A.B. (,(concat module-path "\\.") . tuareg-font-lock-module-face) ,@(and tuareg-support-metaocaml '(("[^-@^!*=<>&/%+~?#]\\(\\(?:\\.<\\|\\.~\\|!\\.\\|>\\.\\)+\\)" 1 tuareg-font-lock-multistage-face))) (,(concat "[][;,()|{}]\\|[-@^!:*=<>&/%+~?#]\\.?\\|\\.\\.\\.*\\|" (regexp-opt (if (tuareg-editing-ls3) '("asr" "asl" "lsr" "lsl" "or" "lor" "and" "land" "lxor" "not" "lnot" "mod" "fby" "pre" "last" "at") '("asr" "asl" "lsr" "lsl" "or" "lor" "land" "lxor" "not" "lnot" "mod")) 'words)) . tuareg-font-lock-operator-face) ;;; (expr: t) and (expr :> t) ;;; If `t' is longer then one word, require a space before. Not only ;;; this is more readable but it also avoids that `~label:expr var` ;;; is taken as a type annotation when surrounded by parentheses. (,(concat "(" balanced-braces-no-end-operator ":>?\\(['_A-Za-z]+" "\\| [ \n'_A-Za-z]" balanced-braces-no-string "\\))") 1 font-lock-type-face keep) ;; (lid: t) (,(concat "(" lid " *:\\(['_A-Za-z]" balanced-braces-no-string "\\))") 1 font-lock-type-face keep) (,(concat "\\ *\\(" uid "\\)") 1 tuareg-font-lock-module-face) ;; (M: S) -- only color S here (may be "A.T with type t = s") (,(concat "( *" uid " *: *\\(" modtype-path "\\(?: *\\" balanced-braces "\\)?\\) *)") 1 tuareg-font-lock-module-face keep) (,(concat "\\" balanced-braces "\\)?" " *)" tuareg--whitespace-re "\\)*\\)\\(?::" tuareg--whitespace-re "\\(" modtype-path "\\) *\\)?\\(?:=" tuareg--whitespace-re "\\(" extended-module-path "\\)\\)?") (1 font-lock-variable-name-face keep); functor (module) variable (2 tuareg-font-lock-module-face keep t) (3 tuareg-font-lock-module-face keep t)) (,(concat "\\ *( *\\(" uid "\\) *: *\\(" modtype-path "\\) *)") (1 font-lock-variable-name-face keep); functor (module) variable (2 tuareg-font-lock-module-face keep)) ;;; "type lid" anywhere (e.g. "let f (type t) x =") introduces a new type (,(concat "\\" tuareg--whitespace-re "\\(" typedef "\\)") 1 font-lock-type-face keep) ;; Constructors (,(concat "\\(" uid "\\)[^.]") 1 tuareg-font-lock-constructor-face) ;;; let-bindings (,(concat let-binding "\\(" lid "\\) *\\(?:: *\\([^=]+\\)\\)?= *" "fun\\(?:ction\\)?\\>") (1 font-lock-function-name-face nil t) (2 font-lock-type-face keep t)) (,(let* ((maybe-constr (concat "\\(?:" constructor " *\\)?")) (var (concat maybe-constr "\\(?:" lid "\\|" tuple "\\)")) (simple-patt (concat var "\\(?: *, *" var "\\)*"))) (concat let-binding "\\(" simple-patt "\\) *\\(?:: *\\([^=]+\\)\\)?=")) ;; module paths, types, constructors already colored by the above (1 font-lock-variable-name-face keep) (2 font-lock-type-face keep t)) (,(concat let-binding "\\(" lid "\\)" gvars "?\\(?: +:" tuareg--whitespace-re "\\([a-z_]\\|[^ =][^=]*[^ =]\\) *=\\)?") (1 font-lock-function-name-face nil t) (2 font-lock-variable-name-face keep t) (3 font-lock-type-face keep t)) (,(concat "\\" maybe-infix-attr+ext tuareg--whitespace-re "\\(" lid "\\)") 1 font-lock-variable-name-face) (,(concat "\\") 1 font-lock-variable-name-face keep nil) (,(concat class-gparams " *\\(" lid "\\)") (1 font-lock-type-face keep t) (2 font-lock-function-name-face)) (,(concat class-gparams " *" lid gvars "? *=") 2 font-lock-variable-name-face keep t) ;; "method": long match first to capture the method name (,(concat "\\ (preceding-char)) (progn (tuareg-backward-char) (tuareg-in-indentation-p)))) (?\] (and (char-equal ?| (preceding-char)) (progn (tuareg-backward-char) (tuareg-in-indentation-p))))) (and tuareg-electric-indent (not (eq syntax ?w)) (let ((end (point))) (skip-syntax-backward "w_") (member (buffer-substring (point) end) tuareg-electric-indent-keywords)) (tuareg-in-indentation-p))))))) (defun tuareg--electric-close-vector () ;; Function for use on post-self-insert-hook. (when tuareg-electric-close-vector (let ((inners (cdr (assq last-command-event '((?\} ?> "{<") (?\] ?| "\\[|")))))) (and inners (eq (char-before) last-command-event) ;; Sanity check. (not (eq (car inners) (char-before (1- (point))))) (not (tuareg-in-literal-or-comment-p)) (save-excursion (when (ignore-errors (backward-sexp 1) t) (looking-at (nth 1 inners)))) (save-excursion (goto-char (1- (point))) (insert (car inners))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SMIE ;; TODO: ;; - Obey tuareg-*-indent customization variables. ;; - Fix use of tuareg-indent-command in tuareg-auto-fill-insert-leading-star. ;; - Use it by default (when possible). ;; - Move the old indentation code to a separate file. (defconst tuareg-smie-grammar ;; Problems: ;; - "let D in E" expression vs "let D" declaration. This is solved ;; by making the lexer return "d-let" for the second case. ;; - FIXME: SMIE assumes that concatenation binds tighter than ;; everything else, whereas OCaml gives tighter precedence to ".". ;; - "x : t1; (y : (t2 -> t3)); z : t4" but ;; "when (x1; x2) -> (z1; z2)". We solve this by distinguishing ;; the two kinds of arrows, using "t->" for the type arrow. ;; - The "with" in modules's "with type" has different precedence. ;; - Big problem with "if...then": because of SMIE's transitivity of the ;; precedence relation, we can't properly parse both "if A then B; C" and ;; "if A then let x = E in B; C else D" (IOW I think a non-transitive OPG ;; could do it). We could try and fix the problem in the lexer, but it's ;; far from obvious how (we'd probably end up having to pre-parse the text ;; in the lexer to decide which kind of "if" and "then" we're looking ;; at). A good solution could be found maybe if SMIE let us disambiguate ;; lexemes late, i.e. at a time where we have access to the relevant parse ;; stack. Or maybe by allowing smie-grammar to use a non-transitive ;; precedence relation. But until that happens, we will live with an ;; incorrect parse, and instead we try to patch up the result with ad-hoc ;; hacks in tuareg-smie-rules. ;; - The " with " syntax introduces many ;; conflicts: ;; "... with module M = A with module B = C" ;; vs "... module M = A with module B = C" ;; In the first, the second "with" should either have the first "with" as ;; sibling, or have some earlier construct as parent, whereas in the second ;; the "with" should have the first "=" (or maybe the first "module", tho ;; that would not correspond to the actual language syntax and would ;; probably break other cases) as parent. Other problems in this ;; mod-constraints syntax: we need a precedence along the lines of ;; "with" < "and" < "module/type", whereas the rest of the syntax wants ;; "module/type" < "and" < "with", so basically all the keywords involved ;; in mod-constraints need to be handled specially in the lexer :-( ;; - and then some... (when (fboundp 'smie-prec2->grammar) (let ((bnfprec2 (smie-bnf->prec2 '((decls (decls "type" decls) (decls "d-let" decls) (decls "and" decls) (decls ";;" decls) (decls "exception" decls) (decls "module" decls) (decls "class" decls) (decls "val" decls) (decls "external" decls) (decls "open" decls) (decls "include" decls) (exception) (def) ;; Hack: at the top-level, a "let D in E" can appear in ;; decls as well, but the lexer classifies it as "d-let", ;; so we need to make sure that "d-let D in E" doesn't ;; end up matching the "in" with some far away thingy. (def-in-exp)) (def-in-exp (defs "in" exp)) (def (var "d=" exp) (id "d=" datatype) (id "d=" module)) (idtype (id ":" type)) (var (id) ("m-type" var) ("d-type" var) ("rec" var) ("private" var) (idtype) ("l-module" var) ("l-class" var)) (exception (id "of" type)) (datatype ("{" typefields "}") (typebranches) (typebranches "with" id)) (typebranches (typebranches "|" typebranches) (id "of" type)) (typefields (typefields ";" typefields) (idtype)) (type (type "*…" type) (type "t->" type) ;; ("<" ... ">") ;; FIXME! (type "as" id)) (id) (module ("struct" decls "end") ("sig" decls "end") ("functor" id "->" module) (module "m-with" mod-constraints)) (simpledef (id "c=" type)) (mod-constraints (mod-constraints "m-and" mod-constraints) ("w-type" simpledef) ("w-module" simpledef)) ;; http://caml.inria.fr/pub/docs/manual-ocaml/expr.html ;; exp1 is "all exps except for `if exp then'". (exp1 ("begin" exp "end") ("(" exp:type ")") ("[|" exp "|]") ("{" fields "}") ("if" exp "then" exp1 "else" exp1) ;; ("if" exp "then" exp) ("while" exp "do" exp "done") ("for" forbounds "do" exp "done") (exp1 ";" exp1) ("match" exp "with" branches) ("function" branches) ("fun" patterns* "->" exp1) ("try" exp "with" branches) ("let" defs "in" exp1) ("let" "exception-let" exception "in" exp1) ("object" class-body "end") ("(" exp:>type ")") ("{<" fields ">}")) ;; Like `exp' but additionally allow if-then without else. (exp (exp1) ("if" exp "then" exp)) (forbounds (iddef "to" exp) (iddef "downto" exp)) (defs (def) (defs "and" defs) ("l-open" id)) (exp:>type (exp:type ":>" type)) (exp:type (exp)) ;; (exp ":" type) (fields (fields1) (exp "with" fields1)) (fields1 (fields1 ";" fields1) (iddef)) (iddef (id "f=" exp1)) (branches (branches "|" branches) (branch)) (branch (patterns "->" exp1)) (patterns* ("-dlpd-" patterns*) (patterns)) ;See use of "-dlpd-". (patterns (pattern) (pattern "when" exp1) ;; Since OCaml 4.02, `match' expressions allow ;; `exception' branches. ("exception-case" pattern)) (pattern (id) (pattern "as" id) (pattern "|-or" pattern) (pattern "," pattern)) (class-body (class-body "inherit" class-body) (class-body "method" class-body) (class-body "initializer" class-body) (class-body "val" class-body) (class-body "constraint" class-body) (class-field)) (class-field (exp) ("mutable" idtype) ("virtual" idtype) ("private" idtype)) ;; We get cyclic dependencies between ; and | because things like ;; "branches | branches" implies that "; > |" whereas "exp ; exp" ;; implies "| > ;" and while those two do not directly conflict ;; because they're constraints on precedences of different sides, ;; they do introduce a cycle later on because those operators are ;; declared associative, which adds a constraint that both sides ;; must be of equal precedence. So we declare here a dummy rule ;; to force a direct conflict, that we can later resolve with ;; explicit precedence rules. (foo1 (foo1 ";" foo1) (foo1 "|" foo1)) ;; "mutable x : int ; y : int". (foo2 ("mutable" id) (foo2 ";" foo2)) ) ;; Type precedence rules. ;; http://caml.inria.fr/pub/docs/manual-ocaml/types.html '((nonassoc "as") (assoc "t->") (assoc "*…")) ;; Pattern precedence rules. ;; http://caml.inria.fr/pub/docs/manual-ocaml/patterns.html '((nonassoc "as") (assoc "|-or") (assoc ",") (assoc "::")) ;; Resolve "{a=(1;b=2)}" vs "{(a=1);(b=2)}". '((nonassoc ";") (nonassoc "f=")) ;; Resolve "(function a -> b) | c -> d". '((nonassoc "function") (nonassoc "|")) ;; Resolve "when (function a -> b) -> c". '((nonassoc "function") (nonassoc "->")) ;; Resolve ambiguity "(let d in e2); e3" vs "let d in (e2; e3)". '((nonassoc "in" "match" "->" "with") (nonassoc ";")) ;; Resolve "(if a then b else c);d" vs "if a then b else (c; d)". '((nonassoc ";") (nonassoc "else")) ;; ("else" > ";") ;; Resolve "match e1 with a → (match e2 with b → e3 | c → e4)" ;; vs "match e1 with a → (match e2 with b → e3) | c → e4" '((nonassoc "with") (nonassoc "|")) ;; Resolve "functor A -> (M with MC)". '((nonassoc "->") (nonassoc "m-with")) ;; Resolve the conflicts caused by "when" and by SMIE's assumption ;; that all non-terminals can match the empty string. '((nonassoc "with") (nonassoc "->")) ; "when (match a with) -> e" '((nonassoc "|") (nonassoc "->")) ; "when (match a with a|b) -> e" ;; Fix up conflict between (decls "and" decls) and (defs "in" exp). '((nonassoc "in") (nonassoc "and")) ;; Resolve the "artificial" conflict introduced by the `foo1' rule. '((assoc "|") (assoc ";")) ;; Fix up associative declaration keywords. '((assoc "type" "d-let" "exception" "module" "val" "open" "external" "include" "class" ";;") (assoc "and")) '((assoc "val" "method" "inherit" "constraint" "initializer")) ;; Declare associativity of remaining sequence separators. '((assoc ";")) '((assoc "|")) '((assoc "m-and"))))) ;; (dolist (pair '()) ;; ("then" . "|") ("|" . "then") ;; (display-warning 'prec2 (format "%s %s %s" ;; (car pair) ;; (gethash pair bnfprec2) ;; (cdr pair)))) ;; SMIE takes for granted that all non-terminals can match the empty ;; string, which can lead to the addition of unnecessary constraints. ;; Let's remove the ones that cause cycles without causing conflicts. (progn ;; This comes from "exp ; exp" and "function branches", where ;; SMIE doesn't realize that `branches' has to have a -> before ;. (assert (eq '> (gethash (cons "function" ";") bnfprec2))) (remhash (cons "function" ";") bnfprec2)) (smie-prec2->grammar (smie-merge-prec2s bnfprec2 (smie-precs->prec2 ;; Precedence of operators. ;; http://caml.inria.fr/pub/docs/manual-ocaml/expr.html (reverse '((nonassoc ".") ;; function application, constructor application, assert, lazy ;; - -. (prefix) – (right "**…" "lsl" "lsr" "asr") (nonassoc "*…" "/…" "%…" "mod" "land" "lor" "lxor") (left "+…" "-…") (assoc "::") (right "@…" "^…") (left "=…" "<…" ">…" "|…" "&…" "$…") (right "&" "&&") (right "or" "||") (assoc ",") (right "<-" ":=") (assoc ";"))))))))) (defun tuareg-smie--search-backward (tokens) (let (tok) (while (progn (setq tok (tuareg-smie--backward-token)) (if (not (zerop (length tok))) (not (member tok tokens)) (unless (bobp) (condition-case err (progn (backward-sexp) t) (scan-error (setq tok (buffer-substring (nth 3 err) (1+ (nth 3 err)))) nil)))))) tok)) (defun tuareg-smie--search-forward (tokens) (let (tok) (while (progn (setq tok (tuareg-smie--forward-token)) (if (not (zerop (length tok))) (not (member tok tokens)) (unless (eobp) (condition-case err (progn (forward-sexp) t) (scan-error (setq tok (buffer-substring (nth 2 err) (nth 3 err))) nil)))))) tok)) (defun tuareg-skip-blank-and-comments () (forward-comment (point-max))) (defconst tuareg-smie--type-label-leader '("->" ":" "=" "")) (defconst tuareg-smie--exp-operator-leader (delq nil (mapcar (lambda (x) (if (numberp (nth 2 x)) (car x))) tuareg-smie-grammar))) (defconst tuareg-smie--float-re "[0-9]+\\(?:\\.[0-9]*\\)?\\(?:e[-+]?[0-9]+\\)") (defun tuareg-smie--forward-token () (tuareg-skip-blank-and-comments) (buffer-substring-no-properties (point) (progn (if (zerop (skip-syntax-forward ".")) (let ((start (point))) (skip-syntax-forward "w_'") ;; Watch out for floats! (and (memq (char-after) '(?- ?+)) (eq (char-before) ?e) (save-excursion (goto-char start) (looking-at tuareg-smie--float-re)) (goto-char (match-end 0)))) ;; The "." char is given symbol property so that "M.x" is ;; considered as a single symbol, but in reality, it's part of the ;; operator chars, since "+." and friends are operators. (while (not (and (zerop (skip-chars-forward ".")) (zerop (skip-syntax-forward ".")))))) (point)))) (defun tuareg-smie--backward-token () (forward-comment (- (point))) (buffer-substring-no-properties (point) (progn (if (and (zerop (skip-chars-backward ".")) (zerop (skip-syntax-backward "."))) (progn (skip-syntax-backward "w_'") ;; Watch out for floats! (and (memq (char-before) '(?- ?+)) (memq (char-after) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0)) (save-excursion (forward-char -1) (skip-syntax-backward "w_") (looking-at tuareg-smie--float-re)) (>= (match-end 0) (point)) (goto-char (match-beginning 0)))) (cond ((memq (char-after) '(?\; ?,)) nil) ; ".;" is not a token. ((and (eq (char-after) ?\.) (memq (char-before) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0))) (skip-chars-backward "0-9")) ; A float number! (t ;; The "." char is given symbol property so that "M.x" is ;; considered as a single symbol, but in reality, it's part of ;; the operator chars, since "+." and friends are operators. (while (not (and (zerop (skip-chars-backward ".")) (zerop (skip-syntax-backward ".")))))))) (point)))) (defun tuareg-smie-forward-token () "Move point to the end of the next token and return its SMIE name." (let ((tok (tuareg-smie--forward-token))) (cond ((zerop (length tok)) (if (not (looking-at "{<\\|\\[|")) tok (goto-char (match-end 0)) (match-string 0))) ((and (equal tok "|") (looking-at-p "\\]")) (forward-char 1) "|]") ((and (equal tok ">") (looking-at-p "}")) (forward-char 1) ">}") ((or (member tok '("let" "=" "->" "module" "class" "open" "type" "with" "and" "exception")) ;; http://caml.inria.fr/pub/docs/manual-ocaml/expr.html lists ;; the tokens whose precedence is based on their prefix. (memq (aref tok 0) '(?* ?/ ?% ?+ ?- ?@ ?^ ?= ?< ?> ?| ?& ?$))) ;; When indenting, the movement is mainly backward, so it's OK to make ;; the forward tokenizer a bit slower. (save-excursion (tuareg-smie-backward-token))) ((and (member tok '("~" "?")) (looking-at "[[:alpha:]_][[:alnum:]'_]*:")) (goto-char (match-end 0)) "label:") ((and (looking-at-p ":\\(?:[^:]\\|\\'\\)") (string-match-p "\\`[[:alpha:]_]" tok) (save-excursion (tuareg-smie--backward-token) ;Go back. (member (tuareg-smie--backward-token) tuareg-smie--type-label-leader))) (forward-char 1) "label:") ((string-match-p "\\`[[:alpha:]_].*\\.\\'" tok) (forward-char -1) (substring tok 0 -1)) (t tok)))) (defconst tuareg-smie--exp-leaders ;; (let ((leaders ())) ;; (dolist (cat tuareg-smie-bnf) ;; (dolist (rule (cdr cat)) ;; (setq rule (reverse rule)) ;; (while (setq rule (cdr (memq 'exp rule))) ;; (push (car rule) leaders)))) ;; leaders) '("if" "then" "try" "match" "do" "while" "begin" "in" "when" "downto" "to" "else")) (defun tuareg-smie--label-colon-p () (and (not (zerop (skip-chars-backward "[[:alnum:]]_"))) (or (not (zerop (skip-chars-backward "?~"))) (save-excursion (member (tuareg-smie--backward-token) tuareg-smie--type-label-leader))))) (defun tuareg-smie--=-disambiguate () "Return which kind of \"=\" we've just found. Point is not moved and should be right in front of the equality. Return values can be \"f=\" for field definition, \"d=\" for a normal definition, \"c=\" for a type equality constraint, and \"=…\" for an equality test." (save-excursion (let* ((pos (point)) (telltale '("type" "let" "module" "class" "and" "external" "val" "method" "=" ":=" "if" "then" "else" "->" ";" )) (nearest (tuareg-smie--search-backward telltale))) (cond ((and (member nearest '("{" ";")) (let ((field t)) (while (let ((x (tuareg-smie--forward-token))) (and (< (point) pos) (cond ((zerop (length x)) (setq field nil)) ((memq (char-syntax (aref x 0)) '(?w ?_))) ((member x '("." ";"))) (t (setq field nil)))))) field)) "f=") ((progn (while (and (equal nearest "->") (save-excursion (forward-char 2) (equal (tuareg-smie-backward-token) "t->"))) (setq nearest (tuareg-smie--search-backward telltale))) nil)) ((and (member nearest '("=" ":=")) (member (tuareg-smie--search-backward telltale) '("type" "module"))) ;; Second equality in "type t = M.t = C" or after mod-constraint "d=") ((not (member nearest '("type" "let" "module" "class" "and" "external" "val" "method"))) "=…") ((and (member nearest '("type" "module")) ;; Maybe a module's type equality constraint? (or (member (tuareg-smie--backward-token) '("with" "and")) ;; Or maybe an alias as part of a definition? (and (equal nearest "type") (goto-char (1+ pos)) ;"1+" to skip the `=' itself! (let ((tok (tuareg-smie--search-forward (cons "=" (mapcar #'car tuareg-smie-grammar))))) (equal tok "="))))) "c=") (t "d="))))) (defun tuareg-smie--:=-disambiguate () "Return which kind of \":=\" we've just found. Point is not moved and should be right in front of the equality. Return values can be \":=\" for assignment definition, \"c=\" for destructive equality constraint." (save-excursion (let* ((telltale '("type" "let" "module" "class" "and" "external" "val" "method" "=" ":=" "if" "then" "else" "->" ";" )) (nearest (tuareg-smie--search-backward telltale))) (cond ;Issue #7 ((and (member nearest '("type" "module")) (member (tuareg-smie--backward-token) '("with" "and"))) "c=") (t ":="))))) (defun tuareg-smie--|-or-p () "Return non-nil if we're just in front of an or pattern \"|\"." (save-excursion (let ((tok (tuareg-smie--search-backward ;; Stop at the first | or any token which should ;; never appear between a "|" and a "|-or". '("|" "[" "->" "with" "function" "=" "of" "in" "then")))) (cond ((equal tok "(") t) ((equal tok "|") ;; Maybe we have a "|-or". Then again maybe not. We should make sure ;; that `tok' is really either a "|-or" or the | of a match (and not ;; the | of a datatype definition). (while (equal "|" (setq tok (tuareg-smie--search-backward '("|" "with" "function" "=" "of" "in" "then"))))) (cond ((equal tok "=") (not (equal (tuareg-smie--=-disambiguate) "d="))) ((equal tok "of") nil) ((member tok '("[" "{" "(")) nil) (t t))))))) (defun tuareg-smie-backward-token () "Move point to the beginning of the next token and return its SMIE name." (let ((tok (tuareg-smie--backward-token))) (cond ;; Distinguish a let expression from a let declaration. ((equal tok "let") (save-excursion (let ((prev (tuareg-smie--backward-token))) (if (or (member prev tuareg-smie--exp-leaders) (if (zerop (length prev)) (and (not (bobp)) (eq 4 (mod (car (syntax-after (1- (point)))) 256))) (and (eq ?. (char-syntax (aref prev 0))) (not (equal prev ";;"))))) tok "d-let")))) ;; Handle "let module" and friends. ((member tok '("module" "class" "open")) (let ((prev (save-excursion (tuareg-smie--backward-token)))) (cond ((equal prev "let") (concat "l-" tok)) ((and (member prev '("with" "and")) (equal tok "module")) "w-module") (t tok)))) ;; Distinguish a "type ->" from a "case ->". ((equal tok "->") (save-excursion (let (nearest) (while (progn (setq nearest (tuareg-smie--search-backward '("with" "|" "fun" "function" "functor" "type" ":" "of"))) (and (equal nearest ":") (tuareg-smie--label-colon-p)))) (if (member nearest '("with" "|" "fun" "function" "functor")) tok "t->")))) ;; Handle "module type", mod-constraint's "with/and type" and ;; polymorphic syntax. ((equal tok "type") (save-excursion (let ((prev (tuareg-smie--backward-token))) (cond ((equal prev "module") "m-type") ((member prev '("and" "with")) "w-type") ((equal prev ":") "d-type"); ": type a. ..." (t tok))))) ;; Disambiguate mod-constraint's "and" and "with". ((member tok '("with" "and")) (save-excursion (tuareg-smie--forward-token) (if (member (tuareg-smie--forward-token) '("type" "module")) (concat "m-" tok) tok))) ;; Distinguish a defining = from a comparison-=. ((equal tok "=") (tuareg-smie--=-disambiguate)) ((equal tok ":=") (tuareg-smie--:=-disambiguate)) ((zerop (length tok)) (if (not (and (memq (char-before) '(?\} ?\])) (save-excursion (forward-char -2) (looking-at ">}\\||\\]")))) tok (goto-char (match-beginning 0)) (match-string 0))) ((and (equal tok "|") (eq (char-before) ?\[)) (forward-char -1) "[|") ((and (equal tok "<") (eq (char-before) ?\{)) (forward-char -1) "{<") ((equal tok "|") ;; Check if it's the | of an or-pattern, since it has a slightly ;; different precedence (see Issue #71 for an example). (if (tuareg-smie--|-or-p) "|-or" "|")) ;; Some infix operators get a precedence based on their prefix, so we ;; collapse them into a canonical representative. ;; See http://caml.inria.fr/pub/docs/manual-ocaml/expr.html. ((memq (aref tok 0) '(?* ?/ ?% ?+ ?- ?@ ?^ ?= ?< ?> ?| ?& ?$)) (cond ((member tok '("|" "||" "&" "&&" "<-" "->")) tok) ((and (eq (aref tok 0) ?*) (> (length tok) 1) (eq (aref tok 1) ?*)) "**…") (t (string (aref tok 0) ?…)))) ((equal tok ":") (let ((pos (point))) (if (tuareg-smie--label-colon-p) "label:" (goto-char pos) tok))) ((equal tok "exception") (let ((back-tok (save-excursion (tuareg-smie--backward-token)))) (cond ((member back-tok '("|" "with")) "exception-case") ((equal back-tok "let") "exception-let") (t tok)))) ((string-match-p "\\`[[:alpha:]_].*\\.\\'" tok) (forward-char (1- (length tok))) ".") (t tok)))) (defun tuareg-smie-rules (kind token) ;; FIXME: Handling of "= |", "with |", "function |", and "[ |" is ;; problematic. (cond ;; Special indentation for module fields. ((and (eq kind :after) (member token '("." ";")) (smie-rule-parent-p "with") (tuareg-smie--with-module-fields-rule))) ((and (eq kind :after) (equal token ";;")) 0) ;; Special indentation for monadic >>>, >>|, >>=, and >|= operators. ((and (eq kind :before) (tuareg-smie--monadic-rule token))) ((and (equal token "and") (smie-rule-parent-p "type")) 0) ((member token '(";" "|" "," "and" "m-and")) (cond ((and (eq kind :before) (member token '("|" ";")) (smie-rule-parent-p "then") ;; We have misparsed the code: TOKEN is not a child of `then' but ;; should have closed the "if E1 then E2" instead! (tuareg-smie--if-then-hack token))) ;; FIXME: smie-rule-separator doesn't behave correctly when the separator ;; is right after the parent (on another line). ((and (smie-rule-bolp) (smie-rule-prev-p "d=" "with" "[" "function")) (if (and (eq kind :before) (smie-rule-bolp) (smie-rule-prev-p "[" "d=" "function")) 0 tuareg-with-indent)) ((and (equal token "|") (smie-rule-bolp) (not (smie-rule-prev-p "d=")) (smie-rule-parent-p "d=")) ;; FIXME: Need a comment explaining what this tries to do. ;; FIXME: Should this only apply when (eq kind :before)? ;; FIXME: Don't use smie--parent. (goto-char (cadr smie--parent)) (smie-indent-forward-token) (tuareg-skip-blank-and-comments) `(column . ,(- (current-column) 2))) (t (smie-rule-separator kind)))) (t (case kind (:elem (cond ((eq token 'basic) tuareg-default-indent) ;; The default tends to indent much too deep. ((eq token 'empty-line-token) ";"))) (:list-intro (member token '("fun"))) (:close-all t) (:before (cond ((equal token "d=") (smie-rule-parent 2)) ((member token '("fun" "match")) (and (not (smie-rule-bolp)) (cond ((smie-rule-prev-p "d=") (smie-rule-parent tuareg-default-indent)) ((smie-rule-prev-p "begin") (smie-rule-parent))))) ((equal token "then") (smie-rule-parent)) ((equal token "if") (if (and (not (smie-rule-bolp)) (smie-rule-prev-p "else")) (smie-rule-parent))) ((and (equal token "with") (smie-rule-parent-p "{")) (smie-rule-parent)) ((and (equal token "with") (smie-rule-parent-p "d=")) (let ((td (smie-backward-sexp "with"))) (assert (equal (nth 2 td) "d=")) (goto-char (nth 1 td)) (setq td (smie-backward-sexp "d=")) ;; Presumably (equal (nth 1 td) "type"). (goto-char (nth 1 td)) `(column . ,(smie-indent-virtual)))) ;; Align the "with" of "module type A = B \n with ..." w.r.t "module". ((and (equal token "m-with") (smie-rule-parent-p "d=")) (save-excursion (smie-backward-sexp token) (goto-char (nth 1 (smie-backward-sexp 'halfsexp))) (cons 'column (+ 2 (current-column))))) ;; Treat purely syntactic block-constructs as being part of their ;; parent, when the opening statement is hanging. ((member token '("let" "(" "[" "{" "sig" "struct" "begin")) (when (and (smie-rule-hanging-p) (apply #'smie-rule-prev-p tuareg-smie--exp-operator-leader)) (if (let ((openers '("{" "(" "{<" "[" "[|"))) (or (apply #'smie-rule-prev-p openers) (not (apply #'smie-rule-parent-p openers)))) (let ((offset (if (and (member token '("(" "struct" "sig")) (not (smie-rule-parent-p "let" "d-let"))) 0 tuareg-default-indent))) (smie-rule-parent offset)) ;; In "{ a = (", "{" and "a =" are not part of the same ;; syntax rule, so "(" is part of "a =" but not of the ;; surrounding "{". (save-excursion (smie-backward-sexp 'halfsexp) (cons 'column (smie-indent-virtual)))))) ((and tuareg-match-patterns-aligned (equal token "|-or") (smie-rule-parent-p "|")) (smie-rule-parent)) ;; If we're looking at the first class-field-spec ;; in a "object(type)...end", don't rely on the default behavior which ;; will treat (type) as a previous element with which to align. ((tuareg-smie--object-hanging-rule token)) ;; Apparently, people like their `| pattern when test -> body' to have ;; the `when' indented deeper than the body. ((equal token "when") (smie-rule-parent tuareg-match-when-indent)))) (:after (cond ((equal token "d=") (and (smie-rule-parent-p "type") (not (smie-rule-next-p "[")) 0)) ((equal token "->") (cond ((smie-rule-parent-p "with") ;; Align with "with" but only if it's the only branch (often ;; the case in try..with), since otherwise subsequent ;; branches can't be both indented well and aligned. (if (save-excursion (and (not (equal "|" (nth 2 (smie-forward-sexp "|")))) ;; Since we may misparse "if..then.." we need to ;; double check that smie-forward-sexp indeed got us ;; to the right place. (equal (nth 2 (smie-backward-sexp "|")) "with"))) (smie-rule-parent 2) ;; Align with other clauses, even with no preceding "|" tuareg-match-clause-indent)) ((smie-rule-parent-p "function") ;; Similar to the previous rule but for "function" (if (save-excursion (and (not (equal "|" (nth 2 (smie-forward-sexp "|")))) (equal (nth 2 (smie-backward-sexp "|")) "function"))) (smie-rule-parent tuareg-default-indent) tuareg-match-clause-indent)) ((smie-rule-parent-p "|") tuareg-match-clause-indent) ;; Special case for "CPS style" code. ;; https://github.com/ocaml/tuareg/issues/5. ((smie-rule-parent-p "fun") (save-excursion (smie-backward-sexp "->") (if (eq ?\( (char-before)) (cons 'column (+ tuareg-default-indent (progn (backward-char 1) (smie-indent-virtual)))) 0))) (t 0))) ((equal token ":") (cond ((smie-rule-parent-p "val" "external") (smie-rule-parent 2)) ((smie-rule-parent-p "module") (smie-rule-parent)) (t 2))) ((equal token "in") tuareg-in-indent) ;;(if (smie-rule-hanging-p) ((equal token "with") (cond ;; ((smie-rule-next-p "|") 2) ((smie-rule-parent-p "{") nil) (t (+ 2 tuareg-with-indent)))) ((or (member token '("." "t->" "]")) (consp (nth 2 (assoc token tuareg-smie-grammar)))) ;; Closer. nil) ((member token '("{" "(")) ;; The virtual indent after ( can be higher than the actual one ;; because it might be "column + tuareg-default-indent", whereas ;; the token only occupies a single column. So make sure we don't ;; get caught in this trap. (let ((vi (smie-indent-virtual))) (forward-char 1) ;Skip paren. (skip-chars-forward " \t") (unless (eolp) `(column . ,(min (current-column) (+ tuareg-default-indent vi)))))) (t tuareg-default-indent))))))) (defun tuareg-smie--with-module-fields-rule () ;; Indentation of fields after "{ E with Module." where the "Module." ;; syntactically only applies to the first field, but has ;; semantically a higher position since it applies to all fields. (save-excursion (forward-char 1) (smie-backward-sexp 'halfsexp) (when (looking-at "\\(?:\\sw\\|\\s_\\)+\\.[ \t]*$") (smie-backward-sexp 'halfsexp) (cons 'column (current-column))))) (defconst tuareg-smie--monadic-operators '(">>|" ">>=" ">>>" ">|=") "Monadic infix operators") (defconst tuareg-smie--monadic-op-re (regexp-opt tuareg-smie--monadic-operators)) (defun tuareg-smie--monadic-rule (token) ;; When trying to indent a >>=, try to look back to find any earlier ;; >>= in a sequence of "monadic steps". (or (and (equal token ">…") (looking-at tuareg-smie--monadic-op-re) (save-excursion (tuareg-smie--forward-token) (let ((indent nil)) (while (let ((parent-data (smie-backward-sexp 'halfsexp))) (cond ((car parent-data) (member (nth 2 parent-data) '("->"))) ((member (nth 2 parent-data) '(";" "d=")) nil) ((member (nth 2 parent-data) '("fun" "function")) (if (member (tuareg-smie--backward-token) tuareg-smie--monadic-operators) (progn (setq indent (cons 'column (smie-indent-virtual))) nil) t))))) indent))) ;; In "foo >>= fun x -> bar" indent `bar' relative to `foo'. (and (member token '("fun" "function")) (not (smie-rule-bolp)) (save-excursion (let ((prev (tuareg-smie-backward-token))) ;; FIXME: Should we use the same loop as above? (and (equal prev ">…") (looking-at tuareg-smie--monadic-op-re) (progn (smie-backward-sexp prev) (cons 'column (current-column))))))))) (defun tuareg-smie--object-hanging-rule (token) ;; If we're looking at the first class-field-spec ;; in a "object(type)...end", don't rely on the default behavior which ;; will treat (type) as a previous element with which to align. (cond ;; An important role of this first condition is to call smie-indent-virtual ;; so that we get called back to compute the (virtual) indentation of ;; "object", thus making sure we get called back to apply the second rule. ((and (member token '("inherit" "val" "method" "constraint")) (smie-rule-parent-p "object")) (save-excursion (forward-word 1) (goto-char (nth 1 (smie-backward-sexp 'halfsexp))) (let ((col (smie-indent-virtual))) `(column . ,(+ tuareg-default-indent col))))) ;; For "class foo = object(type)...end", align object...end with class. ((and (equal token "object") (smie-rule-parent-p "class")) (smie-rule-parent)))) (defun tuareg-smie--if-then-hack (token) ;; Getting SMIE's parser to properly parse "if E1 then E2" is difficult, so ;; instead we live with a confused parser and try to work around the mess ;; here, although it clearly won't help other uses of the parser ;; (e.g. navigation). (save-excursion (let (pd) (while (equal (nth 2 (setq pd (smie-backward-sexp token))) "then") (let ((pdi (smie-backward-sexp 'halfsexp))) (assert (equal (nth 2 pdi) "if")))) (cond ((equal (nth 2 pd) token) (goto-char (nth 1 pd)) (cons 'column (smie-indent-virtual))) ((and (equal token "|") (equal (nth 2 pd) "with") (not (smie-rule-bolp))) (goto-char (nth 1 pd)) (cons 'column (+ 3 (current-column)))) (t (cons 'column (current-column))))))) (defun tuareg-smie--inside-string () (when (nth 3 (syntax-ppss)) (save-excursion (goto-char (1+ (nth 8 (syntax-ppss)))) (current-column)))) (defcustom tuareg-indent-align-with-first-arg nil "Non-nil if indentation should try to align arguments on the first one. With a non-nil value you get let x = List.map (fun x -> 5) my list whereas with a nil value you get let x = List.map (fun x -> 5) my list" :type 'boolean) (defun tuareg-smie--args () ;; FIXME: This is largely copy&pasted from smie.el. SMIE should offer a way ;; to hook into smie-indent-exps in order to control that behavior. (unless (or tuareg-indent-align-with-first-arg (nth 8 (syntax-ppss)) (looking-at comment-start-skip) (numberp (nth 1 (save-excursion (smie-indent-forward-token)))) (numberp (nth 2 (save-excursion (smie-indent-backward-token))))) (save-excursion (let ((positions nil) arg) (while (and (null (car (smie-backward-sexp))) (push (point) positions) (not (smie-indent--bolp)))) (save-excursion ;; Figure out if the atom we just skipped is an argument rather ;; than a function. (setq arg (or (null (car (smie-backward-sexp))) (funcall smie-rules-function :list-intro (funcall smie-backward-token-function))))) (cond ((null positions) ;; We're the first expression of the list. In that case, the ;; indentation should be (have been) determined by its context. nil) (arg ;; There's a previous element, and it's not special (it's not ;; the function), so let's just align with that one. (goto-char (car positions)) (if (fboundp 'smie-indent--current-column) (smie-indent--current-column) (current-column))) (t ;; There's no previous arg at BOL. Align with the function. (goto-char (car positions)) (+ (smie-indent--offset 'args) ;; We used to use (smie-indent-virtual), but that ;; doesn't seem right since it might then indent args less than ;; the function itself. (if (fboundp 'smie-indent--current-column) (smie-indent--current-column) (current-column))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Phrase movements and indentation (defun tuareg--skip-double-colon () (when (looking-at "[ \t\n]*;;[ \t\n]*") (goto-char (match-end 0)))) (defconst tuareg--beginning-of-phrase-syms (let* ((prec (cdr (assoc "d-let" tuareg-smie-grammar))) (syms (delq nil (mapcar (lambda (x) (if (equal (cdr x) prec) (car x))) tuareg-smie-grammar)))) (dolist (k '(";;")) (setq syms (delete k syms))) syms)) (defun tuareg--beginning-of-phrase () "Move the point to the beginning of the OCaml phrase on which the point is. Return a non nil value if at the beginning of a toplevel phrase (and not an expression)." (let ((proper-beginning-of-phrase nil) (state (syntax-ppss))) (if (nth 3 state); in a string (goto-char (nth 8 state))) (while (if (save-excursion (member (tuareg-smie-backward-token) tuareg--beginning-of-phrase-syms)) (progn (tuareg-smie-backward-token) (setq proper-beginning-of-phrase t) nil) (let ((td (smie-backward-sexp 'halfsexp))) (cond ((member (nth 2 td) tuareg--beginning-of-phrase-syms) (setq proper-beginning-of-phrase t) (goto-char (nth 1 td)) nil) ((string= (caddr td) ";;") nil) ((and (car td) (not (numberp (car td)))) (unless (bobp) (goto-char (nth 1 td)) t)) (t t))))) (if (and (bobp) (not proper-beginning-of-phrase)) (save-excursion (member (tuareg-smie-forward-token) tuareg--beginning-of-phrase-syms)) proper-beginning-of-phrase))) (defun tuareg--discover-phrase-forward () (smie-forward-sexp 'halfsexp)) (defun tuareg--discover-phrase-forward-expr () "How to move foward an expr that was not untroduced with a 'let'." (smie-forward-sexp ";;") ;; Since the point may be after the expression and we must go past ;; it to have the full expression, skip all the "space" after the expr. (tuareg--skip-double-colon)) (defun tuareg-discover-phrase (&optional pos) "Return a triplet (BEGIN END END-WITH-COMMENTS) for the OCaml phrase around POS. In case of error, move the point at the beginning of the error and return `nil'." (let (begin end end-comment proper-beginning-of-phrase go-forward (complete-phrase t)) (save-excursion (if pos (goto-char pos) (setq pos (point))) (tuareg-smie-forward-token) (setq proper-beginning-of-phrase (tuareg--beginning-of-phrase)) (setq begin (point)) (setq go-forward (if proper-beginning-of-phrase #'tuareg--discover-phrase-forward #'tuareg--discover-phrase-forward-expr)) (setq end (point)) (while (progn (funcall go-forward) (cond ((= (point) (point-max)) (setq end (point)) nil) ((= end (point)); no move (setq complete-phrase nil) nil) (t (setq end (point)) (tuareg-skip-blank-and-comments) (<= (point) pos)))) ;; Looks like tuareg--beginning-of-phrase went too far back! (setq begin (point))) (setq end-comment (point)) ;; Check if we were not stuck (after POS) because the phrase ;; was not well parenthesized. (when (and complete-phrase (< (point) (point-max))) (smie-forward-sexp 'halfsexp) (when (= end-comment (point)); did not move (setq complete-phrase nil))) ;; ";;" is not part of the phrase and neither comments (goto-char begin) (tuareg--skip-double-colon) (tuareg-skip-blank-and-comments) (setq begin (point))) (if complete-phrase (list begin end end-comment) (goto-char end) nil))) (defun tuareg--string-boundaries () "Assume point is inside a string and return (START . END), the positions delimiting the string (including its delimiters)." (save-excursion (let ((start (nth 8 (syntax-ppss))) end) (goto-char start) (smie-forward-sexp) (setq end (1- (point))) (cons start end)))) (defun tuareg--fill-string () "Assume the point is inside a string delimited by \" and jusfify it. This function moves the point." ;; FIXME: be more subtle: detect lists and @param (let* ((start-end (tuareg--string-boundaries)) (start (set-marker (make-marker) (car start-end))) (end (set-marker (make-marker) (cdr start-end))) fill-prefix (fill-individual-varying-indent t) (use-hard-newlines t)) (indent-region (marker-position start) (marker-position end)) ;; Delete all backslash protected newlines except those without ;; a preceding space that serve to cut a long word. (goto-char (marker-position start)) ;;(indent-according-to-mode) (setq fill-prefix (make-string (1+ (current-column)) ?\ )) (if (looking-at "\"\\\\ *[\n\r] *") (replace-match "\"")) (while (re-search-forward " +\\\\ *[\n\r] *" (marker-position end) t) (replace-match " ")) (set-hard-newline-properties (marker-position start) (marker-position end)) ;; Do not include the final \" not to remove space before it: (fill-region (marker-position start) (1- (marker-position end))) ;; Protect all soft newlines (goto-char (marker-position start)) (end-of-line) (while (< (point) (marker-position end)) (unless (get-char-property (point) 'hard) (insert " \\")) (forward-char) (end-of-line)) (set-marker start nil) (set-marker end nil))) (defun tuareg--fill-comment () "Assumes the point is inside a comment and justify it. This function moves the point." (let* ((start (set-marker (make-marker) (nth 8 (syntax-ppss)))) (end (make-marker)) fill-prefix (use-hard-newlines t)) (goto-char (marker-position start)) (indent-according-to-mode) (setq fill-prefix (make-string (+ 3 (current-column)) ?\ )) (forward-comment 1) (set-marker end (point)) (goto-char (marker-position start)) (let ((e (marker-position end))) (while (re-search-forward "\n\n" e t) (put-text-property (match-beginning 0) (match-end 0) 'hard 't))) (fill-region start end) (remove-text-properties (marker-position start) (marker-position end) '(hard)) (set-marker start nil) (set-marker end nil))) (defun tuareg-indent-phrase () "Depending of the context: justify and indent a comment, or indent all lines in the current phrase." (interactive) (save-excursion (let ((ppss (syntax-ppss))) (cond ((equal ?\" (nth 3 ppss)) (tuareg--fill-string)) ((nth 4 ppss) (tuareg--fill-comment)) (t (let ((phrase (tuareg-discover-phrase))) (if phrase (indent-region (car phrase) (cadr phrase))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Commenting (defun tuareg--end-of-string-or-comment (state) "Return the end position of the comment or string given by STATE." (save-excursion (goto-char (nth 8 state)) (if (nth 4 state) (comment-forward 1) (forward-sexp)) (point))) (defun tuareg-comment-or-uncomment-region (beg end &optional arg) "Replacement for `comment-or-uncomment-region' tailored for OCaml." (interactive "*r\nP") (comment-normalize-vars) (setq beg (save-excursion (goto-char beg) (skip-chars-forward " \t\r\n") (point))) (setq end (save-excursion (goto-char end) (skip-chars-backward " \t\r\n") (point))) (let (state pos) ;; Include the comment or string to which BEG possibly belongs (setq pos (nth 8 (syntax-ppss beg))) (if pos (setq beg pos)) ;; Include the comment or string to which END possibly belongs (setq state (syntax-ppss end)) (if (nth 8 state) (setq end (tuareg--end-of-string-or-comment state))) (if (comment-only-p beg end) (uncomment-region beg end arg) (comment-region beg end arg)))) (defun tuareg-comment-dwim (&optional arg) "Replacement for `comment-dwim' tailored for OCaml." (interactive "*P") (comment-normalize-vars) (if (use-region-p) (save-excursion (tuareg-comment-or-uncomment-region (region-beginning) (region-end) arg)) (let ((state (syntax-ppss))) (cond ((nth 4 state) ;; Point inside a comment. Uncomment just as if a region ;; inside the comment was active. (uncomment-region (nth 8 state) (tuareg--end-of-string-or-comment state) arg)) ((nth 3 state); Point inside a string. (comment-region (nth 8 state) (tuareg--end-of-string-or-comment state) arg)) ((looking-at-p "[ \t]*$"); at end of line and not in string (comment-dwim arg)) (t (save-excursion (tuareg-comment-or-uncomment-region (line-beginning-position) (line-end-position) arg))))))) (define-key tuareg-mode-map [?\C-c ?\C-\;] 'tuareg-comment-dwim) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The major mode (defun tuareg--switch-outside-build () "If the current buffer refers to a file under a _build directory and a corresponding file exists outside the _build directory, propose the user to switch to it. Return t if the switch was made." (let ((fpath (buffer-file-name)) (p nil) (in-build nil) base b) (when fpath ;; Inspired by `locate-dominating-file'. (setq fpath (abbreviate-file-name fpath)) (setq base (file-name-nondirectory fpath)) (setq fpath (file-name-directory fpath)) (while (not (or in-build (null fpath) (string-match-p locate-dominating-stop-dir-regexp fpath))) (setq b (file-name-nondirectory (directory-file-name fpath))) (if (string= b "_build") (setq in-build t) (push (file-name-as-directory b) p) (if (equal fpath (setq fpath (file-name-directory (directory-file-name fpath)))) (setq fpath nil)))) (when in-build ;; Make `fpath' the path without _build. (setq fpath (file-name-directory (directory-file-name fpath))) ;; jbuilder prefixes the path with a dir, not ocamlbuild (let* ((context (pop p)) (rel-fpath (concat (apply #'concat p) base)) (alt0 (concat fpath rel-fpath)); jbuilder (alt1 (concat fpath context rel-fpath)); ocamlbuild (alt (if (file-readable-p alt0) alt0)) (alt (or alt (if (file-readable-p alt1) alt1)))) (if (and alt (y-or-n-p "File in _build. Switch to corresponding \ file outside _build? ")) (progn (kill-buffer) (find-file alt) t) (read-only-mode) (message "File in _build. C-x C-q to edit.") nil)))))) (defmacro tuareg--eval-when-macrop (f form) "Execute FORM but only when F is `fboundp' (because it's a macro). If F is not bound yet, then keep the code un-expanded and perform the expansion at run-time, if the run-time version of Emacs does know this macro." (declare (debug (symbolp body)) (indent 1)) (if (fboundp f) form ;Macro expanded at compile-time. `(if (fboundp ',f) (eval ',form)))) ;Macro expanded at run-time. (defun tuareg--hanging-eolp-advice () "Recognize \"fun ..args.. ->\" at EOL as being hanging." (when (looking-at "fun\\_>") (smie-indent-forward-token) ;; We define a special "-dlpd-" token ;; ("-dummy-left-pattern-delimiter-") in the grammar ;; specifically so as to be able to make the right ;; call to smie-forward-sexp here. (if (equal "->" (nth 2 (smie-forward-sexp "-dlpd-"))) (smie-indent-forward-token)))) (defun tuareg--common-mode-setup () (when (fboundp 'tuareg-syntax-propertize) (setq-local syntax-propertize-function #'tuareg-syntax-propertize)) (setq-local parse-sexp-ignore-comments t) (smie-setup tuareg-smie-grammar #'tuareg-smie-rules :forward-token #'tuareg-smie-forward-token :backward-token #'tuareg-smie-backward-token) (tuareg--eval-when-macrop add-function (when (boundp 'smie--hanging-eolp-function) ;; FIXME: As its name implies, smie--hanging-eolp-function ;; is not to be used by packages like us, but SMIE's maintainer ;; hasn't provided any alternative so far :-( (add-function :before (local 'smie--hanging-eolp-function) #'tuareg--hanging-eolp-advice))) (add-hook 'smie-indent-functions #'tuareg-smie--args nil t) (add-hook 'smie-indent-functions #'tuareg-smie--inside-string nil t) (setq-local add-log-current-defun-function 'tuareg-current-fun-name) (setq prettify-symbols-alist (if tuareg-prettify-symbols-full (append tuareg-prettify-symbols-basic-alist tuareg-prettify-symbols-extra-alist) tuareg-prettify-symbols-basic-alist)) (setq prettify-symbols-compose-predicate #'tuareg--prettify-symbols-compose-p) (tuareg-install-font-lock) (setq-local open-paren-in-column-0-is-defun-start nil) (add-hook 'completion-at-point-functions #'tuareg-completion-at-point nil t) (when (fboundp 'electric-indent-mode) (add-hook 'electric-indent-functions #'tuareg--electric-indent-predicate nil t)) (when (boundp 'post-self-insert-hook) (add-hook 'post-self-insert-hook #'tuareg--electric-close-vector nil t))) ;;;###autoload(add-to-list 'auto-mode-alist '("\\.ml[ip]?\\'" . tuareg-mode)) ;;;###autoload(add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode)) ;;;###autoload(dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmi" ;;;###autoload ".annot" ".cmt" ".cmti")) ;;;###autoload (add-to-list 'completion-ignored-extensions ext)) (defalias 'tuareg--prog-mode (if (fboundp 'prog-mode) #'prog-mode #'fundamental-mode)) (defvar compilation-first-column) (defvar compilation-error-screen-columns) ;;;###autoload (define-derived-mode tuareg-mode tuareg--prog-mode "Tuareg" "Major mode for editing OCaml code. Dedicated to Emacs and XEmacs, version 21 and higher. Provides automatic indentation and compilation interface. Performs font/color highlighting using Font-Lock. It is designed for OCaml but handles Caml Light as well. The Font-Lock minor-mode is used according to your customization options. You have better byte-compile tuareg.el. For customization purposes, you should use `tuareg-mode-hook' \(run for every file) or `tuareg-load-hook' (run once) and not patch the mode itself. You should add to your configuration file something like: (add-hook 'tuareg-mode-hook (lambda () ... ; your customization code )) For example you can change the indentation of some keywords, the `electric' flags, Font-Lock colors... Every customizable variable is documented, use `C-h-v' or look at the mode's source code. `dot-emacs.el' is a sample customization file for standard changes. You can append it to your `.emacs' or use it as a tutorial. `M-x ocamldebug' FILE starts the OCaml debugger ocamldebug on the executable FILE, with input and output in an Emacs buffer named *ocamldebug-FILE*. A Tuareg Interactive Mode to evaluate expressions in a REPL (aka toplevel) is included. Type `M-x tuareg-run-ocaml' or simply `M-x run-ocaml' or see special-keys below. Short cuts for the Tuareg mode: \\{tuareg-mode-map} Short cuts for interactions with the REPL: \\{tuareg-interactive-mode-map}" (unless (tuareg--switch-outside-build) ;; Initialize the Tuareg menu (tuareg-build-menu) (setq-local paragraph-start (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) (setq-local paragraph-separate paragraph-start) (setq-local require-final-newline mode-require-final-newline) (setq-local comment-start "(* ") (setq-local comment-end " *)") (setq-local comment-start-skip "(\\*+[ \t]*") (setq-local comment-style 'multi-line) ;; `ocamlc' counts columns from 0, contrary to other tools which start at 1. (setq-local compilation-first-column 0) (setq-local compilation-error-screen-columns nil) ;; TABs should NOT be used in OCaml files: (setq indent-tabs-mode nil) (tuareg--common-mode-setup) (when (fboundp 'tuareg-auto-fill-function) ;; Emacs-21's newcomment.el provides this functionality by default. (setq-local normal-auto-fill-function #'tuareg-auto-fill-function)) (if (functionp 'tuareg-imenu-create-index) (setq-local imenu-create-index-function #'tuareg-imenu-create-index)) (run-mode-hooks 'tuareg-load-hook))) (defconst tuareg-starters-syms '("module" "type" "let" "d-let" "and")) (defun tuareg-find-matching-starter (starters) (let (tok) (while (let ((td (smie-backward-sexp 'halfsexp))) (cond ((and (car td) (member (nth 2 td) starters)) (goto-char (nth 1 td)) (setq tok (nth 2 td)) nil) ((and (car td) (not (numberp (car td)))) (unless (bobp) (goto-char (nth 1 td)) t)) (t t)))) tok)) (defun tuareg-skip-siblings () (while (and (not (bobp)) (null (car (smie-backward-sexp)))) (tuareg-find-matching-starter tuareg-starters-syms)) (when (looking-at-p "in") ;; Skip over `local...in' and continue. (forward-word 1) (smie-backward-sexp 'halfsexp) (tuareg-skip-siblings))) (defun tuareg-beginning-of-defun () (when (tuareg-find-matching-starter tuareg-starters-syms) (save-excursion (tuareg-smie-forward-token) (tuareg-skip-blank-and-comments) (let ((name (tuareg-smie-forward-token))) (if (not (member name '("rec" "type"))) name (tuareg-skip-blank-and-comments) (tuareg-smie-forward-token)))))) (defcustom tuareg-max-name-components 3 "Maximum number of components to use for the current function name." :type 'integer) (defun tuareg-current-fun-name () (save-excursion (let ((count tuareg-max-name-components) fullname name) (end-of-line) (while (and (> count 0) (setq name (tuareg-beginning-of-defun))) (decf count) (setq fullname (if fullname (concat name "." fullname) name)) ;; Skip all other declarations that we find at the same level. (tuareg-skip-siblings)) fullname))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Error processing (require 'compile) ;; In some versions of Emacs, the regexps in ;; compilation-error-regexp-alist do not match the error messages when ;; the language is not English. Hence we add a regexp. (defconst tuareg--error-regexp "^[ A-\377]+ \"\\([^\"\n]+\\)\", line \\([0-9]+\\), \ characters \\([0-9]+\\)-\\([0-9]+\\)" "Regular expression matching the error messages produced by ocamlc/ocamlopt.") (when (boundp 'compilation-error-regexp-alist-alist) (add-to-list 'compilation-error-regexp-alist-alist `(ocaml ,tuareg--error-regexp 1 2 (3 . 4)))) (when (boundp 'compilation-error-regexp-alist) (add-to-list 'compilation-error-regexp-alist 'ocaml) (eval-after-load 'caml ;; caml-mode also changes `compilation-error-regexp-alist' with a ;; too simple regexp. Make sure the one above comes first. #'(lambda() (setq compilation-error-regexp-alist (delete 'ocaml compilation-error-regexp-alist)) (add-to-list 'compilation-error-regexp-alist 'ocaml)))) ;; Wrapper around next-error. ;; itz 04-21-96 instead of defining a new function, use defadvice ;; that way we get our effect even when we do \C-x` in compilation buffer ;; smclaughlin 07-19-11 defadvice is to be avoided. It makes debugging ;; much more difficult. If you really want this behavior, write your ;; own next-error-function. In particular, it breaks when omake is ;; used. ;; (defadvice next-error (after tuareg-next-error activate) ;; "Read the extra positional information provided by the OCaml compiler. ;; Puts the point and the mark exactly around the erroneous program ;; fragment. The erroneous fragment is also temporarily highlighted if ;; possible." ;; (when (eq major-mode 'tuareg-mode) ;; (let ((beg nil) (end nil)) ;; (with-current-buffer compilation-last-buffer ;; (save-excursion ;; (goto-char (window-point (get-buffer-window (current-buffer) t))) ;; (when (looking-at tuareg-error-chars-regexp) ;; (setq beg (string-to-number (tuareg-match-string 1)) ;; end (string-to-number (tuareg-match-string 2)))))) ;; (beginning-of-line) ;; (when beg ;; (setq beg (+ (point) beg) end (+ (point) end)) ;; (goto-char beg) (push-mark end t t))))) (autoload 'ocaml-module-alist "caml-help") (autoload 'ocaml-visible-modules "caml-help") (autoload 'ocaml-module-symbols "caml-help") (defun tuareg-completion-at-point () (let ((beg (save-excursion (skip-syntax-backward "w_") (point))) (end (save-excursion (skip-syntax-forward "w_") (point))) (table (lambda (string pred action) (let ((dot (string-match-p "\\.[^.]*\\'" string)) ;; ocaml-module-symbols contains an unexplained call to ;; pop-to-buffer within save-window-excursion. Let's try and ;; avoid it pops up a stupid frame. (display-buffer-alist (cons '("^\\*caml-help\\*$" (display-buffer-reuse-window display-buffer-pop-up-window) (reusable-frames . nil); only the selected frame (window-height . 0.25)) display-buffer-alist))) (if (eq (car-safe action) 'boundaries) `(boundaries ,(if dot (1+ dot) 0) ,@(string-match-p "\\." (cdr action))) (if (null dot) (complete-with-action action (apply #'append (mapcar (lambda (mod) (concat (car mod) ".")) (ocaml-module-alist)) (mapcar #'ocaml-module-symbols (ocaml-visible-modules))) string pred) (completion-table-with-context (substring string 0 (1+ dot)) (ocaml-module-symbols (assoc (substring string 0 dot) (ocaml-module-alist))) (substring string (1+ dot)) pred action))))))) (unless (or (eq beg end) (not tuareg-with-caml-mode-p)) (list beg end table)))) (autoload 'caml-complete "caml-help") (defun tuareg-complete (arg) "Completes qualified ocaml identifiers." (interactive "p") (modify-syntax-entry ?_ "w" tuareg-mode-syntax-table) (unwind-protect (caml-complete arg) (modify-syntax-entry ?_ "_" tuareg-mode-syntax-table))) (defun tuareg--try-find-alternate-file (mod-name extensions &optional no-create) "Switch to the file given by MOD-NAME and EXTENSIONS. If NO-CREATE is non-nil and the file doesn't exist, don't switch and return nil, otherwise return non-nil." (let ((ext extensions) (not-found t)) ;; Search for a buffer or filename with the correct extension (while (and not-found (not (null ext))) (let* ((e (car ext)) (filename (concat mod-name e)) (buffer (get-file-buffer filename))) (cond (buffer (switch-to-buffer buffer) (setq not-found nil)) ((file-exists-p filename) (find-file filename) (setq not-found nil)) (t (setq ext (cdr ext)))))) (when not-found (let* ((e (car extensions)) ; Create with the first extention? (filename (concat mod-name e)) (what (cond ((string= e ".mli") "interface") (t "implementation")))) (when (and (not no-create) (y-or-n-p (format "Create %s file %s " what (file-name-nondirectory filename)))) (find-file filename)))))) (defun tuareg-find-alternate-file () "Switch Implementation/Interface." (interactive) (let ((name buffer-file-name)) (when (string-match "\\`\\(.*\\)\\.ml\\([il]\\)?\\'" name) (let ((mod-name (tuareg-match-string 1 name)) (e (tuareg-match-string 2 name))) (cond ((string= e "i") (tuareg--try-find-alternate-file mod-name '(".ml" ".mll"))) (t (tuareg--try-find-alternate-file mod-name '(".mli")))))))) (define-skeleton tuareg-insert-class-form "Insert a nicely formatted class-end form, leaving a mark after end." nil \n "class " @ " = object (self)" > \n "inherit " > _ " as super" \n "end;;" > \n) (define-skeleton tuareg-insert-begin-form "Insert a nicely formatted begin-end form, leaving a mark after end." nil \n "begin" > \n _ \n "end" > \n) (define-skeleton tuareg-insert-for-form "Insert a nicely formatted for-to-done form, leaving a mark after done." nil \n "for " - " do" > \n _ \n "done" > \n) (define-skeleton tuareg-insert-while-form "Insert a nicely formatted for-to-done form, leaving a mark after done." nil \n "while " - " do" > \n _ \n "done" > \n) (define-skeleton tuareg-insert-if-form "Insert a nicely formatted if-then-else form, leaving a mark after else." nil \n "if" > \n _ \n "then" > \n @ \n "else" \n @) (define-skeleton tuareg-insert-match-form "Insert a nicely formatted math-with form, leaving a mark after with." nil \n "match" > \n _ \n "with" > \n) (define-skeleton tuareg-insert-let-form "Insert a nicely formatted let-in form, leaving a mark after in." nil \n "let " > _ " in" > \n) (define-skeleton tuareg-insert-try-form "Insert a nicely formatted try-with form, leaving a mark after with." nil \n "try" > \n _ \n "with" > \n) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; OPAM (defconst tuareg-opam-compilers (when (file-directory-p "~/.opam") (let ((c (directory-files "~/.opam" t "[0-9]+\\.[0-9]+\\.[0-9]+"))) (if (file-directory-p "~/.opam/system") (cons "~/.opam/system" c) c))) "The list of OPAM directories for the installed compilers.") (defvar tuareg-opam (let ((opam (executable-find "opam"))) (if opam opam (let ((opam (locate-file "bin/opam" tuareg-opam-compilers))) (if (and opam (file-executable-p opam)) opam)))) ; or nil "The full path of the opam executable or `nil' if opam wasn't found.") (defun tuareg-shell-command-to-string (command) "Similar to shell-command-to-string, but returns nil when the process return code is not 0 (shell-command-to-string returns the error message as a string)." (let* ((return-value 0) (return-string (with-output-to-string (with-current-buffer standard-output (setq return-value (process-file shell-file-name nil '(t nil) nil shell-command-switch command)))))) (if (= return-value 0) return-string nil))) (defun tuareg-opam-config-env (&optional switch) "Get the opam environment for the given switch (or the default switch if none is provied) and return a list of lists of the form (n v) where n is the name of the environment variable and v its value (both being strings). If opam is not found or the switch is not installed, `nil' is returned." (let* ((switch (if switch (concat " --switch " switch))) (get-env (concat tuareg-opam " config env --sexp" switch)) (opam-env (tuareg-shell-command-to-string get-env))) (if opam-env (car (read-from-string opam-env))))) (defun tuareg-opam-installed-compilers () (let* ((cmd1 (concat tuareg-opam " switch list -i -s")) (cmd2 (concat tuareg-opam " switch list -s")); opam2 (cpl (or (tuareg-shell-command-to-string cmd1) (tuareg-shell-command-to-string cmd2)))) (if cpl (split-string cpl "[ \f\t\n\r\v]+" t) '()))) (defun tuareg-opam-current-compiler () (let* ((cmd (concat tuareg-opam " switch show -s")) (cpl (tuareg-shell-command-to-string cmd))) (when cpl (replace-regexp-in-string "[ \t\n]*" "" cpl)))) (defun tuareg-opam-update-env (switch) "Update the environment to follow current OPAM switch configuration." (interactive (let* ((compl (tuareg-opam-installed-compilers)) (current (tuareg-opam-current-compiler)) (default (if current current "current")) (prompt (format "opam switch (default: %s): " default))) (list (completing-read prompt compl)))) (let* ((switch (if (string= switch "") nil switch)) (env (tuareg-opam-config-env switch))) (if env (dolist (v env) (setenv (car v) (cadr v)) (when (string= (car v) "PATH") (setq exec-path (split-string (cadr v) path-separator)))) (message "Switch %s does not exist (or opam not found)" switch)))) ;; OPAM compilation (defun tuareg--compile-opam (&rest r) "Advice to update the OPAM environment to sync it with the OPAM switch before compiling." (let* ((env (tuareg-opam-config-env))) (when env (setq-local compilation-environment (mapcar (lambda(v) (concat (car v) "=" (cadr v))) (tuareg-opam-config-env)))))) (when (and tuareg-opam-insinuate tuareg-opam) (setq tuareg-interactive-program (concat tuareg-opam " config exec -- ocaml")) (advice-add 'compile :before #'tuareg--compile-opam) (defvar merlin-command) ;Silence byte-compiler. (setq merlin-command 'opam) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tuareg interactive mode ;; Augment Tuareg mode with an OCaml REPL. (require 'comint) (defvar tuareg-interactive-mode-map (let ((map (copy-keymap comint-mode-map))) (define-key map "\C-c\C-i" 'tuareg-interrupt-ocaml) (define-key map "\C-c\C-k" 'tuareg-kill-ocaml) (define-key map "\C-c`" 'tuareg-interactive-next-error-repl) (define-key map "\C-c?" 'tuareg-interactive-next-error-repl) (define-key map "\C-m" 'tuareg-interactive-send-input) (define-key map [(shift return)] 'tuareg-interactive-send-input-end-of-phrase) (define-key map [(ctrl return)] 'tuareg-interactive-send-input-end-of-phrase) (define-key map [kp-enter] 'tuareg-interactive-send-input-end-of-phrase) map)) (defconst tuareg-interactive-buffer-name "*OCaml*") (defconst tuareg-interactive-error-range-regexp "[ \t]*Characters \\([0-9]+\\)-\\([1-9][0-9]*\\):\n" "Regexp matching the char numbers in OCaml REPL's error messages.") (defconst tuareg-interactive-error-regexp "\n\\(Error: [^#]*\\)") (defconst tuareg-interactive-exception-regexp "\\(Exception: [^#]*\\)") (defvar tuareg-interactive-last-phrase-pos-in-source 0) (defvar tuareg-interactive-last-phrase-pos-in-repl 0) (defun tuareg-interactive-filter (_text) (when (eq major-mode 'tuareg-interactive-mode) (save-excursion (when (>= comint-last-input-end comint-last-input-start) (when tuareg-interactive-read-only-input (add-text-properties comint-last-input-start comint-last-input-end (list 'read-only t))) (when (and font-lock-mode tuareg-interactive-input-font-lock) (font-lock-fontify-region comint-last-input-start comint-last-input-end)) (when tuareg-interactive-output-font-lock (save-excursion (goto-char (point-max)) (re-search-backward comint-prompt-regexp comint-last-input-end t) (add-text-properties comint-last-input-end (point) '(font-lock-face tuareg-font-lock-interactive-output-face)))) (when tuareg-interactive-error-font-lock (save-excursion (goto-char comint-last-input-end) (cond ((looking-at tuareg-interactive-error-range-regexp) (let ((beg (string-to-number (tuareg-match-string 1))) (end (string-to-number (tuareg-match-string 2)))) (put-text-property (+ comint-last-input-start beg) (+ comint-last-input-start end) 'font-lock-face 'tuareg-font-lock-error-face)) (goto-char comint-last-input-end) (when (re-search-forward tuareg-interactive-error-regexp nil t) (let ((errbeg (match-beginning 1)) (errend (match-end 1))) (put-text-property errbeg errend 'font-lock-face 'tuareg-font-lock-interactive-error-face)))) ((looking-at tuareg-interactive-exception-regexp) (let ((errbeg (match-beginning 1)) (errend (match-end 1))) (put-text-property errbeg errend 'font-lock-face 'tuareg-font-lock-interactive-error-face))) ))))))) (easy-menu-define tuareg-interactive-mode-menu tuareg-interactive-mode-map "Tuareg Interactive Mode Menu." '("Tuareg" ("Interactive Mode" ["Run OCaml REPL" tuareg-run-ocaml t] ["Interrupt OCaml REPL" tuareg-interrupt-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Kill OCaml REPL" tuareg-kill-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Evaluate Region" tuareg-eval-region :active (region-active-p)] ["Evaluate Phrase" tuareg-eval-phrase t] ["Evaluate Buffer" tuareg-eval-buffer t]) "---" ["Customize Tuareg Mode..." (customize-group 'tuareg) t] ("Tuareg Options" ["Dummy" nil t]) ("Tuareg Interactive Options" ["Dummy" nil t]) "---" ["About" tuareg-about t] ["Help" tuareg-interactive-help t])) (define-derived-mode tuareg-interactive-mode comint-mode "Tuareg-Interactive" "Major mode for interacting with an OCaml process. Runs an OCaml REPL as a subprocess of Emacs, with I/O through an Emacs buffer. A history of input phrases is maintained. Phrases can be sent from another buffer in tuareg mode. Short cuts for interactions with the REPL: \\{tuareg-interactive-mode-map}" (add-hook 'comint-output-filter-functions 'tuareg-interactive-filter) (setq comint-prompt-regexp "^# *") (setq comint-process-echoes nil) (setq comint-get-old-input 'tuareg-interactive-get-old-input) (setq comint-scroll-to-bottom-on-output tuareg-interactive-scroll-to-bottom-on-output) (set-syntax-table tuareg-mode-syntax-table) (setq-local comment-start "(* ") (setq-local comment-end " *)") (setq-local comment-start-skip "(\\*+[ \t]*") (setq-local comint-prompt-read-only t) (tuareg--common-mode-setup) (when (or tuareg-interactive-input-font-lock tuareg-interactive-output-font-lock tuareg-interactive-error-font-lock) (font-lock-mode 1)) (easy-menu-add tuareg-interactive-mode-menu) (tuareg-update-options-menu)) ;;;###autoload (defun tuareg-run-ocaml () "Run an OCaml REPL process. I/O via buffer `*OCaml*'." (interactive) (tuareg-run-process-if-needed) (display-buffer tuareg-interactive-buffer-name)) ;;;###autoload (defalias 'run-ocaml 'tuareg-run-ocaml) ;;;###autoload (add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode)) (defun tuareg-run-process-if-needed (&optional cmd) "Run an OCaml REPL process if needed, with an optional command name. I/O via buffer `*OCaml*'." (if cmd (setq tuareg-interactive-program cmd) (unless (comint-check-proc tuareg-interactive-buffer-name) (setq tuareg-interactive-program (read-shell-command "OCaml REPL to run: " tuareg-interactive-program)))) (unless (comint-check-proc tuareg-interactive-buffer-name) (let ((cmdlist (tuareg--split-args tuareg-interactive-program)) (process-connection-type nil)) (set-buffer (apply (function make-comint) "OCaml" (car cmdlist) nil (cdr cmdlist))) (tuareg-interactive-mode) (sleep-for 1)))) (defun tuareg--split-args (args) (condition-case nil (split-string-and-unquote args) (error (progn (message "Arguments ‘%s’ ill quoted. Ignored." args) nil)))) (defun tuareg-interactive-get-old-input () (save-excursion (let ((end (point))) (re-search-backward comint-prompt-regexp (point-min) t) (when (looking-at comint-prompt-regexp) (re-search-forward comint-prompt-regexp)) (buffer-substring-no-properties (point) end)))) (defconst tuareg-interactive--send-warning "Note: REPL processing requires a terminating `;;', or use S-return.") (defun tuareg-interactive--indent-line () (insert "\n") (indent-according-to-mode) (message tuareg-interactive--send-warning)) (defun tuareg-interactive-send-input () "Send the current phrase to the OCaml REPL or insert a newline. If the point is next to \";;\", the phrase is sent to the REPL, otherwise a newline is inserted and the lines are indented." (interactive) (cond ((tuareg-in-literal-or-comment-p) (tuareg-interactive--indent-line)) ((or (equal ";;" (save-excursion (caddr (smie-backward-sexp)))) (looking-at-p "[ \t\n\r]*;;")) (comint-send-input)) (t (tuareg-interactive--indent-line)))) (defun tuareg-interactive-send-input-end-of-phrase () (interactive) (goto-char (point-max)) (unless (equal ";;" (save-excursion (caddr (smie-backward-sexp)))) (insert ";;")) (comint-send-input)) (defun tuareg-interactive--send-region (start end) "Send the region between START and END to the OCaml REPL. It is assumed that the range START-END delimit valid OCaml phrases." (save-excursion (tuareg-run-process-if-needed)) (comint-preinput-scroll-to-bottom) (let* ((phrases (buffer-substring-no-properties start end)) (phrases (replace-regexp-in-string "[ \t\n]*\\(;;[ \t\n]*\\)?\\'" "" phrases)) (phrases-colon (concat phrases ";;"))) (if (string= phrases "") (message "Cannot send empty commands to OCaml REPL!") (with-current-buffer tuareg-interactive-buffer-name (goto-char (point-max)) (setq tuareg-interactive-last-phrase-pos-in-repl (point)) (comint-send-string tuareg-interactive-buffer-name phrases-colon) (let ((pos (point))) (comint-send-input) (when tuareg-interactive-echo-phrase (save-excursion (goto-char pos) (insert phrases-colon))))))) (when tuareg-display-buffer-on-eval (display-buffer tuareg-interactive-buffer-name))) (defun tuareg-eval-region (start end) "Eval the current region in the OCaml REPL." (interactive "r") (setq tuareg-interactive-last-phrase-pos-in-source start) (setq start (car (tuareg-discover-phrase start))) (if start (progn (setq end (cadr (tuareg-discover-phrase end))) (if end (tuareg-interactive--send-region start end) (message "The expression after the point is not well braced."))) (message "The expression after the point is not well braced."))) (defun tuareg-narrow-to-phrase () "Narrow the editting window to the surrounding OCaml phrase (or block)." (interactive) (let ((phrase (tuareg-discover-phrase))) (if phrase (narrow-to-region (nth 0 phrase) (nth 1 phrase))))) (defun tuareg--after-double-colon () "Non nil if the current position is after or inside ';;'. In this case, the returned value is the position before ';;' (unless it is the first position of the buffer)." (save-excursion (when (looking-at-p "[;[:blank:]]*$") (skip-chars-backward ";[:blank:]") (if (> (point) 1) (- (point) 1))))) (defun tuareg-eval-phrase () "Eval the surrounding OCaml phrase (or block) in the OCaml REPL." (interactive) (let* ((pos (tuareg--after-double-colon)) (pos (if pos pos (point))) (phrase (tuareg-discover-phrase pos))) (if phrase (progn (tuareg-interactive--send-region (nth 0 phrase) (nth 1 phrase)) (when tuareg-skip-after-eval-phrase (goto-char (caddr phrase)) (tuareg--skip-double-colon) (tuareg-skip-blank-and-comments))) (message "The expression after the point is not well braced.")))) (defun tuareg-eval-buffer () "Send the buffer to the Tuareg Interactive process." (interactive) (tuareg-interactive--send-region (point-min) (point-max))) (defvar tuareg-interactive-next-error-olv (make-overlay 1 1)) (overlay-put tuareg-interactive-next-error-olv 'face 'tuareg-font-lock-error-face) (delete-overlay tuareg-interactive-next-error-olv) (defun tuareg-interactive-next-error-source () (interactive) (let ((error-pos) (beg 0) (end 0)) (with-current-buffer tuareg-interactive-buffer-name (goto-char tuareg-interactive-last-phrase-pos-in-repl) (setq error-pos (re-search-forward tuareg-interactive-error-range-regexp (point-max) t)) (when error-pos (setq beg (string-to-number (tuareg-match-string 1)) end (string-to-number (tuareg-match-string 2))))) (if (not error-pos) (message "No syntax or typing error in last phrase.") (setq beg (+ tuareg-interactive-last-phrase-pos-in-source beg) end (+ tuareg-interactive-last-phrase-pos-in-source end)) (goto-char beg) (move-overlay tuareg-interactive-next-error-olv beg end) (unwind-protect (sit-for 60 t) (delete-overlay tuareg-interactive-next-error-olv)) ))) (defun tuareg-interactive-next-error-repl () (interactive) (let ((error-pos) (beg 0) (end 0)) (save-excursion (goto-char tuareg-interactive-last-phrase-pos-in-repl) (setq error-pos (re-search-forward tuareg-interactive-error-range-regexp (point-max) t)) (when error-pos (setq beg (string-to-number (tuareg-match-string 1)) end (string-to-number (tuareg-match-string 2))))) (if (not error-pos) (message "No syntax or typing error in last phrase.") (setq beg (+ tuareg-interactive-last-phrase-pos-in-repl beg) end (+ tuareg-interactive-last-phrase-pos-in-repl end)) (move-overlay tuareg-interactive-next-error-olv beg end) (unwind-protect (sit-for 60 t) (delete-overlay tuareg-interactive-next-error-olv)) (goto-char beg)))) (defun tuareg-interrupt-ocaml () (interactive) (when (comint-check-proc tuareg-interactive-buffer-name) (with-current-buffer tuareg-interactive-buffer-name (comint-interrupt-subjob)))) (defun tuareg-kill-ocaml () (interactive) (when (comint-check-proc tuareg-interactive-buffer-name) (with-current-buffer tuareg-interactive-buffer-name (comint-kill-subjob)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menu support (defun tuareg-about () (interactive) (describe-variable 'tuareg-mode-version)) (defun tuareg-short-cuts () "Short cuts for the Tuareg mode: \\{tuareg-mode-map} Short cuts for interaction within the REPL: \\{tuareg-interactive-mode-map}" (interactive) (describe-function 'tuareg-short-cuts)) (defun tuareg-help () (interactive) (describe-function 'tuareg-mode)) (defun tuareg-interactive-help () (interactive) (describe-function 'tuareg-interactive-mode)) (defun tuareg-build-menu () (easy-menu-define tuareg-mode-menu (list tuareg-mode-map) "Tuareg Mode Menu." '("Tuareg" ("Interactive Mode" ["Run OCaml REPL" tuareg-run-ocaml t] ["Interrupt OCaml REPL" tuareg-interrupt-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Kill OCaml REPL" tuareg-kill-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Evaluate Region" tuareg-eval-region ;; Region-active-p for XEmacs and mark-active for Emacs :active mark-active] ["Evaluate Phrase" tuareg-eval-phrase t] ["Evaluate Buffer" tuareg-eval-buffer t]) ("OCaml Forms" ["try .. with .." tuareg-insert-try-form t] ["match .. with .." tuareg-insert-match-form t] ["let .. in .." tuareg-insert-let-form t] ["if .. then .. else .." tuareg-insert-if-form t] ["while .. do .. done" tuareg-insert-while-form t] ["for .. do .. done" tuareg-insert-for-form t] ["begin .. end" tuareg-insert-begin-form t]) ["Switch .ml/.mli" tuareg-find-alternate-file t] "---" ["Compile..." compile t] ["Reference Manual..." tuareg-browse-manual t] ["OCaml Library..." tuareg-browse-library t] "---" [ "Show type at point" caml-types-show-type tuareg-with-caml-mode-p] [ "Show fully qualified ident at point" caml-types-show-ident tuareg-with-caml-mode-p] [ "Show the kind of call at point" caml-types-show-call tuareg-with-caml-mode-p] "---" [ "Complete identifier" caml-complete tuareg-with-caml-mode-p] [ "Help for identifier" caml-help tuareg-with-caml-mode-p] [ "Add path for documentation" ocaml-add-path tuareg-with-caml-mode-p] [ "Open module for documentation" ocaml-open-module tuareg-with-caml-mode-p] [ "Close module for documentation" ocaml-close-module tuareg-with-caml-mode-p] "---" ["Customize Tuareg Mode..." (customize-group 'tuareg) t] ("Tuareg Options" ["Dummy" nil t]) ("Tuareg Interactive Options" ["Dummy" nil t]) "---" ["About" tuareg-about t] ["Short Cuts" tuareg-short-cuts] ["Help" tuareg-help t])) (easy-menu-add tuareg-mode-menu) (tuareg-update-options-menu)) (defun tuareg-toggle-option (symbol) (interactive) (set symbol (not (symbol-value symbol))) (tuareg-update-options-menu)) (defun tuareg-update-options-menu () (easy-menu-change '("Tuareg") "Tuareg Options" (mapcar (lambda (pair) (if (consp pair) (vector (car pair) (list 'tuareg-toggle-option (cdr pair)) ':style 'toggle ':selected (nth 1 (cdr pair)) ':active t) pair)) tuareg-options-list)) (easy-menu-change '("Tuareg") "Tuareg Interactive Options" (mapcar (lambda (pair) (if (consp pair) (vector (car pair) (list 'tuareg-toggle-option (cdr pair)) ':style 'toggle ':selected (nth 1 (cdr pair)) ':active t) pair)) tuareg-interactive-options-list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Browse Manual ;; From M. Quercia (defun tuareg-browse-manual () "*Browse OCaml reference manual." (interactive) (setq tuareg-manual-url (read-from-minibuffer "URL: " tuareg-manual-url)) (funcall tuareg-browser tuareg-manual-url)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Browse Library ;; From M. Quercia (defvar tuareg-library-mode-map (let ((map (make-keymap))) (suppress-keymap map) (define-key map [return] 'tuareg-library-find-file) (define-key map [mouse-2] 'tuareg-library-mouse-find-file) map)) (defun tuareg-browse-library () "Browse the OCaml library." (interactive) (let ((buf-name "*ocaml-library*") (opoint) (dir (read-from-minibuffer "Library path: " tuareg-library-path))) (when (and (file-directory-p dir) (file-readable-p dir)) (setq tuareg-library-path dir) ;; List *.ml and *.mli files (with-output-to-temp-buffer buf-name (buffer-disable-undo standard-output) (with-current-buffer buf-name (kill-all-local-variables) (setq-local tuareg-library-path dir) ;; Help (insert "Directory \"" dir "\".\n") (insert "Select a file with middle mouse button or RETURN.\n\n") (insert "Interface files (.mli):\n\n") (insert-directory (concat dir "/*.mli") "-C" t nil) (insert "\n\nImplementation files (.ml):\n\n") (insert-directory (concat dir "/*.ml") "-C" t nil) ;; '.', '-' and '_' are now letters (modify-syntax-entry ?. "w") (modify-syntax-entry ?_ "w") (modify-syntax-entry ?- "w") ;; Every file name is now mouse-sensitive (goto-char (point-min)) (while (< (point) (point-max)) (re-search-forward "\\.ml.?\\>") (setq opoint (point)) (re-search-backward "\\<" (point-min) 1) (put-text-property (point) opoint 'mouse-face 'highlight) (goto-char (+ 1 opoint))) ;; Activate tuareg-library mode (setq major-mode 'tuareg-library-mode) (setq mode-name "tuareg-library") (use-local-map tuareg-library-mode-map) (setq buffer-read-only t)))))) (defun tuareg-library-find-file () "Load the file whose name is near point." (interactive) (when (text-properties-at (point)) ;FIXME: Why?? (save-excursion (let (beg) (re-search-backward "\\<") (setq beg (point)) (re-search-forward "\\>") (find-file-read-only (expand-file-name (buffer-substring-no-properties beg (point)) tuareg-library-path)))))) (defun tuareg-library-mouse-find-file (event) "Visit the file name you click on." (interactive "e") (let ((owindow (selected-window))) (mouse-set-point event) (tuareg-library-find-file) (select-window owindow))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Imenu support (when (let (abbrevs-changed) ;Workaround for tuareg#146 (require 'caml nil t)) (defalias 'tuareg-imenu-create-index 'caml-create-index-function)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Related files & modes (eval-when-compile (autoload 'speedbar-add-supported-extension "speedbar") (defvar speedbar-obj-alist)) (when (require 'speedbar nil t) (speedbar-add-supported-extension '(".ml" ".mli" ".mll" ".mly" ".mlp" ".ls")) (add-to-list 'speedbar-obj-alist '("\\.mli$" . ".cmi")) (add-to-list 'speedbar-obj-alist '("\\.ml$" . ".cmo"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hooks and Exit (provide 'tuareg) ;;; tuareg.el ends here tuareg-2.2.0/tuareg.install000066400000000000000000000010771334701535100156700ustar00rootroot00000000000000share_root: [ "tuareg.el" {"emacs/site-lisp/tuareg.el"} "ocamldebug.el" {"emacs/site-lisp/ocamldebug.el"} "tuareg-site-file.el" {"emacs/site-lisp/tuareg-site-file.el"} "tuareg-menhir.el" {"emacs/site-lisp/tuareg-menhir.el"} "tuareg-opam.el" {"emacs/site-lisp/tuareg-opam.el"} "?tuareg.elc" {"emacs/site-lisp/tuareg.elc"} "?ocamldebug.elc" {"emacs/site-lisp/ocamldebug.elc"} "?tuareg-site-file.elc" {"emacs/site-lisp/tuareg-site-file.elc"} "?tuareg-menhir.elc" {"emacs/site-lisp/tuareg-menhir.elc"} "?tuareg-opam.elc" {"emacs/site-lisp/tuareg-opam.elc"} ] tuareg-2.2.0/tuareg.opam000066400000000000000000000017421334701535100151550ustar00rootroot00000000000000opam-version: "1.2" maintainer: "Christophe.Troestler@umons.ac.be" authors: [ "Albert Cohen " "Sam Steingold " "Christophe Troestler " "Stefan Monnier " ] homepage: "https://github.com/ocaml/tuareg" bug-reports: "https://github.com/ocaml/tuareg/issues" dev-repo: "https://github.com/ocaml/tuareg.git" doc: "https://github.com/ocaml/tuareg" build: [ [make "tuareg-site-file.el"] [make "elc"] { os != "darwin" } ] depends: [ "conf-emacs" ] depopts: [ "caml-mode" # {>= "4.05"} "merlin" ] post-messages: [ "If you have not yet done so, please add the following line to ~/.emacs.d/init.el or ~/.emacs: (load \"%{share}%/emacs/site-lisp/tuareg-site-file\") " {success & !user-setup:installed} "You should consider installing \"merlin\" (completion, displaying types,...) or \"caml-mode\" (displaying types). See https://github.com/ocaml/tuareg for customization tips." ]