pax_global_header00006660000000000000000000000064125016314770014520gustar00rootroot0000000000000052 comment=eab0dba22d027d07367b6037d073e66d49c81d4e tuareg-2.0.9/000077500000000000000000000000001250163147700130175ustar00rootroot00000000000000tuareg-2.0.9/.bzrignore000066400000000000000000000000061250163147700150150ustar00rootroot00000000000000*.elc tuareg-2.0.9/.gitignore000066400000000000000000000000341250163147700150040ustar00rootroot00000000000000*.elc *~ *.tar.gz tuareg.*/ tuareg-2.0.9/CHANGES000066400000000000000000000010321250163147700140060ustar00rootroot000000000000002.0.9 (master): * 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.0.9/COPYING000066400000000000000000000432121250163147700140540ustar00rootroot00000000000000 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.0.9/HISTORY000066400000000000000000000136661250163147700141170ustar00rootroot00000000000000Tuareg 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.0.9/Makefile000066400000000000000000000054671250163147700144730ustar00rootroot00000000000000VERSION = $(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 = tuareg.$(VERSION) SOURCES = tuareg.el tuareg_indent.el ocamldebug.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 EMACSFORMACOSX = /Applications/Emacs.app/Contents/MacOS/Emacs ifeq ($(wildcard $(EMACSFORMACOSX)),$(EMACSFORMACOSX)) EMACS ?= $(EMACSFORMACOSX) else EMACS ?= emacs endif #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 tuareg-site-file.el elc : $(ELC) %.elc : %.el $(EMACS) --batch -L . --no-init-file -f batch-byte-compile $< 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.elc $< \ --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 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) opam: $(TARBALL) $(INSTALL_MKDIR) $(OPAM_DIR) $(CP) -a $(filter-out %~, $(wildcard opam/*)) $(OPAM_DIR) echo "archive: \"`pwd`/$(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 opam tuareg-2.0.9/README.md000066400000000000000000000075561250163147700143130ustar00rootroot00000000000000Tuareg: 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 toplevel, and to run the OCaml debugger within Emacs. Contents -------- `README` — 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 ------- See `tuareg.el`. Configuration ------------- Add the following line near the beginning of your ~/.emacs file: (load "/where/ever/you/put/tuareg-mode/tuareg-site-file") 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. It gives you the correct syntax table for the OCaml language. Thanks to the work of Stefan Monnier, a new indentation engine based on SMIE was written. To deactivate it, add (setq tuareg-use-smie nil) to the top-level of your `.emacs` file. Usage ----- See `tuareg.el`. Customization ------------- 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. 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 )) Sample Customizations --------------------- Here are random examples of customization you might like to put in your ~/.emacs file: ;; Indent `=' like a standard keyword. (setq tuareg-lazy-= t) ;; Indent [({ like standard keywords. (setq tuareg-lazy-paren t) ;; No indentation after `in' keywords. (setq tuareg-in-indent 0) (add-hook 'tuareg-mode-hook ;; Turn on auto-fill minor mode. (lambda () (auto-fill-mode 1))) Features, Known Bugs -------------------- Cf. online help. 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.0.9/ocamldebug.el000066400000000000000000000743341250163147700154560ustar00rootroot00000000000000;;; 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-p '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-mode-map (let ((map (make-sparse-keymap))) (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." (set (make-local-variable 'ocamldebug-last-frame) nil) (set (make-local-variable 'ocamldebug-delete-prompt-marker) (make-marker)) (set (make-local-variable 'ocamldebug-filter-accumulator) "") (set (make-local-variable 'ocamldebug-filter-function) #'ocamldebug-marker-filter) (set (make-local-variable 'comint-prompt-regexp) ocamldebug-prompt-pattern) (set (make-local-variable 'comint-dynamic-complete-functions) (cons #'ocamldebug-complete comint-dynamic-complete-functions)) (set (make-local-variable 'paragraph-start) comint-prompt-regexp) (set (make-local-variable 'ocamldebug-last-frame-displayed-p) t) (set (make-local-variable '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-mode-map ,(concat "\C-c" key) ',fun) (define-key tuareg-mode-map ,(concat "\C-x\C-a" 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* ((end (point)) (command (save-excursion (beginning-of-line) (and (looking-at comint-prompt-regexp) (goto-char (match-end 0))) (buffer-substring (point) end))) (ocamldebug-complete-list nil) (command-word)) ;; Find the word break. This match will always succeed. (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) (setq command-word (match-string 2 command)) ;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 comint ;call below will weed out false matches - and it avoids further ;mucking with ocamldebug's lexer. (when (> (length command-word) 0) (setq command (substring command 0 (1- (length command))))) (let ((ocamldebug-filter-function 'ocamldebug-complete-filter)) (ocamldebug-call-1 (concat "complete " command)) (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))))) (when (eq ocamldebug-complete-list 'fail) (setq ocamldebug-complete-list nil)) (setq ocamldebug-complete-list (sort ocamldebug-complete-list 'string-lessp)) (comint-dynamic-simple-complete command-word ocamldebug-complete-list))) (define-key tuareg-mode-map "\C-x " 'ocamldebug-break) (defvar ocamldebug-command-name "ocamldebug" "Pathname for executing the OCaml debugger.") ;;;###autoload (defun ocamldebug (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 path (expand-file-name path)) (let ((file (file-name-nondirectory path))) (pop-to-buffer (concat "*ocamldebug-" file "*")) (setq default-directory (file-name-directory path)) (message "Current directory is %s" default-directory) (setq ocamldebug-command-name (read-from-minibuffer "OCaml debugguer to run: " ocamldebug-command-name)) (make-comint (concat "ocamldebug-" file) (substitute-in-file-name ocamldebug-command-name) nil "-emacs" "-cd" default-directory path) (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 (+ (point-min) schar)) (setq epos (+ (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 (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.0.9/opam/000077500000000000000000000000001250163147700137535ustar00rootroot00000000000000tuareg-2.0.9/opam/descr000066400000000000000000000003501250163147700147740ustar00rootroot00000000000000OCaml 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 toplevel and debugger is provided. tuareg-2.0.9/opam/files/000077500000000000000000000000001250163147700150555ustar00rootroot00000000000000tuareg-2.0.9/opam/files/tuareg.install000066400000000000000000000003521250163147700177340ustar00rootroot00000000000000share_root: [ "tuareg.el" {"emacs/site-lisp/tuareg.el"} "tuareg_indent.el" {"emacs/site-lisp/tuareg_indent.el"} "ocamldebug.el" {"emacs/site-lisp/ocamldebug.el"} "tuareg-site-file.el" {"emacs/site-lisp/tuareg-site-file.el"} ] tuareg-2.0.9/opam/opam000066400000000000000000000013011250163147700146250ustar00rootroot00000000000000opam-version: "1.2" name: "tuareg" version: "2.0.9" maintainer: "Christophe.Troestler@umons.ac.be" authors: [ "Albert Cohen " "Sam Steingold " "Christophe Troestler " "Stefan Monnier " ] homepage: "https://forge.ocamlcore.org/projects/tuareg/" bug-reports: "https://forge.ocamlcore.org/tracker/?group_id=43" dev-repo: "https://github.com/ocaml/tuareg.git" build: [make "tuareg-site-file.el"] depends: "caml-mode" post-messages: " If you have not yet done so, please add in ~/.emacs.d/init.el or in ~/.emacs to following line: (load \"%{share}%/emacs/site-lisp/tuareg-site-file\") " {success} tuareg-2.0.9/sample.ml000066400000000000000000000425631250163147700146440ustar00rootroot00000000000000(* 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} 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 | C with sexp type t = | A | B | C type t = [ | `A | `B | `C ] type t = [ (* Comment. *) | `A | `B | `C ] type t = a 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 ;; (* 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)) 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 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 *) 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.0.9/tuareg-light.el000066400000000000000000002740231250163147700157450ustar00rootroot00000000000000 ;;----------------------------------------------------------------------------;; ;; Customize ;; ;;----------------------------------------------------------------------------;; (require 'cl) (require 'custom) (defgroup tuareg2 nil "Support for the OCaml language." :group 'languages) ;; Comments (defcustom tuareg2-indent-leading-comments t "*If true, indent leading comment lines (starting with `(*') like others." :group 'tuareg2 :type 'boolean) (defcustom tuareg2-indent-comments t "*If true, automatically align multi-line comments." :group 'tuareg2 :type 'boolean) (defcustom tuareg2-comment-end-extra-indent 0 "*How many spaces to indent a leading comment end `*)'. If you expect comments to be indented like (* ... *) even without leading `*', use `tuareg2-comment-end-extra-indent' = 1." :group 'tuareg2 :type '(radio :extra-offset 8 :format "%{Comment End Extra Indent%}: Comment alignment:\n%v" (const :tag "align with `(' in comment opening" 0) (const :tag "align with `*' in comment opening" 1) (integer :tag "custom alignment" 0))) (defcustom tuareg2-support-leading-star-comments t "*Enable automatic intentation of comments of the form (* * ... *) Documentation comments (** *) are not concerned by this variable unless `tuareg2-leading-star-in-doc' is also set. If you do not set this variable and still expect comments to be indented like (* ... *) \(without leading `*'), set `tuareg2-comment-end-extra-indent' to 1." :group 'tuareg2 :type 'boolean) (defcustom tuareg2-leading-star-in-doc nil "*Enable automatic intentation of documentation comments of the form (** * ... *)" :group 'tuareg2 :type 'boolean) ;; Indentation defaults (defcustom tuareg2-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 'tuareg2 :type 'integer) (defcustom tuareg2-let-always-indent t "*If true, enforce indentation is at least `tuareg2-let-indent' after a `let'. As an example, set it to false when you have `tuareg2-with-indent' set to 0, and you want `let x = match ... with' and `match ... with' indent the same way." :group 'tuareg2 :type 'boolean) (defcustom tuareg2-pipe-extra-unindent tuareg2-default-indent "*Extra backward indent for OCaml lines starting with the `|' operator. It is NOT the variable controlling the indentation of the `|' itself: this value is automatically added to `function', `with', `parse' and some cases of `type' keywords to leave enough space for `|' backward indentation. For example, setting this variable to 0 leads to the following indentation: match ... with X -> ... | Y -> ... | Z -> ... To modify the indentation of lines lead by `|' you need to modify the indentation variables for `with', `function' and `parse', and possibly for `type' as well. For example, setting them to 0 (and leaving `tuareg2-pipe-extra-unindent' to its default value) yields: match ... with X -> ... | Y -> ... | Z -> ..." :group 'tuareg2 :type 'integer) (defcustom tuareg2-class-indent tuareg2-default-indent "*How many spaces to indent from a `class' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-sig-struct-align t "*Align `sig' and `struct' keywords with `module'." :group 'tuareg2 :type 'boolean) (defcustom tuareg2-sig-struct-indent tuareg2-default-indent "*How many spaces to indent from a `sig' or `struct' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-method-indent tuareg2-default-indent "*How many spaces to indent from a `method' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-begin-indent tuareg2-default-indent "*How many spaces to indent from a `begin' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-for-while-indent tuareg2-default-indent "*How many spaces to indent from a `for' or `while' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-do-indent tuareg2-default-indent "*How many spaces to indent from a `do' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-fun-indent tuareg2-default-indent "*How many spaces to indent from a `fun' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-function-indent tuareg2-default-indent "*How many spaces to indent from a `function' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-if-then-else-indent tuareg2-default-indent "*How many spaces to indent from an `if', `then' or `else' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-let-indent tuareg2-default-indent "*How many spaces to indent from a `let' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-in-indent 0 ; tuareg2-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 `tuareg2-default-indent'." :group 'tuareg2 :type 'integer) (defcustom tuareg2-match-indent tuareg2-default-indent "*How many spaces to indent from a `match' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-try-indent tuareg2-default-indent "*How many spaces to indent from a `try' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-with-indent tuareg2-default-indent "*How many spaces to indent from a `with' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-rule-indent tuareg2-default-indent "*How many spaces to indent from a `rule' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-type-indent tuareg2-default-indent "*How many spaces to indent from a `type' keyword." :group 'tuareg2 :type 'integer) (defcustom tuareg2-val-indent tuareg2-default-indent "*How many spaces to indent from a `val' keyword." :group 'tuareg2 :type 'integer) (defgroup tuareg2-faces nil "Special faces for the Tuareg2 mode." :group 'tuareg2) (defconst tuareg2-faces-inherit-p (and (boundp 'face-attribute-name-alist) (assq :inherit face-attribute-name-alist))) (defface tuareg2-font-lock-governing-face '((((background light)) (:foreground "blue" :bold t)) (t (:foreground "orange" :bold t))) "Face description for governing/leading keywords." :group 'tuareg2-faces) (defvar tuareg2-font-lock-governing-face 'tuareg2-font-lock-governing-face) (defface tuareg2-font-lock-operator-face '((((background light)) (:foreground "brown")) (t (:foreground "khaki"))) "Face description for all operators." :group 'tuareg2-faces) (defvar tuareg2-font-lock-operator-face 'tuareg2-font-lock-operator-face) ;;----------------------------------------------------------------------------;; ;; Util ;; ;;----------------------------------------------------------------------------;; (defun tuareg2-editing-ocamllex () "Tells whether we are editing OCamlLex syntax." (string-match "\\.mll" (buffer-name))) (defalias 'tuareg2-match-string 'match-string-no-properties) (defun tuareg2-leading-star-p () (and tuareg2-support-leading-star-comments (save-excursion ; this function does not make sense outside of a comment (tuareg2-beginning-of-literal-or-comment) (and (or tuareg2-leading-star-in-doc (not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*"))) (progn (forward-line 1) (back-to-indentation) (looking-at "\\*[^)]")))))) (defun tuareg2-auto-fill-insert-leading-star (&optional leading-star) (let ((point-leading-comment (looking-at "(\\*")) (return-leading nil)) (save-excursion (back-to-indentation)) return-leading)) (defun tuareg2-auto-fill-function () (unless (tuareg2-in-literal-p) (let ((leading-star (and (not (char-equal ?\n last-command-event)) (tuareg2-auto-fill-insert-leading-star)))) (do-auto-fill) (unless (char-equal ?\n last-command-event) (tuareg2-auto-fill-insert-leading-star leading-star))))) (defun tuareg2-forward-char (&optional step) "does not signal errors beginning-of-buffer and end-of-buffer" (if step (goto-char (+ (point) step)) (goto-char (1+ (point))))) (defun tuareg2-backward-char (&optional step) "does not signal errors beginning-of-buffer and end-of-buffer" (if step (goto-char (- (point) step)) (goto-char (1- (point))))) (defun tuareg2-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 tuareg2-in-literal-p () "Returns non-nil if point is inside an OCaml literal." (nth 3 (syntax-ppss))) (defun tuareg2-in-comment-p () "Returns non-nil if point is inside or right before an OCaml comment." (or (nth 4 (syntax-ppss)) (looking-at "[ \t]*(\\*"))) (defun tuareg2-in-literal-or-comment-p () "Returns non-nil if point is inside an OCaml literal or comment." (nth 8 (syntax-ppss))) (defun tuareg2-beginning-of-literal-or-comment () "Skips to the beginning of the current literal or comment (or buffer)." (interactive) (goto-char (or (nth 8 (syntax-ppss)) (point)))) (defun tuareg2-beginning-of-literal-or-comment-fast () (goto-char (or (nth 8 (syntax-ppss)) (point-min)))) (defalias 'tuareg2-backward-up-list 'backward-up-list) (defalias 'tuareg2-backward-up-list 'backward-up-list) (defun tuareg2-false-=-p () "Is the underlying `=' the first/second letter of an operator?" (or (memq (preceding-char) '(?: ?> ?< ?=)) (char-equal ?= (char-after (1+ (point)))))) (defun tuareg2-at-phrase-break-p () "Is the underlying `;' a phrase break?" (and (char-equal ?\; (following-char)) (or (and (not (eobp)) (char-equal ?\; (char-after (1+ (point))))) (char-equal ?\; (preceding-char))))) ;;----------------------------------------------------------------------------;; ;; Font lock ;; ;;----------------------------------------------------------------------------;; (defcustom tuareg2-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." :group 'tuareg2 :type 'boolean) (defvar tuareg2-font-lock-symbols-alist (cond ((and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'symbol)) `(("fun" . ,(make-char 'symbol 108)) ("sqrt" . ,(make-char 'symbol 214)) ("not" . ,(make-char 'symbol 216)) ("&&" . ,(make-char 'symbol 217)) ("or" . ,(make-char 'symbol 218)) ("||" . ,(make-char 'symbol 218)) ("*." . ,(make-char 'symbol 183)) ("/." . ,(make-char 'symbol 184)) ("<=" . ,(make-char 'symbol 163)) ("<-" . ,(make-char 'symbol 172)) ("->" . ,(make-char 'symbol 174)) (">=" . ,(make-char 'symbol 179)) ("<>" . ,(make-char 'symbol 185)) ("==" . ,(make-char 'symbol 186)) ("<=>" . ,(make-char 'symbol 219)) (":=" . ,(make-char 'symbol 220)) ("=>" . ,(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)))) ((fboundp 'decode-char) ;; or a unicode font. `(("fun" . ,(decode-char 'ucs 955)) ("sqrt" . ,(decode-char 'ucs 8730)) ("not" . ,(decode-char 'ucs 172)) ("&&" . ,(decode-char 'ucs 8896)) ("or" . ,(decode-char 'ucs 8897)) ("||" . ,(decode-char 'ucs 8897)) ("*." . ,(decode-char 'ucs 215)) ("/." . ,(decode-char 'ucs 247)) ("->" . ,(decode-char 'ucs 8594)) ("<-" . ,(decode-char 'ucs 8592)) ("<=" . ,(decode-char 'ucs 8804)) (">=" . ,(decode-char 'ucs 8805)) ("<>" . ,(decode-char 'ucs 8800)) ("==" . ,(decode-char 'ucs 8801)) ("<=>" . ,(decode-char 'ucs 8660)) (":=" . ,(decode-char 'ucs 8656)) ("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)))))) (defun tuareg2-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) '(tuareg2-doc-face font-lock-string-face font-lock-comment-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 tuareg2-font-lock-symbols-keywords () (when (fboundp 'compose-region) (let ((alist nil)) (dolist (x tuareg2-font-lock-symbols-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 (tuareg2-font-lock-compose-symbol ',alist)))))))) (defvar tuareg2-doc-face 'font-lock-doc-face) (defconst tuareg2-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. '(("\\<\\('\\)\\([^'\\\n]\\|\\\\.[^\\'\n \")]*\\)\\('\\)" (1 '(7)) (3 '(7))))) (defun tuareg2-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 tuareg2-doc-face font-lock-comment-face)))) ;; Initially empty, set in `tuareg2-install-font-lock' (defvar tuareg2-font-lock-keywords () "Font-Lock patterns for Tuareg2 mode.") (defun tuareg2-install-font-lock () (setq tuareg2-font-lock-keywords `(("\\<\\(external\\|open\\|include\\|rule\\|s\\(ig\\|truct\\)\\|module\\|functor\\|with[ \t\n]+\\(type\\|module\\)\\|val\\|type\\|method\\|virtual\\|constraint\\|class\\|in\\|inherit\\|initializer\\|let\\|rec\\|object\\|and\\|begin\\|end\\)\\>" 0 tuareg2-font-lock-governing-face nil nil) ("\\<\\(false\\|true\\)\\>" 0 font-lock-constant-face nil nil) ("\\<\\(as\\|do\\(ne\\|wnto\\)?\\|else\\|for\\|if\\|mutable\\|new\\|p\\(arser\\|rivate\\)\\|t\\(hen\\|o\\|ry\\)\\|wh\\(en\\|ile\\)\\|match\\|with\\|lazy\\|exception\\|raise\\|failwith[f]?\\|exit\\|assert\\|fun\\(ction\\)?\\)\\>" 0 font-lock-keyword-face nil nil) ("\\[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)" 3 font-lock-function-name-face keep nil) ("\\<\\(fun\\(ction\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_ \t()*,]\\)+\\)" 3 font-lock-variable-name-face keep nil) ( "\\<\\(open\\|\\(class\\([ \t\n]+type\\)?\\)\\([ \t\n]+virtual\\)?\\|inherit\\|include\\|module\\([ \t\n]+\\(type\\|rec\\)\\)?\\|type\\)\\>[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)" 7 font-lock-type-face keep nil) ("[^:>=]:[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)" 1 font-lock-type-face keep nil) ("\\<\\([A-Z]\\w*\\>\\)[ \t]*\\." 1 font-lock-type-face keep nil) ("\\<\\([?~]?[_[:alpha:]]\\w*\\)[ \t\n]*:[^:>=]" 1 font-lock-variable-name-face keep nil) ("\\[ \t\n]*\\(\\<[_[:alpha:]]\\w*\\>\\)" 1 font-lock-variable-name-face keep nil) ("^#\\w+\\>" 0 font-lock-preprocessor-face t nil) ,@(and tuareg2-font-lock-symbols (tuareg2-font-lock-symbols-keywords)))) (setq font-lock-defaults (list 'tuareg2-font-lock-keywords nil nil tuareg2-font-lock-syntax nil '(font-lock-syntactic-keywords . tuareg2-font-lock-syntactic-keywords) '(parse-sexp-lookup-properties . t) '(font-lock-syntactic-face-function . tuareg2-font-lock-syntactic-face-function)))) ;;----------------------------------------------------------------------------;; ;; Abbrev table ;; ;;----------------------------------------------------------------------------;; (defvar tuareg2-mode-abbrev-table () "Abbrev table used for Tuareg2 mode buffers.") (defun tuareg2-define-abbrev (keyword) (define-abbrev tuareg2-mode-abbrev-table keyword keyword 'tuareg2-abbrev-hook)) (if tuareg2-mode-abbrev-table () (setq tuareg2-mode-abbrev-table (make-abbrev-table)) (mapc 'tuareg2-define-abbrev '("module" "class" "functor" "object" "type" "val" "inherit" "include" "virtual" "constraint" "exception" "external" "open" "method" "and" "initializer" "to" "downto" "do" "done" "else" "begin" "end" "let" "in" "then" "with")) (setq abbrevs-changed nil)) ;;----------------------------------------------------------------------------;; ;; Indentation ;; ;;----------------------------------------------------------------------------;; (defconst tuareg2-no-more-code-this-line-regexp "[ \t]*\\((\\*\\|$\\)" "Regexp matching lines which have no more code: blanks + (maybe) comment start.") (defun tuareg2-no-code-after (rex) (concat rex tuareg2-no-more-code-this-line-regexp)) (defconst tuareg2-no-code-this-line-regexp (concat "^" tuareg2-no-more-code-this-line-regexp)) (defun tuareg2-ro (&rest words) (concat "\\<" (regexp-opt words t) "\\>")) (defconst tuareg2-extra-unindent-regexp (concat "\\(" (tuareg2-ro "with" "fun" "function" "parse") "\\|\\[" tuareg2-no-more-code-this-line-regexp "\\)") "Regexp for keywords needing extra indentation to compensate for case matches.") (defun tuareg2-extra-unindent-regexp () tuareg2-extra-unindent-regexp) (defconst tuareg2-keyword-regexp (concat (tuareg2-ro "and" "as" "assert" "begin" "class" "constraint" "do" "done" "downto" "else" "end" "exception" "external" "for" "fun" "function" "functor" "if" "in" "include" "inherit" "initializer" "lazy" "let" "match" "method" "module" "mutable" "new" "object" "of" "open" "or" "private" "rec" "sig" "struct" "then" "to" "true" "try" "type" "val" "virtual" "when" "while" "with" ;; infix "mod" "land" "lor" "lxor" "lsl" "lsr" "asr" ) "\\|->\\|[;,|]") "Regexp for all recognized keywords. See parsing/lexer.mll in the ocaml source.") (defun tuareg2-keyword-regexp () tuareg2-keyword-regexp) (defconst tuareg2-match-pipe-kwop-regexp (concat (tuareg2-ro "and" "function" "type" "with" "parse" ) "\\|[[({=]\\||[^!]") "Regexp for keywords supporting case match.") (defun tuareg2-match-pipe-kwop-regexp () tuareg2-match-pipe-kwop-regexp) (defconst tuareg2-operator-regexp "[---+*/=<>@^&|]\\|:>\\|::\\|\\<\\(or\\|l\\(and\\|x?or\\|s[lr]\\)\\|as[lr]\\|mod\\)\\>" "Regexp for all operators.") (defun tuareg2-operator-regexp () tuareg2-operator-regexp) (defconst tuareg2-matching-keyword-regexp (tuareg2-ro "and" "do" "done" "then" "else" "end" "in" "down" "downto") "Regexp matching OCaml keywords which act as end block delimiters.") (defun tuareg2-matching-keyword-regexp () tuareg2-matching-keyword-regexp) (defconst tuareg2-matching-kwop-regexp (concat tuareg2-matching-keyword-regexp "\\|\\\\|[|>]?\\]\\|>?}\\|[|)]\\|;;") "Regexp matching OCaml keywords or operators which act as end block delimiters.") (defun tuareg2-matching-kwop-regexp () tuareg2-matching-kwop-regexp) (defconst tuareg2-block-regexp (concat (tuareg2-ro "for" "while" "do" "if" "begin" "sig" "struct" "object") "\\|[][(){}]\\|\\*)")) (defun tuareg2-block-regexp () tuareg2-block-regexp) (defconst tuareg2-find-kwop-regexp (concat tuareg2-matching-keyword-regexp "\\|" tuareg2-block-regexp)) (defun tuareg2-find-kwop-regexp () tuareg2-find-kwop-regexp) (defconst tuareg2-governing-phrase-regexp (tuareg2-ro "val" "type" "method" "module" "constraint" "class" "inherit" "initializer" "external" "exception" "open" "let" "object" "include") "Regexp matching tuareg2 phrase delimitors.") (defun tuareg2-governing-phrase-regexp () tuareg2-governing-phrase-regexp) (defconst tuareg2-keyword-alist '(("module" . tuareg2-default-indent) ("class" . tuareg2-class-indent) ("sig" . tuareg2-sig-struct-indent) ("struct" . tuareg2-sig-struct-indent) ("method" . tuareg2-method-indent) ("object" . tuareg2-begin-indent) ("begin" . tuareg2-begin-indent) (".<" . tuareg2-begin-indent) ("for" . tuareg2-for-while-indent) ("while" . tuareg2-for-while-indent) ("do" . tuareg2-do-indent) ("val" . tuareg2-val-indent) ("fun" . tuareg2-fun-indent) ("if" . tuareg2-if-then-else-indent) ("then" . tuareg2-if-then-else-indent) ("else" . tuareg2-if-then-else-indent) ("let" . tuareg2-let-indent) ("match" . tuareg2-match-indent) ("try" . tuareg2-try-indent) ("rule" . tuareg2-rule-indent) ;; Case match keywords ("function" . tuareg2-function-indent) ("with" . tuareg2-with-indent) ("parse" . tuareg2-with-indent) ("automaton" . tuareg2-with-indent) ("present" . tuareg2-with-indent) ("type" . tuareg2-type-indent) ; sometimes, `type' acts like a case match ;; Assume default indentation for other keywords and operators ) "Association list of indentation values based on governing keywords.") (defconst tuareg2-leading-kwop-alist '(("|" . tuareg2-find-pipe-match) ("}" . tuareg2-find-match) (">}" . tuareg2-find-match) (">." . tuareg2-find-match) (")" . tuareg2-find-match) ("]" . tuareg2-find-match) ("|]" . tuareg2-find-match) (">]" . tuareg2-find-match) ("end" . tuareg2-find-match) ("done" . tuareg2-find-done-match) ("unless" . tuareg2-find-done-match) ("until" . tuareg2-find-done-match) ("every" . tuareg2-find-done-match) ("in" . tuareg2-find-in-match) ("where" . tuareg2-find-in-match) ("with" . tuareg2-find-with-match) ("else" . tuareg2-find-else-match) ("then" . tuareg2-find-then-match) ("do" . tuareg2-find-do-match) ("to" . tuareg2-find-match) ("downto" . tuareg2-find-match) ("and" . tuareg2-find-and-match)) "Association list used in Tuareg2 mode for skipping back over nested blocks.") (defun tuareg2-find-leading-kwop-match (kwop) (funcall (cdr (assoc kwop tuareg2-leading-kwop-alist)))) (defconst tuareg2-binding-regexp "\\(\\\\|(*\\\\)") (defun tuareg2-assoc-indent (kwop &optional look-for-let-or-and) "Return relative indentation of the keyword given in argument." (let ((ind (or (symbol-value (cdr (assoc kwop tuareg2-keyword-alist))) tuareg2-default-indent)) (looking-let-or-and (and look-for-let-or-and (looking-at tuareg2-binding-regexp)))) (if (string-match (tuareg2-extra-unindent-regexp) kwop) (- (if (and tuareg2-let-always-indent looking-let-or-and (< ind tuareg2-let-indent)) tuareg2-let-indent ind) tuareg2-pipe-extra-unindent) ind))) (defun tuareg2-in-monadic-op-p (&optional pos) (unless pos (setq pos (point))) (and (char-equal ?> (char-before pos)) (char-equal ?> (char-before (1- pos))))) (defconst tuareg2-meaningful-word-regexp "[^ \t\n_[:alnum:]]\\|\\<\\(\\w\\|_\\)+\\>\\|\\*)") (defun tuareg2-find-meaningful-word () "Look back for a word, skipping comments and blanks. Returns the actual text of the word, if found." (let ((found nil) (kwop nil) (pt (point))) (while (and (not found) (re-search-backward tuareg2-meaningful-word-regexp (point-min) t)) (setq kwop (tuareg2-match-string 0)) (cond ((and (or (string= kwop "|") (string= kwop "=") (string= kwop ">")) (tuareg2-in-monadic-op-p)) (backward-char 2) (setq kwop (concat ">>" kwop))) ((and (string= kwop ">") (char-equal ?- (char-before))) (backward-char) (setq kwop "->"))) (when (= pt (point)) (error "tuareg2-find-meaningful-word: inf loop at %d, kwop=%s" pt kwop)) (setq pt (point)) (if kwop (if (tuareg2-in-comment-p) (tuareg2-beginning-of-literal-or-comment-fast) (setq found t)) (setq found t))) (if found kwop (goto-char (point-min)) nil))) (defun tuareg2-make-find-kwop-regexp (kwop-regexp) "Make a custom indentation regexp." (concat (tuareg2-find-kwop-regexp) "\\|" kwop-regexp)) ;; Static regexps (defconst tuareg2-find-and-match-regexp (concat (tuareg2-ro "do" "done" "else" "end" "in" "then" "down" "downto" "for" "while" "do" "if" "begin" "sig" "struct" "class" "rule" "exception" "let" "in" "type" "val" "module") "\\|[][(){}]\\|\\*)")) (defconst tuareg2-find-phrase-beginning-regexp (concat (tuareg2-ro "end" "type" "module" "sig" "struct" "class" "exception" "open" "let") "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;;")) (defconst tuareg2-find-phrase-beginning-and-regexp (concat "\\<\\(and\\)\\>\\|" tuareg2-find-phrase-beginning-regexp)) (defconst tuareg2-back-to-paren-or-indentation-regexp "[][(){}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") ;; Specific regexps for module/class detection (defconst tuareg2-inside-module-or-class-opening (tuareg2-ro "struct" "sig" "object")) (defconst tuareg2-inside-module-or-class-opening-full (concat tuareg2-inside-module-or-class-opening "\\|" (tuareg2-ro "module" "class"))) (defconst tuareg2-inside-module-or-class-regexp (concat tuareg2-matching-keyword-regexp "\\|" tuareg2-inside-module-or-class-opening)) (defconst tuareg2-find-comma-match-regexp (tuareg2-make-find-kwop-regexp (concat (tuareg2-ro "and" "match" "begin" "else" "exception" "then" "try" "with" "or" "fun" "function" "let" "do") "\\|->\\|[[{(]"))) (defconst tuareg2-find-with-match-regexp (tuareg2-make-find-kwop-regexp (concat (tuareg2-ro "match" "try" "module" "begin" "with" "type") "\\|[[{(]"))) (defconst tuareg2-find-in-match-regexp ;;(tuareg2-make-find-kwop-regexp (tuareg2-ro "let" "open"))) (tuareg2-make-find-kwop-regexp (tuareg2-ro "let"))) (defconst tuareg2-find-else-match-regexp (tuareg2-make-find-kwop-regexp ";")) (defconst tuareg2-find-do-match-regexp (tuareg2-make-find-kwop-regexp "->")) (defconst tuareg2-find-=-match-regexp (tuareg2-make-find-kwop-regexp (concat (tuareg2-ro "val" "let" "method" "module" "type" "class" "when" "if" "in" "do") "\\|="))) (defconst tuareg2-find-pipe-match-regexp (tuareg2-make-find-kwop-regexp (tuareg2-match-pipe-kwop-regexp))) (defconst tuareg2-find-arrow-match-regexp (tuareg2-make-find-kwop-regexp (concat (tuareg2-ro "external" "type" "val" "method" "let" "with" "fun" "function" "functor" "class") "\\|[|;]"))) (defconst tuareg2-find-semicolon-match-regexp (tuareg2-make-find-kwop-regexp (concat ";" tuareg2-no-more-code-this-line-regexp "\\|->\\|" (tuareg2-ro "let" "method" "with" "try" "initializer")))) (defconst tuareg2-find-phrase-indentation-regexp (tuareg2-make-find-kwop-regexp (concat tuareg2-governing-phrase-regexp "\\|" (tuareg2-ro "and")))) (defconst tuareg2-find-phrase-indentation-break-regexp (concat tuareg2-find-phrase-indentation-regexp "\\|;;")) (defconst tuareg2-find-phrase-indentation-class-regexp (concat (tuareg2-matching-keyword-regexp) "\\|\\")) (defconst tuareg2-compute-argument-indent-regexp (tuareg2-make-find-kwop-regexp (concat (tuareg2-keyword-regexp) "\\|="))) (defconst tuareg2-compute-normal-indent-regexp (concat tuareg2-compute-argument-indent-regexp "\\|^.[ \t]*")) (defconst tuareg2-find-module-regexp (tuareg2-make-find-kwop-regexp "\\")) (defconst tuareg2-find-pipe-bang-match-regexp (concat tuareg2-find-comma-match-regexp "\\|=")) (defconst tuareg2-find-monadic-match-regexp (concat tuareg2-block-regexp "\\|\\([;=]\\)\\|\\(->\\)\\|" (tuareg2-ro "val" "let" "method" "module" "type" "class" "when" "if" "in" "do" "done" "end"))) (defun tuareg2-strip-trailing-whitespace (string) (if (string-match "[ \t]*\\'" string) (substring string 0 (match-beginning 0)) string)) (defun tuareg2-find-kwop-pos (kr do-not-skip-regexp may-terminate-early) "Look back for a keyword or operator matching KR (short for kwop regexp). Skips blocks etc... Ignore occurences inside literals and comments. If found, return the actual text of the keyword or operator." (let ((found nil) (kwop nil) pos (kwop-regexp kr)) (while (and (not found) (setq pos (re-search-backward kwop-regexp (point-min) t)) (setq kwop (tuareg2-strip-trailing-whitespace ;; for trailing blanks after a semicolon (tuareg2-match-string 0)))) (cond ((tuareg2-in-literal-or-comment-p) (tuareg2-beginning-of-literal-or-comment-fast)) ((looking-at "[]})]") (tuareg2-backward-up-list)) ((tuareg2-at-phrase-break-p) (setq found t)) ((and do-not-skip-regexp (looking-at do-not-skip-regexp)) (if (and (string= kwop "|") (char-equal ?| (preceding-char))) (backward-char) (setq found t))) ((looking-at (tuareg2-matching-keyword-regexp)) (let ((mkwop (tuareg2-find-leading-kwop-match (tuareg2-match-string 0)))) (when (and may-terminate-early (string-match kwop-regexp mkwop)) (setq found t)))) (t (setq found t)))) (if found (list kwop pos) (goto-char (point-min)) nil))) (defun tuareg2-find-kwop (kr &optional do-not-skip-regexp) (car (tuareg2-find-kwop-pos kr do-not-skip-regexp nil))) (defun tuareg2-find-match () (let ((kwop (tuareg2-find-kwop (tuareg2-find-kwop-regexp)))) (when (string= kwop "then") (tuareg2-find-then-match) (tuareg2-find-match)) kwop)) (defun tuareg2-find-comma-match () (car (tuareg2-find-kwop-pos tuareg2-find-comma-match-regexp nil t))) (defun tuareg2-find-pipe-bang-match () (destructuring-bind (kwop pos) (tuareg2-find-kwop-pos tuareg2-find-pipe-bang-match-regexp nil t) ;; when matched "if ... then", kwop is "then" but point is at "if" (goto-char pos) ; go back to kwop for tuareg2-indent-to-code (if (looking-at "\\[|") "[|" kwop))) (defun tuareg2-monadic-operator-p (word) (and (or (string= ">>=" word) (string= ">>|" word) (string= ">>>" word)) word)) (defun tuareg2-ignorable-arrow-p () (save-excursion (or (tuareg2-monadic-operator-p (tuareg2-find-arrow-match)) (looking-at (tuareg2-extra-unindent-regexp))))) (defun tuareg2-find-monadic-match () (let (kwop) (while (or (null kwop) (and (string= kwop "=") (tuareg2-in-monadic-op-p))) (when kwop (tuareg2-backward-char 2)) (setq kwop (tuareg2-find-kwop tuareg2-find-monadic-match-regexp)) (when (and (string= kwop "->") (tuareg2-ignorable-arrow-p)) (setq kwop nil))) kwop)) (defun tuareg2-find-with-match () (tuareg2-find-kwop tuareg2-find-with-match-regexp)) (defun tuareg2-find-in-match () (let ((kwop (tuareg2-find-kwop tuareg2-find-in-match-regexp "\\"))) (cond ((string= kwop "and") (tuareg2-find-in-match)) (t kwop)))) (defconst tuareg2-find-then-match-regexp (tuareg2-make-find-kwop-regexp "\\(->\\)")) (defun tuareg2-find-then-kwop () (tuareg2-find-kwop tuareg2-find-then-match-regexp)) (defun tuareg2-find-then-match () (let ((kwop (tuareg2-find-then-kwop))) (cond ((string= kwop "if") (let ((back (point))) (tuareg2-back-to-paren-or-indentation) (if (looking-at "else[ \t]*\\((\\*.*\\*)\\)*[ \t]*if") "else if" (goto-char back) kwop))) (t kwop)))) (defun tuareg2-find-then-else-match () (let ((kwop (tuareg2-find-then-kwop))) (cond ((string= kwop "if") (let ((pos (point))) (if (and (not (tuareg2-in-indentation-p)) (string= "else" (tuareg2-find-meaningful-word))) "else" (goto-char pos) kwop))) (t kwop)))) (defun tuareg2-find-else-match () (let ((kwop (tuareg2-find-kwop tuareg2-find-else-match-regexp "\\"))) (cond ((string= kwop "then") (tuareg2-find-then-else-match)) ((string= kwop ";") (tuareg2-find-semicolon-match) (tuareg2-find-else-match))))) (defconst tuareg2-do-match-stop-regexp (tuareg2-ro "down" "downto")) (defun tuareg2-find-do-match () (let ((kwop (tuareg2-find-kwop tuareg2-find-do-match-regexp tuareg2-do-match-stop-regexp))) (if (or (string= kwop "to") (string= kwop "downto")) (tuareg2-find-match) kwop))) (defconst tuareg2-done-match-stop-regexp (tuareg2-ro "and" "do")) (defun tuareg2-find-done-match () (let ((kwop (tuareg2-find-kwop (tuareg2-find-kwop-regexp) tuareg2-done-match-stop-regexp))) (cond ((string= kwop "and") (tuareg2-find-and-match)) ((string= kwop "done") (tuareg2-find-done-match) (tuareg2-find-done-match)) ((string= kwop "do") (tuareg2-find-do-match)) (t kwop)))) (defun tuareg2-and-stop-regexp () "\\") (defun tuareg2-find-and-match () (let* ((kwop (tuareg2-find-kwop tuareg2-find-and-match-regexp (tuareg2-and-stop-regexp))) (old-point (point))) (cond ((or (string= kwop "type") (string= kwop "module")) (let ((kwop2 (tuareg2-find-meaningful-word))) (cond ((string= kwop2 "with") kwop2) ((string= kwop2 "and") (tuareg2-find-and-match)) ((and (string= kwop "module") (string= kwop2 "let")) kwop2) (t (goto-char old-point) kwop)))) (t kwop)))) (defconst tuareg2-=-stop-regexp (concat (tuareg2-ro "and" "in") "\\|=")) (defun tuareg2-=-stop-regexp () tuareg2-=-stop-regexp) (defun tuareg2-find-=-match () (let ((kwop (tuareg2-find-kwop tuareg2-find-=-match-regexp (tuareg2-=-stop-regexp)))) (cond ((string= kwop "and") (tuareg2-find-and-match)) ((and (string= kwop "=") (not (tuareg2-false-=-p))) (while (and (string= kwop "=") (not (tuareg2-false-=-p))) (setq kwop (tuareg2-find-=-match))) kwop) (t kwop)))) (defconst tuareg2-if-when-regexp (tuareg2-ro "if" "when")) (defun tuareg2-if-when-= () (save-excursion (tuareg2-find-=-match) (looking-at tuareg2-if-when-regexp))) (defconst tuareg2-captive-regexp (tuareg2-ro "let" "if" "when" "module" "type" "class")) (defun tuareg2-captive-= () (save-excursion (tuareg2-find-=-match) (looking-at tuareg2-captive-regexp))) (defconst tuareg2-pipe-stop-regexp (concat (tuareg2-ro "and" "with") "\\||")) (defun tuareg2-pipe-stop-regexp () tuareg2-pipe-stop-regexp) (defun tuareg2-find-pipe-match () (let ((kwop (let ((k (tuareg2-find-kwop tuareg2-find-pipe-match-regexp (tuareg2-pipe-stop-regexp)))) (if (and k (string-match "|[^!]" k)) "|" k))) (old-point (point))) (cond ((string= kwop "and") (setq old-point (point)) (setq kwop (tuareg2-find-and-match)) (if (not (string= kwop "do")) (goto-char old-point) (setq kwop (tuareg2-find-arrow-match))) kwop) ((and (string= kwop "|") (looking-at "|[^|]") (tuareg2-in-indentation-p)) kwop) ((string= kwop "|") (tuareg2-find-pipe-match)) ((and (string= kwop "=") (or (looking-at (tuareg2-no-code-after "=")) (tuareg2-false-=-p) (not (string= (save-excursion (tuareg2-find-=-match)) "type")))) (tuareg2-find-pipe-match)) ((string= kwop "parse") (if (and (tuareg2-editing-ocamllex) (save-excursion (string= (tuareg2-find-meaningful-word) "="))) kwop (tuareg2-find-pipe-match))) (t kwop)))) (defun tuareg2-find-arrow-match () (let ((kwop (tuareg2-find-kwop tuareg2-find-arrow-match-regexp "\\"))) (cond ((string= kwop "|") (if (tuareg2-in-indentation-p) kwop (progn (forward-char -1) (tuareg2-find-arrow-match)))) ((string= kwop "fun") (let ((pos (point))) (or (tuareg2-monadic-operator-p (tuareg2-find-meaningful-word)) (progn (goto-char pos) kwop)))) ((not (string= kwop ":")) kwop) ;; If we get this far, we know we're looking at a colon. ((or (char-equal (char-before) ?:) (char-equal (char-after (1+ (point))) ?:) (char-equal (char-after (1+ (point))) ?>)) (tuareg2-find-arrow-match)) ;; Patch by T. Freeman (t (let ((oldpoint (point)) (match (tuareg2-find-arrow-match))) (if (looking-at ":") match (progn ;; Go back to where we were before the recursive call. (goto-char oldpoint) kwop))))))) (defconst tuareg2-semicolon-match-stop-regexp (tuareg2-ro "and" "do" "end" "in" "with")) (defconst tuareg2-no-code-after-paren-regexp (tuareg2-no-code-after "[[{(][|<]?")) (defun tuareg2-semicolon-indent-kwop-point (&optional leading-semi-colon) ;; return (kwop kwop-point indentation) (let ((kwop (tuareg2-find-kwop tuareg2-find-semicolon-match-regexp tuareg2-semicolon-match-stop-regexp)) (point (point))) ;; We don't need to find the keyword matching `and' since we know it's `let'! (list (cond ((string= kwop ";") (forward-line 1) (while (or (tuareg2-in-comment-p) (looking-at tuareg2-no-code-this-line-regexp)) (forward-line 1)) (back-to-indentation) (current-column)) ((and leading-semi-colon (looking-at "\\((\\|\\[[<|]?\\|{\\|\\((\\|\\[[<|]?\\|{") (if (save-excursion (tuareg2-find-arrow-match) (or (looking-at "\\\\||") (looking-at (tuareg2-extra-unindent-regexp)))) (tuareg2-paren-or-indentation-indent) (tuareg2-find-semicolon-match))) ((string= kwop "end") (tuareg2-find-match) (tuareg2-find-semicolon-match)) ((string= kwop "in") (tuareg2-find-in-match) (+ (current-column) tuareg2-in-indent)) ((string= kwop "where") (tuareg2-find-in-match) (+ (tuareg2-paren-or-indentation-column) tuareg2-in-indent)) ((string= kwop "let") (+ (current-column) tuareg2-let-indent)) ((string= kwop "try") (forward-char 3) (skip-syntax-forward " ") (current-column)) (t (tuareg2-paren-or-indentation-indent))) kwop point))) (defun tuareg2-find-semicolon-match (&optional leading-semi-colon) (car (tuareg2-semicolon-indent-kwop-point leading-semi-colon))) (defmacro tuareg2-reset-and-kwop (kwop) `(when (and ,kwop (string= ,kwop "and")) (setq ,kwop (tuareg2-find-and-match)))) (defconst tuareg2-phrase-regexp-1 (tuareg2-ro "module" "type")) (defconst tuareg2-phrase-regexp-2 (tuareg2-ro "and" "let" "module" "with")) (defconst tuareg2-phrase-regexp-3 (tuareg2-ro "and" "end" "every" "in" "with")) (defun tuareg2-looking-at-false-type () (save-excursion (tuareg2-find-meaningful-word) (looking-at tuareg2-false-type-regexp))) (defun tuareg2-find-phrase-indentation (&optional phrase-break) (if (and (looking-at tuareg2-phrase-regexp-1) (> (point) (point-min)) (save-excursion (tuareg2-find-meaningful-word) (looking-at tuareg2-phrase-regexp-2))) (progn (tuareg2-find-meaningful-word) (+ (current-column) tuareg2-default-indent)) (let ((looking-at-and (looking-at "\\")) (kwop (tuareg2-find-kwop (if phrase-break tuareg2-find-phrase-indentation-break-regexp tuareg2-find-phrase-indentation-regexp) tuareg2-phrase-regexp-3)) (tmpkwop nil) (curr nil)) (tuareg2-reset-and-kwop kwop) (cond ((not kwop) (current-column)) ((string= kwop "every") (tuareg2-find-phrase-indentation phrase-break)) ((string= kwop "end") (if (not (save-excursion (setq tmpkwop (tuareg2-find-match)) (setq curr (point)) (string= tmpkwop "object"))) (progn (tuareg2-find-match) (tuareg2-find-phrase-indentation phrase-break)) (tuareg2-find-kwop tuareg2-find-phrase-indentation-class-regexp) (current-column))) ((and (string= kwop "with") (not (save-excursion (setq tmpkwop (tuareg2-find-with-match)) (setq curr (point)) (string= tmpkwop "module")))) (goto-char curr) (tuareg2-find-phrase-indentation phrase-break)) ((and (string= kwop "in") (not (save-excursion (setq tmpkwop (tuareg2-find-in-match)) (tuareg2-reset-and-kwop tmpkwop) (setq curr (point)) (and (string= tmpkwop "let") (not (tuareg2-looking-at-internal-let)))))) (goto-char curr) (tuareg2-find-phrase-indentation phrase-break)) ((tuareg2-at-phrase-break-p) (end-of-line) (tuareg2-skip-blank-and-comments) (current-column)) ((string= kwop "let") (if (tuareg2-looking-at-internal-let) (tuareg2-find-phrase-indentation phrase-break) (current-column))) ((string= kwop "with") (current-column)) ((string= kwop "end") (current-column)) ((or (string= kwop "in") (string= kwop "where")) (tuareg2-find-in-match) (current-column)) ((string= kwop "class") (tuareg2-paren-or-indentation-column)) ((looking-at tuareg2-inside-module-or-class-opening) (+ (tuareg2-paren-or-indentation-column) (tuareg2-assoc-indent kwop))) ((or (string= kwop "type") (string= kwop "module")) (if (or (tuareg2-looking-at-false-type) (tuareg2-looking-at-false-module)) (if looking-at-and (current-column) (if (string= "and" (tuareg2-find-meaningful-word)) (progn (tuareg2-find-and-match) (tuareg2-find-phrase-indentation phrase-break)) (tuareg2-find-phrase-indentation phrase-break))) (current-column))) ((looking-at "\\(\\.<\\|(\\|\\[[<|]?\\|{") (setq kwop "with") (goto-char with-point)))) (setq retval (cond ((string= kwop "with") nil) ((or (string= kwop "in") (string= kwop "do")) (tuareg2-in-indentation-p)) (t (back-to-indentation) t))) (cond ; ((looking-at "|[^|]") ; (re-search-forward "|[^|][ \t]*") nil) ((or (string= kwop "in") (string= kwop "do")) (tuareg2-find-in-match) (tuareg2-back-to-paren-or-indentation) (if (looking-at "\\<\\(let\\|and\\)\\>") (forward-char tuareg2-in-indent)) nil) (t retval))))) (defun tuareg2-paren-or-indentation-column () (tuareg2-back-to-paren-or-indentation) (current-column)) (defun tuareg2-paren-or-indentation-indent () (+ (tuareg2-paren-or-indentation-column) tuareg2-default-indent)) (defun tuareg2-search-forward-paren () (re-search-forward "\\(\\.<\\|(\\|\\[[<|]?\\|{\\|("))) (defconst tuareg2-false-type-regexp (tuareg2-ro "and" "class" "module" "with")) (defun tuareg2-looking-at-in-let () (save-excursion (string= (tuareg2-find-meaningful-word) "in"))) (defun tuareg2-find-module () (tuareg2-find-kwop tuareg2-find-module-regexp)) (defun tuareg2-indent-from-previous-kwop () (let* ((start-pos (point)) (kwop (tuareg2-find-argument-kwop-non-blank t)) (captive= (and (string= kwop "=") (tuareg2-captive-=))) (kwop-pos (point))) (forward-char (length kwop)) (tuareg2-skip-blank-and-comments) (cond ((or (not captive=) (/= (point) start-pos)) ; code between paren and kwop (goto-char start-pos) (tuareg2-paren-or-indentation-indent)) (t (goto-char kwop-pos) (when (string= kwop "=") (setq kwop (tuareg2-find-=-match))) (+ tuareg2-default-indent (if (assoc kwop tuareg2-leading-kwop-alist) (tuareg2-compute-kwop-indent kwop) (current-column))))))) (defun tuareg2-find-colon-typespec (start-pos) (let* ((old-pos (point)) (new-pos (search-forward ":" start-pos t))) (when new-pos (backward-char 1) (skip-syntax-backward " ") (skip-syntax-backward "w") (skip-syntax-backward " ") (let ((char (char-before))) (cond ((or (char-equal char ??) (char-equal char ?~)) (goto-char old-pos) nil) (t (goto-char new-pos) t)))))) (defun tuareg2-indent-from-paren (leading-operator start-pos) (cond ((looking-at (tuareg2-no-code-after "\\(\\(\\.<\\|(\\|\\[[<|]?\\|{") (tuareg2-paren-or-indentation-indent)) ((looking-at "([ \t]*\\(\\w\\)") (goto-char (match-beginning 1)) (current-column)) (t (+ (tuareg2-add-default-indent leading-operator) (current-column))))) (defun tuareg2-skip-to-next-form (old-point) (while (and (not (looking-at tuareg2-no-more-code-this-line-regexp)) (< (point) old-point)) ; do not go beyond old-point (forward-sexp 1)) (tuareg2-skip-blank-and-comments) (tuareg2-back-to-paren-or-indentation)) (defun tuareg2-find-argument-kwop (leading-operator) (tuareg2-find-kwop (if leading-operator tuareg2-compute-argument-indent-regexp tuareg2-compute-normal-indent-regexp) (tuareg2-keyword-regexp))) (defun tuareg2-find-argument-kwop-clean (leading-operator) (let (kwop) (while (or (progn (setq kwop (tuareg2-find-argument-kwop leading-operator)) (tuareg2-reset-and-kwop kwop) nil) (and (string= kwop "=") (tuareg2-false-=-p)) (and (looking-at tuareg2-no-code-this-line-regexp) (not (= (point) (point-min)))))) kwop)) (defun tuareg2-find-argument-kwop-non-blank (leading-operator) (let ((kwop "") (point (1+ (point)))) (while (and (> point (point)) (string= "" kwop)) (setq point (point) kwop (tuareg2-find-argument-kwop-clean leading-operator))) kwop)) (defun tuareg2-compute-argument-indent (leading-operator) (let* ((old-point (line-beginning-position)) (kwop (tuareg2-find-argument-kwop-non-blank leading-operator)) (match-end-point (+ (point) (length kwop)))) ; match-end is invalid! (cond ((and (string= kwop "->") (not (looking-at (tuareg2-no-code-after "->")))) (let (matching-kwop matching-pos) (save-excursion (setq matching-kwop (tuareg2-find-arrow-match)) (setq matching-pos (point))) (cond ((string= matching-kwop ":") (goto-char matching-pos) (tuareg2-find-arrow-match) ; matching `val' or `let' (+ (current-column) tuareg2-val-indent)) ((or (string= matching-kwop "val") (string= matching-kwop "let")) (+ (current-column) tuareg2-val-indent)) ((string= matching-kwop "|") (goto-char matching-pos) (+ (tuareg2-add-default-indent leading-operator) (current-column) (- tuareg2-pipe-extra-unindent) tuareg2-default-indent)) (t (+ (tuareg2-paren-or-indentation-column) (tuareg2-add-default-indent leading-operator)))))) ((string= kwop "fun") (+ (tuareg2-paren-or-indentation-column) (tuareg2-add-default-indent leading-operator) (tuareg2-assoc-indent kwop))) ((<= old-point (point)) (+ (tuareg2-add-default-indent leading-operator) (current-column))) (t (goto-char match-end-point) ; skip kwop == (forward-char (length kwop)) (tuareg2-skip-to-next-form old-point) (+ (tuareg2-add-default-indent (if (save-excursion (goto-char match-end-point) (looking-at tuareg2-no-more-code-this-line-regexp)) (or leading-operator (string= kwop "{") (looking-at (tuareg2-no-code-after "[[:upper:]].*\\."))) (not (looking-at tuareg2-operator-regexp)))) (current-column)))))) (defun tuareg2-compute-arrow-indent (start-pos) (let (kwop pos) (save-excursion (setq kwop (tuareg2-find-arrow-match) pos (point))) (cond ((string= kwop "|") (tuareg2-find-arrow-match) (+ (current-column) tuareg2-default-indent)) ((or (string= kwop "val") (string= kwop "let")) (goto-char pos) (+ (current-column) tuareg2-val-indent)) ((string= kwop "type") (goto-char pos) (+ (current-column) tuareg2-type-indent tuareg2-default-indent)) ((string= kwop "(") (goto-char pos) (tuareg2-indent-after-next-char)) ((or (string= kwop "{") (string= kwop ";")) (if (and (looking-at "->") (search-backward ":" pos t)) (tuareg2-indent-after-next-char) (tuareg2-back-to-paren-or-indentation) (current-column))) ((tuareg2-monadic-operator-p kwop) (destructuring-bind (indent kwop point) (tuareg2-semicolon-indent-kwop-point) (- indent (if (string= kwop "in") tuareg2-in-indent 0)))) (t (tuareg2-paren-or-indentation-indent))))) (defun tuareg2-compute-keyword-indent (kwop leading-operator start-pos) (cond ((string= kwop ";") (if (looking-at (tuareg2-no-code-after ";")) (let* ((pos (point)) (indent (tuareg2-find-semicolon-match))) (if (looking-at tuareg2-phrase-regexp-1) (progn (goto-char start-pos) (if (search-backward ":" pos t) (tuareg2-indent-after-next-char) indent)) indent)) (tuareg2-paren-or-indentation-indent))) ((string= kwop ",") (if (looking-at (tuareg2-no-code-after ",")) (let ((mkwop (tuareg2-find-comma-match))) (cond ((or (string= mkwop "[") (string= mkwop "{") (string= mkwop "(")) (forward-char 1) (skip-syntax-forward " ") (current-column)) ((looking-at "[[{(]\\|\\.<") (tuareg2-indent-from-paren t start-pos)) ((or (and (looking-at "[<|]") (char-equal ?\[ (preceding-char))) (and (looking-at "<") (char-equal ?\{ (preceding-char)))) (tuareg2-backward-char) (tuareg2-indent-from-paren t start-pos)) ((and (looking-at "\\") (string= mkwop "in")) (+ (current-column) tuareg2-in-indent)) (t (+ (tuareg2-paren-or-indentation-column) (tuareg2-assoc-indent mkwop))))) (tuareg2-paren-or-indentation-indent))) ((looking-at "\\\\|->") (if (looking-at (tuareg2-no-code-after "\\(\\\\|->\\)")) (tuareg2-indent-from-paren leading-operator start-pos) (+ tuareg2-default-indent (tuareg2-indent-from-paren leading-operator start-pos)))) ((or (string= kwop "let") (string= kwop "and")) (tuareg2-back-to-paren-or-indentation) (+ (tuareg2-paren-or-indentation-indent) (tuareg2-assoc-indent kwop t))) ((string= kwop "with") (if (save-excursion (let ((tmpkwop (tuareg2-find-with-match))) (or (string= tmpkwop "module") (string= tmpkwop "{")))) (tuareg2-paren-or-indentation-indent) (+ (tuareg2-paren-or-indentation-column) (* 2 tuareg2-default-indent) ; assume a missing first "|" (tuareg2-assoc-indent kwop t)))) ((string-match "\\<\\(fun\\|of\\)\\>" kwop) (+ (tuareg2-paren-or-indentation-column) (tuareg2-add-default-indent leading-operator) (tuareg2-assoc-indent kwop t))) ((string-match (tuareg2-extra-unindent-regexp) kwop) (+ (tuareg2-paren-or-indentation-column) (tuareg2-assoc-indent kwop t))) ((string= kwop "in") (when (looking-at (tuareg2-no-code-after "\\")) (tuareg2-find-in-match)) (+ (current-column) tuareg2-in-indent)) ((string-match (tuareg2-matching-kwop-regexp) kwop) (tuareg2-find-leading-kwop-match kwop) (if (tuareg2-in-indentation-p) (+ (current-column) (tuareg2-assoc-indent kwop t)) (tuareg2-back-to-paren-or-indentation) (+ (tuareg2-paren-or-indentation-indent) (tuareg2-assoc-indent kwop t)))) ((string= kwop "try") (forward-char 3) (if (looking-at tuareg2-no-more-code-this-line-regexp) (+ (current-column) -3 tuareg2-default-indent) (skip-syntax-forward " ") (+ (current-column) tuareg2-default-indent))) (t (+ (if (tuareg2-in-indentation-p) (current-column) (tuareg2-paren-or-indentation-indent)) (tuareg2-assoc-indent kwop t))))) (defconst tuareg2-=-indent-regexp-1 (tuareg2-ro "val" "let" "method" "module" "class" "when" "for" "if" "do")) (defun tuareg2-compute-=-indent (start-pos) (let ((current-column-module-type nil) (kwop1 (tuareg2-find-=-match)) (next-pos (point))) (+ (save-excursion (tuareg2-reset-and-kwop kwop1) (cond ((string= kwop1 "type") (tuareg2-find-meaningful-word) (cond ((looking-at "\\") (setq current-column-module-type (current-column)) tuareg2-default-indent) ((looking-at "\\<\\(with\\|and\\)\\>") (tuareg2-find-with-match) (setq current-column-module-type (current-column)) tuareg2-default-indent) (t (goto-char start-pos) (beginning-of-line) (+ (tuareg2-add-default-indent (looking-at "[ \t]*[\[|]")) tuareg2-type-indent)))) ((looking-at tuareg2-=-indent-regexp-1) (let ((matched-string (tuareg2-match-string 0))) (setq current-column-module-type (current-column)) (tuareg2-assoc-indent matched-string))) ((looking-at "\\") (tuareg2-back-to-paren-or-indentation) (setq current-column-module-type (current-column)) (+ (tuareg2-assoc-indent "object") tuareg2-default-indent)) ((looking-at tuareg2-no-code-after-paren-regexp) (setq current-column-module-type (tuareg2-indent-from-paren nil next-pos)) tuareg2-default-indent) (t (setq current-column-module-type (tuareg2-paren-or-indentation-indent)) tuareg2-default-indent))) (or current-column-module-type (current-column))))) (defun tuareg2-indent-after-next-char () (forward-char 1) (tuareg2-skip-blank-and-comments) (current-column)) (defconst tuareg2-definitions-regexp (tuareg2-ro "and" "val" "type" "module" "class" "exception" "let") "Regexp matching definition phrases.") (defun tuareg2-compute-normal-indent () (let ((leading-operator (looking-at tuareg2-operator-regexp))) (beginning-of-line) (save-excursion (let ((start-pos (point)) (kwop (tuareg2-find-argument-kwop-clean leading-operator))) (cond ((not kwop) (current-column)) ((tuareg2-at-phrase-break-p) (tuareg2-find-phrase-indentation t)) ((and (string= kwop "|") (not (char-equal ?\[ (preceding-char)))) (tuareg2-backward-char) (+ (tuareg2-paren-or-indentation-indent) (tuareg2-add-default-indent leading-operator))) ((or (looking-at "[[{(]") (and (looking-at "[<|]") (char-equal ?\[ (preceding-char)) (progn (tuareg2-backward-char) t)) (and (looking-at "<") (char-equal ?\{ (preceding-char)) (progn (tuareg2-backward-char) t))) (cond ((looking-at "{ *[A-Z]") (forward-char 1) (skip-syntax-forward " ") (current-column)) ((looking-at (tuareg2-no-code-after "[[{(][<|]?")) (tuareg2-indent-from-paren leading-operator start-pos)) ((and leading-operator (string= kwop "(")) (tuareg2-indent-after-next-char)) (t (+ tuareg2-default-indent (tuareg2-indent-from-paren leading-operator start-pos))))) ((looking-at "\\.<") (if (looking-at (tuareg2-no-code-after "\\.<")) (tuareg2-indent-from-paren leading-operator start-pos) (+ tuareg2-default-indent (tuareg2-indent-from-paren leading-operator start-pos)))) ((looking-at "->") (tuareg2-compute-arrow-indent start-pos)) ((looking-at (tuareg2-keyword-regexp)) (tuareg2-compute-keyword-indent kwop leading-operator start-pos)) ((and (string= kwop "=") (not (tuareg2-false-=-p)) (or (null leading-operator) ;; defining "=", not testing for equality (string-match tuareg2-definitions-regexp (save-excursion (tuareg2-find-argument-kwop-clean t))))) (tuareg2-compute-=-indent start-pos)) (nil 0) (t (tuareg2-compute-argument-indent leading-operator))))))) (defun tuareg2-compute-pipe-indent (matching-kwop old-point) (cond ((string= matching-kwop "|") (tuareg2-back-to-paren-or-indentation) (current-column)) ((and (string= matching-kwop "=") (not (tuareg2-false-=-p))) (re-search-forward "=[ \t]*") (current-column)) ((and matching-kwop (looking-at (tuareg2-match-pipe-kwop-regexp))) (when (looking-at (tuareg2-extra-unindent-regexp)) (tuareg2-back-to-paren-or-indentation)) (+ (tuareg2-assoc-indent matching-kwop t) (tuareg2-add-default-indent (not (looking-at "|"))) (current-column) (if (or (string= matching-kwop "type") (string= matching-kwop "[")) 0 tuareg2-pipe-extra-unindent))) (t (goto-char old-point) (tuareg2-compute-normal-indent)))) (defun tuareg2-compute-paren-indent (paren-match-p old-point) (unless paren-match-p (tuareg2-search-forward-paren)) (let ((looking-at-paren (char-equal ?\( (char-after))) (start-pos (point))) (when (or looking-at-paren (looking-at (tuareg2-no-code-after "\\(\{\\(.*with[ \t]*\\([[:upper:]].*\\.\\)?\\)?\\|\\[\\)"))) (if (or (tuareg2-in-indentation-p) (save-excursion (string= ":" (tuareg2-find-meaningful-word)))) (tuareg2-back-to-paren-or-indentation) (tuareg2-indent-from-previous-kwop)) (when looking-at-paren (skip-chars-forward "( \t" start-pos)) (while (and (looking-at "[([{]") (> (scan-sexps (point) 1) (save-excursion (goto-char old-point) (line-end-position)))) (forward-char 1) (skip-syntax-forward " ")))) (current-column)) (defun tuareg2-compute-kwop-indent-general (kwop matching-kwop) (let* ((looking-at-matching (looking-at matching-kwop)) (extra-unindent ; non-paren code before matching-kwop (unless (save-excursion (skip-chars-backward "( \t" (line-beginning-position)) (bolp)) (tuareg2-back-to-paren-or-indentation) t))) (+ (current-column) (tuareg2-add-default-indent (if extra-unindent (or (string= matching-kwop "struct") (string= matching-kwop "object") (string= matching-kwop "with") (string= kwop "end")) (or (not (string= kwop "then")) looking-at-matching)))))) (defun tuareg2-compute-kwop-indent (kwop) (when (string= kwop "rec") (setq kwop "and")) (let* ((old-point (point)) (paren-match-p (looking-at "[|>]?[]})]\\|>\\.")) (real-pipe (looking-at "|\\([^|]\\|$\\)")) (matching-kwop (tuareg2-find-leading-kwop-match kwop))) (cond ((string= kwop "|") (if real-pipe (tuareg2-compute-pipe-indent matching-kwop old-point) (goto-char old-point) (tuareg2-compute-normal-indent))) ((looking-at "[[{(][<|]?\\|\\.<") (tuareg2-compute-paren-indent paren-match-p old-point)) ((string= kwop "with") (when (string= matching-kwop "type") (setq old-point (point) matching-kwop (tuareg2-find-meaningful-word))) (while (string= matching-kwop "with") (tuareg2-find-with-match) (setq matching-kwop (tuareg2-find-leading-kwop-match kwop))) (cond ((or (string= matching-kwop "module") (string= matching-kwop "struct")) (tuareg2-paren-or-indentation-indent)) ((or (string= matching-kwop "try") (string= matching-kwop "match")) (tuareg2-compute-kwop-indent-general kwop matching-kwop)) (t (goto-char old-point) (tuareg2-compute-kwop-indent-general kwop matching-kwop)))) ((or (and (string= kwop "and") (string= matching-kwop "reset"))) (if (tuareg2-in-indentation-p) (current-column) (tuareg2-paren-or-indentation-column))) ((string= kwop "in") (+ (current-column) (tuareg2-add-default-indent (string= matching-kwop "let")))) ((not (string= kwop "and")) ; pretty general case (tuareg2-compute-kwop-indent-general kwop matching-kwop)) ((string= matching-kwop "with") (current-column)) (t (tuareg2-paren-or-indentation-column))))) (defun tuareg2-indent-to-code (beg-pos match) (unless (and (string= match "(") (search-forward "->" beg-pos t)) (forward-char (length match))) (tuareg2-skip-blank-and-comments) (current-column)) (defun tuareg2-indent-command (&optional from-leading-star) "Indent the current line in Tuareg2 mode. Compute new indentation based on OCaml syntax." (interactive "*") (unless from-leading-star (tuareg2-auto-fill-insert-leading-star)) (let ((case-fold-search nil)) (tuareg2-with-internal-syntax (save-excursion (back-to-indentation) (indent-line-to (max 0 (tuareg2-compute-indent)))) (when (tuareg2-in-indentation-p) (back-to-indentation))))) (defconst tuareg2-sig-struct-regexp (tuareg2-ro "sig" "struct")) (defconst tuareg2-top-level-command-regexp (concat "#" (tuareg2-ro "open" "load" "use"))) (defun tuareg2-compute-indent () (save-excursion (cond ((tuareg2-in-comment-p) (cond ((looking-at "(\\*") (if tuareg2-indent-leading-comments (save-excursion (tuareg2-skip-blank-and-comments) (back-to-indentation) (current-column)) (current-column))) ((looking-at "\\*\\**)") (tuareg2-beginning-of-literal-or-comment-fast) (if (tuareg2-leading-star-p) (+ (current-column) (if (save-excursion (forward-line 1) (back-to-indentation) (looking-at "*")) 1 tuareg2-comment-end-extra-indent)) (+ (current-column) tuareg2-comment-end-extra-indent))) (tuareg2-indent-comments (let ((star (and (tuareg2-leading-star-p) (looking-at "\\*")))) (tuareg2-beginning-of-literal-or-comment-fast) (if star (re-search-forward "(") (re-search-forward "(\\*+[ \t]*")) (current-column))) (t (current-column)))) ((tuareg2-in-literal-p) (current-column)) ((or (looking-at "\\") (looking-at "\\")) (if (tuareg2-looking-at-internal-let) (if (tuareg2-looking-at-in-let) (progn (tuareg2-find-meaningful-word) (tuareg2-find-in-match) (current-column)) (tuareg2-compute-normal-indent)) (tuareg2-find-phrase-indentation))) ((or (looking-at tuareg2-governing-phrase-regexp) (looking-at ";;")) (tuareg2-find-phrase-indentation)) ((and tuareg2-sig-struct-align (looking-at tuareg2-sig-struct-regexp)) (if (string= (tuareg2-find-module) "module") (current-column) (tuareg2-paren-or-indentation-indent))) ((looking-at ";") (tuareg2-find-semicolon-match t)) ((looking-at "|!") (tuareg2-indent-to-code (line-beginning-position) (tuareg2-find-pipe-bang-match))) ((looking-at ">>[=>|]") (tuareg2-indent-to-code (line-beginning-position) (tuareg2-find-monadic-match))) ((or (looking-at "%\\|;;") (looking-at tuareg2-top-level-command-regexp)) 0) ((or (looking-at (tuareg2-matching-kwop-regexp)) (looking-at "\\")) (tuareg2-compute-kwop-indent (tuareg2-match-string 0))) (t (tuareg2-compute-normal-indent))))) (defun tuareg2-split-string () "Called whenever a line is broken inside an OCaml string literal." (insert-before-markers "\\ ") (tuareg2-backward-char)) (defadvice newline-and-indent (around tuareg2-newline-and-indent activate) "Handle multi-line strings in Tuareg2 mode." (let ((hooked (and (eq major-mode 'tuareg2-mode) (tuareg2-in-literal-p))) (split-mark)) (when hooked (setq split-mark (set-marker (make-marker) (point))) (tuareg2-split-string)) ad-do-it (when hooked (goto-char split-mark) (set-marker split-mark nil)))) (defun tuareg2-abbrev-hook () "If inserting a leading keyword at beginning of line, reindent the line." (unless (tuareg2-in-literal-or-comment-p) (let* ((bol (line-beginning-position)) (kw (save-excursion (and (re-search-backward "^[ \t]*\\(\\w\\|_\\)+\\=" bol t) (tuareg2-match-string 1))))) (when kw (insert " ") (indent-according-to-mode) (backward-delete-char-untabify 1))))) (defun tuareg2-skip-to-end-of-phrase () (let ((old-point (point))) (when (and (string= (tuareg2-find-meaningful-word) ";") (char-equal (preceding-char) ?\;)) (setq old-point (1- (point)))) (goto-char old-point) (let ((kwop (tuareg2-find-meaningful-word))) (goto-char (+ (point) (length kwop)))))) (defun tuareg2-skip-blank-and-comments () (skip-syntax-forward " ") (while (and (not (eobp)) (tuareg2-in-comment-p) (search-forward "*)" nil t)) (skip-syntax-forward " "))) (defun tuareg2-skip-back-blank-and-comments () (skip-syntax-backward " ") (while (save-excursion (tuareg2-backward-char) (and (> (point) (point-min)) (tuareg2-in-comment-p))) (tuareg2-backward-char) (tuareg2-beginning-of-literal-or-comment) (skip-syntax-backward " "))) (defun tuareg2-find-phrase-beginning (&optional stop-at-and) "Find `real' phrase beginning and return point." (beginning-of-line) (tuareg2-skip-blank-and-comments) (end-of-line) (tuareg2-skip-to-end-of-phrase) (let ((old-point (point)) (pt (point))) (if stop-at-and (tuareg2-find-kwop tuareg2-find-phrase-beginning-and-regexp "and") (tuareg2-find-kwop tuareg2-find-phrase-beginning-regexp)) (while (and (> (point) (point-min)) (< (point) old-point) (or (not (looking-at tuareg2-find-phrase-beginning-and-regexp)) (and (looking-at "\\") (tuareg2-looking-at-internal-let)) (and (looking-at "\\") (save-excursion (tuareg2-find-and-match) (tuareg2-looking-at-internal-let))) (and (looking-at "\\") (tuareg2-looking-at-false-module)) (and (looking-at tuareg2-sig-struct-regexp) (tuareg2-looking-at-false-sig-struct)) (and (looking-at "\\") (tuareg2-looking-at-false-type)))) (when (= pt (point)) (error "tuareg2-find-phrase-beginning: inf loop at %d" pt)) (setq pt (point)) (if (looking-at "\\") (tuareg2-find-match) (unless (bolp) (tuareg2-backward-char)) (setq old-point (point)) (if stop-at-and (tuareg2-find-kwop tuareg2-find-phrase-beginning-and-regexp "and") (tuareg2-find-kwop tuareg2-find-phrase-beginning-regexp)))) (when (tuareg2-at-phrase-break-p) (end-of-line) (tuareg2-skip-blank-and-comments)) (back-to-indentation) (point))) (defun tuareg2-search-forward-end () (let ((begin (point)) (current -1) (found) (move t)) (while (and move (> (point) current)) (if (re-search-forward "\\" (point-max) t) (let ((stop (point)) (kwop)) (unless (tuareg2-in-literal-or-comment-p) (save-excursion (tuareg2-backward-char 3) (setq kwop (tuareg2-find-match)) (cond ((string= kwop "object") (tuareg2-find-phrase-beginning)) ((and (looking-at tuareg2-sig-struct-regexp) (tuareg2-looking-at-false-sig-struct)) (tuareg2-find-phrase-beginning))) (cond ((or (> (point) begin) (and (string= kwop "sig") (looking-at "[ \t\n]*\\(\\[ \t\n]*\\\\|=\\)"))) (if (> (point) current) (progn (setq current (point)) (goto-char stop)) (setq found nil move nil))) (t (setq found t move nil)))))) (setq found nil move nil))) found)) (defun tuareg2-inside-module-or-class-find-kwop () (let ((kwop (tuareg2-find-kwop tuareg2-inside-module-or-class-regexp "\\<\\(and\\|end\\)\\>"))) (tuareg2-reset-and-kwop kwop) (when (string= kwop "with") (setq kwop nil)) (if (string= kwop "end") (progn (tuareg2-find-match) (tuareg2-find-kwop tuareg2-inside-module-or-class-regexp) (tuareg2-inside-module-or-class-find-kwop)) kwop))) (defun tuareg2-inside-module-or-class-p () (let ((begin) (end) (and-end) (and-iter t) (kwop t)) (save-excursion (when (looking-at "\\") (tuareg2-find-and-match)) (setq begin (point)) (unless (or (and (looking-at "\\") (save-excursion (re-search-forward "\\" (point-max) t) (tuareg2-find-phrase-beginning) (> (point) begin))) (and (looking-at "\\") (save-excursion (re-search-forward tuareg2-sig-struct-regexp (point-max) t) (tuareg2-find-phrase-beginning) (> (point) begin)))) (unless (looking-at tuareg2-inside-module-or-class-opening-full) (setq kwop (tuareg2-inside-module-or-class-find-kwop))) (when kwop (setq begin (point)) (when (tuareg2-search-forward-end) (tuareg2-backward-char 3) (when (looking-at "\\") (tuareg2-forward-char 3) (setq end (point)) (setq and-end (point)) (tuareg2-skip-blank-and-comments) (while (and and-iter (looking-at "\\")) (setq and-end (point)) (when (tuareg2-search-forward-end) (tuareg2-backward-char 3) (when (looking-at "\\") (tuareg2-forward-char 3) (setq and-end (point)) (tuareg2-skip-blank-and-comments))) (when (<= (point) and-end) (setq and-iter nil))) (list begin end and-end)))))))) (defun tuareg2-move-inside-module-or-class-opening () "Go to the beginning of the enclosing module or class. Notice that white-lines (or comments) located immediately before a module/class are considered enclosed in this module/class." (interactive) (let* ((old-point (point)) (kwop (tuareg2-inside-module-or-class-find-kwop))) (unless kwop (goto-char old-point)) (tuareg2-find-phrase-beginning))) (defun tuareg2-discover-phrase (&optional quiet stop-at-and) (end-of-line) (let ((end (point)) (case-fold-search nil)) (tuareg2-with-internal-syntax (tuareg2-find-phrase-beginning stop-at-and) (when (> (point) end) (setq end (point))) (save-excursion (let ((begin (point)) (cpt 0) (lines-left 0) (stop) (inside-module-or-class (tuareg2-inside-module-or-class-p)) (looking-block (looking-at tuareg2-inside-module-or-class-opening-full))) (if (and looking-block inside-module-or-class) (progn (setq begin (nth 0 inside-module-or-class)) (setq end (nth 2 inside-module-or-class)) (goto-char end)) (if inside-module-or-class (progn (setq stop (save-excursion (goto-char (nth 1 inside-module-or-class)) (line-beginning-position))) (if (< stop end) (setq stop (point-max)))) (setq stop (point-max))) (save-restriction (goto-char end) (while (and (= lines-left 0) (or (not inside-module-or-class) (< (point) stop)) (<= (save-excursion (tuareg2-find-phrase-beginning stop-at-and)) end)) (unless quiet (setq cpt (1+ cpt)) (when (= 8 cpt) (message "Looking for enclosing phrase..."))) (setq end (point)) (tuareg2-skip-to-end-of-phrase) (narrow-to-region (line-beginning-position) (point-max)) (goto-char end) (setq lines-left (forward-line 1))))) (when (>= cpt 8) (message "Looking for enclosing phrase... done.")) (save-excursion (tuareg2-skip-blank-and-comments) (setq end (point))) (tuareg2-skip-back-blank-and-comments) (list begin (point) end)))))) (defun tuareg2-mark-phrase () "Put mark at end of this OCaml phrase, point at beginning. The OCaml phrase is the phrase just before the point." (interactive) (let ((pair (tuareg2-discover-phrase))) (goto-char (nth 1 pair)) (push-mark (nth 0 pair) t t))) (defun tuareg2-next-phrase (&optional quiet stop-at-and) "Skip to the beginning of the next phrase." (interactive "i") (goto-char (save-excursion (nth 2 (tuareg2-discover-phrase quiet stop-at-and)))) (cond ((looking-at "\\") (tuareg2-next-phrase quiet stop-at-and)) ((looking-at ")") (forward-char 1) (tuareg2-skip-blank-and-comments)) ((looking-at ";;") (forward-char 2) (tuareg2-skip-blank-and-comments)))) (defun tuareg2-previous-phrase () "Skip to the beginning of the previous phrase." (interactive) (beginning-of-line) (tuareg2-skip-to-end-of-phrase) (tuareg2-discover-phrase)) (defun tuareg2-indent-phrase () "Depending of the context: justify and indent a comment, or indent all lines in the current phrase." (interactive) (save-excursion (back-to-indentation) (if (tuareg2-in-comment-p) (let* ((cobpoint (save-excursion (tuareg2-beginning-of-literal-or-comment) (point))) (begpoint (save-excursion (while (and (> (point) cobpoint) (tuareg2-in-comment-p) (not (looking-at "^[ \t]*$"))) (forward-line -1)) (max cobpoint (point)))) (coepoint (save-excursion (while (tuareg2-in-comment-p) (re-search-forward "\\*)" nil 'end)) (point))) (endpoint (save-excursion (re-search-forward "^[ \t]*$" coepoint 'end) (line-beginning-position 2))) (leading-star (tuareg2-leading-star-p))) (goto-char begpoint) (while (and leading-star (< (point) endpoint) (not (looking-at "^[ \t]*$"))) (forward-line 1) (back-to-indentation) (when (looking-at "\\*\\**\\([^)]\\|$\\)") (delete-char 1) (setq endpoint (1- endpoint)))) (goto-char (min (point) endpoint)) (fill-region begpoint endpoint) (re-search-forward "\\*)" nil 'end) (setq endpoint (point)) (when leading-star (goto-char begpoint) (forward-line 1) (if (< (point) endpoint) (tuareg2-auto-fill-insert-leading-star t))) (indent-region begpoint endpoint nil)) (let ((pair (tuareg2-discover-phrase))) (indent-region (nth 0 pair) (nth 1 pair) nil))))) ;;----------------------------------------------------------------------------;; ;; Keymap ;; ;;----------------------------------------------------------------------------;; (defvar tuareg2-mode-map (let ((map (make-sparse-keymap))) (define-key map "\M-q" 'tuareg2-indent-phrase) (define-key map "\C-c\C-q" 'tuareg2-indent-phrase) (define-key map "\M-\C-\\" 'indent-region) (define-key map "\C-c\C-a" 'tuareg2-find-alternate-file) (define-key map "\C-c\C-c" 'compile) (define-key map "\C-xnd" 'tuareg2-narrow-to-phrase) (define-key map "\M-\C-x" 'tuareg2-eval-phrase) (define-key map "\C-x\C-e" 'tuareg2-eval-phrase) (define-key map "\C-c\C-e" 'tuareg2-eval-phrase) (define-key map "\C-c\C-r" 'tuareg2-eval-region) (define-key map "\C-c\C-b" 'tuareg2-eval-buffer) (define-key map "\C-c\C-s" 'tuareg2-run-ocaml) (define-key map "\C-c\C-i" 'tuareg2-interrupt-ocaml) (define-key map "\C-c\C-k" 'tuareg2-kill-ocaml) (define-key map "\C-c\C-n" 'tuareg2-next-phrase) (define-key map "\C-c\C-p" 'tuareg2-previous-phrase) (define-key map [(backspace)] 'backward-delete-char-untabify) (define-key map [(control c) (home)] 'tuareg2-move-inside-module-or-class-opening) (define-key map [(control c) (control down)] 'tuareg2-next-phrase) (define-key map [(control c) (control up)] 'tuareg2-previous-phrase) (define-key map [(meta control down)] 'tuareg2-next-phrase) (define-key map [(meta control up)] 'tuareg2-previous-phrase) (define-key map [(meta control n)] 'tuareg2-next-phrase) (define-key map [(meta control p)] 'tuareg2-previous-phrase) (define-key map [(meta control h)] 'tuareg2-mark-phrase) (define-key map "\C-c`" 'tuareg2-interactive-next-error-source) (define-key map "\C-c?" 'tuareg2-interactive-next-error-source) (define-key map "\C-c.c" 'tuareg2-insert-class-form) (define-key map "\C-c.b" 'tuareg2-insert-begin-form) (define-key map "\C-c.f" 'tuareg2-insert-for-form) (define-key map "\C-c.w" 'tuareg2-insert-while-form) (define-key map "\C-c.i" 'tuareg2-insert-if-form) (define-key map "\C-c.l" 'tuareg2-insert-let-form) (define-key map "\C-c.m" 'tuareg2-insert-match-form) (define-key map "\C-c.t" 'tuareg2-insert-try-form) map) "Keymap used in Tuareg2 mode.") (defconst tuareg2-font-lock-syntax `((?_ . "w") (?` . ".")) "Syntax changes for Font-Lock.") ;;----------------------------------------------------------------------------;; ;; Syntax table ;; ;;----------------------------------------------------------------------------;; (defvar tuareg2-mode-syntax-table (let ((st (make-syntax-table))) (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?? ". p" st) (modify-syntax-entry ?~ ". p" st) (modify-syntax-entry ?: "." st) (modify-syntax-entry ?' "w" st) ; ' is part of words (for primes). (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))) st) "Syntax table in use in Tuareg2 mode buffers.") (defmacro tuareg2-with-internal-syntax (&rest body) `(progn ;; Switch to a modified internal syntax. (modify-syntax-entry ?. "w" tuareg2-mode-syntax-table) (modify-syntax-entry ?_ "w" tuareg2-mode-syntax-table) (unwind-protect (progn ,@body) ;; Switch back to the interactive syntax. (modify-syntax-entry ?. "." tuareg2-mode-syntax-table) (modify-syntax-entry ?_ "_" tuareg2-mode-syntax-table)))) (defun tuareg2-complete (arg) "Completes qualified ocaml identifiers." (interactive "p") (modify-syntax-entry ?_ "w" tuareg2-mode-syntax-table) (caml-complete arg) (modify-syntax-entry ?_ "_" tuareg2-mode-syntax-table)) ;;----------------------------------------------------------------------------;; ;; Misc ;; ;;----------------------------------------------------------------------------;; (defun tuareg2-find-alternate-file () "Switch Implementation/Interface." (interactive) (let ((name (buffer-file-name))) (when (string-match "\\`\\(.*\\)\\.ml\\(i\\)?\\'" name) (find-file (concat (tuareg2-match-string 1 name) (if (match-beginning 2) ".ml" ".mli")))))) ;;----------------------------------------------------------------------------;; ;; Major mode ;; ;;----------------------------------------------------------------------------;; (defun tuareg2-mode () "Major mode for editing OCaml code. Dedicated to GNU Emacs, version 23 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. Report bugs, remarks and questions to Albert.Cohen@prism.uvsq.fr. The Font-Lock minor-mode is used according to your customization options. You have better byte-compile tuareg2.el. For customization purposes, you should use `tuareg2-mode-hook' \(run for every file) or `tuareg2-load-hook' (run once) and not patch the mode itself. You should add to your configuration file something like: (add-hook 'tuareg2-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. For the best indentation experience, some elementary rules must be followed. - Because the `function' keyword has a special indentation (to handle case matches) use the `fun' keyword when no case match is performed. - In OCaml, `;;' is no longer necessary for correct indentation, except before top level phrases not introduced by `type', `val', `let' etc. (i.e., phrases used for their side-effects or to be executed in a top level.) - Long sequences of `and's may slow down indentation slightly, since some computations (few) require to go back to the beginning of the sequence. Some very long nested blocks may also lead to slow processing of `end's, `else's, `done's... - Multiline strings are handled properly, but you may prefer string concatenation `^' to break long strings (the C-j keystroke can help). - Comment indentation is often a matter of taste and context, yet sophisticated heuristics provide reasonable indentation in most cases. When inserting a comment right before the code it refers to, it is generally expected that this comment will be aligned with the folowing code; to enforce this, leave a blank line before the comment. Known bugs: - When writting a line with mixed code and comments, avoid putting comments at the beginning or middle of the text. More precisely, writing comments immediately after `=' or parentheses then writing some more code on the line leads to indentation errors. You may write `let x (* blah *) = blah' but should avoid `let x = (* blah *) blah'. Short cuts for the Tuareg2 mode: \\{tuareg2-mode-map} Short cuts for interactions with the toplevel: \\{tuareg2-interactive-mode-map}" (interactive) (kill-all-local-variables) (setq major-mode 'tuareg2-mode) (setq mode-name "Tuareg2") (use-local-map tuareg2-mode-map) (set-syntax-table tuareg2-mode-syntax-table) (setq local-abbrev-table tuareg2-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "(* ") (make-local-variable 'comment-end) (setq comment-end " *)") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+[ \t]*") (make-local-variable 'comment-multi-line) (setq comment-multi-line t) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (make-local-variable 'indent-line-function) (setq indent-line-function 'tuareg2-indent-command) (make-local-variable 'normal-auto-fill-function) (setq normal-auto-fill-function 'tuareg2-auto-fill-function) ;; Hooks for tuareg2-mode, use them for tuareg2-mode configuration (tuareg2-install-font-lock) (run-hooks 'tuareg2-mode-hook) (message nil)) ;;----------------------------------------------------------------------------;; ;; Hooks ;; ;;----------------------------------------------------------------------------;; (defvar tuareg2-load-hook nil "This hook is run when Tuareg2 is loaded in. It is a good place to put key-bindings or hack Font-Lock keywords...") (run-hooks 'tuareg2-load-hook) ;;----------------------------------------------------------------------------;; ;; End ;; ;;----------------------------------------------------------------------------;; (provide 'tuareg2) tuareg-2.0.9/tuareg-site-file.el000066400000000000000000000055511250163147700165150ustar00rootroot00000000000000;;; 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" (21289 25149 485562 ;;;;;; 840000)) ;;; 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 PATH)" t nil) (defalias 'camldebug 'ocamldebug) ;;;*** ;;;### (autoloads nil "tuareg" "tuareg.el" (21767 12781 330987 783000)) ;;; Generated autoloads from tuareg.el (add-to-list 'auto-mode-alist '("\\.ml[ip]?\\'" . 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 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 toplevel: \\{tuareg-interactive-mode-map} \(fn)" t nil) (autoload 'tuareg-run-ocaml "tuareg" "\ Run an OCaml toplevel process. I/O via buffer `*ocaml-toplevel*'. \(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 nil ("tuareg-light.el" "tuareg-mly.el" "tuareg_indent.el") ;;;;;; (21767 12785 775655 707000)) ;;;*** tuareg-2.0.9/tuareg.el000066400000000000000000004100561250163147700146360ustar00rootroot00000000000000;;; 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.0.9 ;; 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 toplevel, 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', `tuareg_indent.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 ;; toplevel with input and output in an Emacs buffer named ;; `*ocaml-toplevel*. This gives you the full power of Emacs to edit ;; the input to the OCaml toplevel. 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 toplevel, and evaluates it. If ;; you type one of these commands before M-x tuareg-run-ocaml, the ;; toplevel 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.0.9")) (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 "\\.ls\\'" (or buffer-file-name (buffer-name)))) (defun tuareg-editing-ocamllex () "Tell whether we are editing OCamlLex syntax." (string-match "\\.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)))) (unless (fboundp 'derived-mode-p) ;; in derived.el in emacs21 (require 'derived)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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) (defvar tuareg-use-smie (featurep 'smie) "Whether to use SMIE as the indentation engine.") ;; 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) ;; Comments (defcustom tuareg-leading-star-in-doc nil "*Enable automatic intentation of documentation comments of the form (** * ... *)" :group 'tuareg :type 'boolean) (defcustom tuareg-support-leading-star-comments t "*Enable automatic intentation of comments of the form (* * ... *) Documentation comments (** *) are not concerned by this variable unless `tuareg-leading-star-in-doc' is also set. If you do not set this variable and still expect comments to be indented like (* ... *) \(without leading `*'), set `tuareg-comment-end-extra-indent' to 1." :group 'tuareg :type 'boolean) ;; 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 (tuareg-make-indentation-regexps) (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 after a pattern match `| ... ->'. 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") ;; Automatic indentation ;; Using abbrev-mode and electric keys (defcustom tuareg-use-abbrev-mode nil "*Non-nil means electrically indent lines starting with leading keywords. Leading keywords are such as `end', `done', `else' etc. It makes use of `abbrev-mode'. Many people find electric keywords irritating, so you can disable them by setting this variable to nil." :group 'tuareg :type 'boolean :set (lambda (var val) (set-default var val) (dolist (buf (buffer-list)) (with-current-buffer buf (when (derived-mode-p 'tuareg-mode) (abbrev-mode (if val 1 -1))))))) (defcustom tuareg-electric-indent t "*Non-nil means electrically indent lines starting with `|', `)', `]' or `}'. Many people find electric keys irritating, so you can disable them by setting this variable to nil." :group 'tuareg :type 'boolean) (when (fboundp 'electric-indent-mode) (make-obsolete-variable 'tuareg-electric-indent 'electric-indent-mode "Emacs-24.1")) ;; Tuareg-Interactive ;; Configure via `tuareg-mode-hook' (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) (set (make-local-variable '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 Caml toplevel." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-read-only-input nil "*Non-nil means input sent to the OCaml toplevel is read-only." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-echo-phrase t "*Non-nil means echo phrases in the toplevel buffer when sending them to the OCaml toplevel." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-input-font-lock t "*Non nil means Font-Lock for toplevel input phrases." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-output-font-lock t "*Non nil means Font-Lock for toplevel output messages." :group 'tuareg :type 'boolean) (defcustom tuareg-interactive-error-font-lock t "*Non nil means Font-Lock for toplevel error messages." :group 'tuareg :type 'boolean) (defcustom tuareg-display-buffer-on-eval t "*Non nil means pop up the OCaml toplevel 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) (defcustom tuareg-definitions-max-items 30 "*Maximum number of items a definitions menu can contain." :group 'tuareg :type 'integer) (defvar tuareg-options-list `(("Automatic indentation of leading keywords" . 'tuareg-use-abbrev-mode) ("Automatic indentation of ), ] and }" . 'tuareg-electric-indent) ,@(unless tuareg-use-smie '(("Automatic matching of [| and {<" . 'tuareg-electric-close-vector))) "---" ,@(unless tuareg-use-smie '(("Indent body of comments" . 'tuareg-indent-comments) ("Indent first line of comments" . 'tuareg-indent-leading-comments) ("Leading-`*' comment style" . 'tuareg-support-leading-star-comments) ))) "*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 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) (eval-and-compile (defconst tuareg-use-syntax-ppss (fboundp 'syntax-ppss) "*If nil, use our own parsing and caching.")) (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-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 toplevel outputs." :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 toplevel errors." :group 'tuareg-faces) (defvar tuareg-font-lock-interactive-error-face 'tuareg-font-lock-interactive-error-face) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support definitions (defun tuareg-leading-star-p () (and tuareg-support-leading-star-comments (save-excursion ; this function does not make sense outside of a comment (tuareg-beginning-of-literal-or-comment) (and (or tuareg-leading-star-in-doc (not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*"))) (progn (forward-line 1) (back-to-indentation) (looking-at "\\*[^)]")))))) (defun tuareg-auto-fill-insert-leading-star (&optional leading-star) (let ((point-leading-comment (looking-at "(\\*")) (return-leading nil)) (save-excursion (back-to-indentation) (when tuareg-electric-indent (when (and (tuareg-in-comment-p) (or leading-star (tuareg-leading-star-p))) (unless (looking-at "(?\\*") (insert-before-markers "* ")) (setq return-leading t)) (unless point-leading-comment ;; Use optional argument to break recursion (tuareg-indent-command t)))) return-leading)) (unless (fboundp 'comment-normalize-vars) (defun tuareg-auto-fill-function () (unless (tuareg-in-literal-p) (let ((leading-star (and (not (char-equal ?\n last-command-event)) (tuareg-auto-fill-insert-leading-star)))) (do-auto-fill) (unless (char-equal ?\n last-command-event) (tuareg-auto-fill-insert-leading-star leading-star)))))) ;; these two functions are different from the standard ;; in that they do NOT signal errors beginning-of-buffer and end-of-buffer (defun tuareg-forward-char (&optional step) (if step (goto-char (+ (point) step)) (goto-char (1+ (point))))) (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))) (defvar tuareg-cache-stop (point-min)) (make-variable-buffer-local 'tuareg-cache-stop) (defvar tuareg-cache nil) (make-variable-buffer-local 'tuareg-cache) (defvar tuareg-cache-local nil) (make-variable-buffer-local 'tuareg-cache-local) (defvar tuareg-cache-last-local nil) (make-variable-buffer-local 'tuareg-cache-last-local) (defvar tuareg-last-loc (cons nil nil)) ;; PPSS definitions (defun tuareg-ppss-in-literal-or-comment () (error "tuareg uses PPSS")) (defun tuareg-ppss-fontify (_beg _end) (error "tuareg uses PPSS")) (defun tuareg-ppss-in-literal-p () "Return non-nil if point is inside an OCaml literal." (nth 3 (syntax-ppss))) (defun tuareg-ppss-in-comment-p () "Return non-nil if point is inside or right before an OCaml comment." (or (nth 4 (syntax-ppss)) (looking-at "[ \t]*(\\*"))) (defun tuareg-ppss-in-literal-or-comment-p () "Return non-nil if point is inside an OCaml literal or comment." (nth 8 (syntax-ppss))) (defun tuareg-ppss-beginning-of-literal-or-comment () "Skips to the beginning of the current literal or comment (or buffer)." (interactive) (goto-char (or (nth 8 (syntax-ppss)) (point)))) (defun tuareg-ppss-beginning-of-literal-or-comment-fast () (goto-char (or (nth 8 (syntax-ppss)) (point-min)))) ;; non-PPSS definitions (defun tuareg-!ppss-in-literal-p () "Return non-nil if point is inside an OCaml literal." (car (tuareg-in-literal-or-comment))) (defun tuareg-!ppss-in-comment-p () "Return non-nil if point is inside an OCaml comment." (cdr (tuareg-in-literal-or-comment))) (defun tuareg-!ppss-in-literal-or-comment-p () "Return non-nil if point is inside an OCaml literal or comment." (tuareg-in-literal-or-comment) (or (car tuareg-last-loc) (cdr tuareg-last-loc))) (defun tuareg-!ppss-in-literal-or-comment () "Return the pair `((tuareg-in-literal-p) . (tuareg-in-comment-p))'." (if (and (<= (point) tuareg-cache-stop) tuareg-cache) (progn (if (or (not tuareg-cache-local) (not tuareg-cache-last-local) (and (>= (point) (caar tuareg-cache-last-local)))) (setq tuareg-cache-local tuareg-cache)) (while (and tuareg-cache-local (< (point) (caar tuareg-cache-local))) (setq tuareg-cache-last-local tuareg-cache-local tuareg-cache-local (cdr tuareg-cache-local))) (setq tuareg-last-loc (if tuareg-cache-local (cons (eq (cadar tuareg-cache-local) 'b) (> (cddar tuareg-cache-local) 0)) (cons nil nil)))) (let ((flag t) (op (point)) (mp (min (point) (1- (point-max)))) (balance 0) (end-of-comment nil)) (while (and tuareg-cache (<= tuareg-cache-stop (caar tuareg-cache))) (setq tuareg-cache (cdr tuareg-cache))) (if tuareg-cache (if (eq (cadar tuareg-cache) 'b) (progn (setq tuareg-cache-stop (1- (caar tuareg-cache))) (goto-char tuareg-cache-stop) (setq balance (cddar tuareg-cache)) (setq tuareg-cache (cdr tuareg-cache))) (setq balance (cddar tuareg-cache)) (setq tuareg-cache-stop (caar tuareg-cache)) (goto-char tuareg-cache-stop) (skip-chars-forward "(")) (goto-char (point-min))) (skip-chars-backward "\\\\*") (while flag (if end-of-comment (setq balance 0 end-of-comment nil)) (skip-chars-forward "^\\\\'`\"(\\*") (cond ((looking-at "\\\\") (tuareg-forward-char 2)) ((looking-at "'\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)'") (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance)) tuareg-cache)) (goto-char (match-end 0)) (setq tuareg-cache (cons (cons (point) (cons 'e balance)) tuareg-cache))) ((and tuareg-support-camllight (looking-at "`\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)`")) (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance)) tuareg-cache)) (goto-char (match-end 0)) (setq tuareg-cache (cons (cons (point) (cons 'e balance)) tuareg-cache))) ((looking-at "\"") (tuareg-forward-char) (setq tuareg-cache (cons (cons (point) (cons 'b balance)) tuareg-cache)) (skip-chars-forward "^\\\\\"") (while (looking-at "\\\\") (tuareg-forward-char 2) (skip-chars-forward "^\\\\\"")) (tuareg-forward-char) (setq tuareg-cache (cons (cons (point) (cons 'e balance)) tuareg-cache))) ((looking-at "(\\*") (setq balance (1+ balance)) (setq tuareg-cache (cons (cons (point) (cons nil balance)) tuareg-cache)) (tuareg-forward-char 2)) ((looking-at "\\*)") (tuareg-forward-char 2) (if (> balance 1) (progn (setq balance (1- balance)) (setq tuareg-cache (cons (cons (point) (cons nil balance)) tuareg-cache))) (setq end-of-comment t) (setq tuareg-cache (cons (cons (point) (cons nil 0)) tuareg-cache)))) (t (tuareg-forward-char))) (setq flag (<= (point) mp))) (setq tuareg-cache-local tuareg-cache tuareg-cache-stop (point)) (goto-char op) (if tuareg-cache (tuareg-in-literal-or-comment) (setq tuareg-last-loc (cons nil nil)) tuareg-last-loc)))) (defun tuareg-!ppss-beginning-of-literal-or-comment () "Skips to the beginning of the current literal or comment (or buffer)." (interactive) (when (tuareg-in-literal-or-comment-p) (tuareg-beginning-of-literal-or-comment-fast))) (defun tuareg-!ppss-beginning-of-literal-or-comment-fast () (while (and tuareg-cache-local (or (eq 'b (cadar tuareg-cache-local)) (> (cddar tuareg-cache-local) 0))) (setq tuareg-cache-last-local tuareg-cache-local tuareg-cache-local (cdr tuareg-cache-local))) (if tuareg-cache-last-local (goto-char (caar tuareg-cache-last-local)) (goto-char (point-min))) (when (eq 'b (cadar tuareg-cache-last-local)) (tuareg-backward-char))) (defun tuareg-!ppss-backward-up-list () "Safe up-list regarding comments, literals and errors." (let ((balance 1) (op (point)) (oc nil)) (tuareg-in-literal-or-comment) (while (and (> (point) (point-min)) (> balance 0)) (setq oc (if tuareg-cache-local (caar tuareg-cache-local) (point-min))) (condition-case nil (up-list -1) (error (goto-char (point-min)))) (if (>= (point) oc) (setq balance (1- balance)) (goto-char op) (skip-chars-backward "^[]{}()") (tuareg-backward-char) (cond ((tuareg-in-literal-or-comment-p) (tuareg-beginning-of-literal-or-comment-fast)) ((looking-at "[[{(]") (setq balance (1- balance))) ((looking-at "[]})]") (setq balance (1+ balance))))) (setq op (point))))) (defalias 'tuareg-in-literal-or-comment ;; FIXME: These eval-and-compile have no effect. Maybe eval-when-compile ;; was intended? (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-in-literal-or-comment 'tuareg-!ppss-in-literal-or-comment))) (defalias 'tuareg-fontify (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-fontify 'tuareg-!ppss-fontify))) (defalias 'tuareg-in-literal-p (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-in-literal-p 'tuareg-!ppss-in-literal-p))) (defalias 'tuareg-in-comment-p (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-in-comment-p 'tuareg-!ppss-in-comment-p))) (defalias 'tuareg-in-literal-or-comment-p (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-in-literal-or-comment-p 'tuareg-!ppss-in-literal-or-comment-p))) (defalias 'tuareg-beginning-of-literal-or-comment (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-beginning-of-literal-or-comment 'tuareg-!ppss-beginning-of-literal-or-comment))) (defalias 'tuareg-beginning-of-literal-or-comment-fast (eval-and-compile (if tuareg-use-syntax-ppss 'tuareg-ppss-beginning-of-literal-or-comment-fast 'tuareg-!ppss-beginning-of-literal-or-comment-fast))) (defalias 'tuareg-backward-up-list ;; FIXME: not clear if moving out of a string/comment counts as 1 or no. (eval-and-compile (if tuareg-use-syntax-ppss (lambda () (condition-case nil (backward-up-list) (scan-error (goto-char (point-min))))) 'tuareg-!ppss-backward-up-list))) (defun tuareg-false-=-p () "Is the underlying `=' the first/second letter of an operator?" (or (memq (preceding-char) '(?: ?> ?< ?=)) (char-equal ?= (char-after (1+ (point)))))) (defun tuareg-at-phrase-break-p () "Is the underlying `;' a phrase break?" (and (char-equal ?\; (following-char)) (or (and (not (eobp)) (char-equal ?\; (char-after (1+ (point))))) (char-equal ?\; (preceding-char))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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." :group 'tuareg :type 'boolean) (when (fboundp 'prettify-symbols-mode) (make-obsolete-variable 'tuareg-font-lock-symbols 'prettify-symbols-mode "Emacs-24.4")) (defvar tuareg-font-lock-symbols-alist (cond ((fboundp 'decode-char) ;; or a unicode font. `(("fun" . ,(decode-char 'ucs 955)) ("sqrt" . ,(decode-char 'ucs 8730)) ("not" . ,(decode-char 'ucs 172)) ("&&" . ,(decode-char 'ucs 8743)); 'LOGICAL AND' (U+2227) ("or" . ,(decode-char 'ucs 8744)); 'LOGICAL OR' (U+2228) ("||" . ,(decode-char 'ucs 8744)) ("[|" . ,(decode-char 'ucs 12314)) ;; 〚 ("|]" . ,(decode-char 'ucs 12315)) ;; 〛 ("*." . ,(decode-char 'ucs 215)) ("/." . ,(decode-char 'ucs 247)) ("->" . ,(decode-char 'ucs 8594)) ("<-" . ,(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)) (":=" . ,(decode-char 'ucs 8656)) ("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)) `(("fun" . ,(make-char 'symbol 108)) ("sqrt" . ,(make-char 'symbol 214)) ("not" . ,(make-char 'symbol 216)) ("&&" . ,(make-char 'symbol 217)) ("or" . ,(make-char 'symbol 218)) ("||" . ,(make-char 'symbol 218)) ("*." . ,(make-char 'symbol 183)) ("/." . ,(make-char 'symbol 184)) ("<=" . ,(make-char 'symbol 163)) ("<-" . ,(make-char 'symbol 172)) ("->" . ,(make-char 'symbol 174)) (">=" . ,(make-char 'symbol 179)) ("<>" . ,(make-char 'symbol 185)) ("==" . ,(make-char 'symbol 186)) ("<=>" . ,(make-char 'symbol 219)) (":=" . ,(make-char 'symbol 220)) ("=>" . ,(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)))))) (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))) ;; 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 nil)) (dolist (x tuareg-font-lock-symbols-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.") (defmacro tuareg-with-internal-syntax (&rest body) `(progn ;; Switch to a modified internal syntax. (modify-syntax-entry ?. "w" tuareg-mode-syntax-table) (modify-syntax-entry ?' "w" tuareg-mode-syntax-table) (modify-syntax-entry ?_ "w" tuareg-mode-syntax-table) (unwind-protect (progn ,@body) ;; Switch back to the interactive syntax. (modify-syntax-entry ?. "'" tuareg-mode-syntax-table) (modify-syntax-entry ?' "_" tuareg-mode-syntax-table) (modify-syntax-entry ?_ "_" tuareg-mode-syntax-table)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font-Lock (defvar tuareg-doc-face 'font-lock-doc-face) (unless tuareg-use-syntax-ppss (defun tuareg-fontify-buffer () (font-lock-default-fontify-buffer) (tuareg-fontify (point-min) (point-max))) (defun tuareg-fontify-region (begin end &optional verbose) (font-lock-default-fontify-region begin end verbose) (tuareg-fontify begin end)) (defun tuareg-fontify (begin end) (when (eq major-mode 'tuareg-mode) (save-excursion (tuareg-with-internal-syntax (let ((case-fold-search nil) (modified (buffer-modified-p))) ; Emacs hack (see below) (goto-char begin) (setq begin (line-beginning-position)) (goto-char (1- end)) (end-of-line) ;; Dirty hack to trick `font-lock-default-unfontify-region' (forward-line 2) (setq end (point)) (while (> end begin) (goto-char (1- end)) (tuareg-in-literal-or-comment) (cond ((cdr tuareg-last-loc) (tuareg-beginning-of-literal-or-comment) (put-text-property (max begin (point)) end 'face (if (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*[^*]") tuareg-doc-face 'font-lock-comment-face)) (setq end (1- (point)))) ((car tuareg-last-loc) (tuareg-beginning-of-literal-or-comment) (put-text-property (max begin (point)) end 'face 'font-lock-string-face) (setq end (point))) (t (while (and tuareg-cache-local (or (> (caar tuareg-cache-local) end) (eq 'b (cadar tuareg-cache-local)))) (setq tuareg-cache-local (cdr tuareg-cache-local))) (setq end (if tuareg-cache-local (caar tuareg-cache-local) begin))))) (unless modified (set-buffer-modified-p nil))) )))) ) ;; end tuareg-use-syntax-ppss (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 "\"")) ("\\(<\\)\\(?:<\\S.\\|:[[:alpha:]]+<\\)" (1 (prog1 "|" (tuareg--syntax-quotation end)))) ("\\({\\)[a-z_]*|" (1 (prog1 "|" (tuareg--syntax-quotation end)))) ) start 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 t) (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 t) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "|"))))))))) (defun tuareg-font-lock-syntactic-face-function (state) (if (nth 3 state) (if (and (eq t (nth 3 state)) (eq ?< (char-after (nth 8 state)))) font-lock-preprocessor-face 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") ,@(unless tuareg-use-syntax-ppss '((?` . ".") (?\" . ".") (?\( . ".") (?\) . ".") (?* . ".")))) "Syntax changes for Font-Lock.") (defconst tuareg--whitespace-re ;; FIXME: Why's 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_']*\\>") ;; Matches corresponding braces for 3 levels. (balanced-braces ; needs a closing brace (let ((b "\\(?:[^()]\\|(") (e ")\\)*")) (concat b b b "[^()]*" e e e))) (balanced-braces-no-string (let ((b "\\(?:[^()\"]\\|(") (e ")\\)*")) (concat b b b "[^()\"]*" e e e))) (unbraced-tuple (concat lid " *\\(?:, *" lid " *\\)*")) (tuple (concat "(" balanced-braces ")")); much more than tuple! (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\\(?: +" (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) ("\\<\\(false\\|true\\)\\>" . 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)) (,(regexp-opt '("module" "include" "sig" "struct" "functor" "type" "constraint" "class" "in" "inherit" "method" "external" "val" "open" "initializer" "let" "rec" "object" "and" "begin" "end") 'words) . tuareg-font-lock-governing-face) ,@(if (tuareg-editing-ls3) `((,(concat "\\<\\(let[ \t]+" let-ls3 "\\)\\>") . 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\\>\\) *\\(" 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!\\)\\( *" 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 font-lock-constant-face keep) ;;; label in a type signature (,(concat "\\(?:->\\|:[^:>=]\\)" tuareg--whitespace-re "\\(" lid "\\)[ \t]*:[^:>=]") 1 font-lock-constant-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" "ref" "ignore") 'words) . font-lock-builtin-face) ;; module paths A.B. (,(concat module-path "\\.") . tuareg-font-lock-module-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) ;;; (lid: t) and (lid :> t) (,(concat "( *" lid " *:>?\\([ \n'_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 "`" id) . tuareg-font-lock-constructor-face) (,(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 "\\" 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 "\\") . font-lock-preprocessor-face) ,@(and tuareg-support-metaocaml '(("\\.<\\|>\\.\\|\\.~\\|\\.!" 0 tuareg-font-lock-multistage-face nil nil))) ,@(and tuareg-font-lock-symbols (tuareg-font-lock-symbols-keywords))))) (setq font-lock-defaults `(tuareg-font-lock-keywords ,(not tuareg-use-syntax-ppss) nil ,tuareg-font-lock-syntax nil ,@(unless (fboundp 'tuareg-syntax-propertize) '((font-lock-syntactic-keywords . tuareg-font-lock-syntactic-keywords) (parse-sexp-lookup-properties . t))) (font-lock-syntactic-face-function . tuareg-font-lock-syntactic-face-function) ,@(unless tuareg-use-syntax-ppss '((font-lock-fontify-region-function . tuareg-fontify-region))))) ;; (if tuareg-use-smie ;; (push 'smie-backward-sexp-command font-lock-extend-region-functions)) (when (and (boundp 'font-lock-fontify-region-function) (not tuareg-use-syntax-ppss)) (set (make-local-variable 'font-lock-fontify-region-function) 'tuareg-fontify-region))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keymap (defvar tuareg-mode-map (let ((map (make-sparse-keymap))) (define-key map "|" 'tuareg-electric-pipe) (define-key map ")" 'tuareg-electric-rp) (define-key map "}" 'tuareg-electric-rc) (define-key map "]" 'tuareg-electric-rb) (define-key map "\M-q" 'tuareg-indent-phrase) (define-key map "\C-c\C-q" 'tuareg-indent-phrase) ;; Don't bother: it's the global default anyway. ;;(define-key map "\M-\C-\\" 'indent-region) (define-key map "\C-c\C-a" 'tuareg-find-alternate-file) (define-key map "\C-c\C-c" 'compile) (define-key map "\C-xnd" 'tuareg-narrow-to-phrase) (define-key map "\M-\C-x" 'tuareg-eval-phrase) (define-key map [remap newline-and-indent] 'tuareg-newline-and-indent) (define-key map "\C-x\C-e" 'tuareg-eval-phrase) (define-key map "\C-c\C-e" 'tuareg-eval-phrase) (define-key map "\C-c\C-r" 'tuareg-eval-region) (define-key map "\C-c\C-b" 'tuareg-eval-buffer) (define-key map "\C-c\C-s" 'tuareg-run-ocaml) (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\C-n" 'tuareg-next-phrase) (define-key map "\C-c\C-p" 'tuareg-previous-phrase) (define-key map [(backspace)] 'backward-delete-char-untabify) (define-key map [(control c) (home)] 'tuareg-move-inside-module-or-class-opening) (unless tuareg-use-smie (define-key map [(control c) (control down)] 'tuareg-next-phrase) (define-key map [(control c) (control up)] 'tuareg-previous-phrase) (define-key map [(meta control down)] 'tuareg-next-phrase) (define-key map [(meta control up)] 'tuareg-previous-phrase) (define-key map [(meta control n)] 'tuareg-next-phrase) (define-key map [(meta control p)] 'tuareg-previous-phrase) ) (define-key map [(meta control h)] 'tuareg-mark-phrase) (define-key map "\C-c`" 'tuareg-interactive-next-error-source) (define-key map "\C-c?" 'tuareg-interactive-next-error-source) (define-key map "\C-c.c" 'tuareg-insert-class-form) (define-key map "\C-c.b" 'tuareg-insert-begin-form) (define-key map "\C-c.f" 'tuareg-insert-for-form) (define-key map "\C-c.w" 'tuareg-insert-while-form) (define-key map "\C-c.i" 'tuareg-insert-if-form) (define-key map "\C-c.l" 'tuareg-insert-let-form) (define-key map "\C-c.m" 'tuareg-insert-match-form) (define-key map "\C-c.t" 'tuareg-insert-try-form) (when tuareg-with-caml-mode-p ;; Trigger caml-types (define-key map [?\C-c ?\C-t] 'caml-types-show-type) ; "type" (define-key map [?\C-c ?\C-f] 'caml-types-show-call) ; "function" (define-key map [?\C-c ?\C-l] 'caml-types-show-ident) ; "let" ;; To prevent misbehavior in case of error during exploration. (define-key map [?\C-c mouse-1] 'caml-types-mouse-ignore) (define-key map [?\C-c down-mouse-1] 'caml-types-explore) ;; Trigger caml-help (define-key map [?\C-c ?i] 'ocaml-add-path) (define-key map [?\C-c ?\[] 'ocaml-open-module) (define-key map [?\C-c ?\]] 'ocaml-close-module) (define-key map [?\C-c ?h] 'caml-help) (define-key map [?\C-c ?\t] 'tuareg-complete)) map) "Keymap used in Tuareg mode.") (defvar tuareg-electric-indent-keywords '("module" "class" "functor" "object" "type" "val" "inherit" "include" "virtual" "constraint" "exception" "external" "open" "method" "and" "initializer" "to" "downto" "do" "done" "else" "begin" "end" "let" "in" "then" "with")) (defvar tuareg-mode-abbrev-table () "Abbrev table used for Tuareg mode buffers.") (if tuareg-mode-abbrev-table () (define-abbrev-table 'tuareg-mode-abbrev-table (mapcar (lambda (keyword) `(,keyword ,keyword tuareg-abbrev-hook nil t)) tuareg-electric-indent-keywords))) (defun tuareg--electric-indent-predicate (char) "Check whether we should auto-indent. For use on `electric-indent-functions'." (save-excursion (forward-char -1) ;; Go before the inserted char. (let ((syntax (char-syntax char))) (if (tuareg-in-indentation-p) (or (eq char ?|) (eq syntax ?\))) (or (case char (?\) (char-equal ?* (preceding-char))) (?\} (and (char-equal ?> (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-use-abbrev-mode ;; Misnomer, eh? (not (eq syntax ?w)) (let ((end (point))) (skip-syntax-backward "w_") (member (buffer-substring (point) end) tuareg-electric-indent-keywords)) (tuareg-in-indentation-p))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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) (decls "DEFINE" 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) ("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) ("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 (pattern) (pattern "when" exp1)) (pattern (id) (pattern "as" id) (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 ;; Note that we don't include "|" because its precedence collides ;; with the one of the | used between branches and resolving the ;; conflict in the lexer is not worth the trouble. '((nonassoc "as") (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" "DEFINE" ";;") (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)) (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 () (forward-comment (point-max)) (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 the point at the end of the next token and return the SMIE name of the token." (let ((tok (tuareg-smie--forward-token))) (cond ((zerop (length tok)) (if (not (looking-at "{<\\|\\[|")) tok (goto-char (match-end 0)) (match-string 0))) ((or (member tok '("let" "=" "->" "module" "class" "open" "type" "with" "and")) ;; 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 ":\\(?:[^:]\\|\\'\\)") (string-match "\\`[[:alpha:]_]" tok) (save-excursion (tuareg-smie--backward-token) ;Go back. (member (tuareg-smie--backward-token) tuareg-smie--type-label-leader))) (forward-char 1) "label:") ((and (equal tok "|") (looking-at "\\]")) (forward-char 1) "|]") ((and (equal tok ">") (looking-at "}")) (forward-char 1) ">}") ((string-match "\\`[[: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" "DEFINE" "=" "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)) ((not (member nearest '("type" "let" "module" "class" "and" "external" "val" "method" "DEFINE"))) "=…") ((and (member nearest '("type" "module")) (member (tuareg-smie--backward-token) '("with" "and"))) "c=") (t "d="))))) (defun tuareg-smie-backward-token () (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" "functor" "type" ":" "of"))) (and (equal nearest ":") (tuareg-smie--label-colon-p)))) (if (member nearest '("with" "|" "fun" "functor")) tok "t->")))) ;; Handle "module type" and mod-constraint's "with/and type". ((equal tok "type") (save-excursion (let ((prev (tuareg-smie--backward-token))) (cond ((equal prev "module") "m-type") ((member prev '("and" "with")) "w-type") (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)) ((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) "{<") ;; 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))) ((string-match "\\`[[: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))) ;; Special indentation for monadic >>>, >>|, and >>= operators. ((and (eq kind :before) (tuareg-smie--monadic-rule token))) ((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). ((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)) (t (smie-rule-separator kind)))) (t (case kind (:elem (if (eq token 'basic) tuareg-default-indent)) (:list-intro (member token '("fun"))) (:before (cond ((equal token "d=") (smie-rule-parent 2)) ((member token '("fun" "match")) (if (and (not (smie-rule-bolp)) (smie-rule-prev-p "d=")) (smie-rule-parent tuareg-default-indent))) ((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)) ;; 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 (equal token "(") 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)))))) ;; 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 ((and (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. (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)) ((smie-rule-parent-p "|") tuareg-match-clause-indent) (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) (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))))) (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 ">>[>=|]") (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) '(">>|" ">>=" ">>>")) (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 ">>[>=|]") (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))) (t (cons 'column (current-column))))))) (defun tuareg-smie--inside-string () (when (nth 3 (syntax-ppss)) (goto-char (1+ (nth 8 (syntax-ppss)))) (current-column))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The major mode (defun tuareg--common-mode-setup () (setq local-abbrev-table tuareg-mode-abbrev-table) (set (make-local-variable 'syntax-propertize-function) #'tuareg-syntax-propertize) (set (make-local-variable 'parse-sexp-ignore-comments) ;; Tuareg used to set this to nil (for an unknown reason) but SMIE needs ;; it to be set to t. tuareg-use-smie) (if (and tuareg-smie-grammar tuareg-use-smie) (progn (smie-setup tuareg-smie-grammar #'tuareg-smie-rules :forward-token #'tuareg-smie-forward-token :backward-token #'tuareg-smie-backward-token) (add-hook 'smie-indent-functions #'tuareg-smie--inside-string nil t) (set (make-local-variable 'add-log-current-defun-function) 'tuareg-current-fun-name)) (set (make-local-variable 'indent-line-function) #'tuareg-indent-command)) (set (make-local-variable 'prettify-symbols-alist) tuareg-font-lock-symbols-alist) (tuareg-install-font-lock) (set (make-local-variable '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(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 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 toplevel: \\{tuareg-interactive-mode-map}" ;; Initialize the Tuareg menu (tuareg-build-menu) (unless tuareg-use-smie ;; Initialize indentation regexps (tuareg-make-indentation-regexps)) (set (make-local-variable 'paragraph-start) (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'require-final-newline) t) (set (make-local-variable 'comment-start) "(* ") (set (make-local-variable 'comment-end) " *)") (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]*") ;(set (make-local-variable 'comment-column) 40) ;FIXME: Why? ;(set (make-local-variable 'comment-multi-line) t) ;FIXME: Why? ;; `ocamlc' counts columns from 0, contrary to other tools which start at 1. (set (make-local-variable 'compilation-first-column) 0) (set (make-local-variable 'compilation-error-screen-columns) nil) (tuareg--common-mode-setup) (unless tuareg-use-syntax-ppss (add-hook 'before-change-functions 'tuareg-before-change-function nil t)) (when (fboundp 'tuareg-auto-fill-function) ;; Emacs-21's newcomment.el provides this functionality by default. (set (make-local-variable 'normal-auto-fill-function) #'tuareg-auto-fill-function)) (set (make-local-variable 'imenu-create-index-function) #'tuareg-imenu-create-index) (when (and tuareg-use-abbrev-mode (not (and (boundp 'electric-indent-mode) electric-indent-mode))) (abbrev-mode 1)) (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 "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) (forward-comment (point-max)) (let ((name (tuareg-smie-forward-token))) (if (not (member name '("rec" "type"))) name (forward-comment (point-max)) (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. ;; FIXME: We should report those cases to bug-gnu-emacs@gnu.org. (defconst tuareg-error-regexp ;; Errors can take forms like: ;; "File "main.ml", line 1154, characters 30-48:\nError: ..." ;; "Raised at file "pervasives.ml", line 22, characters 22-33" ;; "File "main.ml", line 1018, characters 2-2632:\nWarning 8: ..." ;; as well as localized variants depending on locale. (concat "^\\(Called from \\)?[[:alpha:]][ [:alpha:]]*[[:alpha:]] " "\"\\([^\"\n]+\\)\", " ;File name. "[[:alpha:]]+ \\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?, " ;Lines. "[[:alpha:]]+ \\([0-9]+\\)-\\([0-9]+\\)" ;Columns. "\\(?::\\(\nWarning\\)?\\|[-,:]\\|$\\)") ;Warning/error. "Regular expression matching the error messages produced by ocamlc.") (when (boundp 'compilation-error-regexp-alist) (or (assoc tuareg-error-regexp compilation-error-regexp-alist) (setq compilation-error-regexp-alist (cons (if (fboundp 'compilation-fake-loc) (list tuareg-error-regexp 2 '(3 . 4) '(5 . 6) '(7 . 1)) (list tuareg-error-regexp 2 3)) ;; Other error format used for unhandled match case. (cons '("^Fatal error: exception [^ \n]*(\"\\([^\"]*\\)\", \\([0-9]+\\), \\([0-9]+\\))" 1 2 3) compilation-error-regexp-alist))))) ;; A regexp to extract the range info. ;; (defconst tuareg-error-chars-regexp ;; ".*, .*, [^\0-@]+ \\([0-9]+\\)-\\([0-9]+\\):" ;; "Regexp matching the char numbers in an error message produced by ocamlc.") ;; 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 "\\.[^.]*\\'" 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. (special-display-buffer-names (cons '("*caml-help*" (same-frame . t)) special-display-buffer-names))) (if (eq (car-safe action) 'boundaries) `(boundaries ,(if dot (1+ dot) 0) ,@(string-match "\\." (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 extension &optional no-create) "Switch to the file given by MOD-NAME and EXTENSION. If NO-CREATE is non-nil and the file doesn't exist, don't switch and return nil, otherwise return non-nil." (let* ((filename (concat mod-name extension)) (buffer (get-file-buffer filename)) (what (cond ((string= extension ".ml") "implementation") ((string= extension ".mli") "interface")))) (cond (buffer (switch-to-buffer buffer)) ((file-exists-p filename) (find-file filename)) ((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")) (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") (cons "~/.opam/system" (directory-files "~/.opam" t "[0-9]+\\.[0-9]+\\.[0-9]+"))) "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.") (when tuareg-opam (setq tuareg-interactive-program (concat tuareg-opam " config exec -- ocaml")) (defun tuareg-opam-config-env() (let* ((get-env (concat tuareg-opam " config env")) (opam-env (shell-command-to-string get-env))) (replace-regexp-in-string "; *export.*$" "" opam-env))) ;; OPAM compilation — one must update to the current compiler ;; before launching the compilation. (defadvice compile (before tuareg-compile-opam activate) "Run opam to update environment variables." (let* ((env (tuareg-opam-config-env))) (set (make-local-variable 'compilation-environment) ;; Quotes MUST be removed. (split-string (replace-regexp-in-string "\"" "" env))))) (eval-after-load "merlin" (defun merlin-command () "Return path of ocamlmerlin binary using the opam executable detected by Tuareg" (if (equal merlin-command 'opam) (let* ((opam (concat tuareg-opam " config var bin")) (bin (replace-regexp-in-string "\n$" "" (shell-command-to-string opam))) (merlin (concat bin "/ocamlmerlin"))) (if (file-executable-p merlin) merlin "ocamlmerlin")) merlin-command))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tuareg interactive mode ;; Augment Tuareg mode with an OCaml toplevel. (require 'comint) (defvar tuareg-interactive-mode-map (let ((map (copy-keymap comint-mode-map))) (define-key map "|" 'tuareg-electric-pipe) (define-key map ")" 'tuareg-electric-rp) (define-key map "}" 'tuareg-electric-rc) (define-key map "]" 'tuareg-electric-rb) (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-toplevel) (define-key map "\C-c?" 'tuareg-interactive-next-error-toplevel) (define-key map "\C-m" 'tuareg-interactive-send-input) (define-key map "\C-j" 'tuareg-interactive-send-input-or-indent) (define-key map "\M-\C-m" '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-toplevel*") (defconst tuareg-interactive-error-range-regexp "[ \t]*Characters \\([0-9]+\\)-\\([1-9][0-9]*\\):\n" "Regexp matching the char numbers in OCaml toplevel'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-toplevel 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 Toplevel" tuareg-run-ocaml t] ["Interrupt OCaml Toplevel" tuareg-interrupt-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Kill OCaml Toplevel" 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 toplevel 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 toplevel: \\{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) (set (make-local-variable 'comment-start) "(* ") (set (make-local-variable 'comment-end) " *)") (set (make-local-variable 'comment-start-skip) "(\\*+[ \t]*") (set (make-local-variable '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)) (when (boundp 'after-change-functions) ;FIXME: Why? (remove-hook 'after-change-functions 'font-lock-after-change-function t)) (when (boundp 'pre-idle-hook) (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook t)) (easy-menu-add tuareg-interactive-mode-menu) (tuareg-update-options-menu)) ;;;###autoload (defun tuareg-run-ocaml () "Run an OCaml toplevel process. I/O via buffer `*ocaml-toplevel*'." (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 toplevel process if needed, with an optional command name. I/O via buffer `*ocaml-toplevel*'." (if cmd (setq tuareg-interactive-program cmd) (unless (comint-check-proc tuareg-interactive-buffer-name) (setq tuareg-interactive-program (read-shell-command "OCaml toplevel to run: " tuareg-interactive-program)))) (unless (comint-check-proc tuareg-interactive-buffer-name) (let ((cmdlist (tuareg-args-to-list tuareg-interactive-program)) (process-connection-type nil)) (set-buffer (apply (function make-comint) "ocaml-toplevel" (car cmdlist) nil (cdr cmdlist))) (tuareg-interactive-mode) (sleep-for 1)))) (defun tuareg-args-to-list (string) (let ((where (string-match "[ \t]" string))) (cond ((null where) (list string)) ((/= where 0) (cons (substring string 0 where) (tuareg-args-to-list (substring string (+ 1 where) (length string))))) (t (let ((pos (string-match "[^ \t]" string))) (when pos (tuareg-args-to-list (substring string pos (length string))))))))) (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)))) (defun tuareg-interactive-end-of-phrase () (save-excursion (end-of-line) (tuareg-find-meaningful-word) (tuareg-find-meaningful-word) (looking-at ";;"))) (defun tuareg-interactive-send-input-end-of-phrase () (interactive) (goto-char (point-max)) (unless (tuareg-interactive-end-of-phrase) (insert ";;")) (comint-send-input)) (defconst tuareg-interactive-send-warning "Note: toplevel processing requires a terminating `;;'") (defun tuareg-interactive-send-input () "Process if the current line ends with `;;' then send the current phrase else insert a newline." (interactive) (if (tuareg-interactive-end-of-phrase) (progn (comint-send-input) (goto-char (point-max))) (insert "\n") (message tuareg-interactive-send-warning))) (defun tuareg-interactive-send-input-or-indent () "Process if the current line ends with `;;' then send the current phrase else insert a newline and indent." (interactive) (if (tuareg-interactive-end-of-phrase) (progn (goto-char (point-max)) (comint-send-input)) (insert "\n") (indent-according-to-mode) (message tuareg-interactive-send-warning))) (defun tuareg-eval-region (start end) "Eval the current region in the OCaml toplevel." (interactive "r") (save-excursion (tuareg-run-process-if-needed)) (comint-preinput-scroll-to-bottom) (setq tuareg-interactive-last-phrase-pos-in-source start) (save-excursion (goto-char start) (tuareg-skip-blank-and-comments) (setq start (point)) (goto-char end) (tuareg-skip-to-end-of-phrase) (setq end (point)) (let ((text (buffer-substring-no-properties start end))) (goto-char end) (if (string= text "") (message "Cannot send empty commands to OCaml toplevel!") (set-buffer tuareg-interactive-buffer-name) (goto-char (point-max)) (setq tuareg-interactive-last-phrase-pos-in-toplevel (point)) (comint-send-string tuareg-interactive-buffer-name (concat text ";;")) (let ((pos (point))) (comint-send-input) (when tuareg-interactive-echo-phrase (save-excursion (goto-char pos) (insert (concat text ";;"))))))) (when tuareg-display-buffer-on-eval (display-buffer tuareg-interactive-buffer-name)))) (when tuareg-use-smie (defconst tuareg-beginning-of-phrase-syms '("module" "open" "include" "type" "d-let")) (defconst tuareg-beginning-of-phrase-syms-re (concat (regexp-opt '("open" "include") 'words) " *") "A regular expression matching tokens at beginning of a phrase for which `smie-backward-sexp' returns `nil'.") (defun tuareg--beginning-of-phrase () (while (let ((td (smie-backward-sexp 'halfsexp))) (cond ((member (nth 2 td) tuareg-beginning-of-phrase-syms) (goto-char (nth 1 td)) nil) ;; When we are after, say, "open X", `td' is `nil' ((and (null td) (looking-back tuareg-beginning-of-phrase-syms-re)) (tuareg-smie-backward-token) nil) ((and (car td) (not(numberp (car td)))) (unless (bobp) (goto-char (nth 1 td)) t)) (t t))))) (defun tuareg-discover-phrase (&optional quiet stop-at-and) "Return a triplet '(begin end end-with-comments)." (save-excursion (end-of-line) (tuareg--beginning-of-phrase) (let ((begin (point))) (smie-forward-sexp 'halfsexp) (let ((end (point))) (forward-comment 5) (list begin end (point))))))) (defun tuareg-narrow-to-phrase () "Narrow the editting window to the surrounding OCaml phrase (or block)." (interactive) (save-excursion (let ((pair (tuareg-discover-phrase))) (narrow-to-region (nth 0 pair) (nth 1 pair))))) (defun tuareg-eval-phrase () "Eval the surrounding OCaml phrase (or block) in the Caml toplevel." (interactive) (let ((end)) (save-excursion (let ((pair (tuareg-discover-phrase))) (setq end (nth 2 pair)) (tuareg-eval-region (nth 0 pair) (nth 1 pair)))) (when tuareg-skip-after-eval-phrase (goto-char end)))) (defun tuareg-eval-buffer () "Send the buffer to the Tuareg Interactive process." (interactive) (tuareg-eval-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-toplevel) (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-toplevel () (interactive) (let ((error-pos) (beg 0) (end 0)) (save-excursion (goto-char tuareg-interactive-last-phrase-pos-in-toplevel) (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-toplevel beg) end (+ tuareg-interactive-last-phrase-pos-in-toplevel 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 toplevel: \\{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)) (defvar tuareg-definitions-menu (list ["Scan..." tuareg-list-definitions t]) "Initial content of the definitions menu.") (make-variable-buffer-local 'tuareg-definitions-menu) (defvar tuareg-definitions-menu-last-buffer nil) (defvar tuareg-definitions-keymaps nil) (defun tuareg-build-menu () (easy-menu-define tuareg-mode-menu (list tuareg-mode-map) "Tuareg Mode Menu." '("Tuareg" ("Interactive Mode" ["Run OCaml Toplevel" tuareg-run-ocaml t] ["Interrupt OCaml Toplevel" tuareg-interrupt-ocaml :active (comint-check-proc tuareg-interactive-buffer-name)] ["Kill OCaml Toplevel" 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] ("Definitions" ["Scan..." tuareg-list-definitions 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-update-definitions-menu () (when (eq major-mode 'tuareg-mode) (easy-menu-change '("Tuareg") "Definitions" tuareg-definitions-menu))) (defun tuareg-toggle-option (symbol) (interactive) (set symbol (not (symbol-value symbol))) (when (eq 'tuareg-use-abbrev-mode symbol) (abbrev-mode tuareg-use-abbrev-mode)) ; toggle abbrev minor mode (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) (set (make-local-variable '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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Definitions List ;; Designed from original code by M. Quercia (defconst tuareg--id-regexp "[[:alpha:]][_'[:alnum:]]*") (defconst tuareg-definitions-regexp (regexp-opt '("and" "val" "type" "module" "class" "exception" "let") 'words) "Regexp matching definition phrases.") (defconst tuareg-definitions-bind-skip-regexp (concat (regexp-opt '("rec" "type" "virtual") 'words) "\\|'" tuareg--id-regexp "\\|('.*)") "Regexp matching stuff to ignore after a binding keyword.") (defconst tuareg-identifier-regexp (concat "\\<" tuareg--id-regexp "\\>")) (defun tuareg-imenu-create-index () (let ((cpt (if (fboundp 'make-progress-reporter) (make-progress-reporter "Searching definitions..." (point-min) (point-max)) 0)) (kw) (value-list) (type-list) (module-list) (class-list) (misc-list)) (goto-char (point-min)) (tuareg-skip-blank-and-comments) (while (not (eobp)) (when (looking-at tuareg-definitions-regexp) (setq kw (tuareg-match-string 0)) (save-match-data (tuareg-reset-and-kwop kw)) (when (member kw '("exception" "val")) (setq kw "let")) ;; Skip optional elements (goto-char (match-end 0)) (tuareg-skip-blank-and-comments) (when (looking-at tuareg-definitions-bind-skip-regexp) (goto-char (match-end 0))) (tuareg-skip-blank-and-comments) (when (looking-at tuareg-identifier-regexp) (let ((ref (cons (tuareg-match-string 0) (point-marker)))) (if (not (integerp cpt)) (progress-reporter-update cpt (point)) (setq cpt (1+ cpt)) (message "Searching definitions... (%d)" cpt)) (cond ((string= kw "let") (setq value-list (cons ref value-list))) ((string= kw "type") (setq type-list (cons ref type-list))) ((string= kw "module") (setq module-list (cons ref module-list))) ((string= kw "class") (setq class-list (cons ref class-list))) (t (setq misc-list (cons ref misc-list))))))) ;; Skip to next phrase or next top-level `and' (tuareg-forward-char) (let ((old-point (point)) (last-and (progn (tuareg-next-phrase t t) (point)))) (when (< last-and old-point) (error "Scan error")) (save-excursion (while (and (re-search-backward "\\" old-point t) (not (tuareg-in-literal-or-comment-p)) (save-excursion (tuareg-find-and-match) (>= old-point (point)))) (setq last-and (point)))) (goto-char last-and))) (if (integerp cpt) (message "Searching definitions... done") (progress-reporter-done cpt)) (let ((index ())) (when module-list (push (cons "Modules" module-list) index)) (when type-list (push (cons "Types" type-list) index)) (when class-list (push (cons "Classes" class-list) index)) (when value-list (push (cons "Values" value-list) index)) (when misc-list (push (cons "Miscellaneous" misc-list) index)) index))) (defun tuareg-list-definitions () "Parse the buffer and gather toplevel definitions for a quick jump via the definitions menu." (interactive) (let ((defs (save-excursion (tuareg-imenu-create-index))) menu) ;; Sort and build lists (dolist (pair defs) (let ((entries (mapcar (lambda (elem) (vector (car elem) (list 'tuareg-goto (cdr elem)) t)) (cdr pair)))) (setq menu (append (tuareg-split-long-list (car pair) (tuareg-sort-definitions entries)) menu)))) ;; Update definitions menu (setq tuareg-definitions-menu (append menu (list "---" ["Rescan..." tuareg-list-definitions t])))) (tuareg-update-definitions-menu)) (defun tuareg-goto (pos) (goto-char pos) (recenter)) (defun tuareg-sort-definitions (list) (let* ((last "") (cpt 1) (list (sort (nreverse list) ;FIXME: Why reverse before sorting? (lambda (p q) (string< (elt p 0) (elt q 0))))) (tail list)) (while tail (if (string= (elt (car tail) 0) last) (progn (setq cpt (1+ cpt)) (aset (car tail) 0 (format "%s (%d)" last cpt))) (setq cpt 1) (setq last (elt (car tail) 0))) (setq tail (cdr tail))) list)) ;; Split a definition list if it is too long (defun tuareg-split-long-list (title list) (let ((tail (nthcdr tuareg-definitions-max-items list))) (if (null (cdr tail)) ;; List not too long, cons the title (list (cons title list)) ;; List too long, split and add initials to the title (let (lists) (while list (let ((beg (substring (elt (car list) 0) 0 1)) (end (substring (elt (car tail) 0) 0 1))) (setq lists (cons (cons (format "%s %s-%s" title beg end) list) lists)) (setq list (cdr tail)) (setcdr tail nil) (setq tail (nthcdr tuareg-definitions-max-items list)))) (nreverse lists))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hooks and Exit (eval-when-compile (autoload 'speedbar-add-supported-extension "speedbar")) (when (require 'speedbar nil t) (speedbar-add-supported-extension '(".ml" ".mli" ".mll" ".mly" ".ls"))) (provide 'tuareg) ;; Pre-SMIE indentation functions. ;; Load it after providing `tuareg' to avoid circular dependencies. (require 'tuareg_indent) ;; For compatibility with caml support modes ;; you may also link caml.el to tuareg.el (provide 'caml) ;;; tuareg.el ends here tuareg-2.0.9/tuareg_indent.el000066400000000000000000002425471250163147700162070ustar00rootroot00000000000000;;; tuareg_indent.el --- Old (pre-SMIE) indentation code for tuarge-mode ;; This software 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 software 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 GNU Emacs. If not, see . ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (require 'tuareg) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User customizable variables ;; Comments (defcustom tuareg-indent-leading-comments t "*If true, indent leading comment lines (starting with `(*') like others." :group 'tuareg :type 'boolean) (defcustom tuareg-indent-comments t "*If true, automatically align multi-line comments." :group 'tuareg :type 'boolean) (defcustom tuareg-comment-end-extra-indent 0 "*How many spaces to indent a leading comment end `*)'. If you expect comments to be indented like (* ... *) even without leading `*', use `tuareg-comment-end-extra-indent' = 1." :group 'tuareg :type '(radio :extra-offset 8 :format "%{Comment End Extra Indent%}: Comment alignment:\n%v" (const :tag "align with `(' in comment opening" 0) (const :tag "align with `*' in comment opening" 1) (integer :tag "custom alignment" 0))) ;; Indentation defaults (defcustom tuareg-let-always-indent t "*If true, enforce indentation is at least `tuareg-let-indent' after a `let'. As an example, set it to nil when you have `tuareg-with-indent' set to 0, and you want `let x = match ... with' and `match ... with' indent the same way." :group 'tuareg :type 'boolean) (defcustom tuareg-pipe-extra-unindent tuareg-default-indent "*Extra backward indent for OCaml lines starting with the `|' operator. It is NOT the variable controlling the indentation of the `|' itself: this value is automatically added to `function', `with', `parse' and some cases of `type' keywords to leave enough space for `|' backward indentation. For example, setting this variable to 0 leads to the following indentation: match ... with X -> ... | Y -> ... | Z -> ... To modify the indentation of lines lead by `|' you need to modify the indentation variables for `with', `function', and possibly for `type' as well. For example, setting them to 0 (and leaving `tuareg-pipe-extra-unindent' to its default value) yields: match ... with X -> ... | Y -> ... | Z -> ..." :group 'tuareg :type 'integer) (defcustom tuareg-class-indent tuareg-default-indent "*How many spaces to indent from a `class' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-sig-struct-align t "*Align `sig' and `struct' keywords with `module'." :group 'tuareg :type 'boolean) (defcustom tuareg-sig-struct-indent tuareg-default-indent "*How many spaces to indent from a `sig' or `struct' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-method-indent tuareg-default-indent "*How many spaces to indent from a `method' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-begin-indent tuareg-default-indent "*How many spaces to indent from a `begin' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-for-while-indent tuareg-default-indent "*How many spaces to indent from a `for' or `while' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-do-indent tuareg-default-indent "*How many spaces to indent from a `do' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-fun-indent tuareg-default-indent "*How many spaces to indent from a `fun' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-function-indent 0 ;tuareg-default-indent "*How many spaces to indent from a `function' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-if-then-else-indent tuareg-default-indent "*How many spaces to indent from an `if', `then' or `else' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-let-indent tuareg-default-indent "*How many spaces to indent from a `let' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-match-indent tuareg-default-indent "*How many spaces to indent from a `match' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-try-indent tuareg-default-indent "*How many spaces to indent from a `try' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-type-indent tuareg-default-indent "*How many spaces to indent from a `type' keyword." :group 'tuareg :type 'integer) (defcustom tuareg-val-indent tuareg-default-indent "*How many spaces to indent from a `val' keyword." :group 'tuareg :type 'integer) ;; Automatic indentation (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) ;; Tuareg-Interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun tuareg-ro (&rest words) (concat "\\<" (regexp-opt words t) "\\>")) (eval-and-compile (defconst tuareg-no-more-code-this-line-regexp "[ \t]*\\((\\*\\|$\\)" "Regexp matching lines which have no more code: blanks + (maybe) comment start.")) (defmacro tuareg-no-code-after (rex) `(eval-when-compile (concat ,rex tuareg-no-more-code-this-line-regexp))) (defconst tuareg-no-code-this-line-regexp (concat "^" tuareg-no-more-code-this-line-regexp)) (defconst tuareg-extra-unindent-regexp (concat "\\(" (tuareg-ro "with" "fun" "function") "\\|\\[" tuareg-no-more-code-this-line-regexp "\\)") "Regexp for keywords needing extra indentation to compensate for case matches.") (defconst tuareg-ls3-extras (concat "\\|" (tuareg-ro "automaton" "present"))) (defconst tuareg-extra-unindent-regexp-ls3 (concat tuareg-extra-unindent-regexp tuareg-ls3-extras) "Regexp for keywords needing extra indentation to compensate for case matches.") (defun tuareg-give-extra-unindent-regexp () (if (tuareg-editing-ls3) tuareg-extra-unindent-regexp-ls3 tuareg-extra-unindent-regexp)) (defconst tuareg-keyword-regexp (concat (tuareg-ro "object" "initializer" "and" "constraint" "class" "match" "module" "method" "mutable" "sig" "struct" "begin" "else" "exception" "external" "to" "then" "try" "type" "virtual" "val" "while" "when" "with" "if" "in" "inherit" "for" "fun" "functor" "function" "let" "do" "downto" "of") "\\|->\\|[;,|]") "Regexp for all recognized keywords.") (defconst tuareg-keyword-regexp-ls3 (concat tuareg-keyword-regexp "\\|" (tuareg-ro "where" "automaton" "present" "fby" "pre" "last" "merge" "when" "reset" "every" "emit" "until" "unless" "period" "at")) "Regexp for all recognized keywords. For synchronous programming.") (defun tuareg-give-keyword-regexp () (if (tuareg-editing-ls3) tuareg-keyword-regexp-ls3 tuareg-keyword-regexp)) (defconst tuareg-match-pipe-kwop-regexp (concat (tuareg-ro "and" "function" "type" "with") "\\|[[({=]\\||[^!]") "Regexp for keywords supporting case match.") (defconst tuareg-match-pipe-kwop-regexp-ls3 (concat tuareg-match-pipe-kwop-regexp tuareg-ls3-extras) "Regexp for keywords supporting case match. For synchronous programming.") (defun tuareg-give-match-pipe-kwop-regexp () (if (tuareg-editing-ls3) tuareg-match-pipe-kwop-regexp-ls3 tuareg-match-pipe-kwop-regexp)) (defconst tuareg-operator-regexp "[-+*/=<>@^&|]\\|:>\\|::\\|\\<\\(or\\|l\\(and\\|x?or\\|s[lr]\\)\\|as[lr]\\|mod\\)\\>" "Regexp for all operators.") (defconst tuareg-matching-keyword-regexp (tuareg-ro "and" "do" "done" "then" "else" "end" "in" "downto") "Regexp matching OCaml keywords which act as end block delimiters.") (defconst tuareg-extra-ls3-keyword-regexp (tuareg-ro "where" "unless" "until" "every") "Additional Lucid Synchrone keywords.") (defconst tuareg-matching-keyword-regexp-ls3 (concat tuareg-matching-keyword-regexp "\\|" tuareg-extra-ls3-keyword-regexp) "Regexp matching OCaml keywords which act as end block delimiters For synchronous programming.") (defun tuareg-give-matching-keyword-regexp () (let ((rxp (if (tuareg-editing-ls3) tuareg-matching-keyword-regexp-ls3 tuareg-matching-keyword-regexp))) (if tuareg-support-metaocaml (concat rxp "\\|>\\.") rxp))) (defconst tuareg-matching-kwop-regexp (concat tuareg-matching-keyword-regexp "\\|\\\\|[|>]?\\]\\|>?}\\|[|)]\\|;;") ;; FIXME: what about \\|\\ ? "Regexp matching OCaml keywords or operators which act as end block delimiters.") (defconst tuareg-matching-kwop-regexp-ls3 (concat tuareg-matching-kwop-regexp "\\|" tuareg-extra-ls3-keyword-regexp) "Regexp matching OCaml keywords or operators which act as end block delimiters. For synchronous programming.") (defun tuareg-give-matching-kwop-regexp () (if (tuareg-editing-ls3) tuareg-matching-kwop-regexp-ls3 tuareg-matching-kwop-regexp)) (defconst tuareg-block-regexp (concat (tuareg-ro "for" "while" "do" "if" "begin" "sig" "struct" "object") "\\|[][(){}]\\|\\*)")) (defconst tuareg-find-kwop-regexp (concat tuareg-matching-keyword-regexp "\\|" tuareg-block-regexp)) (defconst tuareg-find-kwop-regexp-ls3 (concat tuareg-find-kwop-regexp "\\|" (tuareg-ro "where" "automaton" "present" "match"))) (defun tuareg-give-find-kwop-regexp () (if (tuareg-editing-ls3) tuareg-find-kwop-regexp-ls3 tuareg-find-kwop-regexp)) (defconst tuareg-governing-phrase-regexp (tuareg-ro "val" "type" "method" "module" "constraint" "class" "inherit" "initializer" "external" "exception" "open" "let" "object" "include") "Regexp matching tuareg phrase delimitors.") (defconst tuareg-keyword-alist '(("module" . tuareg-default-indent) ("class" . tuareg-class-indent) ("sig" . tuareg-sig-struct-indent) ("struct" . tuareg-sig-struct-indent) ("method" . tuareg-method-indent) ("object" . tuareg-begin-indent) ("begin" . tuareg-begin-indent) (".<" . tuareg-begin-indent) ("for" . tuareg-for-while-indent) ("while" . tuareg-for-while-indent) ("do" . tuareg-do-indent) ("val" . tuareg-val-indent) ("fun" . tuareg-fun-indent) ("if" . tuareg-if-then-else-indent) ("then" . tuareg-if-then-else-indent) ("else" . tuareg-if-then-else-indent) ("let" . tuareg-let-indent) ("match" . tuareg-match-indent) ("try" . tuareg-try-indent) ;; Case match keywords ("function" . tuareg-function-indent) ("with" . tuareg-with-indent) ("automaton" . tuareg-with-indent) ("present" . tuareg-with-indent) ("type" . tuareg-type-indent) ; sometimes, `type' acts like a case match ;; Assume default indentation for other keywords and operators ) "Association list of indentation values based on governing keywords.") (defconst tuareg-leading-kwop-alist '(("|" . tuareg-find-pipe-match) ("}" . tuareg-find-match) (">}" . tuareg-find-match) (">." . tuareg-find-match) (")" . tuareg-find-match) ("]" . tuareg-find-match) ("|]" . tuareg-find-match) (">]" . tuareg-find-match) ("end" . tuareg-find-match) ("done" . tuareg-find-done-match) ("unless" . tuareg-find-done-match) ("until" . tuareg-find-done-match) ("every" . tuareg-find-done-match) ("in" . tuareg-find-in-match) ("where" . tuareg-find-in-match) ("with" . tuareg-find-with-match) ("else" . tuareg-find-else-match) ("then" . tuareg-find-then-match) ("do" . tuareg-find-do-match) ("to" . tuareg-find-match) ("downto" . tuareg-find-match) ("and" . tuareg-find-and-match)) "Association list used in Tuareg mode for skipping back over nested blocks.") (defun tuareg-find-leading-kwop-match (kwop) (funcall (cdr (assoc kwop tuareg-leading-kwop-alist)))) (defconst tuareg-binding-regexp "\\(\\\\|(*\\\\)") (defun tuareg-assoc-indent (kwop &optional look-for-let-or-and) "Return relative indentation of the keyword given in argument." (let ((ind (or (symbol-value (cdr (assoc kwop tuareg-keyword-alist))) tuareg-default-indent)) (looking-let-or-and (and look-for-let-or-and (looking-at tuareg-binding-regexp)))) (if (string-match (tuareg-give-extra-unindent-regexp) kwop) (- (if (and tuareg-let-always-indent looking-let-or-and (< ind tuareg-let-indent)) tuareg-let-indent ind) tuareg-pipe-extra-unindent) ind))) (defun tuareg-in-monadic-op-p (&optional pos) (unless pos (setq pos (point))) (and (char-equal ?> (char-before pos)) (char-equal ?> (char-before (1- pos))))) (defconst tuareg-meaningful-word-regexp "[^ \t\n_[:alnum:]]\\|\\<\\(\\w\\|_\\)+\\>\\|\\*)") (defun tuareg-find-meaningful-word () "Look back for a word, skipping comments and blanks. Returns the actual text of the word, if found." (let ((found nil) (kwop nil) (pt (point))) (while (and (not found) (re-search-backward tuareg-meaningful-word-regexp (point-min) t)) (setq kwop (tuareg-match-string 0)) (cond ((and (or (string= kwop "|") (string= kwop "=") (string= kwop ">")) (tuareg-in-monadic-op-p)) (backward-char 2) (setq kwop (concat ">>" kwop))) ((and (string= kwop ">") (char-equal ?- (char-before))) (backward-char) (setq kwop "->"))) (when (= pt (point)) (error "tuareg-find-meaningful-word: inf loop at %d, kwop=%s" pt kwop)) (setq pt (point)) (if kwop (if (tuareg-in-comment-p) (tuareg-beginning-of-literal-or-comment-fast) (setq found t)) (setq found t))) (if found kwop (goto-char (point-min)) nil))) (defun tuareg-make-find-kwop-regexp (kwop-regexp) "Make a custom indentation regexp." (concat (tuareg-give-find-kwop-regexp) "\\|" kwop-regexp)) ;; Dynamic regexps (for language changes, see `tuareg-editing-ls3') (defvar tuareg-find-comma-match-regexp nil) (defvar tuareg-find-with-match-regexp nil) (defvar tuareg-find-in-match-regexp nil) (defvar tuareg-find-else-match-regexp nil) (defvar tuareg-find-do-match-regexp nil) (defvar tuareg-find-=-match-regexp nil) (defvar tuareg-find-pipe-match-regexp nil) (defvar tuareg-find-arrow-match-regexp nil) (defvar tuareg-find-semicolon-match-regexp nil) (defvar tuareg-find-phrase-indentation-regexp nil) (defvar tuareg-find-phrase-indentation-break-regexp nil) (defvar tuareg-find-phrase-indentation-class-regexp nil) (defvar tuareg-compute-argument-indent-regexp nil) (defvar tuareg-compute-normal-indent-regexp nil) (defvar tuareg-find-module-regexp nil) (defvar tuareg-find-pipe-bang-match-regexp nil) (defvar tuareg-find-monadic-match-regexp nil) ;; Static regexps (defconst tuareg-find-and-match-regexp (concat (tuareg-ro "do" "done" "else" "end" "in" "then" "downto" "for" "while" "do" "if" "begin" "sig" "struct" "class" "exception" "let" "in" "type" "val" "module") "\\|[][(){}]\\|\\*)")) (defconst tuareg-find-phrase-beginning-regexp (concat (tuareg-ro "end" "type" "module" "sig" "struct" "class" "exception" "open" "let") "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;;")) (defconst tuareg-find-phrase-beginning-and-regexp (concat "\\<\\(and\\)\\>\\|" tuareg-find-phrase-beginning-regexp)) (defconst tuareg-back-to-paren-or-indentation-regexp "[][(){}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") ;; Specific regexps for module/class detection (defconst tuareg-inside-module-or-class-opening (tuareg-ro "struct" "sig" "object")) (defconst tuareg-inside-module-or-class-opening-full (concat tuareg-inside-module-or-class-opening "\\|" (tuareg-ro "module" "class"))) (defconst tuareg-inside-module-or-class-regexp (concat (tuareg-give-matching-keyword-regexp) "\\|" tuareg-inside-module-or-class-opening)) (defun tuareg-make-indentation-regexps () "Initialisation of specific indentation regexp. Gathered here for memoization and dynamic reconfiguration purposes." (setq tuareg-find-comma-match-regexp (tuareg-make-find-kwop-regexp (concat (tuareg-ro "and" "match" "begin" "else" "exception" "then" "try" "with" "or" "fun" "function" "let" "do") "\\|->\\|[[{(]")) tuareg-find-with-match-regexp (tuareg-make-find-kwop-regexp (concat (tuareg-ro "match" "try" "module" "begin" "with" "type") "\\|[[{(]")) tuareg-find-in-match-regexp ;; (tuareg-make-find-kwop-regexp (tuareg-ro "let" "open")) (tuareg-make-find-kwop-regexp (tuareg-ro "let")) tuareg-find-else-match-regexp (tuareg-make-find-kwop-regexp ";") tuareg-find-do-match-regexp (tuareg-make-find-kwop-regexp "->") tuareg-find-=-match-regexp (tuareg-make-find-kwop-regexp (concat (tuareg-ro "val" "let" "method" "module" "type" "class" "when" "if" "in" "do") "\\|=")) tuareg-find-pipe-match-regexp (tuareg-make-find-kwop-regexp (tuareg-give-match-pipe-kwop-regexp)) tuareg-find-arrow-match-regexp (tuareg-make-find-kwop-regexp (concat (tuareg-ro "external" "type" "val" "method" "let" "with" "fun" "function" "functor" "class") "\\|[|;]")) tuareg-find-semicolon-match-regexp (tuareg-make-find-kwop-regexp (concat ";" tuareg-no-more-code-this-line-regexp "\\|->\\|" (tuareg-ro "let" "method" "with" "try" "initializer"))) tuareg-find-phrase-indentation-regexp (tuareg-make-find-kwop-regexp (concat tuareg-governing-phrase-regexp "\\|" (tuareg-ro "and" "every"))) tuareg-find-phrase-indentation-break-regexp (concat tuareg-find-phrase-indentation-regexp "\\|;;") tuareg-find-phrase-indentation-class-regexp (concat (tuareg-give-matching-keyword-regexp) "\\|\\") tuareg-compute-argument-indent-regexp (tuareg-make-find-kwop-regexp (concat (tuareg-give-keyword-regexp) "\\|=")) tuareg-compute-normal-indent-regexp (concat tuareg-compute-argument-indent-regexp "\\|^.[ \t]*") tuareg-find-module-regexp (tuareg-make-find-kwop-regexp "\\") tuareg-find-pipe-bang-match-regexp (concat tuareg-find-comma-match-regexp "\\|=") tuareg-find-monadic-match-regexp (concat tuareg-block-regexp "\\|\\([;=]\\)\\|\\(->\\)\\|" (tuareg-ro "val" "let" "method" "module" "type" "class" "when" "if" "in" "do" "done" "end")))) (defun tuareg-strip-trailing-whitespace (string) (if (string-match "[ \t]*\\'" string) (substring string 0 (match-beginning 0)) string)) (defun tuareg-find-kwop-pos (kr do-not-skip-regexp may-terminate-early) "Look back for a keyword or operator matching KR (short for kwop regexp). Skips blocks etc... Ignore occurences inside literals and comments. If found, return the actual text of the keyword or operator." (let ((found nil) (kwop nil) pos (kwop-regexp (if tuareg-support-metaocaml (concat kr "\\|\\.<\\|>\\.") kr))) (while (and (not found) (setq pos (re-search-backward kwop-regexp (point-min) t)) (setq kwop (tuareg-strip-trailing-whitespace ;; for trailing blanks after a semicolon (tuareg-match-string 0)))) (cond ((tuareg-in-literal-or-comment-p) (tuareg-beginning-of-literal-or-comment-fast)) ((looking-at "[]})]") (tuareg-backward-up-list)) ((tuareg-at-phrase-break-p) (setq found t)) ((and do-not-skip-regexp (looking-at do-not-skip-regexp)) (if (and (string= kwop "|") (char-equal ?| (preceding-char))) (backward-char) (setq found t))) ((looking-at (tuareg-give-matching-keyword-regexp)) (let ((mkwop (tuareg-find-leading-kwop-match (tuareg-match-string 0)))) (when (and may-terminate-early (string-match kwop-regexp mkwop)) (setq found t)))) (t (setq found t)))) (if found (list kwop pos) (goto-char (point-min)) nil))) (defun tuareg-find-kwop (kr &optional do-not-skip-regexp) (car (tuareg-find-kwop-pos kr do-not-skip-regexp nil))) (defun tuareg-find-match () (let ((kwop (tuareg-find-kwop (tuareg-give-find-kwop-regexp)))) (when (string= kwop "then") (tuareg-find-then-match) (tuareg-find-match)) kwop)) (defun tuareg-find-comma-match () (car (tuareg-find-kwop-pos tuareg-find-comma-match-regexp nil t))) (defun tuareg-find-pipe-bang-match () (destructuring-bind (kwop pos) (tuareg-find-kwop-pos tuareg-find-pipe-bang-match-regexp nil t) ;; when matched "if ... then", kwop is "then" but point is at "if" (goto-char pos) ; go back to kwop for tuareg-indent-to-code (if (looking-at "\\[|") "[|" kwop))) (defun tuareg-monadic-operator-p (word) (and (or (string= ">>=" word) (string= ">>|" word) (string= ">>>" word)) word)) (defun tuareg-ignorable-arrow-p () (save-excursion (or (tuareg-monadic-operator-p (tuareg-find-arrow-match)) (looking-at (tuareg-give-extra-unindent-regexp))))) (defun tuareg-find-monadic-match () (let (kwop) (while (or (null kwop) (and (string= kwop "=") (tuareg-in-monadic-op-p))) (when kwop (tuareg-backward-char 2)) (setq kwop (tuareg-find-kwop tuareg-find-monadic-match-regexp)) (when (and (string= kwop "->") (tuareg-ignorable-arrow-p)) (setq kwop nil))) kwop)) (defun tuareg-find-with-match () (tuareg-find-kwop tuareg-find-with-match-regexp)) (defun tuareg-find-in-match () (let ((kwop (tuareg-find-kwop tuareg-find-in-match-regexp "\\"))) (cond ((string= kwop "and") (tuareg-find-in-match)) (t kwop)))) (defconst tuareg-find-arrow-match-regexp-ls3 (concat tuareg-find-arrow-match-regexp tuareg-ls3-extras)) (defun tuareg-give-find-arrow-match-regexp () (if (tuareg-editing-ls3) tuareg-find-arrow-match-regexp-ls3 tuareg-find-arrow-match-regexp)) (defconst tuareg-find-then-match-skip-regexp-ls3 (regexp-opt '("->" "unless" "until") t)) (defconst tuareg-find-then-match-regexp-ls3 (tuareg-make-find-kwop-regexp tuareg-find-then-match-skip-regexp-ls3)) (defconst tuareg-find-then-match-regexp (tuareg-make-find-kwop-regexp "\\(->\\)")) (defun tuareg-find-then-kwop () (let ((ls3 (tuareg-editing-ls3))) (tuareg-find-kwop (if ls3 tuareg-find-then-match-regexp-ls3 tuareg-find-then-match-regexp) (if ls3 tuareg-find-then-match-regexp-ls3 "\\(->\\)")))) (defun tuareg-find-then-match () (let ((kwop (tuareg-find-then-kwop))) (cond ((string= kwop "if") (let ((back (point))) (tuareg-back-to-paren-or-indentation) (if (looking-at "else[ \t]*\\((\\*.*\\*)\\)*[ \t]*if") "else if" (goto-char back) kwop))) (t kwop)))) (defun tuareg-find-then-else-match () (let ((kwop (tuareg-find-then-kwop))) (cond ((string= kwop "if") (let ((pos (point))) (if (and (not (tuareg-in-indentation-p)) (string= "else" (tuareg-find-meaningful-word))) "else" (goto-char pos) kwop))) (t kwop)))) (defun tuareg-find-else-match () (let ((kwop (tuareg-find-kwop tuareg-find-else-match-regexp "\\"))) (cond ((string= kwop "then") (tuareg-find-then-else-match)) ((string= kwop ";") (tuareg-find-semicolon-match) (tuareg-find-else-match))))) (defconst tuareg-do-match-stop-regexp (tuareg-ro "downto")) (defun tuareg-find-do-match () (let ((kwop (tuareg-find-kwop tuareg-find-do-match-regexp tuareg-do-match-stop-regexp))) (if (or (string= kwop "to") (string= kwop "downto")) (tuareg-find-match) kwop))) (defconst tuareg-done-match-stop-regexp (tuareg-ro "and" "do")) (defun tuareg-find-done-match () (let ((kwop (tuareg-find-kwop (tuareg-give-find-kwop-regexp) tuareg-done-match-stop-regexp))) (cond ((string= kwop "and") (tuareg-find-and-match)) ((string= kwop "done") (tuareg-find-done-match) (tuareg-find-done-match)) ((string= kwop "do") (tuareg-find-do-match)) (t kwop)))) (defconst tuareg-and-stop-regexp-ls3 (tuareg-ro "and" "do" "where")) (defun tuareg-give-and-stop-regexp () (if (tuareg-editing-ls3) tuareg-and-stop-regexp-ls3 "\\")) (defun tuareg-find-and-match () (let* ((kwop (tuareg-find-kwop tuareg-find-and-match-regexp (tuareg-give-and-stop-regexp))) (old-point (point))) (cond ((or (string= kwop "type") (string= kwop "module")) (let ((kwop2 (tuareg-find-meaningful-word))) (cond ((string= kwop2 "with") kwop2) ((string= kwop2 "and") (tuareg-find-and-match)) ((and (string= kwop "module") (string= kwop2 "let")) kwop2) (t (goto-char old-point) kwop)))) (t kwop)))) (defconst tuareg-=-stop-regexp-ls3 (concat (tuareg-ro "and" "do" "in" "where") "\\|=")) (defconst tuareg-=-stop-regexp (concat (tuareg-ro "and" "in") "\\|=")) (defun tuareg-give-=-stop-regexp () (if (tuareg-editing-ls3) tuareg-=-stop-regexp-ls3 tuareg-=-stop-regexp)) (defun tuareg-find-=-match () (let ((kwop (tuareg-find-kwop tuareg-find-=-match-regexp (tuareg-give-=-stop-regexp)))) (cond ((string= kwop "and") (tuareg-find-and-match)) ((and (string= kwop "=") (not (tuareg-false-=-p))) (while (and (string= kwop "=") (not (tuareg-false-=-p))) (setq kwop (tuareg-find-=-match))) kwop) (t kwop)))) (defconst tuareg-if-when-regexp (tuareg-ro "if" "when")) (defun tuareg-if-when-= () (save-excursion (tuareg-find-=-match) (looking-at tuareg-if-when-regexp))) (defconst tuareg-captive-regexp (tuareg-ro "let" "if" "when" "module" "type" "class")) (defun tuareg-captive-= () (save-excursion (tuareg-find-=-match) (looking-at tuareg-captive-regexp))) (defconst tuareg-pipe-stop-regexp (concat (tuareg-ro "and" "with") "\\||")) (defconst tuareg-pipe-stop-regexp-ls3 (concat tuareg-pipe-stop-regexp tuareg-ls3-extras)) (defun tuareg-give-pipe-stop-regexp () (if (tuareg-editing-ls3) tuareg-pipe-stop-regexp-ls3 tuareg-pipe-stop-regexp)) (defun tuareg-find-pipe-match () (let ((kwop (let ((k (tuareg-find-kwop tuareg-find-pipe-match-regexp (tuareg-give-pipe-stop-regexp)))) (if (and k (string-match "|[^!]" k)) "|" k))) (old-point (point))) (cond ((string= kwop "and") (setq old-point (point)) (setq kwop (tuareg-find-and-match)) (if (not (string= kwop "do")) (goto-char old-point) (setq kwop (tuareg-find-arrow-match))) kwop) ((and (string= kwop "|") (looking-at "|[^|]") (tuareg-in-indentation-p)) kwop) ((string= kwop "|") (tuareg-find-pipe-match)) ((and (string= kwop "=") (or (looking-at (tuareg-no-code-after "=")) (tuareg-false-=-p) (not (string= (save-excursion (tuareg-find-=-match)) "type")))) (tuareg-find-pipe-match)) (t kwop)))) (defun tuareg-find-arrow-match () (let ((kwop (tuareg-find-kwop (tuareg-give-find-arrow-match-regexp) "\\"))) (cond ((string= kwop "|") (if (tuareg-in-indentation-p) kwop (progn (forward-char -1) (tuareg-find-arrow-match)))) ((string= kwop "fun") (let ((pos (point))) (or (tuareg-monadic-operator-p (tuareg-find-meaningful-word)) (progn (goto-char pos) kwop)))) ((not (string= kwop ":")) kwop) ;; If we get this far, we know we're looking at a colon. ((or (char-equal (char-before) ?:) (char-equal (char-after (1+ (point))) ?:) (char-equal (char-after (1+ (point))) ?>)) (tuareg-find-arrow-match)) ;; Patch by T. Freeman (t (let ((oldpoint (point)) (match (tuareg-find-arrow-match))) (if (looking-at ":") match (progn ;; Go back to where we were before the recursive call. (goto-char oldpoint) kwop))))))) (defconst tuareg-semicolon-match-stop-regexp (tuareg-ro "and" "do" "end" "in" "with")) (defconst tuareg-no-code-after-paren-regexp (tuareg-no-code-after "[[{(][|<]?")) (defun tuareg-semicolon-indent-kwop-point (&optional leading-semi-colon) ;; return (kwop kwop-point indentation) (let ((kwop (tuareg-find-kwop tuareg-find-semicolon-match-regexp tuareg-semicolon-match-stop-regexp)) (point (point))) ;; We don't need to find the keyword matching `and' since we know ;; it's `let'! (list (cond ((string= kwop ";") (forward-line 1) (while (or (tuareg-in-comment-p) (looking-at tuareg-no-code-this-line-regexp)) (forward-line 1)) (back-to-indentation) (current-column)) ((and leading-semi-colon (looking-at "\\((\\|\\[[<|]?\\|{\\|\\((\\|\\[[<|]?\\|{") (if (save-excursion (tuareg-find-arrow-match) (or (looking-at "\\\\||") (looking-at (tuareg-give-extra-unindent-regexp)))) (tuareg-paren-or-indentation-indent) (tuareg-find-semicolon-match))) ((string= kwop "end") (tuareg-find-match) (tuareg-find-semicolon-match)) ((string= kwop "in") (tuareg-find-in-match) (+ (current-column) tuareg-in-indent)) ((string= kwop "where") (tuareg-find-in-match) (+ (tuareg-paren-or-indentation-column) tuareg-in-indent)) ((string= kwop "let") (+ (current-column) tuareg-let-indent)) ((string= kwop "try") (forward-char 3) (skip-syntax-forward " ") (current-column)) (t (tuareg-paren-or-indentation-indent))) kwop point))) (defun tuareg-find-semicolon-match (&optional leading-semi-colon) (car (tuareg-semicolon-indent-kwop-point leading-semi-colon))) (defmacro tuareg-reset-and-kwop (kwop) `(when (and ,kwop (string= ,kwop "and")) (setq ,kwop (tuareg-find-and-match)))) (defconst tuareg-phrase-regexp-1 (tuareg-ro "module" "type")) (defconst tuareg-phrase-regexp-2 (tuareg-ro "and" "let" "module" "with")) (defconst tuareg-phrase-regexp-3 (tuareg-ro "and" "end" "every" "in" "with")) (defun tuareg-find-phrase-indentation (&optional phrase-break) (if (and (looking-at tuareg-phrase-regexp-1) (> (point) (point-min)) (save-excursion (tuareg-find-meaningful-word) (looking-at tuareg-phrase-regexp-2))) (progn (tuareg-find-meaningful-word) (+ (current-column) tuareg-default-indent)) (let ((looking-at-and (looking-at "\\")) (kwop (tuareg-find-kwop (if phrase-break tuareg-find-phrase-indentation-break-regexp tuareg-find-phrase-indentation-regexp) tuareg-phrase-regexp-3)) (tmpkwop nil) (curr nil)) (tuareg-reset-and-kwop kwop) (cond ((not kwop) (current-column)) ((string= kwop "every") (if (tuareg-editing-ls3) (progn (tuareg-find-done-match) (tuareg-find-phrase-indentation phrase-break) (current-column)) (tuareg-find-phrase-indentation phrase-break))) ((string= kwop "end") (if (not (save-excursion (setq tmpkwop (tuareg-find-match)) (setq curr (point)) (string= tmpkwop "object"))) (progn (tuareg-find-match) (tuareg-find-phrase-indentation phrase-break)) (tuareg-find-kwop tuareg-find-phrase-indentation-class-regexp) (current-column))) ((and (string= kwop "with") (not (save-excursion (setq tmpkwop (tuareg-find-with-match)) (setq curr (point)) (string= tmpkwop "module")))) (goto-char curr) (tuareg-find-phrase-indentation phrase-break)) ((and (string= kwop "in") (not (save-excursion (setq tmpkwop (tuareg-find-in-match)) (tuareg-reset-and-kwop tmpkwop) (setq curr (point)) (and (string= tmpkwop "let") (not (tuareg-looking-at-internal-let)))))) (goto-char curr) (tuareg-find-phrase-indentation phrase-break)) ((tuareg-at-phrase-break-p) (end-of-line) (tuareg-skip-blank-and-comments) (current-column)) ((string= kwop "let") (if (tuareg-looking-at-internal-let) (tuareg-find-phrase-indentation phrase-break) (current-column))) ((string= kwop "with") (current-column)) ((string= kwop "end") (current-column)) ((or (string= kwop "in") (string= kwop "where")) (tuareg-find-in-match) (current-column)) ((string= kwop "class") (tuareg-paren-or-indentation-column)) ((looking-at tuareg-inside-module-or-class-opening) (+ (tuareg-paren-or-indentation-column) (tuareg-assoc-indent kwop))) ((or (string= kwop "type") (string= kwop "module")) (if (or (tuareg-looking-at-false-type) (tuareg-looking-at-false-module)) (if looking-at-and (current-column) (if (string= "and" (tuareg-find-meaningful-word)) (progn (tuareg-find-and-match) (tuareg-find-phrase-indentation phrase-break)) (tuareg-find-phrase-indentation phrase-break))) (current-column))) ((looking-at "\\(\\.<\\|(\\|\\[[<|]?\\|{") (setq kwop "with") (goto-char with-point)))) (setq retval (cond ((string= kwop "with") nil) ((or (string= kwop "in") (string= kwop "do")) (tuareg-in-indentation-p)) ;; ((looking-at "[[{(]") (tuareg-search-forward-paren) nil) ;; ((looking-at "\\.<") ;; (if tuareg-support-metaocaml ;; (progn ;; (tuareg-search-forward-paren) nil) ;; (tuareg-back-to-paren-or-indentation))) (t (back-to-indentation) t))) (cond ;; ((looking-at "|[^|]") ;; (re-search-forward "|[^|][ \t]*") nil) ((or (string= kwop "in") (string= kwop "do")) (tuareg-find-in-match) (tuareg-back-to-paren-or-indentation) (if (looking-at "\\<\\(let\\|and\\)\\>") (forward-char tuareg-in-indent)) nil) (t retval))))) (defun tuareg-paren-or-indentation-column () (tuareg-back-to-paren-or-indentation) (current-column)) (defun tuareg-paren-or-indentation-indent () (+ (tuareg-paren-or-indentation-column) tuareg-default-indent)) (defun tuareg-search-forward-paren () (re-search-forward "\\(\\.<\\|(\\|\\[[<|]?\\|{ (preceding-char)))) (or (looking-at tuareg-internal-let-regexp) (looking-at tuareg-operator-regexp))))) (defconst tuareg-false-module-regexp (tuareg-ro "and" "let" "with")) (defun tuareg-looking-at-false-module () (save-excursion (tuareg-find-meaningful-word) (looking-at tuareg-false-module-regexp))) (defun tuareg-looking-at-false-sig-struct () (save-excursion (tuareg-find-module) (looking-at "\\\\|("))) (defconst tuareg-false-type-regexp (tuareg-ro "and" "class" "module" "with")) (defun tuareg-looking-at-false-type () (save-excursion (tuareg-find-meaningful-word) (looking-at tuareg-false-type-regexp))) (defun tuareg-looking-at-in-let () (save-excursion (string= (tuareg-find-meaningful-word) "in"))) (defun tuareg-find-module () (tuareg-find-kwop tuareg-find-module-regexp)) (defun tuareg-indent-from-previous-kwop () (let* ((start-pos (point)) (kwop (tuareg-find-argument-kwop-non-blank t)) (captive= (and (string= kwop "=") (tuareg-captive-=))) (kwop-pos (point))) (forward-char (length kwop)) (tuareg-skip-blank-and-comments) (cond ((or (not captive=) (/= (point) start-pos)) ; code between paren and kwop (goto-char start-pos) (tuareg-paren-or-indentation-indent)) (t (goto-char kwop-pos) (when (string= kwop "=") (setq kwop (tuareg-find-=-match))) (+ tuareg-default-indent (if (assoc kwop tuareg-leading-kwop-alist) (tuareg-compute-kwop-indent kwop) (current-column))))))) (defun tuareg-find-colon-typespec (start-pos) (let* ((old-pos (point)) (new-pos (search-forward ":" start-pos t))) (when new-pos (backward-char 1) (skip-syntax-backward " ") (skip-syntax-backward "w") (skip-syntax-backward " ") (let ((char (char-before))) (cond ((or (char-equal char ??) (char-equal char ?~)) (goto-char old-pos) nil) (t (goto-char new-pos) t)))))) (defun tuareg-indent-from-paren (leading-operator start-pos) (cond ((looking-at (tuareg-no-code-after "\\(\\(\\.<\\|(\\|\\[[<|]?\\|{") (tuareg-paren-or-indentation-indent)) ((looking-at "([ \t]*\\(\\w\\)") (goto-char (match-beginning 1)) (current-column)) (t (+ (tuareg-add-default-indent leading-operator) (current-column))))) (defun tuareg-skip-to-next-form (old-point) (while (and (not (looking-at tuareg-no-more-code-this-line-regexp)) (< (point) old-point)) ; do not go beyond old-point (forward-sexp 1)) (tuareg-skip-blank-and-comments) (tuareg-back-to-paren-or-indentation)) (defun tuareg-find-argument-kwop (leading-operator) (tuareg-find-kwop (if leading-operator tuareg-compute-argument-indent-regexp tuareg-compute-normal-indent-regexp) (tuareg-give-keyword-regexp))) (defun tuareg-find-argument-kwop-clean (leading-operator) (let (kwop) (while (or (progn (setq kwop (tuareg-find-argument-kwop leading-operator)) (tuareg-reset-and-kwop kwop) nil) (and (string= kwop "=") (tuareg-false-=-p)) (and (looking-at tuareg-no-code-this-line-regexp) (not (= (point) (point-min)))))) kwop)) (defun tuareg-find-argument-kwop-non-blank (leading-operator) (let ((kwop "") (point (1+ (point)))) (while (and (> point (point)) (string= "" kwop)) (setq point (point) kwop (tuareg-find-argument-kwop-clean leading-operator))) kwop)) (defun tuareg-compute-argument-indent (leading-operator) (let* ((old-point (line-beginning-position)) (kwop (tuareg-find-argument-kwop-non-blank leading-operator)) (match-end-point (+ (point) (length kwop)))) ; match-end is invalid! (cond ((and (string= kwop "->") (not (looking-at (tuareg-no-code-after "->")))) (let (matching-kwop matching-pos) (save-excursion (setq matching-kwop (tuareg-find-arrow-match)) (setq matching-pos (point))) (cond ((string= matching-kwop ":") (goto-char matching-pos) (tuareg-find-arrow-match) ; matching `val' or `let' (+ (current-column) tuareg-val-indent)) ((or (string= matching-kwop "val") (string= matching-kwop "let")) (+ (current-column) tuareg-val-indent)) ((string= matching-kwop "|") (goto-char matching-pos) (+ (tuareg-add-default-indent leading-operator) (current-column) (- tuareg-pipe-extra-unindent) tuareg-match-clause-indent tuareg-default-indent)) (t (+ (tuareg-paren-or-indentation-column) (tuareg-add-default-indent leading-operator)))))) ((string= kwop "fun") (+ (tuareg-paren-or-indentation-column) (tuareg-add-default-indent leading-operator) (tuareg-assoc-indent kwop))) ((<= old-point (point)) (+ (tuareg-add-default-indent leading-operator) (current-column))) (t (goto-char match-end-point) ; skip kwop == (forward-char (length kwop)) (tuareg-skip-to-next-form old-point) (+ (tuareg-add-default-indent (if (save-excursion (goto-char match-end-point) (looking-at tuareg-no-more-code-this-line-regexp)) (or leading-operator (string= kwop "{") (looking-at (tuareg-no-code-after "[[:upper:]].*\\."))) (not (looking-at tuareg-operator-regexp)))) (current-column)))))) (defun tuareg-compute-arrow-indent () (let (kwop pos) (save-excursion (setq kwop (tuareg-find-arrow-match) pos (point))) (cond ((string= kwop "|") (tuareg-find-arrow-match) (+ (current-column) tuareg-default-indent tuareg-match-clause-indent)) ((or (string= kwop "val") (string= kwop "let")) (goto-char pos) (+ (current-column) tuareg-val-indent)) ((string= kwop "type") (goto-char pos) (+ (current-column) tuareg-type-indent tuareg-default-indent)) ((string= kwop "(") (goto-char pos) (tuareg-indent-after-next-char)) ((or (string= kwop "{") (string= kwop ";")) (if (and (looking-at "->") (search-backward ":" pos t)) (tuareg-indent-after-next-char) (tuareg-back-to-paren-or-indentation) (current-column))) ((tuareg-monadic-operator-p kwop) ;; find the last ">>=" or ">>>" ;; (goto-char pos) ;; (let ((back (point))) ;; (while (tuareg-monadic-operator-p (tuareg-find-arrow-match)) ;; (setq back (point))) ;; (goto-char back)) ;; (if (not (re-search-backward ;; (concat "(\\|" (tuareg-give-keyword-regexp)) ;; (point-min) t)) ;; 0 ;; (goto-char (match-end 0)) ;; (tuareg-skip-blank-and-comments) ;; (tuareg-compute-indent)) ;; this is not perfect, in particular, inside match. ;; (see example in sample.ml) ;; the problem is that we cannot skip an expression backwards. ;; workaround: wrap code in parens (destructuring-bind (indent kwop _point) (tuareg-semicolon-indent-kwop-point) (- indent (if (string= kwop "in") tuareg-in-indent 0)))) (t (tuareg-paren-or-indentation-indent))))) (defun tuareg-compute-keyword-indent (kwop leading-operator start-pos) (cond ((string= kwop ";") (if (looking-at (tuareg-no-code-after ";")) (let* ((pos (point)) (indent (tuareg-find-semicolon-match))) (if (looking-at tuareg-phrase-regexp-1) (progn (goto-char start-pos) (if (search-backward ":" pos t) (tuareg-indent-after-next-char) indent)) indent)) (tuareg-paren-or-indentation-indent))) ((string= kwop ",") (if (looking-at (tuareg-no-code-after ",")) (let ((mkwop (tuareg-find-comma-match))) (cond ((or (string= mkwop "[") (string= mkwop "{") (string= mkwop "(")) (forward-char 1) (skip-syntax-forward " ") (current-column)) ((looking-at "[[{(]\\|\\.<") (tuareg-indent-from-paren t start-pos)) ((or (and (looking-at "[<|]") (char-equal ?\[ (preceding-char))) (and (looking-at "<") (char-equal ?\{ (preceding-char)))) (tuareg-backward-char) (tuareg-indent-from-paren t start-pos)) ((and (looking-at "\\") (string= mkwop "in")) (+ (current-column) tuareg-in-indent)) (t (+ (tuareg-paren-or-indentation-column) (tuareg-assoc-indent mkwop))))) (tuareg-paren-or-indentation-indent))) ((looking-at "\\\\|->") (if (looking-at (tuareg-no-code-after "\\(\\\\|->\\)")) (tuareg-indent-from-paren leading-operator start-pos) (+ tuareg-default-indent (tuareg-indent-from-paren leading-operator start-pos)))) ((or (string= kwop "let") (string= kwop "and")) (tuareg-back-to-paren-or-indentation) (+ (tuareg-paren-or-indentation-indent) (tuareg-assoc-indent kwop t))) ((string= kwop "with") (if (save-excursion (let ((tmpkwop (tuareg-find-with-match))) (or (string= tmpkwop "module") (string= tmpkwop "{")))) (tuareg-paren-or-indentation-indent) (+ (tuareg-paren-or-indentation-column) (* 2 tuareg-default-indent) ; assume a missing first "|" (tuareg-assoc-indent kwop t)))) ((string-match "\\<\\(fun\\|of\\)\\>" kwop) (+ (tuareg-paren-or-indentation-column) (tuareg-add-default-indent leading-operator) (tuareg-assoc-indent kwop t))) ((string-match (tuareg-give-extra-unindent-regexp) kwop) (+ (tuareg-paren-or-indentation-column) (tuareg-assoc-indent kwop t))) ((string= kwop "in") (when (looking-at (tuareg-no-code-after "\\")) (tuareg-find-in-match)) (+ (current-column) tuareg-in-indent)) ((string-match (tuareg-give-matching-kwop-regexp) kwop) (tuareg-find-leading-kwop-match kwop) (if (tuareg-in-indentation-p) (+ (current-column) (tuareg-assoc-indent kwop t)) (tuareg-back-to-paren-or-indentation) (+ (tuareg-paren-or-indentation-indent) (tuareg-assoc-indent kwop t)))) ((string= kwop "try") (forward-char 3) (if (looking-at tuareg-no-more-code-this-line-regexp) (+ (current-column) -3 tuareg-default-indent) (skip-syntax-forward " ") (+ (current-column) tuareg-default-indent))) (t (+ (if (tuareg-in-indentation-p) (current-column) (tuareg-paren-or-indentation-indent)) (tuareg-assoc-indent kwop t))))) (defconst tuareg-=-indent-regexp-1 (tuareg-ro "val" "let" "method" "module" "class" "when" "for" "if" "do")) (defun tuareg-compute-=-indent (start-pos) (let ((current-column-module-type nil) (kwop1 (tuareg-find-=-match)) (next-pos (point))) (+ (save-excursion (tuareg-reset-and-kwop kwop1) (cond ((string= kwop1 "type") (tuareg-find-meaningful-word) (cond ((looking-at "\\") (setq current-column-module-type (current-column)) tuareg-default-indent) ((looking-at "\\<\\(with\\|and\\)\\>") (tuareg-find-with-match) (setq current-column-module-type (current-column)) tuareg-default-indent) (t (goto-char start-pos) (beginning-of-line) ;; A first sum constructor without a preceding `|' ;; needs extra indentation to be aligned with the other ;; constructors. (+ (if (looking-at "[ \t]*[A-Z]") 2 0) tuareg-type-indent)))) ((looking-at tuareg-=-indent-regexp-1) (let ((matched-string (tuareg-match-string 0))) (setq current-column-module-type (current-column)) (tuareg-assoc-indent matched-string))) ((looking-at "\\") (tuareg-back-to-paren-or-indentation) (setq current-column-module-type (current-column)) (+ (tuareg-assoc-indent "object") tuareg-default-indent)) ((looking-at tuareg-no-code-after-paren-regexp) (setq current-column-module-type (tuareg-indent-from-paren nil next-pos)) tuareg-default-indent) (t (setq current-column-module-type (tuareg-paren-or-indentation-indent)) tuareg-default-indent))) (or current-column-module-type (current-column))))) (defun tuareg-indent-after-next-char () (forward-char 1) (tuareg-skip-blank-and-comments) (current-column)) (defun tuareg-compute-normal-indent () (let ((leading-operator (looking-at tuareg-operator-regexp))) (beginning-of-line) (save-excursion (let ((start-pos (point)) (kwop (tuareg-find-argument-kwop-clean leading-operator))) (cond ((not kwop) (current-column)) ((tuareg-at-phrase-break-p) (tuareg-find-phrase-indentation t)) ((and (string= kwop "|") (not (char-equal ?\[ (preceding-char)))) (tuareg-backward-char) (+ (tuareg-paren-or-indentation-indent) (tuareg-add-default-indent leading-operator))) ((or (looking-at "[[{(]") (and (looking-at "[<|]") (char-equal ?\[ (preceding-char)) (progn (tuareg-backward-char) t)) (and (looking-at "<") (char-equal ?\{ (preceding-char)) (progn (tuareg-backward-char) t))) (cond ((looking-at "{ *[A-Z]") (forward-char 1) (skip-syntax-forward " ") (current-column)) ((looking-at (tuareg-no-code-after "[[{(][<|]?")) (tuareg-indent-from-paren leading-operator start-pos)) ((and leading-operator (string= kwop "(")) (tuareg-indent-after-next-char)) (t (+ tuareg-default-indent (tuareg-indent-from-paren leading-operator start-pos))))) ((looking-at "\\.<") (if (looking-at (tuareg-no-code-after "\\.<")) (tuareg-indent-from-paren leading-operator start-pos) (+ tuareg-default-indent (tuareg-indent-from-paren leading-operator start-pos)))) ((looking-at "->") (tuareg-compute-arrow-indent)) ((looking-at (tuareg-give-keyword-regexp)) (tuareg-compute-keyword-indent kwop leading-operator start-pos)) ((and (string= kwop "=") (not (tuareg-false-=-p)) (or (null leading-operator) ;; defining "=", not testing for equality (string-match tuareg-definitions-regexp (save-excursion (tuareg-find-argument-kwop-clean t))))) (tuareg-compute-=-indent start-pos)) (nil 0) (t (tuareg-compute-argument-indent leading-operator))))))) (defun tuareg-compute-pipe-indent (matching-kwop old-point) (cond ((or (string= matching-kwop "|") (string= matching-kwop "[")) (tuareg-back-to-paren-or-indentation) (current-column)) ((and (string= matching-kwop "=") (not (tuareg-false-=-p))) (re-search-forward "=[ \t]*") (current-column)) ((and matching-kwop (looking-at (tuareg-give-match-pipe-kwop-regexp))) (when (looking-at (tuareg-give-extra-unindent-regexp)) (tuareg-back-to-paren-or-indentation)) (+ (tuareg-assoc-indent matching-kwop t) (tuareg-add-default-indent (not (looking-at "|"))) (current-column) (if (or (string= matching-kwop "type") (string= matching-kwop "[")) 0 tuareg-pipe-extra-unindent))) (t (goto-char old-point) (tuareg-compute-normal-indent)))) (defun tuareg-compute-paren-indent (paren-match-p old-point) (unless paren-match-p (tuareg-search-forward-paren)) (let ((looking-at-paren (char-equal ?\( (char-after))) (start-pos (point))) (when (or looking-at-paren (looking-at (tuareg-no-code-after "\\(\{\\(.*with[ \t]*\\([[:upper:]].*\\.\\)?\\)?\\|\\[\\)"))) (if (or (tuareg-in-indentation-p) (save-excursion (string= ":" (tuareg-find-meaningful-word)))) (tuareg-back-to-paren-or-indentation) (tuareg-indent-from-previous-kwop)) (when looking-at-paren (skip-chars-forward "( \t" start-pos)) (while (and (looking-at "[([{]") (> (scan-sexps (point) 1) (save-excursion (goto-char old-point) (line-end-position)))) (forward-char 1) (skip-syntax-forward " ")))) (current-column)) (defun tuareg-compute-kwop-indent-general (kwop matching-kwop) (let* ((looking-at-matching (looking-at matching-kwop)) (extra-unindent ; non-paren code before matching-kwop (unless (save-excursion (skip-chars-backward "( \t" (line-beginning-position)) (bolp)) (tuareg-back-to-paren-or-indentation) t))) (+ (current-column) (tuareg-add-default-indent (if extra-unindent (or (string= matching-kwop "struct") (string= matching-kwop "object") (string= matching-kwop "with") (string= kwop "end")) (or (not (string= kwop "then")) looking-at-matching)))))) (defun tuareg-compute-kwop-indent (kwop) (when (string= kwop "rec") (setq kwop "and")) (let* ((old-point (point)) (paren-match-p (looking-at "[|>]?[]})]\\|>\\.")) (real-pipe (looking-at "|\\([^|]\\|$\\)")) (matching-kwop (tuareg-find-leading-kwop-match kwop))) (cond ((string= kwop "|") (if real-pipe (tuareg-compute-pipe-indent matching-kwop old-point) (goto-char old-point) (tuareg-compute-normal-indent))) ((looking-at "[[{(][<|]?\\|\\.<") (tuareg-compute-paren-indent paren-match-p old-point)) ((string= kwop "with") (when (string= matching-kwop "type") (setq old-point (point) matching-kwop (tuareg-find-meaningful-word))) (while (string= matching-kwop "with") (tuareg-find-with-match) (setq matching-kwop (tuareg-find-leading-kwop-match kwop))) (cond ((or (string= matching-kwop "module") (string= matching-kwop "struct")) (tuareg-paren-or-indentation-indent)) ((or (string= matching-kwop "try") (string= matching-kwop "match")) (tuareg-compute-kwop-indent-general kwop matching-kwop)) (t (goto-char old-point) (tuareg-compute-kwop-indent-general kwop matching-kwop)))) ((and (tuareg-editing-ls3) (or (string= kwop "do") (string= kwop "done") (string= kwop "reset") (string= kwop "unless") (string= kwop "until"))) (tuareg-back-to-paren-or-indentation) (if (string= matching-kwop "->") (+ (current-column) tuareg-default-indent) (current-column))) ((or (and (string= kwop "and") (string= matching-kwop "reset")) (and (string= kwop "end") (tuareg-editing-ls3) (or (string= matching-kwop "match") (string= matching-kwop "automaton") (string= matching-kwop "present")))) (if (tuareg-in-indentation-p) (current-column) (tuareg-paren-or-indentation-column))) ((string= kwop "in") (+ (current-column) (tuareg-add-default-indent (string= matching-kwop "let")))) ((not (string= kwop "and")) ; pretty general case (tuareg-compute-kwop-indent-general kwop matching-kwop)) ((string= matching-kwop "with") (current-column)) (t (tuareg-paren-or-indentation-column))))) (defun tuareg-indent-to-code (beg-pos match) (unless (and (string= match "(") (search-forward "->" beg-pos t)) (forward-char (length match))) (tuareg-skip-blank-and-comments) (current-column)) (defun tuareg-indent-command (&optional from-leading-star) "Indent the current line in Tuareg mode. Compute new indentation based on OCaml syntax." (interactive "*") (unless from-leading-star (tuareg-auto-fill-insert-leading-star)) (let ((case-fold-search nil)) (tuareg-with-internal-syntax (save-excursion (back-to-indentation) (indent-line-to (max 0 (tuareg-compute-indent)))) (when (tuareg-in-indentation-p) (back-to-indentation))))) (defconst tuareg-sig-struct-regexp (tuareg-ro "sig" "struct")) (defconst tuareg-top-level-command-regexp (concat "#" (tuareg-ro "open" "load" "use"))) (defun tuareg-compute-indent () (save-excursion (cond ((tuareg-in-comment-p) (cond ((looking-at "(\\*") (if tuareg-indent-leading-comments (save-excursion (tuareg-skip-blank-and-comments) (back-to-indentation) (current-column)) (current-column))) ((looking-at "\\*\\**)") (tuareg-beginning-of-literal-or-comment-fast) (if (tuareg-leading-star-p) (+ (current-column) (if (save-excursion (forward-line 1) (back-to-indentation) (looking-at "*")) 1 tuareg-comment-end-extra-indent)) (+ (current-column) tuareg-comment-end-extra-indent))) (tuareg-indent-comments (let ((star (and (tuareg-leading-star-p) (looking-at "\\*")))) (tuareg-beginning-of-literal-or-comment-fast) (if star (re-search-forward "(") (re-search-forward "(\\*+[ \t]*")) (current-column))) (t (current-column)))) ((tuareg-in-literal-p) (current-column)) ((or (looking-at "\\") (looking-at "\\")) (if (tuareg-looking-at-internal-let) (if (tuareg-looking-at-in-let) (progn (tuareg-find-meaningful-word) (tuareg-find-in-match) (current-column)) (tuareg-compute-normal-indent)) (tuareg-find-phrase-indentation))) ((or (looking-at tuareg-governing-phrase-regexp) (looking-at ";;")) (tuareg-find-phrase-indentation)) ((and tuareg-sig-struct-align (looking-at tuareg-sig-struct-regexp)) (if (string= (tuareg-find-module) "module") (current-column) (tuareg-paren-or-indentation-indent))) ((looking-at ";") (tuareg-find-semicolon-match t)) ((looking-at "|!") (tuareg-indent-to-code (line-beginning-position) (tuareg-find-pipe-bang-match))) ((looking-at ">>[=>|]") (tuareg-indent-to-code (line-beginning-position) (tuareg-find-monadic-match))) ((or (looking-at "%\\|;;") (and tuareg-support-camllight (looking-at "#")) (looking-at tuareg-top-level-command-regexp)) 0) ((or (looking-at (tuareg-give-matching-kwop-regexp)) (looking-at "\\") (and tuareg-support-metaocaml (looking-at ">\\."))) (tuareg-compute-kwop-indent (tuareg-match-string 0))) (t (tuareg-compute-normal-indent))))) (defun tuareg-split-string () "Called whenever a line is broken inside an OCaml string literal." (insert-before-markers "\\ ") (tuareg-backward-char)) (defun tuareg-newline-and-indent () "Like `newline-and-indent' but handles OCaml's multi-line strings." (interactive) (let ((hooked (tuareg-in-literal-p)) (split-mark)) (when hooked (setq split-mark (set-marker (make-marker) (point))) (tuareg-split-string)) (newline-and-indent) (when hooked (goto-char (max (point) split-mark)) (set-marker split-mark nil)))) (defun tuareg-electric-pipe () "If inserting a | operator at beginning of line, reindent the line." (interactive "*") (let ((electric (and tuareg-electric-indent (not (and (boundp 'electric-indent-mode) electric-indent-mode)) (tuareg-in-indentation-p) (not (tuareg-in-literal-p)) (not (tuareg-in-comment-p))))) (self-insert-command 1) (and electric (not (and (char-equal ?| (preceding-char)) (save-excursion (tuareg-backward-char) (tuareg-find-pipe-match) (not (looking-at (tuareg-give-match-pipe-kwop-regexp)))))) (indent-according-to-mode)))) (defun tuareg-electric-rp () "If inserting a ) operator or a comment-end at beginning of line, reindent the line." (interactive "*") (let ((electric (and tuareg-electric-indent (not (and (boundp 'electric-indent-mode) electric-indent-mode)) (or (tuareg-in-indentation-p) (char-equal ?* (preceding-char))) (not (tuareg-in-literal-p)) (or (not (tuareg-in-comment-p)) (save-excursion (back-to-indentation) (looking-at "\\*")))))) (self-insert-command 1) (and electric (indent-according-to-mode)))) (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))))))) (defun tuareg-electric-rc () "If inserting a } operator at beginning of line, reindent the line. Reindent also if } is inserted after a > operator at beginning of line. Also, if the matching { is followed by a < and this } is not preceded by >, insert one >." (interactive "*") (let* ((prec (preceding-char)) (look-bra (and tuareg-electric-close-vector (not (boundp 'post-self-insert-hook)) (not (tuareg-in-literal-or-comment-p)) (not (char-equal ?> prec)))) (electric (and tuareg-electric-indent (not (and (boundp 'electric-indent-mode) electric-indent-mode)) (or (tuareg-in-indentation-p) (and (char-equal ?> prec) (save-excursion (tuareg-backward-char) (tuareg-in-indentation-p)))) (not (tuareg-in-literal-or-comment-p))))) (self-insert-command 1) (when look-bra (save-excursion (let ((inserted-char (save-excursion (tuareg-backward-char) (tuareg-backward-up-list) (cond ((looking-at "{<") ">") (t ""))))) (tuareg-backward-char) (insert inserted-char)))) (when electric (indent-according-to-mode)))) (defun tuareg-electric-rb () "If inserting a ] operator at beginning of line, reindent the line. Reindent also if ] is inserted after a | operator at beginning of line. Also, if the matching [ is followed by a | and this ] is not preceded by |, insert one |." (interactive "*") (let* ((prec (preceding-char)) (look-pipe-or-bra (and tuareg-electric-close-vector (not (boundp 'post-self-insert-hook)) (not (tuareg-in-literal-or-comment-p)) (not (and (char-equal ?| prec) (not (char-equal (save-excursion (tuareg-backward-char) (preceding-char)) ?\[)))))) (electric (and tuareg-electric-indent (not (and (boundp 'electric-indent-mode) electric-indent-mode)) (or (tuareg-in-indentation-p) (and (char-equal ?| prec) (save-excursion (tuareg-backward-char) (tuareg-in-indentation-p)))) (not (tuareg-in-literal-or-comment-p))))) (self-insert-command 1) (when look-pipe-or-bra (save-excursion (let ((inserted-char (save-excursion (tuareg-backward-char) (tuareg-backward-up-list) (cond ((looking-at "\\[|") "|") (t ""))))) (tuareg-backward-char) (insert inserted-char)))) (when electric (indent-according-to-mode)))) (defun tuareg-abbrev-hook () "If inserting a leading keyword at beginning of line, reindent the line." (unless (or (and (boundp 'electric-indent-mode) electric-indent-mode) (tuareg-in-literal-or-comment-p)) (let* ((bol (line-beginning-position)) (kw (save-excursion (and (re-search-backward "^[ \t]*\\(\\w\\|_\\)+\\=" bol t) (tuareg-match-string 1))))) (when kw (insert " ") (indent-according-to-mode) (backward-delete-char-untabify 1))))) (defun tuareg-skip-to-end-of-phrase () (let ((old-point (point))) (when (and (string= (tuareg-find-meaningful-word) ";") (char-equal (preceding-char) ?\;)) (setq old-point (1- (point)))) (goto-char old-point) (let ((kwop (tuareg-find-meaningful-word))) (goto-char (+ (point) (length kwop)))))) (defun tuareg-skip-blank-and-comments () (if tuareg-use-syntax-ppss (forward-comment (point-max)) (skip-syntax-forward " ") (while (and (not (eobp)) (tuareg-in-comment-p) (search-forward "*)" nil t)) (skip-syntax-forward " ")))) (defun tuareg-skip-back-blank-and-comments () (skip-syntax-backward " ") (while (save-excursion (tuareg-backward-char) (and (> (point) (point-min)) (tuareg-in-comment-p))) (tuareg-backward-char) (tuareg-beginning-of-literal-or-comment) (skip-syntax-backward " "))) (defun tuareg-find-phrase-beginning (&optional stop-at-and) "Find `real' phrase beginning and return point." (beginning-of-line) (tuareg-skip-blank-and-comments) (end-of-line) (tuareg-skip-to-end-of-phrase) (let ((old-point (point)) (pt (point))) (if stop-at-and (tuareg-find-kwop tuareg-find-phrase-beginning-and-regexp "and") (tuareg-find-kwop tuareg-find-phrase-beginning-regexp)) (while (and (> (point) (point-min)) (< (point) old-point) (or (not (looking-at tuareg-find-phrase-beginning-and-regexp)) (and (looking-at "\\") (tuareg-looking-at-internal-let)) (and (looking-at "\\") (save-excursion (tuareg-find-and-match) (tuareg-looking-at-internal-let))) (and (looking-at "\\") (tuareg-looking-at-false-module)) (and (looking-at tuareg-sig-struct-regexp) (tuareg-looking-at-false-sig-struct)) (and (looking-at "\\") (tuareg-looking-at-false-type)))) (when (= pt (point)) (error "tuareg-find-phrase-beginning: inf loop at %d" pt)) (setq pt (point)) (if (looking-at "\\") (tuareg-find-match) (unless (bolp) (tuareg-backward-char)) (setq old-point (point)) (if stop-at-and (tuareg-find-kwop tuareg-find-phrase-beginning-and-regexp "and") (tuareg-find-kwop tuareg-find-phrase-beginning-regexp)))) (when (tuareg-at-phrase-break-p) (end-of-line) (tuareg-skip-blank-and-comments)) (back-to-indentation) (point))) (defun tuareg-search-forward-end () (let ((begin (point)) (current -1) (found) (move t)) (while (and move (> (point) current)) (if (re-search-forward "\\" (point-max) t) (let ((stop (point)) (kwop)) (unless (tuareg-in-literal-or-comment-p) (save-excursion (tuareg-backward-char 3) (setq kwop (tuareg-find-match)) (cond ((string= kwop "object") (tuareg-find-phrase-beginning)) ((and (looking-at tuareg-sig-struct-regexp) (tuareg-looking-at-false-sig-struct)) (tuareg-find-phrase-beginning))) (cond ((or (> (point) begin) (and (string= kwop "sig") (looking-at "[ \t\n]*\\(\\[ \t\n]*\\\\|=\\)"))) (if (> (point) current) (progn (setq current (point)) (goto-char stop)) (setq found nil move nil))) (t (setq found t move nil)))))) (setq found nil move nil))) found)) (defun tuareg-inside-module-or-class-find-kwop () (let ((kwop (tuareg-find-kwop tuareg-inside-module-or-class-regexp "\\<\\(and\\|end\\)\\>"))) (tuareg-reset-and-kwop kwop) (when (string= kwop "with") (setq kwop nil)) (if (string= kwop "end") (progn (tuareg-find-match) (tuareg-find-kwop tuareg-inside-module-or-class-regexp) (tuareg-inside-module-or-class-find-kwop)) kwop))) (defun tuareg-inside-module-or-class-p () (let ((begin) (end) (and-end) (and-iter t) (kwop t)) (save-excursion (when (looking-at "\\") (tuareg-find-and-match)) (setq begin (point)) (unless (or (and (looking-at "\\") (save-excursion (re-search-forward "\\" (point-max) t) (tuareg-find-phrase-beginning) (> (point) begin))) (and (looking-at "\\") (save-excursion (re-search-forward tuareg-sig-struct-regexp (point-max) t) (tuareg-find-phrase-beginning) (> (point) begin)))) (unless (looking-at tuareg-inside-module-or-class-opening-full) (setq kwop (tuareg-inside-module-or-class-find-kwop))) (when kwop (setq begin (point)) (when (tuareg-search-forward-end) (tuareg-backward-char 3) (when (looking-at "\\") (tuareg-forward-char 3) (setq end (point)) (setq and-end (point)) (tuareg-skip-blank-and-comments) (while (and and-iter (looking-at "\\")) (setq and-end (point)) (when (tuareg-search-forward-end) (tuareg-backward-char 3) (when (looking-at "\\") (tuareg-forward-char 3) (setq and-end (point)) (tuareg-skip-blank-and-comments))) (when (<= (point) and-end) (setq and-iter nil))) (list begin end and-end)))))))) (defun tuareg-move-inside-module-or-class-opening () "Go to the beginning of the enclosing module or class. Notice that white-lines (or comments) located immediately before a module/class are considered enclosed in this module/class." (interactive) (let* ((old-point (point)) (kwop (tuareg-inside-module-or-class-find-kwop))) (unless kwop (goto-char old-point)) (tuareg-find-phrase-beginning))) (unless tuareg-use-smie (defun tuareg-discover-phrase (&optional quiet stop-at-and) (end-of-line) (let ((end (point)) (case-fold-search nil)) (tuareg-with-internal-syntax (tuareg-find-phrase-beginning stop-at-and) (when (> (point) end) (setq end (point))) (save-excursion (let ((begin (point)) (cpt 0) (lines-left 0) (stop) (inside-module-or-class (tuareg-inside-module-or-class-p)) (looking-block (looking-at tuareg-inside-module-or-class-opening-full))) (if (and looking-block inside-module-or-class) (progn (setq begin (nth 0 inside-module-or-class)) (setq end (nth 2 inside-module-or-class)) (goto-char end)) (if inside-module-or-class (progn (setq stop (save-excursion (goto-char (nth 1 inside-module-or-class)) (line-beginning-position))) (if (< stop end) (setq stop (point-max)))) (setq stop (point-max))) (save-restriction (goto-char end) (while (and (= lines-left 0) (or (not inside-module-or-class) (< (point) stop)) (<= (save-excursion (tuareg-find-phrase-beginning stop-at-and)) end)) (unless quiet (setq cpt (1+ cpt)) (when (= 8 cpt) (message "Looking for enclosing phrase..."))) (setq end (point)) (tuareg-skip-to-end-of-phrase) (narrow-to-region (line-beginning-position) (point-max)) (goto-char end) (setq lines-left (forward-line 1))))) (when (>= cpt 8) (message "Looking for enclosing phrase... done.")) (save-excursion (tuareg-skip-blank-and-comments) (setq end (point))) (tuareg-skip-back-blank-and-comments) (list begin (point) end))))))) (defun tuareg-mark-phrase () "Put mark at end of this OCaml phrase, point at beginning. The OCaml phrase is the phrase just before the point." (interactive) (let ((pair (tuareg-discover-phrase))) (goto-char (nth 1 pair)) (push-mark (nth 0 pair) t t))) (defun tuareg-next-phrase (&optional quiet stop-at-and) "Skip to the beginning of the next phrase." (interactive "i") (goto-char (save-excursion (nth 2 (tuareg-discover-phrase quiet stop-at-and)))) (cond ((looking-at "\\") (tuareg-next-phrase quiet stop-at-and)) ((looking-at ")") (forward-char 1) (tuareg-skip-blank-and-comments)) ((looking-at ";;") (forward-char 2) (tuareg-skip-blank-and-comments)))) (defun tuareg-previous-phrase () "Skip to the beginning of the previous phrase." (interactive) (beginning-of-line) (tuareg-skip-to-end-of-phrase) (tuareg-discover-phrase)) (defun tuareg-indent-phrase () "Depending of the context: justify and indent a comment, or indent all lines in the current phrase." (interactive) (save-excursion (back-to-indentation) (if (tuareg-in-comment-p) (let* ((cobpoint (save-excursion (tuareg-beginning-of-literal-or-comment) (point))) (begpoint (save-excursion (while (and (> (point) cobpoint) (tuareg-in-comment-p) (not (looking-at "^[ \t]*$"))) (forward-line -1)) (max cobpoint (point)))) (coepoint (save-excursion (while (and (tuareg-in-comment-p) (< (point) (point-max))) (re-search-forward "\\*)" nil 'end)) (point))) (endpoint (save-excursion (re-search-forward "^[ \t]*$" coepoint 'end) (line-beginning-position 2))) (leading-star (tuareg-leading-star-p))) (goto-char begpoint) (while (and leading-star (< (point) endpoint) (not (looking-at "^[ \t]*$"))) (forward-line 1) (back-to-indentation) (when (looking-at "\\*\\**\\([^)]\\|$\\)") (delete-char 1) (setq endpoint (1- endpoint)))) (goto-char (min (point) endpoint)) (fill-region begpoint endpoint) (re-search-forward "\\*)" nil 'end) (setq endpoint (point)) (when leading-star (goto-char begpoint) (forward-line 1) (if (< (point) endpoint) (tuareg-auto-fill-insert-leading-star t))) (indent-region begpoint endpoint nil)) (let ((pair (tuareg-discover-phrase))) (indent-region (nth 0 pair) (nth 1 pair) nil))))) (provide 'tuareg_indent) ;;; tuareg_indent.el ends here