Commits

Anonymous committed 25c59cb Merge

auto merge without conflicts

Comments (0)

Files changed (135)

 
 *.old.*
 
+.DS_Store
 *.annot
 *.cmi
 *.cmx
 \#*\#
 *.pyc
 *__pycache__
+.DS_Store
 
 bins.inferred-1step.deps
 *.build_info.c
+changes
+=======
+- defaulted tuareg-indent-comments to nil to avoid accidentally
+  clobbering carefully indented comments
+- omake server protocol version increment to support unset environment
+  variables, whose default values are determined by the project
+  OMakeroot rather than Jane Elisp
+- removed post-Santy TOT hacks.  You can switch your
+  ~/.omake-server/config back from "omake_command_tot_after_sandy"
+  back to omake_command.
+
 bug fixes
 =========
 - highlighting of long lines in Emacs 24
-- ocaml-indenter: customize-variable choice menu
+- ocaml-indenter: customize-variable choice menu (easier to customize)
+- friend commander password prompts
 
 ================================================================================
 2012-12-03 Rolled rev 79467e4aacd1 to prod

Makefile

-OCAMLOPTFLAGS += -g
-
-default : ocaml
-
-ocaml :
-	cd ocaml && $(MAKE)
-
-clean :
-	cd ocaml && $(MAKE) clean
-	cd elisp && $(MAKE) clean
-
-.PHONY : ocaml elisp
-Subdirs()
+Subdirs ()

doc/Makefile

-
-files=omake-mode jane-emacs
-texi=$(addsuffix .texi, $(files))
-info=$(addsuffix .info, $(files))
-
-default: $(info) #commit
-
-# omake-server.info: omake-server.texi
-# 	makeinfo $<
-# 	if [ -n "$$(hg st -m $@)" ]; then hg com -m 'rebuilt $@' $@; fi
-
-%.info : %.texi
-	makeinfo $<
-
-commit:
-	if [ -n "$$(hg st -m $(info))" ]; then hg com -m 'rebuilt info docs' $(info); fi
-
-clean :
-	-rm *.info
+
 jane-emacs.info: jane-emacs.texi
 	makeinfo $<
 
 	makeinfo $<
 
 .DEFAULT: jane-emacs.info omake-mode.info
+
+.PHONY: clean
+clean:
+	rm -f *.info

doc/jane-emacs.info

 (Jane.perl)
 
    You can see the code for these functions by putting the cursor on
-one of the functions and doing `M-x find-function-at-point'.
+one of the functions and doing `M-x find-function-at-point RET'.  You
+can see the code for all the latest micro-features available to you via
+`M-x find-library RET jane-micro-features RET'.
 
    * `Jane.advanced'   Re-enable features that are turned off by
-     default because they confuse casual users.  (e.g. recursive
+     default because they confuse casual users (e.g., recursive
      minibuffers.)
 
    * `Jane.auto-modes'   Open files in the most natural major mode.
      neighbors.)
 
    * `Jane.buffer-menu'   Improve the buffer-menu (the buffer that
-     shows all the current buffers).
+     shows all the current buffers.)
 
    * `Jane.comint'   Improve shell interaction.
 
 
    * `Jane.edit-with-emacs'   Use Emacs to edit Chrome text boxes.
 
+   * `Jane.evil'   VIM emulation.
+
    * `Jane.faces-{default,basic,dark,light,subtle}'   Faces.
 
-   * `Jane.find'   Fancy find-file support (due to sweeks)
+   * `Jane.find'   Fancy find-file support (due to sweeks.)
 
    * `Jane.flyspell'   Incremental spell checking.
 
    * `Jane.frame'   Frames.
 
-   * `Jane.frame'   Frames.
-
    * `Jane.global-keybindings'   Bindings some users find useful.
 
-   * `Jane.grep'   Use grep from Emacs
+   * `Jane.grep'   Use grep from Emacs.
 
    * `Jane.hg-blame-summary'   Quickly show the last user who edited a
      line.
 
-   * `Jane.ido'   Settings for ido (nice buffer switching)
+   * `Jane.ido'   Settings for ido (nice buffer switching).
 
    * `Jane.iswitchb'   Settings for iswitchb (another nice buffer
-     switching package)
+     switching package.)
 
    * `Jane.linum'   Show line numbers in the left margin.
 
 
    * `Jane.pages'   Use visible page delimiters.
 
-   * `Jane.perl'   Perl-mode.
+   * `Jane.perl'   Perl Mode.
 
    * `Jane.prefer-other-visible-frame'   More frame hacking.
 
+   * `Jane.rainbow-delimiters'   Different colors for parens nested at
+     different levels.
+
    * `Jane.recentf'   Remember recently opened files.
 
    * `Jane.rectangle'   Buffer rectangle customizations.
    * `Jane.selective-display'   Activate selective display based on the
      column at point.
 
-   * `Jane.server'   Use the emacs server (with emacsclient)
+   * `Jane.server'   Use the emacs server (with emacsclient.)
 
    * `Jane.text'   Improved text modes.
 
 
    * Jump to the definition of a value.
 
-     `M-x ocamlspot-query', `C-c;'
+     `M-x ocamlspot-query', `C-c ;'
 
    * Show the type of an expression.
 
-     `M-x ocamlspot-type', `C-ct'
+     `M-x ocamlspot-type', `C-c t'
 
 
 
 Tag Table:
 Node: Top180
 Node: Micro-features459
-Node: Ocamlspotter4517
+Node: Ocamlspotter4751
 
 End Tag Table

doc/jane-emacs.texi

 @settitle Jane Street Emacs customizations
 
 @set VERSION 3.0
-@set EMACSVER 23.3
-@set DATE April 2012
+@set EMACSVER 23.2.1
+@set DATE December 2012
 
 @dircategory Jane Street
 @direntry
 @title Jane Street Emacs
 @subtitle For Emacs Version @value{EMACSVER}
 @subtitle Revision @value{VERSION}, @value{DATE}
-@author Sean McLaughlin and Stephen Weeks
+@author Sean McLaughlin, Stephen Weeks, and Peter Szilagyi
 @page
 @vskip 0pt plus 1filll
 @end titlepage
 @end verbatim
 
 You can see the code for these functions by putting the cursor on
-one of the functions and doing @kbd{M-x find-function-at-point}.
+one of the functions and doing @kbd{M-x find-function-at-point RET}.
+You can see the code for all the latest micro-features available to
+you via @kbd{M-x find-library RET jane-micro-features RET}.
 
 @itemize
 @item @kbd{Jane.advanced}
   Re-enable features that are turned off by default because they
-confuse casual users.  (e.g. recursive minibuffers.)
+confuse casual users (e.g., recursive minibuffers.)
 @item @kbd{Jane.auto-modes}
   Open files in the most natural major mode.
 @item @kbd{Jane.auto-revert}
 @item @kbd{Jane.bell}
   How to alert in case of an error (and not annoy your neighbors.)
 @item @kbd{Jane.buffer-menu}
-  Improve the buffer-menu (the buffer that shows all the current buffers).
+  Improve the buffer-menu (the buffer that shows all the current buffers.)
 @item @kbd{Jane.comint}
   Improve shell interaction.
 @item @kbd{Jane.compilation}
   Diff tool.
 @item @kbd{Jane.edit-with-emacs}
   Use Emacs to edit Chrome text boxes.
+@item @kbd{Jane.evil}
+  VIM emulation.
 @item @kbd{Jane.faces-@{default,basic,dark,light,subtle@}}
   Faces.
 @item @kbd{Jane.find}
-  Fancy find-file support (due to sweeks)
+  Fancy find-file support (due to sweeks.)
 @item @kbd{Jane.flyspell}
   Incremental spell checking.
 @item @kbd{Jane.frame}
   Frames.
-@item @kbd{Jane.frame}
-  Frames.
 @item @kbd{Jane.global-keybindings}
   Bindings some users find useful.
 @item @kbd{Jane.grep}
-  Use grep from Emacs
+  Use grep from Emacs.
 @item @kbd{Jane.hg-blame-summary}
   Quickly show the last user who edited a line.
 @item @kbd{Jane.ido}
-  Settings for ido (nice buffer switching)
+  Settings for ido (nice buffer switching).
 @item @kbd{Jane.iswitchb}
-  Settings for iswitchb (another nice buffer switching package)
+  Settings for iswitchb (another nice buffer switching package.)
 @item @kbd{Jane.linum}
   Show line numbers in the left margin.
 @item @kbd{Jane.midnight}
 @item @kbd{Jane.pages}
   Use visible page delimiters.
 @item @kbd{Jane.perl}
-  Perl-mode.
+  Perl Mode.
 @item @kbd{Jane.prefer-other-visible-frame}
   More frame hacking.
+@item @kbd{Jane.rainbow-delimiters}
+  Different colors for parens nested at different levels.
 @item @kbd{Jane.recentf}
   Remember recently opened files.
 @item @kbd{Jane.rectangle}
 @item @kbd{Jane.selective-display}
   Activate selective display based on the column at point.
 @item @kbd{Jane.server}
-  Use the emacs server (with emacsclient)
+  Use the emacs server (with emacsclient.)
 @item @kbd{Jane.text}
   Improved text modes.
 @item @kbd{Jane.time}
 @itemize
 @item Jump to the definition of a value.
 
-      @kbd{M-x ocamlspot-query}, @kbd{C-c;}
+      @kbd{M-x ocamlspot-query}, @kbd{C-c ;}
 @item Show the type of an expression.
 
-      @kbd{M-x ocamlspot-type}, @kbd{C-ct}
+      @kbd{M-x ocamlspot-type}, @kbd{C-c t}
 @end itemize
 
 @bye

doc/omake-mode.info

Binary file modified.

elisp/jane/jane-micro-features.el

 
 ;; (Jane.comint)
 (defun Jane.comint ()
+  (require 'comint)
   (ansi-color-for-comint-mode-on)
   (set-custom-defaults
 
-   ;; This produces a lot of false positives.  The default is probably
-   ;; better than when this was originally set, but we may have to
-   ;; rediscover some knowledge.
-   ;;
-   ;;'(comint-password-prompt-regexp "password\\|passphrase\\|Encryption")
+   `(comint-password-prompt-regexp
+
+     ;; We had tried the following ca. 2012, but it produced a lot of
+     ;; false positives.  We had to rediscover some knowledge below,
+     ;; retaining the (mostly general Unix) knowledge encapsulated in
+     ;; the Emacs default (which covers SSH, Kerberos, Samba, etc.).
+     ;;
+     ;;'(comint-password-prompt-regexp "password\\|passphrase\\|Encryption")
+     ,(concat "\\(" comint-password-prompt-regexp
+              "\\|^Enter the \\w+ password: " ; friend commander
+              "\\)"))
 
    '(comint-buffer-maximum-size 10000)
    '(comint-move-point-for-output t)

elisp/jane/jane-ocaml.el

  '(tuareg-with-indent 0)
  '(tuareg-type-indent 0)
  '(tuareg-leading-star-in-doc t)
- '(tuareg-display-buffer-on-eval nil))
+ '(tuareg-display-buffer-on-eval nil)
+ '(tuareg-indent-comments nil) ; don't accidentally clobber carefully indented comments
+ )
 
 ;; CR pszilagyi: This variable is not used anymore and confuses me.
 ;; Remove after Hurricane Sandy recovery.

elisp/omake/omake-custom.el

 ;;============================================================================;;
 
 (defcustom Omake.Server.program
-  (expand-file-name "../../ocaml/omake/omake_server.exe"
+  (expand-file-name "../../ocaml/omake/exe/omake_server.exe"
                     (file-name-directory load-file-name))
   "location of the executable program to find the next error"
   :group 'omake

elisp/omake/omake-env.el

 (defun Omake.Env.value-p (v)
   (assert (symbolp v))
   (case v
-    ((true false) t)
+    ((true false nil) t)
     (t nil)))
 
 (defstruct
     (intern (completing-read "Var: " vars nil t))))
 
 (defun Omake.Env.completing-read-value ()
-  (let ((vals '("true" "false")))
+  (let ((vals '("true" "false" "nil")))
     (intern (completing-read "Value: " vals nil t))))
 ;; (Omake.Env.completing-read-value)
 
 
 (defun Omake.Env.not (env)
   (case env
-   ('true 'false)
-   ('false 'true)
-   (t (error "Omake.Env.not error: %s" env))))
+    ((true) 'false)
+    ((false nil) 'true)
+    (t (error "Omake.Env.not error: %s" env))))
 ;; (Omake.Env.not "true")
 
 (defun Omake.Env.var-to-string (var val new-val)
+  (unless val (setq val '<default>))
+  (unless new-val (setq new-val '<default>))
   (let ((val (if (equal val new-val) val
                (format "%s (on next compilation: %s)" val new-val))))
     (Omake.Model.verbose-line var val)))

elisp/omake/omake-server.el

      "client" "set-project-env" id key data)))
 ;; (Omake.Server.setenv (Omake.Id.of-path "~/ocaml/lib") 'X_LIBRARY_INLINING 'true)
 ;; (Omake.Server.setenv (Omake.Id.of-path "~/ocaml/lib") 'X_LIBRARY_INLINING 'false)
+;; (Omake.Server.setenv (Omake.Id.of-path "~/local/jane-elisp") 'X_LIBRARY_INLINING 'true)
+;; (Omake.Server.setenv (Omake.Id.of-path "~/local/jane-elisp") 'X_LIBRARY_INLINING 'false)
+;; (Omake.Server.setenv (Omake.Id.of-path "~/local/jane-elisp") 'X_LIBRARY_INLINING nil)
 
 (defun Omake.Server.getenv (id key)
   (assert (Omake.Id.is id))

elisp/omake/omake-version.el

 
 ;; Detect version changes
 
-(defconst Omake.pre-version 16
+(defconst Omake.pre-version 17
   "We use a version number to synchronize the elisp code the omake server
 To roll a new version of elisp that is incompatible with ocaml or vice
 versa, you must bump the version number.  This prevents old elisp code

obsolete/js/js-common.el

 (if (yes-or-no-p "Update ~/.emacs? ")
     (progn (find-file (expand-file-name "~/.emacs"))
            (goto-char (point-min))      ; point may be saved
+           ;; Do the path and library name separately, in case people
+           ;; have split their load into an (add-to-list 'load-path
+           ;; ...) and (require ...).  That happens, for example, when
+           ;; people replace jane-defaults with a copy in their
+           ;; ~/.emacs, in order to comment some features out.
+           ;;
+           ;; While we're at it, handle both "test" and "prod" and
+           ;; both jane-defaults and jane-common.
            (query-replace-regexp
-            "/mnt/global/\\(base\\|dev\\)/lib/elisp/js/js-common"
-            "/j/office/app/emacs/prod/jane-elisp/elisp/jane/jane-common")))
+            "/mnt/global/\\(base\\|dev\\)/lib/elisp/js"
+            "/j/office/app/emacs/prod/jane-elisp/elisp/jane")
+           (goto-char (point-min))
+           (query-replace-regexp
+            "/mnt/global/\\(base\\|dev\\)/lib/elisp/jane-test"
+            "/j/office/app/emacs/dev/jane-elisp/elisp/jane")
+           (goto-char (point-min))
+           (query-replace-regexp "js-defaults" "jane-defaults")
+           (goto-char (point-min))
+           (query-replace-regexp "js-common" "jane-common")
+           ))

obsolete/js/js-defaults.el

 (if (yes-or-no-p "Update ~/.emacs? ")
     (progn (find-file (expand-file-name "~/.emacs"))
            (goto-char (point-min))      ; point may be saved
+           ;; Do the path and library name separately, in case people
+           ;; have split their load into an (add-to-list 'load-path
+           ;; ...) and (require ...).  That happens, for example, when
+           ;; people replace jane-defaults with a copy in their
+           ;; ~/.emacs, in order to comment some features out.
+           ;;
+           ;; While we're at it, handle both "test" and "prod" and
+           ;; both jane-defaults and jane-common.
            (query-replace-regexp
-            "/mnt/global/\\(base\\|dev\\)/lib/elisp/js/js-defaults"
-            "/j/office/app/emacs/prod/jane-elisp/elisp/jane/jane-defaults")))
+            "/mnt/global/\\(base\\|dev\\)/lib/elisp/js"
+            "/j/office/app/emacs/prod/jane-elisp/elisp/jane")
+           (goto-char (point-min))
+           (query-replace-regexp
+            "/mnt/global/\\(base\\|dev\\)/lib/elisp/jane-test"
+            "/j/office/app/emacs/dev/jane-elisp/elisp/jane")
+           (goto-char (point-min))
+           (query-replace-regexp "js-defaults" "jane-defaults")
+           (goto-char (point-min))
+           (query-replace-regexp "js-common" "jane-common")
+           ))

ocaml/Makefile

-
-default : contrib omake
-
-contrib :
-	cd contrib && $(MAKE)
-
-omake :
-	cd omake && $(MAKE)
-
-clean :
-	cd contrib && $(MAKE) clean
-	cd omake && $(MAKE) clean
-
-.PHONY : contrib omake

ocaml/contrib/Makefile

-default :
-	cd ocaml_inotify && $(MAKE)
-
-clean :
-	cd ocaml_inotify && $(MAKE) clean

ocaml/contrib/ocaml_inotify/Makefile

-OCAMLC = ocamlc
-OCAMLOPT = ocamlopt
-
-OS=$(shell uname)
-
-ifeq ($(OS), Darwin)
-  CC_OPTS=-bundle -flat_namespace -undefined suppress
-else
-  CC_OPTS=-shared
-endif
-
-# inotify.cmxa: inotify_stubs.o inotify.cmx inotify.cmo
-#	ocamlmklib -o inotify inotify_stubs.o inotify.cmx inotify.cmo
-#	ocamlopt -pack -o ocaml_inotify.cmxa unix.cmxa inotify_stubs.o inotify.cmx
-
-# inotify.cma: inotify_stubs.o inotify.cmo
-#	ocamlc -pack -o $@ inotify.cmo inotify_stubs.o
-#	ocamlc -pack -o $@ inotify.cmo inotify_stubs.o
-#	ar rc libinotify.a inotify_stubs.o
-
-# inotify.cma: inotify_stubs.o inotify.cmi inotify.cmx inotify.cmo
-# 	ocamlmklib -v -o inotify unix.cma inotify_stubs.o inotify.cmx inotify.cmo
-
-# inotify.cmxa: inotify_stubs.o inotify.cmi inotify.cmo inotify.cmx
-# 	gcc -bundle -flat_namespace -undefined suppress -o dllinotify.so inotify_stubs.o
-# 	ar cq libinotify.a inotify_stubs.o
-# 	ranlib libinotify.a
-# 	ocamlc -a -o inotify.cma unix.cma inotify.cmo -dllib -linotify -cclib -linotify
-# 	ocamlopt -a -o inotify.cmxa inotify.cmx -cclib -linotify
-
-OCAMLFLAGS = -for-pack Ocaml_inotify
-
-all: ocaml_inotify.cmxa inotify_test
-
-ocaml_inotify.cmxa: inotify_stubs.o inotify.cmi inotify.cmo inotify.cmx
-	gcc $(CC_OPTS) -o dllocaml_inotify_stubs.so inotify_stubs.o
-	ar cq libocaml_inotify_stubs.a inotify_stubs.o
-	ranlib libocaml_inotify_stubs.a
-	ocamlopt -pack -o ocaml_inotify.cmx inotify.cmx
-	ocamlopt -a -o ocaml_inotify.cmxa ocaml_inotify.cmx -cclib -locaml_inotify_stubs
-	ocamlc -pack -o ocaml_inotify.cmo inotify.cmo
-	ocamlc -a -o ocaml_inotify.cma unix.cma ocaml_inotify.cmo -dllib -locaml_inotify_stubs -cclib -locaml_inotify_stubs
-
-%.cmo: %.ml
-	$(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
-
-%.cmi: %.mli
-	$(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
-
-%.cmx: %.ml
-	$(OCAMLOPT) $(OCAMLFLAGS) -c -o $@ $<
-
-%.o: %.c
-	$(OCAMLC) -c -o $@ $<
-
-OCAMLFIND_INSTALL_FLAGS ?= -destdir $(OCAMLDESTDIR) -ldconf ignore
-OCAMLLIBDIR := $(shell ocamlc -where)
-OCAMLDESTDIR ?= $(OCAMLLIBDIR)
-PKG_NAME = ocaml_inotify
-
-.PHONY: install
-
-install: $(LIBS)
-	ocamlfind install $(OCAMLFIND_INSTALL_FLAGS) $(PKG_NAME) META ocaml_inotify.cmi inotify.mli ocaml_inotify.cma ocaml_inotify.cmxa *.a *.so *.cmx
-
-install-byte:
-	ocamlfind install $(OCAMLFIND_INSTALL_FLAGS) $(PKG_NAME) META ocaml_inotify.cmi inotify.mli ocaml_inotify.cma *.a *.so
-
-install-opt:
-	ocamlfind install $(OCAMLFIND_INSTALL_FLAGS) $(PKG_NAME) META ocaml_inotify.cmi inotify.mli ocaml_inotify.cma ocaml_inotify.cmxa *.a *.so *.cmx
-
-uninstall:
-	ocamlfind remove $(OCAMLFIND_INSTALL_FLAGS) $(PKG_NAME)
-
-ocaml_inotify_test: ocaml_inotify.cmxa ocaml_inotify_test.ml
-	$(OCAMLOPT) -I . -o $@ unix.cmxa $+
-
-clean:
-	-rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa $(LIBS) $(PROGRAMS)

ocaml/contrib/ocp-indent/src/approx_lexer.mll

 
 let newline = ('\010' | '\013' | "\013\010")
 let blank = [' ' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
+let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_' '\'']
+let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222' '`']
 let identchar =
   ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
 let symbolchar =
     ('.' ['0'-'9' '_']* )?
     (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)?
 
+
     rule token = parse
       | newline
           { update_loc lexbuf None 1 false 0;
             lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 };
             STAR
           }
+      | "<:" identchar * "<" ([^'>'] | '>' [^'>']) * ">>"
+          { QUOTATION(Lexing.lexeme lexbuf) }
       | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
           ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")?
           [^ '\010' '\013'] * newline
           { INFIXOP4(Lexing.lexeme lexbuf) }
       | ['*' '/' '%'] symbolchar *
           { INFIXOP3(Lexing.lexeme lexbuf) }
+
       | eof { EOF }
       | _
           { ILLEGAL_CHAR (Lexing.lexeme_char lexbuf 0)      }

ocaml/contrib/ocp-indent/src/approx_tokens.ml

 
 (* ADMIN: fabrice *)
 
-module type Sig = sig
+module Struct = struct
 
   type token =
   | AMPERAMPER
   | PRIVATE
   | QUESTION
   | QUESTIONQUESTION
+  | QUOTATION of (string)
   | QUOTE
   | RBRACE
   | RBRACKET
 
 end
 
-
-module Struct : Sig = struct
-
-  type token =
-  | AMPERAMPER
-  | AMPERSAND
-  | AND
-  | AS
-  | ASSERT
-  | BACKQUOTE
-  | BANG
-  | BAR
-  | BARBAR
-  | BARRBRACKET
-  | BEGIN
-  | CHAR of (char Approx_common.overflow)
-  | CLASS
-  | COLON
-  | COLONCOLON
-  | COLONEQUAL
-  | COLONGREATER
-  | COMMA
-  | COMMENT of (int * int)
-  | CONSTRAINT
-  | DO
-  | DONE
-  | DOT
-  | DOTDOT
-  | DOWNTO
-  | ELSE
-  | END
-  | EOF
-  | EOF_IN_COMMENT of (int)
-  | EOF_IN_STRING of (int)
-  | EQUAL
-  | EXCEPTION
-  | EXTERNAL
-  | FALSE
-  | FLOAT of (string)
-  | FOR
-  | FUN
-  | FUNCTION
-  | FUNCTOR
-  | GREATER
-  | GREATERRBRACE
-  | GREATERRBRACKET
-  | IF
-  | ILLEGAL_CHAR of (char)
-  | IN
-  | INCLUDE
-  | INFIXOP0 of (string)
-  | INFIXOP1 of (string)
-  | INFIXOP2 of (string)
-  | INFIXOP3 of (string)
-  | INFIXOP4 of (string)
-  | INHERIT
-  | INITIALIZER
-  | INT of (int Approx_common.overflow)
-  | INT32 of (int32 Approx_common.overflow)
-  | INT64 of (int64 Approx_common.overflow)
-  | LABEL of (string)
-  | LAZY
-  | LBRACE
-  | LBRACELESS
-  | LBRACKET
-  | LBRACKETBAR
-  | LBRACKETLESS
-  | LBRACKETGREATER
-  | LESS
-  | LESSMINUS
-  | LET
-  | LIDENT of (string)
-  | LPAREN
-  | MATCH
-  | METHOD
-  | MINUS
-  | MINUSDOT
-  | MINUSGREATER
-  | MODULE
-  | MUTABLE
-  | NATIVEINT of (nativeint Approx_common.overflow)
-  | NEW
-  | OBJECT
-  | OF
-  | OPEN
-  | OPTLABEL of (string)
-  | OR
-  | PLUS
-  | PLUSDOT
-  | PREFIXOP of (string)
-  | PRIVATE
-  | QUESTION
-  | QUESTIONQUESTION
-  | QUOTE
-  | RBRACE
-  | RBRACKET
-  | REC
-  | RPAREN
-  | SEMI
-  | SEMISEMI
-  | SHARP
-  | SIG
-  | STAR
-  | STRING of (string)
-  | STRUCT
-  | THEN
-  | TILDE
-  | TO
-  | TRUE
-  | TRY
-  | TYPE
-  | UIDENT of (string)
-  | UNDERSCORE
-  | VAL
-  | VIRTUAL
-  | WHEN
-  | WHILE
-  | WITH
-
-end
-
+module type Sig = module type of Struct
 
 module StringOfToken(S : Sig) = struct
 
     | PRIVATE -> "PRIVATE"
     | QUESTION -> "QUESTION"
     | QUESTIONQUESTION -> "QUESTIONQUESTION"
+    | QUOTATION(string) -> Printf.sprintf "QUOTATION(%s)" string
     | QUOTE -> "QUOTE"
     | RBRACE -> "RBRACE"
     | RBRACKET -> "RBRACKET"

ocaml/contrib/ocp-indent/src/block.ml

 open Nstream
 open Approx_lexer
 
+let compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c = fun f g x -> f (g (x))
+let ( @* ) = compose
+
 let debug = ref false
 
 let log fmt =
-  Printf.kprintf (fun str ->
-    if !debug then
-      Printf.printf "%s\n%!" str
-  ) fmt
+  if !debug then
+    Printf.eprintf (fmt ^^ "\n%!")
+  else
+    Printf.ifprintf stderr fmt
+
+module Config = struct
+  let getconf name default = try int_of_string (Sys.getenv name) with
+    | Not_found | Failure "int_of_string" -> default
+
+  (* let default_indent = 2 *)
+  (* let pipe_extra_unindent = 2 *)
+  let with_indent = getconf "with_indent" 0
+  let let_indent = getconf "let_indent" 2
+  (* let function_indent = 0 *)
+  (* let in_indent = 0 *)
+  let match_clause_indent = getconf "match_clause_indent" 4
+  let type_indent = getconf "type_indent" 2
+  let align_list_contents_with_first_element = getconf "align_first" 1 <> 0
+end
 
 module Node = struct
 
   (* Node kind *)
   type kind =
-    | KExpr
-    | KPattern
     | KParen
     | KBrace
     | KBracket
     | KBracketBar
-    | KField
     | KLet
     | KAnd of kind
     | KLetIn
     | KIn
+
+    | KExpr of int
+    (* actually handles also patterns / types / ... *)
+    (* Parameter:Priority - next expression is deindented if the op has
+       lower priority *)
+
     | KBody of kind
     | KArrow of kind
     | KEq
     | KWhen
     | KExternal
 
+  (* Priority of open expression constructs (see below for operators) *)
+  let prio = function
+    | KIn | KArrow _ -> 0
+    | KThen | KElse -> 10
+    | KExpr i -> i
+    | _ -> -10
+
+  let prio_max = 200
+  let prio_apply = 140
+  let expr_atom = KExpr prio_max
+  let expr_apply = KExpr 140
+
   let rec follow = function
     | KAnd k
     | KBody k
     | KBar k
-    | KWith k
+    | KWith k -> follow k
     | k -> k
 
   let rec string_of_kind = function
-    | KExpr -> "KExpr"
-    | KPattern -> "KPattern"
+    | KExpr i -> Printf.sprintf "KExpr(%d)" i
     | KParen -> "KParen"
     | KBrace -> "KBrace"
     | KBracket -> "KBracket"
     | KBracketBar -> "KBracketBar"
-    | KField -> "KField"
+    (* | KField -> "KField" *)
     | KLet -> "KLet"
     | KIn -> "KIn"
     | KAnd k -> aux "KAnd" k
   type t = Node.t list
 
   let to_string t =
-    let i = ref (-1) in
-    String.concat "\n" (List.map (fun n -> incr i; Node.to_string !i n) (List.rev t))
+    String.concat " \027[35m/\027[m " (List.map (fun n -> Node.to_string 0 n) (List.rev t))
 
   let l = function
     | [] -> 0
   { t with path = Path.shift t.path n }
 
 let to_string t =
-  Printf.sprintf "%s\n%d %b" (Path.to_string t.path) t.toff t.nb
+  Path.to_string t.path
+    (* Printf.sprintf "%s\n%d %b" (Path.to_string t.path) t.toff t.nb *)
 
 let empty = {
   path = [];
   orig = 0;
 }
 
+(*
 (* Does the token close a top LET construct ? *)
+(* NB: we do this with another way below, but this one might be more robust *)
 let rec close_top_let = function
   | None -> true
   | Some t ->
       match t.token with
       | COMMENT _ -> assert false (* COMMENT must be skipped *)
 
-      | STRUCT | SEMISEMI
-      | UIDENT _|STRING _|OPTLABEL _|NATIVEINT _|LIDENT _|LABEL _|INT64 _|INT32 _
-      | INT _|FLOAT _|CHAR _|WITH|VIRTUAL|VAL|UNDERSCORE|TYPE|TRUE|TILDE|SIG|SHARP
-      | RPAREN|REC|RBRACKET|RBRACE|QUOTE|QUESTIONQUESTION|QUESTION|PRIVATE|OPEN
-      | OF|OBJECT|NEW|MUTABLE|MODULE|METHOD|MATCH|LET|LESS|LAZY|INHERIT|INCLUDE
-      | GREATERRBRACKET|GREATERRBRACE|GREATER|FUNCTOR|FUNCTION|FUN|FOR|FALSE
-      | EXTERNAL|EXCEPTION|EOF|END|DOTDOT|DOT|DONE|CONSTRAINT|COLONGREATER
-      | COLONCOLON|COLON|CLASS|BARRBRACKET|BARBAR|BAR|BANG|BACKQUOTE|ASSERT|AS|AND
-      | AMPERSAND|AMPERAMPER -> true
+      (* Tokens that allow a let-in after them *)
+      | AMPERSAND | AMPERAMPER | BARBAR | BEGIN | COLONCOLON | COLONEQUAL
+      | COMMA | DO | DOWNTO | ELSE | EQUAL | GREATER | IF | IN
+      | INFIXOP0 _ | INFIXOP1 _ | INFIXOP2 _ | INFIXOP3 _ | INFIXOP4 _
+      | LBRACE | LBRACELESS
+      | LBRACKET | LBRACKETBAR | LBRACKETLESS | LBRACKETGREATER
+      | LESS | LESSMINUS | LPAREN | MATCH | MINUS | MINUSDOT | MINUSGREATER | OR
+      | PLUS | PLUSDOT | QUESTION | QUESTIONQUESTION | SEMI | STAR | THEN
+      | TO | TRY | WHEN | WHILE
+      | TILDE -> false
 
-      | _ -> false
-
-let rec in_pattern = function
-  | {k=(KAnd _|KLet|KLetIn|KFun|KType|KModule|KPattern|KVal|KExternal|KBar _)}::_ -> true
-  | {k=(KNone|KParen|KBrace|KBracket|KBracketBar)} :: path -> in_pattern path
-  | _ -> false
-
-let rec in_sig_pattern = function
-  | {k=KVal|KExternal}::_   -> true
-  | {k=(KNone|KPattern)}::p -> in_sig_pattern p
-  | _                       -> false
-
-let rec in_record = function
-  | {k=KBrace}::_         -> true
-  | {k=(KExpr|KNone)} ::p -> in_record p
-  | _                     -> false
+      | _ -> true
+*)
 
 (* Go back to the node path path until [f] holds *)
 let rec unwind f path = match path with
-  | { k } :: _ when f (follow k) -> path
+  | { k } :: _ when f k -> path
   | _ :: path -> unwind f path
   | [] -> []
 
+(* Unwinds the path while [f] holds, returning the last step for which it does *)
+let unwind_while f path =
+  let rec aux acc = function
+    | { k } as h :: p when f k -> aux h p
+    | p -> acc :: p
+  in
+  match path with
+  | { k } as h :: p when f k -> Some (aux h p)
+  | _ -> None
+
 (* Unwind the struct/sig top *)
 let unwind_top =
   unwind (function KStruct|KSig|KParen|KBegin -> true | _ -> false)
       | _ -> true
 
 (* Get the next token *)
-let rec next_token stream =
+let rec next_token_full stream =
   match Nstream.next stream with
   | None
   | Some ({token=EOF},_)       -> None
-  | Some ({token=COMMENT _},s) -> next_token s
-  | Some (t,_)                 -> Some t.token
+  | Some ({token=COMMENT _},s) -> next_token_full s
+  | Some (t,_)                 -> Some t
+
+let next_token stream =
+  match next_token_full stream with
+  | None -> None
+  | Some t -> Some t.token
 
 let last_token t =
   match t.last with
   | Some t -> Region.start_line t.region
 
 let stacktrace t =
-  log "\n====\n%s\n====" (to_string t)
+  log "\027[32m%8s\027[m %s"
+    (match t.last with Some tok -> tok.substr | _ -> "")
+    (to_string t)
 
 (* different kinds of position:
    [T]: token aligned: the child is aligned with the token position
 (* Take a block, a token stream and a token.
    Return the new block stack. *)
 let rec update_path t stream tok =
-
   let node replace k pos pad path =
     let line = Region.start_line tok.region in
     if tok.newlines > 0 then
       let l = match pos with
         | A p -> p
-        | L   -> Path.l path + (if replace then 0 else Path.pad path)
-        | T   -> Path.t path + (if replace then 0 else Path.pad path) in
+        | L   -> Path.l path + if replace then 0 else Path.pad path
+        | T   -> Path.t path + if replace then 0 else Path.pad path in
       Node.create k l l pad line
     else
       let l = Path.l path in
       let t = t.toff + tok.offset in
-      Node.create k l t pad line in
-
+      Node.create k l t pad line
+  in
   (* Add a new child block *)
   let append k pos pad path =
-    node false k pos pad path :: path in
-
+    node false k pos pad path :: path
+  in
   (* replace the current block with a new one *)
   let replace k pos pad path = match path with
     | []   -> [node true k pos pad path]
-    | _::t -> node true k pos pad path :: t in
-
+    | _::t -> node true k pos pad path :: t
+  in
+  (* Used when expressions are merged together (for example in "3 +" the "+"
+     extends the lower-priority expression "3") *)
+  let extend k pos pad = function
+    | [] -> [node true k pos pad []]
+    | h::p ->
+        let prio_changed =
+          match k,h.k with
+          | KExpr pk, KExpr ph when ph = pk -> false
+          | _ -> true
+        in
+        if pad < 0 && tok.newlines > 0 && prio_changed then
+          (* Special negative indent: relative, only at beginning of line,
+             and when prio is changed *)
+          let l = max 0 (h.t + pad)
+          in { h with k; l; t=l; pad = 0 } :: p
+        else
+          (* change l to set the starting column of the expression,
+             if the expression is starting a line or over_indent
+             is set *)
+          let pad = max 0 pad in
+          let l = if pos = T then h.t + pad else Path.l p + Path.pad p in
+          { h with k; l; pad } :: p
+  in
+  (* use before appending a new expr_atom: checks if that may cause an
+     apply and folds parent exprs accordingly *)
+  let fold_expr path =
+    match path with
+    | {k=KExpr i}::p when i = prio_max ->
+        (* we are appending two expr_atom next to each other: this is an apply. *)
+        (* this "folds" the left-side of the apply *)
+        let p = match unwind_while (fun k -> prio k >= prio_apply) path with
+          | Some({k=KExpr i}::_ as p) when i = prio_apply -> p
+          | Some p -> extend (KExpr prio_apply) L 2 p
+          | None -> assert false
+        in
+        p
+    | _ -> path
+  in
+  let atom pad path =
+    let path = match path with
+      | {k=KWith(KTry|KMatch as m)}::_ -> append (KBar m) L 2 path
+      | _ -> fold_expr path
+    in
+    append expr_atom L (max pad (Path.pad path)) path
+  in
+  let open_paren k path =
+    let p = append k L 2 (fold_expr path) in
+    if Config.align_list_contents_with_first_element then
+      match p,next_token_full stream with
+      | h::p, Some ({newlines=0} as next) ->
+          if tok.newlines = 0 then
+            if k = KBracket || k = KBracketBar || k = KBrace then
+              let l = t.toff + tok.offset in
+              (* set alignment for next lines relative to [ *)
+              { h with l; t=l; pad = next.offset } :: p
+            else
+              h::p
+          else
+            (* set padding for next lines *)
+            { h with pad = next.offset } :: p
+      | _ -> p
+    else
+      p
+  in
   let close f path =
     let path = unwind f path in
-    let k = if in_pattern path then KPattern else KExpr in
     match path with
-    | []   -> []
+    | [] -> []
     | h::p ->
-      match p with
-      | {k=(KExpr|KPattern)}::_ -> p
-      | _ -> Node.create k h.l h.t 0 h.line :: p in
+        (* Remove the padding for the closing brace/bracket/paren/etc. *)
+        {h with k=expr_atom; pad=0} :: p
+  in
+  let op_prio_align_indent = function
+    (* anything else : -10 *)
+    (* in -> : 0 *)
+    | SEMI -> 5,L,-2
+    | AS -> 8,L,2
+    (* special negative indent is only honored at beginning of line *)
+    (* then else : 10 *)
+    | BAR -> 10,T,-2
+    | OF -> 20,L,0
+    | LESSMINUS | COLONEQUAL -> 20,L,2
+    | COMMA -> 30,L,0
+    | MINUSGREATER -> 32,L,0 (* is an operator only in types *)
+    | COLON | COLONGREATER -> 35,L,2
+    | OR | BARBAR -> 40,T,0
+    | AMPERSAND | AMPERAMPER -> 50,T,0
+    | INFIXOP0 s ->
+        (match String.sub s 0 (min 2 (String.length s)) with
+        | ">>" | "|!" -> 60,L,0 (* these should deindent fun -> *)
+        | _ -> 60,L,2)
+    | EQUAL | LESS | GREATER -> 60,L,2
+    | INFIXOP1 _ -> 70,L,2
+    | COLONCOLON -> 80,L,2
+    | INFIXOP2 _ | PLUSDOT | PLUS | MINUSDOT | MINUS -> 90,L,2
+    | INFIXOP3 _ | STAR -> 100,L,2
+    | INFIXOP4 _ -> 110,L,2
+    (* apply: 140 *)
+    | TILDE | QUESTION -> 140,L,2
+    | LABEL _ | OPTLABEL _ -> 145,L,0
+    | SHARP -> 150,L,2
+    | DOT -> 160,L,2
+    | _ -> assert false
+  in
+  let make_infix token path =
+    let op_prio, align, indent = op_prio_align_indent token in
+    match unwind_while (fun k -> prio k >= op_prio) path with
+    | Some p ->
+        extend (KExpr op_prio) align indent p
+    | None -> (* used as prefix ? Don't apply T indent *)
+        append (KExpr op_prio) L (max 0 indent) path
+  in
+  (* KNone nodes correspond to comments or top-level stuff, they shouldn't be
+     taken into account when indenting the next token *)
+  let t = match t.path with {k=KNone}::path -> {t with path}
+    | _ -> t
+  in
+  match tok.token with
+  | SEMISEMI    -> append KNone L 0 (unwind_top t.path)
+  | INCLUDE     -> append KInclude L 2 (unwind_top t.path)
+  | EXCEPTION   -> append KException L 2 (unwind_top t.path)
+  | BEGIN       -> append KBegin L 2 (fold_expr t.path)
+  | OBJECT      -> append KObject L 2 t.path
+  | VAL         -> append KVal L 2 (unwind_top t.path)
+  | MATCH       -> append KMatch L 2 t.path
+  | TRY         -> append KTry L 2 t.path
+  | LPAREN      -> open_paren KParen t.path
+  | LBRACKET | LBRACKETGREATER | LBRACKETLESS ->
+      open_paren KBracket t.path
+  | LBRACKETBAR -> open_paren KBracketBar t.path
+  | LBRACE | LBRACELESS ->
+      open_paren KBrace t.path
+  | FUNCTION -> append (KWith KMatch) L 2 (fold_expr t.path)
+  | FUN         -> append KFun L 2 (fold_expr t.path)
+  | STRUCT      -> append KStruct L 2 t.path
+  | WHEN ->
+      append KWhen L 4
+        (unwind (function
+        | KWith(KTry|KMatch) | KBar(KTry|KMatch) -> true
+        | _ -> false)
+           t.path)
+  | SIG         -> append KSig L 2 t.path
 
-  let pad k path =
-    match Nstream.next stream with
-    | Some (tok,_) when tok.newlines = 0 ->
-        append k L (tok.spaces + 1) path
-    | _ -> append k L 2 path in
+  | OPEN ->
+      if last_token t = Some LET then
+        append KOpen L 2 t.path
+      else
+        append KOpen L 2 (unwind_top t.path)
 
-  match tok.token with
-    | SEMISEMI    -> append KNone L 0 (unwind_top t.path)
-    | INCLUDE     -> append KInclude L 2 (unwind_top t.path)
-    | EXCEPTION   -> append KException L 2 (unwind_top t.path)
-    | BEGIN       -> append KBegin L 2 t.path
-    | OBJECT      -> append KObject L 2 t.path
-    | VAL         -> append KVal L 2 (unwind_top t.path)
-    | MATCH       -> append KMatch L 2 t.path
-    | TRY         -> append KTry L 2 t.path
-    | LPAREN      -> append KParen L 2 t.path
-    | LBRACKET    -> pad    KBracket t.path
-    | LBRACKETBAR -> pad    KBracketBar t.path
-    | LBRACE      -> append KBrace L 2 t.path
-    | FUNCTION
-    | FUN         -> append KFun L 2 t.path
-    | STRUCT      -> append KStruct L 2 t.path
-    | WHEN        -> append KWhen L 4 t.path
-    | SIG         -> append KSig L 2 t.path
+  | LET ->
+      (* Two ways to detect let vs letin ;
+         both seem to work, but need to check which one
+         is the most robust (for example w.r.t. unfinished expressions) *)
+      (* - it's a top Let if it is after a closed expression *)
+      (match t.path with
+      | {k=KExpr i}::p when i = prio_max ->
+          append KLet L (Config.let_indent) (unwind_top p)
+      | {k=KNone}::_ | [] ->
+          append KLet L (Config.let_indent) []
+      | _ ->
+          append KLetIn L 2 (fold_expr t.path))
+      (* - or if after a specific token *)
+      (* if close_top_let t.last then *)
+      (*   append KLet L 2 (unwind_top t.path) *)
+      (* else *)
+      (*   append KLetIn L 2 (fold_expr t.path) *)
 
-    | OPEN when last_token t = Some LET -> append KOpen L 2 t.path
+  | METHOD ->
+      append KLet L 4 (unwind_top t.path)
 
-    | OPEN -> append KOpen L 2 (unwind_top t.path)
+  | AND ->
+      let unwind_to = function
+        | KLet | KLetIn | KBody(KLet|KLetIn|KAnd(KLet|KLetIn))
+        | KType | KModule
+        | KWith(KType|KModule) | KAnd(KWith(KType|KModule)) -> true
+        | _ -> false
+      in let path = unwind unwind_to t.path in
+      (match path with
+      | {k=KWith _} as m :: p ->
+          (* hack to align "and" with the 'i' of "with": consider "with" was
+             1 column further to the right *)
+          let m = if tok.newlines > 0 then {m with t = m.t+1} else m in
+          replace (KAnd m.k) T 0 (m :: p)
+      | {k=KAnd (KWith _)} as m :: _ ->
+          replace m.k T 0 path
+      | h::_ -> replace (KAnd (follow h.k)) L 2 path
+      | []   -> append (KAnd KNone) L 2 path)
 
-    | LET when close_top_let t.last ->
+  | IN ->
+      let path = unwind ((=) KLetIn @* follow) t.path in
+      (match unwind_while ((=) KIn) (parent path) with
+      | Some p -> replace KIn L 0 p
+      | None -> replace KIn L 0 path)
+
+  | TYPE ->
+      (match last_token t with
+      | Some MODULE -> t.path (* module type *)
+      | Some (WITH|AND) -> append KType L 2 t.path
+      | _ -> append KType L 2 (unwind_top t.path))
+
+  | MODULE ->
+      (match last_token t with
+      | Some LET -> t.path (* let module *)
+      | Some (WITH|AND) -> append KType L 2 t.path
+      | _ -> append KModule L 2 (unwind_top t.path))
+
+  | END ->
+      close (function KStruct|KSig|KBegin|KObject -> true | _ -> false) t.path
+
+  | WITH ->
+      (match next_token stream with
+      | Some (TYPE|MODULE as tm) ->
+          let path =
+            unwind (function
+            | KModule | KOpen | KInclude | KParen -> true
+            | _ -> false)
+              t.path
+          in
+          let k =
+            match tm with TYPE -> KType | MODULE -> KModule | _ -> assert false
+          in
+          append (KWith k) L 2 path
+      | _ ->
+          let path = unwind (function
+            |KTry|KMatch
+            |KVal|KType|KBody KType|KException (* type-conv *)
+            |KBrace -> true
+            | _ -> false
+          ) t.path in
+          match path with
+          | {k=KBrace} :: _ -> append  (KWith KBrace) L 2 path
+          | {k=KVal|KType|KException as k}::_ -> replace (KWith k) L 2 path
+          | {k=KTry|KMatch} as m::({k=KBody (KLet|KLetIn)} as l)::_
+            when m.l = l.l ->
+              replace (KWith KMatch) L (max 2 Config.with_indent) path
+          | {k=(KTry|KMatch as k)}::_ ->
+              replace (KWith k) L Config.with_indent path
+          | _ -> path)
+
+  | IF ->
+      (match last_token t with
+      | Some ELSE  -> replace KIf L 2 t.path
+      | _ -> append  KIf L 2 (fold_expr t.path))
+
+  | THEN ->
+      extend KThen L 2 (unwind ((=) KIf) t.path)
+
+  | ELSE ->
+      extend KElse L 2 (unwind ((=) KThen) t.path)
+
+  | WHILE | FOR ->
+      append KLoop L 2 (fold_expr t.path)
+
+  | DO ->
+      extend KDo L 2 (unwind ((=) KLoop) t.path)
+
+  | DONE ->
+      close ((=) KDo) t.path
+
+  | BARRBRACKET -> close ((=) KBracketBar) t.path
+
+  | RPAREN -> close ((=) KParen) t.path
+
+  | RBRACE | GREATERRBRACE -> close ((=) KBrace) t.path
+
+  | RBRACKET | GREATERRBRACKET -> close ((=) KBracket) t.path
+
+  | BAR ->
+      let unwind_to = function
+        | KParen | KBracket | KBrace | KBracketBar
+        | KWith(KMatch|KTry) | KBar(KMatch|KTry) | KArrow(KMatch|KTry)
+        | KFun | KLet | KLetIn
+        | KBody(KType) -> true
+        | _ -> false
+      in
+      let path = unwind unwind_to t.path in
+      (match path with
+      | {k=KWith m} :: p -> append (KBar m) L 2 path
+      | {k=KArrow m} :: ({k=KBar _} as h:: _) as p ->
+          replace (KBar m) (A h.t) 2 p
+      | {k=KArrow m} :: p ->
+          append (KBar m) L 2 p
+      | _ -> make_infix tok.token t.path)
+
+  | MINUSGREATER ->
+      let path = unwind (function
+        | KParen | KBrace | KBracket | KBracketBar
+        | KFun | KWith(KMatch|KTry) | KBar(KMatch|KTry)
+        | KBody(KType|KExternal) | KColon -> true
+        | _ -> false)
+        t.path
+       in
+      (match path with
+       | {k=KFun} :: ({k=KExpr i} :: _ as path) when i = 60 ->
+           (* eg '>>= fun x ->': indent like the top of the expression *)
+           path
+       | {k=KFun} :: _ -> append (KArrow KFun) L 2 path
+       | {k=KWith m | KBar m} :: p ->
+           let indent = Config.match_clause_indent - if tok.newlines > 0 then 2 else 0 in
+           append (KArrow m) L indent path
+       | _ -> make_infix tok.token t.path)
+
+  | EQUAL ->
+      let unwind_to = function
+        | KParen | KBrace | KBracket | KBracketBar | KBody _
+        | KExternal | KModule | KType | KLet | KLetIn | KException
+        | KAnd(KModule|KType|KLet|KLetIn) -> true
+        | _ -> false
+      in let path = unwind unwind_to t.path in
+      (match path with
+      | {k=KBody KType}::_ -> (* type t = t' = ... *)
+          replace (KBody KType) L Config.type_indent path
+      | {k=KParen|KBrace|KBracket|KBracketBar|KBody _}::_ ->
+          make_infix tok.token t.path
+      | h::p ->
+          let indent = match next_token stream, h.k with
+            | Some (STRUCT|SIG|OBJECT), _ -> 0
+            | _, (KType | KBody KType) -> Config.type_indent
+            | _ -> 2
+          in
+          if tok.newlines > 0 then
+            let h = {h with l = h.l + indent; pad = 0} in
+            replace (KBody h.k) L 0 (h :: p)
+          else
+            replace (KBody h.k) L indent (h :: p)
+      | [] ->
+          append (KBody KNone) L 2 [])
+
+  | COLONEQUAL ->
+      (match
+         unwind_while (function KExpr _ | KType -> true | _ -> false) t.path
+       with
+       | Some ({k=KType}::_ as p) -> (* type t := t' *)
+           replace (KBody KType) L 2 p
+       | _ ->
+           make_infix tok.token t.path)
+
+  | COLON ->
+      let path = unwind (function
+        | KParen | KBrace | KBracket | KBracketBar | KBody _
+        | KModule | KLet | KLetIn | KExternal | KVal
+        | KAnd(KModule|KLet|KLetIn) -> true
+        | _ -> false)
+        t.path
+      in
+      (match path with
+      | {k=KModule|KLet|KLetIn|KExternal} :: _ -> path
+      | {k=KVal} as h :: p ->
+          let indent = 2 in
+          if tok.newlines > 0 then
+            let h = {h with l = h.l + indent; pad = 0} in
+            replace (KBody h.k) L 0 (h :: p)
+          else
+            replace (KBody h.k) L indent (h :: p)
+      | _ -> make_infix tok.token t.path)
+
+  (* Some commom preprocessor directives *)
+  | UIDENT ("INCLUDE"|"IFDEF"|"THEN"|"ELSE"|"ENDIF"
+           |"TEST"|"TEST_UNIT"|"TEST_MODULE" as s)
+    when tok.newlines > 0 ->
+      if String.sub s 0 4 = "TEST" then
         append KLet L 4 (unwind_top t.path)
+      else
+        replace KNone L 2 (unwind_top t.path)
 
-    | LET -> append KLetIn L 4 t.path
+  | EXTERNAL ->
+      append KExternal L 2 (unwind_top t.path)
 
-    | AND ->
-        let path =
-          unwind (function KLet|KLetIn|KType|KModule -> true | _ -> false) t.path in
-        (match path with
-        | []   -> append (KAnd KNone) L 2 path
-        | h::_ -> replace (KAnd (follow h.k)) L 2 path)
+  | DOT ->
+      (match t.path with
+      | {k=KExpr i} :: ({k=KBrace} as h :: p)
+        when i = prio_max ->
+          (* special case: distributive { Module. field; field } *)
+          { h with pad = 2 } :: p
+      | _ -> make_infix tok.token t.path)
 
-    | IN ->
-        let path = unwind (function KLetIn -> true | _ -> false) t.path in
-        replace KIn L 0 path
+  | LESSMINUS | COMMA | SEMI | OR | BARBAR
+  | AMPERSAND | AMPERAMPER | INFIXOP0 _ | INFIXOP1 _
+  | COLONCOLON | INFIXOP2 _ | PLUSDOT | PLUS | MINUSDOT | MINUS
+  | INFIXOP3 _ | STAR | INFIXOP4 _
+  | SHARP | AS | COLONGREATER
+  | LESS | GREATER | OF ->
+      make_infix tok.token t.path
 
-    | TYPE when last_token t = Some MODULE -> (* module type *)
-        (* we might change the kind to KModuleType, but ... let's keep it simpler *)
-        t.path
+  | LABEL _ | OPTLABEL _ ->
+      (match
+        unwind_while (function
+            | KExpr _ | KLet | KLetIn | KFun | KAnd(KLet|KLetIn) -> true
+            | _ -> false)
+          t.path
+      with
+      | Some ({k=KExpr _}::_) | None ->
+          (* considered as infix, but forcing function application *)
+          make_infix tok.token (fold_expr t.path)
+      | _ -> (* in function definition *)
+          atom 2 t.path)
 
-    | TYPE -> append KType L 2 (unwind_top t.path)
+  | INT64 _ | INT32 _ | INT _ | LIDENT _ | UIDENT _
+  | FLOAT _ | CHAR _ | STRING _ | TRUE | FALSE | NATIVEINT _
+  | UNDERSCORE | TILDE | QUESTION
+  | QUOTE | QUOTATION _ ->
+      atom 2 t.path
 
-    | MODULE when last_token t = Some LET -> (* let module *)
-        t.path
+  | PREFIXOP _ | BANG | QUESTIONQUESTION ->
+      (* FIXME: should be highest priority, > atom
+         ( append is not right for atoms ) *)
+      atom 2 t.path
 
-    | MODULE -> append KModule L 2 (unwind_top t.path)
+  | ASSERT | LAZY | NEW ->
+      append expr_apply L 2 (fold_expr t.path)
 
-    | END ->
-        parent
-          (unwind (function KStruct|KSig|KBegin|KObject -> true | _ -> false) t.path)
-
-    | WITH ->
-        let path = unwind (function
-          |KTry|KMatch
-          |KVal|KType|KException (* type-conv *)
-          |KBrace|KInclude|KModule -> true
-          | _ -> false
-        ) t.path in
-        (match path with
-        |{k=(KBrace|KInclude)} as h ::_      -> append  (KWith h.k) L 2 path
-        |{k=(KVal|KType|KException as k)}::_ -> replace (KWith k) L 2 path
-        |({k=KMatch}as m)::({k=KBody KLet} as l)::_ when m.l = l.l
-                                             -> replace (KWith KMatch) L 2 path
-        |{k=(KTry|KMatch as k)}::_ when
-            next_token stream = Some BAR     -> replace (KWith k) L 0 path
-        |{k=(KTry|KMatch as k)}::_           -> replace (KWith k) L 4 path
-        | _ -> path)
-
-    | IF when last_token t = Some ELSE -> replace KIf L 2 t.path
-    | IF                         -> append  KIf L 2 t.path
-
-    | THEN ->
-        let path = unwind (function KIf -> true | _ -> false) t.path in
-        replace KThen L 2 path
-
-    | ELSE ->
-        let path = unwind (function KThen -> true | _ -> false) t.path in
-        replace KElse L 2 path
-
-    | WHILE | FOR ->
-        append KLoop L 2 t.path
-
-    | DO ->
-        let path = unwind (function KLoop -> true | _ -> false) t.path in
-        replace KDo L 2 path
-
-    | DONE ->
-        close (function KDo -> true | _ -> false) t.path
-
-    | BARRBRACKET -> close (function KBracketBar -> true | _ -> false) t.path
-
-    | RPAREN      -> close (function KParen -> true | _ -> false) t.path
-
-    | RBRACE      -> close (function KBrace -> true | _ -> false) t.path
-
-    | RBRACKET    -> close (function KBracket -> true | _ -> false) t.path
-
-    | BAR ->
-        let path =
-          unwind (function KParen|KMatch|KType|KTry|KFun -> true | _ -> false) t.path in
-        (match path with
-
-        (* type t =
-               Foo
-             | Bar *)
-        | {k=KBody k} as h :: _ when last_token_start_line t <> h.line ->
-            append (KBar k) L 2 (replace (KBody k) L 2 path)
-
-        (* type t = Foo
-                  | Bar *)
-        | {k=KBody k} as h:: _ when
-            last_token_start_line t = h.line && last_token t <> Some EQUAL ->
-            append (KBar k) T 2 (replace (KBody k) T 0 path)
-
-        (* type t = | Foo *)
-        | {k=KBody k} :: _ when last_token t = Some EQUAL && tok.newlines = 0 ->
-            append (KBar k) T 2 path
-
-        (* type t =
-             | Foo *)
-        | {k=KBody k} :: _ when last_token t = Some EQUAL && tok.newlines > 0 ->
-            append (KBar k) L 2 path
-
-        | {k=KBody _} :: _ -> failwith "TODO"
-
-        (* match t with (Foo|Bar) -> *)
-        | {k=KParen} :: _ -> path
-
-        (* match x with
-           | X *|* Y -> .. *)
-        | {k=KBar k} :: _ when tok.newlines = 0 -> path
-
-        | {k=KBar k} as h :: _ -> replace (KBar k) (A h.t) 2 path
-
-        | {k=(KWith(KMatch|KTry)|KType|KFun as k)}::_ ->
-            append (KBar (follow k)) L 2 path
-
-        | h::_ -> replace (KBar (follow h.k)) L 2 path
-        | []   -> append  (KBar KNone) L 2 [])
-
-    | MINUSGREATER ->
-        let path = unwind (function
-          |KColon|KFun|KMatch|KTry|KVal|KType|KExternal|KParen -> true
-          | _ -> false
-        ) t.path in
-        (match path with
-        | {k=KBody KType}::_
-               -> append (KArrow KType) L 2 (replace (KBody (KType)) L 2 path)
-        | h::_ -> append (KArrow (follow h.k)) L 2 path
-        | []   -> append (KArrow KNone) L 2 path)
-
-    | COMMA ->
-        unwind (function
-          |KBegin|KBracket|KBracketBar|KBrace
-          |KMatch|KLet|KLetIn|KTry
-          |KType (* type-conv *)
-          |KParen|KThen|KElse|KFun -> true
-          | _ -> false
-        ) t.path
-
-    | SEMI ->
-        let path = unwind (function
-          |KParen|KBegin|KBracket|KBracketBar|KBrace|KEq|KIn|KFun
-          |KMatch|KTry|KLet|KLoop|KDo
-          |KThen|KElse -> true
-          | _ -> false
-        ) t.path in
-        (match path with
-        | [] -> []
-        | {k=(KThen|KElse)} :: path -> path
-        |  _ -> path)
-
-    | EQUAL when in_pattern t.path ->
-        let path =
-          unwind (function KExternal|KParen|KBrace|KModule|KType|KLet|KLetIn -> true | _ -> false) t.path in
-        (match path with
-        | []   -> append (KBody KNone) L 2 []
-        | {k=KParen}::_ -> path
-        | h::_ ->
-            let k = follow h.k in
-            match k with
-            | KModule when next_token stream = Some STRUCT
-                        || next_token stream = Some SIG
-                      -> replace (KBody k) L 0 path
-            | KModule -> replace (KBody k) L 2 path
-            | KType when
-                next_token stream = Some LBRACE
-                || next_token stream = Some BAR
-                    -> append  (KBody k) L 2 path
-            | KType -> append (KBody k) L 4 path
-            | _ -> replace (KBody k) L 2 path)
-
-    (* val x : *)
-    | COLON when in_sig_pattern t.path ->
-        let path = unwind (function (KModule|KVal|KExternal) -> true | _ -> false) t.path in
-        (match path with
-        | h::_ -> replace (KBody h.k) L 2 path
-        | _    -> failwith "colon")
-
-    (* Colon markers are only useful inside record definitions *)
-    | COLON when in_record t.path -> append KColon L 2 t.path
-
-    (* x: int -> y: unit *)
-    | COLON                       -> t.path
-
-    | UIDENT ("INCLUDE"|"IFDEF"|"THEN"|"ELSE"|"ENDIF"|"TEST") ->
-        replace KNone (A 0) 2 t.path
-
-    | EXTERNAL ->
-        append KExternal L 2 (unwind_top t.path)
-
-    | INT64 _ | INT32 _ | INT _ | LIDENT _ | UIDENT _
-    | FLOAT _| CHAR _ | STRING _ | TRUE | FALSE
-    | TILDE when in_pattern t.path ->
-        (match t.path with
-        | {k=KLet}     :: _  -> append KPattern L 4 t.path
-        | {k=KPattern} :: _  -> t.path
-        | _ -> append KPattern L 2 t.path)
-
-    |BARBAR|AMPERAMPER
-    |INFIXOP4 _|INFIXOP3 _|INFIXOP2 _ when tok.newlines > 0 ->
-        let path = unwind (function KExpr -> true | _ -> false) t.path in
-        (match path with
-        | h::_ -> replace h.k T 0 path
-        | _    -> failwith "infixop")
-
-    | INT64 _ | INT32 _ | INT _ | LIDENT _ | UIDENT _
-    | FLOAT _| CHAR _ | STRING _ | TRUE | FALSE
-    | ASSERT | TILDE
-    | QUOTE | BANG
-    | INFIXOP1 _ | INFIXOP0 _ | INFIXOP4 _| INFIXOP3 _| INFIXOP2 _
-    | BARBAR | AMPERAMPER
-    | STAR | PLUSDOT | PLUS | MINUSDOT | MINUS | EQUAL
-    | LABEL _|OPTLABEL _|PREFIXOP _|NATIVEINT _ ->
-        (match t.path with
-        | {k=KExpr} :: _ -> t.path
-        | _ -> append KExpr L 2 t.path)
-
-    | COMMENT _ when tok.newlines = 0         -> t.path
-    | COMMENT _ ->
+  | COMMENT _ ->
+      if tok.newlines = 0 then t.path
+      else
         (match Nstream.next stream with
         | None | Some ({token=EOF},_) ->
             if tok.newlines <= 1 then
-              (* comment is associated with the last token *)
+            (* comment is associated with the last token *)
               []
             else
-              (* closing comments *)
+            (* closing comments *)
               append KNone (A 0) 0 t.path
         | Some (ntok, nstream) ->
-            let npath = update_path t nstream ntok in
             if ntok.newlines <= 1 || tok.newlines > 1 then
-              (* comment is associated to the next token *)
+            (* comment is associated to the next token: look-ahead *)
+              let npath = update_path t nstream ntok in
               append KNone (A (Path.l npath)) 0 t.path
             else
-              (* comment is associated to the previous token *)
+            (* comment is associated to the previous token *)
               append KNone (A (Path.l t.path)) 0 t.path)
 
-    |VIRTUAL|UNDERSCORE|TO
-    |SHARP|REC|QUESTIONQUESTION|QUESTION
-    |PRIVATE|OR|OF|NEW|MUTABLE|METHOD
-    |LESSMINUS|LESS|LBRACKETGREATER|LBRACKETLESS
-    |LBRACELESS|LAZY|INITIALIZER|INHERIT|GREATERRBRACKET
-    |GREATERRBRACE|GREATER|FUNCTOR|EOF
-    |DOWNTO|DOTDOT|DOT|CONSTRAINT|COLONGREATER|COLONEQUAL
-    |COLONCOLON|CLASS|BACKQUOTE|AS
-    |AMPERSAND ->
-        t.path
+  |VIRTUAL|TO
+  |REC
+  |PRIVATE|MUTABLE
+  |INITIALIZER|INHERIT
+  |FUNCTOR|EOF
+  |DOWNTO|DOTDOT|CONSTRAINT
+  |CLASS|BACKQUOTE ->
+      t.path
 
-    | ILLEGAL_CHAR _
-    | EOF_IN_STRING _
-    | EOF_IN_COMMENT _ ->
-	Printf.fprintf stderr "Parse error\n%!";
-        exit 2
+  | ILLEGAL_CHAR _
+  | EOF_IN_STRING _
+  | EOF_IN_COMMENT _ ->
+      Printf.fprintf stderr "Parse error\n%!";
+      exit 2
 
 let update block stream t =
   let path = update_path block stream t in
 
 let original_indent t =
   t.orig
-

ocaml/contrib/ocp-indent/src/main.ml

 
 let get_file () = match !file with
   | Some p -> p
-  | None   ->
-      Printf.eprintf "Usage:  %s\n%!" usage;
-      exit 1
+  | None   -> "/dev/stdin"
 
 let version () =
   Printf.printf "\

ocaml/contrib/ocp-indent/tests/core-failing.ml

+exception IOError of
+  int *
+  exn
+
+  (** | check that reindent keeps alignment
+      | bla (also for multi-line strings) *)
+
+module type S = S
+  with type ('a, 'b, 'c) map := ('a, 'b, 'c) t
+
+module Make_using_comparator (Elt : Comparator.S)
+  : S with type Elt.t = Elt.t
+    with type Elt.comparator = Elt.comparator
+
+
+let create
+    ?(message = Pid.to_string (Unix.getpid ()))
+    ?(close_on_exec=true)
+  =
+  xx
+
+type variant = [ `Jan | `Feb | `Mar | `Apr | `May | `Jun
+               | `Jul | `Aug | `Sep | `Oct | `Nov | `Dec ]
+
+let _ =
+  let start_finaliser_thread () =
+    ignore (Thread.create (fun () -> Fn.forever (fun () ->
+      match read_finaliser_queue () with
+      | None -> Thread.delay 1.0
+      | Some f -> Exn.handle_uncaught ~exit:false f)) ())
+  in
+  ()
+
+let _ =
+  find_thread_count
+    (In_channel.read_lines
+      ("/proc/" ^ string_of_int (Unix.getpid ()) ^ "/status"))

ocaml/contrib/ocp-indent/tests/core-passing.ml

+type t1 =
+  {
+    a: int;
+    b: int -> int;
+    c: int;
+  }
+
+let try_lock t =
+  wrap_mutex a.b (fun () ->
+    was_locked)
+
+let blit_string_bigstring ~src ?src_pos ?src_len ~dst ?dst_pos () =
+  blit_common
+    ~get_src_len:String.length ~get_dst_len:length
+    ~blit:unsafe_blit_string_bigstring
+    ~src ?src_pos ?src_len ~dst ?dst_pos
+    ()
+
+let f =
+  test bla Int32.to_string
+    pack_signed_32
+
+module S : S1
+  with type t = S1.t
+  with type comparator = S.comparator
+
+let error_string message = error message () <:sexp_of< unit >>
+let unimplemented s = ()
+
+let () =
+  StdLabels.List.iter
+    ~f:(fun (exc, handler) ->
+      Conv.Exn_converter.add_auto ~finalise:false exc handler)
+    ()
+
+let _ =
+  Date.to_string date
+  :: " "
+  :: (if is_utc then ["Z"]
+    else bla)
+
+val v
+  : t
+
+let _ =
+  let module M = (val m : S with type t = t') in
+  x
+
+let a,b,c =
+  d
+
+type t = t0 = {
+  a: int;
+}
+
+type t2 = [
+  | `a
+  | `b
+]
+
+type t = private
+  | A
+  | B
+
+module Make : (S with type t = t') =
+struct
+  type contents = C.t
+end
+
+module Map_and_set_binable = struct
+  module C : (S with type t = t)
+  val v
+end
+
+type compare =
+  [`no_polymorphic_compare]
+  -> [`no_polymorphic_compare]
+
+let _ =
+  {Parts.
+    sign = sign;
+    hr   = hr;
+  }
+
+module M (A) : sig
+  val bla : bla
+end = struct
+end
+