emacs/external/tuareg/tuareg.el

   1 ;;; tuareg.el --- Caml mode for (X)Emacs.   -*- coding: latin-1 -*-
   2
   3 ;;        Copyright © 1997-2008 Albert Cohen, all rights reserved.
   4 ;;        Licensed under the GNU General Public License.
   5
   6 ;;    This program is free software; you can redistribute it and/or modify
   7 ;;    it under the terms of the GNU General Public License as published by
   8 ;;    the Free Software Foundation; either version 2 of the License, or
   9 ;;    (at your option) any later version.
  10
  11 ;;    This program is distributed in the hope that it will be useful,
  12 ;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14 ;;    GNU General Public License for more details.
  15
  16 ;;; Commentary:
  17
  18 ;;; Code:
  19
  20 (require 'cl)
  21 (require 'easymenu)
  22
  23 (defconst tuareg-mode-version "Tuareg Version 1.45.6"
  24   "        Copyright © 1997-2008 Albert Cohen, all rights reserved.
  25          Copying is covered by the GNU General Public License.
  26
  27     This program is free software; you can redistribute it and/or modify
  28     it under the terms of the GNU General Public License as published by
  29     the Free Software Foundation; either version 2 of the License, or
  30     (at your option) any later version.
  31
  32     This program is distributed in the hope that it will be useful,
  33     but WITHOUT ANY WARRANTY; without even the implied warranty of
  34     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  35     GNU General Public License for more details.")
  36
  37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;;                        Emacs versions support
  39
  40 (defconst tuareg-with-xemacs (featurep 'xemacs))
  41
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;;                      Compatibility functions
  44
  45 (defalias 'tuareg-match-string
  46   (if (fboundp 'match-string-no-properties)
  47       'match-string-no-properties
  48     'match-string))
  49
  50 (if (not (fboundp 'read-shell-command))
  51     (defun read-shell-command  (prompt &optional initial-input history)
  52       "Read a string from the minibuffer, using `shell-command-history'."
  53       (read-from-minibuffer prompt initial-input nil nil
  54                             (or history 'shell-command-history))))
  55
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ;;                             Import types and help features
  58
  59 (defvar tuareg-with-caml-mode-p
  60   (condition-case nil
  61       (and (require 'caml-types) (require 'caml-help))
  62     (error nil)))
  63
  64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65 ;;                       User customizable variables
  66
  67 ;; Use the standard `customize' interface or `tuareg-mode-hook' to
  68 ;; Configure these variables
  69
  70 (require 'custom)
  71
  72 (defgroup tuareg nil
  73   "Support for the Objective Caml language."
  74   :group 'languages)
  75
  76 ;; Comments
  77
  78 (defcustom tuareg-indent-leading-comments t
  79   "*If true, indent leading comment lines (starting with `(*') like others."
  80   :group 'tuareg :type 'boolean)
  81
  82 (defcustom tuareg-indent-comments t
  83   "*If true, automatically align multi-line comments."
  84   :group 'tuareg :type 'boolean)
  85
  86 (defcustom tuareg-comment-end-extra-indent 0
  87   "*How many spaces to indent a leading comment end `*)'.
  88 If you expect comments to be indented like
  89         (*
  90           ...
  91          *)
  92 even without leading `*', use `tuareg-comment-end-extra-indent' = 1."
  93   :group 'tuareg
  94   :type '(radio :extra-offset 8
  95                 :format "%{Comment End Extra Indent%}:
  96    Comment alignment:\n%v"
  97                 (const :tag "align with `(' in comment opening" 0)
  98                 (const :tag "align with `*' in comment opening" 1)
  99                 (integer :tag "custom alignment" 0)))
 100
 101 (defcustom tuareg-support-leading-star-comments t
 102   "*Enable automatic intentation of comments of the form
 103         (*
 104          * ...
 105          *)
 106 Documentation comments (** *) are not concerned by this variable
 107 unless `tuareg-leading-star-in-doc' is also set.
 108
 109 If you do not set this variable and still expect comments to be
 110 indented like
 111         (*
 112           ...
 113          *)
 114 \(without leading `*'), set `tuareg-comment-end-extra-indent' to 1."
 115   :group 'tuareg :type 'boolean)
 116
 117 (defcustom tuareg-leading-star-in-doc nil
 118   "*Enable automatic intentation of documentation comments of the form
 119         (**
 120          * ...
 121          *)"
 122   :group 'tuareg :type 'boolean)
 123
 124 ;; Indentation defaults
 125
 126 (defcustom tuareg-default-indent 2
 127   "*Default indentation.
 128
 129 Global indentation variable (large values may lead to indentation overflows).
 130 When no governing keyword is found, this value is used to indent the line
 131 if it has to."
 132   :group 'tuareg :type 'integer)
 133
 134 (defcustom tuareg-lazy-paren nil
 135   "*If true, indent parentheses like a standard keyword."
 136   :group 'tuareg :type 'boolean)
 137
 138 (defcustom tuareg-support-camllight nil
 139   "*If true, handle Caml Light character syntax (incompatible with labels)."
 140   :group 'tuareg :type 'boolean
 141   :set '(lambda (var val)
 142           (setq tuareg-support-camllight val)
 143           (if (boundp 'tuareg-mode-syntax-table)
 144               (modify-syntax-entry ?` (if val "\"" ".")
 145                                    tuareg-mode-syntax-table))))
 146
 147 (defcustom tuareg-support-metaocaml nil
 148   "*If true, handle MetaOCaml character syntax."
 149   :group 'tuareg :type 'boolean
 150   :set '(lambda (var val)
 151           (setq tuareg-support-metaocaml val)
 152           (if (boundp 'tuareg-font-lock-keywords)
 153               (tuareg-install-font-lock))))
 154
 155 (defcustom tuareg-let-always-indent t
 156   "*If true, enforce indentation is at least `tuareg-let-indent' after a `let'.
 157
 158 As an example, set it to false when you have `tuareg-with-indent' set to 0,
 159 and you want `let x = match ... with' and `match ... with' indent the
 160 same way."
 161   :group 'tuareg :type 'boolean)
 162
 163 (defcustom tuareg-|-extra-unindent tuareg-default-indent
 164   "*Extra backward indent for Caml lines starting with the `|' operator.
 165
 166 It is NOT the variable controlling the indentation of the `|' itself:
 167 this value is automatically added to `function', `with', `parse' and
 168 some cases of `type' keywords to leave enough space for `|' backward
 169 indentation.
 170
 171 For exemple, setting this variable to 0 leads to the following indentation:
 172   match ... with
 173     X -> ...
 174     | Y -> ...
 175     | Z -> ...
 176
 177 To modify the indentation of lines lead by `|' you need to modify the
 178 indentation variables for `with', `function' and `parse', and possibly
 179 for `type' as well. For example, setting them to 0 (and leaving
 180 `tuareg-|-extra-unindent' to its default value) yields:
 181   match ... with
 182     X -> ...
 183   | Y -> ...
 184   | Z -> ..."
 185   :group 'tuareg :type 'integer)
 186
 187 (defcustom tuareg-class-indent tuareg-default-indent
 188   "*How many spaces to indent from a `class' keyword."
 189   :group 'tuareg :type 'integer)
 190
 191 (defcustom tuareg-sig-struct-align t
 192   "*Align `sig' and `struct' keywords with `module'."
 193   :group 'tuareg :type 'boolean)
 194
 195 (defcustom tuareg-sig-struct-indent tuareg-default-indent
 196   "*How many spaces to indent from a `sig' or `struct' keyword."
 197   :group 'tuareg :type 'integer)
 198
 199 (defcustom tuareg-method-indent tuareg-default-indent
 200   "*How many spaces to indent from a `method' keyword."
 201   :group 'tuareg :type 'integer)
 202
 203 (defcustom tuareg-begin-indent tuareg-default-indent
 204   "*How many spaces to indent from a `begin' keyword."
 205   :group 'tuareg :type 'integer)
 206
 207 (defcustom tuareg-for-while-indent tuareg-default-indent
 208   "*How many spaces to indent from a `for' or `while' keyword."
 209   :group 'tuareg :type 'integer)
 210
 211 (defcustom tuareg-do-indent tuareg-default-indent
 212   "*How many spaces to indent from a `do' keyword."
 213   :group 'tuareg :type 'integer)
 214
 215 (defcustom tuareg-fun-indent tuareg-default-indent
 216   "*How many spaces to indent from a `fun' keyword."
 217   :group 'tuareg :type 'integer)
 218
 219 (defcustom tuareg-function-indent tuareg-default-indent
 220   "*How many spaces to indent from a `function' keyword."
 221   :group 'tuareg :type 'integer)
 222
 223 (defcustom tuareg-if-then-else-indent tuareg-default-indent
 224   "*How many spaces to indent from an `if', `then' or `else' keyword."
 225   :group 'tuareg :type 'integer)
 226
 227 (defcustom tuareg-let-indent tuareg-default-indent
 228   "*How many spaces to indent from a `let' keyword."
 229   :group 'tuareg :type 'integer)
 230
 231 (defcustom tuareg-in-indent tuareg-default-indent
 232   "*How many spaces to indent from a `in' keyword.
 233 A lot of people like formatting `let' ... `in' expressions whithout
 234 indentation:
 235         let x = 0 in
 236         blah x
 237 Set this variable to 0 to get this behaviour.
 238 However, nested declarations are always correctly handled:
 239         let x = 0 in                             let x = 0
 240         let y = 0 in              or             in let y = 0
 241         let z = 0 ...                            in let z = 0 ..."
 242   :group 'tuareg :type 'integer)
 243
 244 (defcustom tuareg-match-indent tuareg-default-indent
 245   "*How many spaces to indent from a `match' keyword."
 246   :group 'tuareg :type 'integer)
 247
 248 (defcustom tuareg-try-indent tuareg-default-indent
 249   "*How many spaces to indent from a `try' keyword."
 250   :group 'tuareg :type 'integer)
 251
 252 (defcustom tuareg-with-indent tuareg-default-indent
 253   "*How many spaces to indent from a `with' keyword."
 254   :group 'tuareg :type 'integer)
 255
 256 (defcustom tuareg-rule-indent tuareg-default-indent
 257   "*How many spaces to indent from a `rule' keyword."
 258   :group 'tuareg :type 'integer)
 259
 260 (defcustom tuareg-parse-indent tuareg-default-indent
 261   "*How many spaces to indent from a `parse' keyword."
 262   :group 'tuareg :type 'integer)
 263
 264 (defcustom tuareg-parser-indent tuareg-default-indent
 265   "*How many spaces to indent from a `parser' keyword."
 266   :group 'tuareg :type 'integer)
 267
 268 (defcustom tuareg-type-indent tuareg-default-indent
 269   "*How many spaces to indent from a `type' keyword."
 270   :group 'tuareg :type 'integer)
 271
 272 (defcustom tuareg-val-indent tuareg-default-indent
 273   "*How many spaces to indent from a `val' keyword."
 274   :group 'tuareg :type 'integer)
 275
 276 ;; Automatic indentation
 277 ;; Using abbrev-mode and electric keys
 278
 279 (defcustom tuareg-use-abbrev-mode t
 280   "*Non-nil means electrically indent lines starting with leading keywords.
 281 Leading keywords are such as `end', `done', `else' etc.
 282 It makes use of `abbrev-mode'.
 283
 284 Many people find eletric keywords irritating, so you can disable them by
 285 setting this variable to nil."
 286   :group 'tuareg :type 'boolean
 287   :set '(lambda (var val)
 288           (setq tuareg-use-abbrev-mode val)
 289           (abbrev-mode val)))
 290
 291 (defcustom tuareg-electric-indent t
 292   "*Non-nil means electrically indent lines starting with `|', `)', `]' or `}'.
 293
 294 Many people find eletric keys irritating, so you can disable them in
 295 setting this variable to nil."
 296   :group 'tuareg :type 'boolean)
 297
 298 (defcustom tuareg-electric-close-vector t
 299   "*Non-nil means electrically insert `|' before a vector-closing `]' or
 300 `>' before an object-closing `}'.
 301
 302 Many people find eletric keys irritating, so you can disable them in
 303 setting this variable to nil. You should probably have this on,
 304 though, if you also have `tuareg-electric-indent' on."
 305   :group 'tuareg :type 'boolean)
 306
 307 ;; Tuareg-Interactive
 308 ;; Configure via `tuareg-mode-hook'
 309
 310 (defcustom tuareg-skip-after-eval-phrase t
 311   "*Non-nil means skip to the end of the phrase after evaluation in the
 312 Caml toplevel."
 313   :group 'tuareg :type 'boolean)
 314
 315 (defcustom tuareg-interactive-read-only-input nil
 316   "*Non-nil means input sent to the Caml toplevel is read-only."
 317   :group 'tuareg :type 'boolean)
 318
 319 (defcustom tuareg-interactive-echo-phrase t
 320   "*Non-nil means echo phrases in the toplevel buffer when sending
 321 them to the Caml toplevel."
 322   :group 'tuareg :type 'boolean)
 323
 324 (defcustom tuareg-interactive-input-font-lock t
 325   "*Non nil means Font-Lock for toplevel input phrases."
 326   :group 'tuareg :type 'boolean)
 327
 328 (defcustom tuareg-interactive-output-font-lock t
 329   "*Non nil means Font-Lock for toplevel output messages."
 330   :group 'tuareg :type 'boolean)
 331
 332 (defcustom tuareg-interactive-error-font-lock t
 333   "*Non nil means Font-Lock for toplevel error messages."
 334   :group 'tuareg :type 'boolean)
 335
 336 (defcustom tuareg-display-buffer-on-eval t
 337   "*Non nil means pop up the Caml toplevel when evaluating code."
 338   :group 'tuareg :type 'boolean)
 339
 340 (defcustom tuareg-manual-url "http://pauillac.inria.fr/ocaml/htmlman/index.html"
 341   "*URL to the Caml reference manual."
 342   :group 'tuareg :type 'string)
 343
 344 (defcustom tuareg-browser 'tuareg-netscape-manual
 345   "*Name of function that displays the Caml reference manual.
 346 Valid names are `tuareg-netscape-manual', `tuareg-mmm-manual'
 347 and `tuareg-xemacs-w3-manual' (XEmacs only)."
 348   :group 'tuareg)
 349
 350 (defcustom tuareg-library-path "/usr/local/lib/ocaml/"
 351   "*Path to the Caml library."
 352   :group 'tuareg :type 'string)
 353
 354 (defcustom tuareg-definitions-max-items 30
 355   "*Maximum number of items a definitions menu can contain."
 356   :group 'tuareg :type 'integer)
 357
 358 (defvar tuareg-options-list
 359   '(("Lazy parentheses indentation" . 'tuareg-lazy-paren)
 360     ("Force indentation after `let'" . 'tuareg-let-always-indent)
 361     "---"
 362     ("Automatic indentation of leading keywords" . 'tuareg-use-abbrev-mode)
 363     ("Electric indentation of ), ] and }" . 'tuareg-electric-indent)
 364     ("Electric matching of [| and {<" . 'tuareg-electric-close-vector)
 365     "---"
 366     ("Indent body of comments" . 'tuareg-indent-comments)
 367     ("Indent first line of comments" . 'tuareg-indent-leading-comments)
 368     ("Leading-`*' comment style" . 'tuareg-support-leading-star-comments))
 369   "*List of menu-configurable Tuareg options.")
 370
 371 (defvar tuareg-interactive-options-list
 372   '(("Skip phrase after evaluation" . 'tuareg-skip-after-eval-phrase)
 373     ("Echo phrase in interactive buffer" . 'tuareg-interactive-echo-phrase)
 374     "---"
 375     ("Font-lock interactive input" . 'tuareg-interactive-input-font-lock)
 376     ("Font-lock interactive output" . 'tuareg-interactive-output-font-lock)
 377     ("Font-lock interactive error" . 'tuareg-interactive-error-font-lock)
 378     "---"
 379     ("Read only input" . 'tuareg-interactive-read-only-input))
 380   "*List of menu-configurable Tuareg options.")
 381
 382 (defvar tuareg-interactive-program "ocaml"
 383   "*Default program name for invoking a Caml toplevel from Emacs.")
 384 ;; Could be interesting to have this variable buffer-local
 385 ;;   (e.g., ocaml vs. metaocaml buffers)
 386 ;; (make-variable-buffer-local 'tuareg-interactive-program)
 387
 388 ;; Backtrack to custom parsing and caching by default, until stable
 389 ;;(defvar tuareg-use-syntax-ppss (fboundp 'syntax-ppss)
 390 (defconst tuareg-use-syntax-ppss nil
 391   "*If nil, use our own parsing and caching.")
 392
 393 (defgroup tuareg-faces nil
 394   "Special faces for the Tuareg mode."
 395   :group 'tuareg)
 396
 397 (defconst tuareg-faces-inherit-p
 398   (if (boundp 'face-attribute-name-alist)
 399       (assq :inherit face-attribute-name-alist)))
 400
 401 (defface tuareg-font-lock-governing-face
 402   (if tuareg-faces-inherit-p
 403       '((t :inherit font-lock-keyword-face))
 404     '((((background light)) (:foreground "darkorange3" :bold t))
 405       (t (:foreground "orange" :bold t))))
 406   "Face description for governing/leading keywords."
 407   :group 'tuareg-faces)
 408 (defvar tuareg-font-lock-governing-face
 409   'tuareg-font-lock-governing-face)
 410
 411 (defface tuareg-font-lock-multistage-face
 412   '((((background light))
 413      (:foreground "darkblue" :background "lightgray" :bold t))
 414     (t (:foreground "steelblue" :background "darkgray" :bold t)))
 415   "Face description for MetaOCaml staging operators."
 416   :group 'tuareg-faces)
 417 (defvar tuareg-font-lock-multistage-face
 418   'tuareg-font-lock-multistage-face)
 419
 420 (defface tuareg-font-lock-operator-face
 421   (if tuareg-faces-inherit-p
 422       '((t :inherit font-lock-keyword-face))
 423     '((((background light)) (:foreground "brown"))
 424       (t (:foreground "khaki"))))
 425   "Face description for all operators."
 426   :group 'tuareg-faces)
 427 (defvar tuareg-font-lock-operator-face
 428   'tuareg-font-lock-operator-face)
 429
 430 (defface tuareg-font-lock-error-face
 431   '((t (:foreground "yellow" :background "red" :bold t)))
 432   "Face description for all errors reported to the source."
 433   :group 'tuareg-faces)
 434 (defvar tuareg-font-lock-error-face
 435   'tuareg-font-lock-error-face)
 436
 437 (defface tuareg-font-lock-interactive-output-face
 438   '((((background light))
 439      (:foreground "blue4"))
 440     (t (:foreground "cyan")))
 441   "Face description for all toplevel outputs."
 442   :group 'tuareg-faces)
 443 (defvar tuareg-font-lock-interactive-output-face
 444   'tuareg-font-lock-interactive-output-face)
 445
 446 (defface tuareg-font-lock-interactive-error-face
 447   (if tuareg-faces-inherit-p
 448       '((t :inherit font-lock-warning-face))
 449     '((((background light)) (:foreground "red3"))
 450       (t (:foreground "red2"))))
 451   "Face description for all toplevel errors."
 452   :group 'tuareg-faces)
 453 (defvar tuareg-font-lock-interactive-error-face
 454   'tuareg-font-lock-interactive-error-face)
 455
 456 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 457 ;;                            Support definitions
 458
 459 (defun tuareg-leading-star-p ()
 460   (and tuareg-support-leading-star-comments
 461        (save-excursion ; this function does not make sense outside of a comment
 462          (tuareg-beginning-of-literal-or-comment)
 463          (and (or tuareg-leading-star-in-doc
 464                   (not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*")))
 465               (progn
 466                 (forward-line 1)
 467                 (back-to-indentation)
 468                 (looking-at "\\*[^)]"))))))
 469
 470 (defun tuareg-auto-fill-insert-leading-star (&optional leading-star)
 471   (let ((point-leading-comment (looking-at "(\\*")) (return-leading nil))
 472     (save-excursion
 473       (back-to-indentation)
 474       (if tuareg-electric-indent
 475           (progn
 476             (if (and (tuareg-in-comment-p)
 477                      (or leading-star
 478                          (tuareg-leading-star-p)))
 479                 (progn
 480                   (if (not (looking-at "(?\\*"))
 481                       (insert-before-markers "* "))
 482                   (setq return-leading t)))
 483             (if (not point-leading-comment)
 484                 ;; Use optional argument to break recursion
 485                 (tuareg-indent-command t)))))
 486     return-leading))
 487
 488 (defun tuareg-auto-fill-function ()
 489   (if (tuareg-in-literal-p) ()
 490     (let ((leading-star
 491            (if (not (char-equal ?\n last-command-char))
 492                (tuareg-auto-fill-insert-leading-star)
 493              nil)))
 494       (do-auto-fill)
 495       (if (not (char-equal ?\n last-command-char))
 496           (tuareg-auto-fill-insert-leading-star leading-star)))))
 497
 498 (defun tuareg-forward-char (&optional step)
 499   (if step (goto-char (+ (point) step))
 500     (goto-char (1+ (point)))))
 501
 502 (defun tuareg-backward-char (&optional step)
 503   (if step (goto-char (- (point) step))
 504     (goto-char (1- (point)))))
 505
 506 (defun tuareg-in-indentation-p ()
 507   "Return non-nil if all chars between beginning of line and point are blanks."
 508   (save-excursion
 509     (skip-chars-backward " \t")
 510     (bolp)))
 511
 512 (defvar tuareg-cache-stop (point-min))
 513 (make-variable-buffer-local 'tuareg-cache-stop)
 514 (defvar tuareg-cache nil)
 515 (make-variable-buffer-local 'tuareg-cache)
 516 (defvar tuareg-cache-local nil)
 517 (make-variable-buffer-local 'tuareg-cache-local)
 518 (defvar tuareg-cache-last-local nil)
 519 (make-variable-buffer-local 'tuareg-cache-last-local)
 520 (defvar tuareg-last-loc (cons nil nil))
 521
 522 (if tuareg-use-syntax-ppss
 523     (progn
 524       (defun tuareg-in-literal-p ()
 525         "Returns non-nil if point is inside a Caml literal."
 526         (nth 3 (syntax-ppss)))
 527       (defun tuareg-in-comment-p ()
 528         "Returns non-nil if point is inside a Caml comment."
 529         (nth 4 (syntax-ppss)))
 530       (defun tuareg-in-literal-or-comment-p ()
 531         "Returns non-nil if point is inside a Caml literal or comment."
 532         (nth 8 (syntax-ppss)))
 533       (defun tuareg-beginning-of-literal-or-comment ()
 534         "Skips to the beginning of the current literal or comment (or buffer)."
 535         (interactive)
 536         (goto-char (or (nth 8 (syntax-ppss)) (point))))
 537       (defun tuareg-beginning-of-literal-or-comment-fast ()
 538         (goto-char (or (nth 8 (syntax-ppss)) (point-min))))
 539       ;; FIXME: not clear if moving out of a string/comment counts as 1 or no.
 540       (defalias 'tuareg-backward-up-list 'backward-up-list))
 541
 542   (defun tuareg-before-change-function (begin end)
 543     (setq tuareg-cache-stop
 544           (if (save-excursion (beginning-of-line) (= (point) (point-min)))
 545               (point-min)
 546             (min tuareg-cache-stop (1- begin)))))
 547
 548   (defun tuareg-in-literal-p ()
 549     "Return non-nil if point is inside a Caml literal."
 550     (car (tuareg-in-literal-or-comment)))
 551   (defun tuareg-in-comment-p ()
 552     "Return non-nil if point is inside a Caml comment."
 553     (cdr (tuareg-in-literal-or-comment)))
 554   (defun tuareg-in-literal-or-comment-p ()
 555     "Return non-nil if point is inside a Caml literal or comment."
 556     (tuareg-in-literal-or-comment)
 557     (or (car tuareg-last-loc) (cdr tuareg-last-loc)))
 558   (defun tuareg-in-literal-or-comment ()
 559     "Return the pair `((tuareg-in-literal-p) . (tuareg-in-comment-p))'."
 560     (if (and (<= (point) tuareg-cache-stop) tuareg-cache)
 561         (progn
 562           (if (or (not tuareg-cache-local) (not tuareg-cache-last-local)
 563                   (and (>= (point) (caar tuareg-cache-last-local))))
 564               (setq tuareg-cache-local tuareg-cache))
 565           (while (and tuareg-cache-local (< (point) (caar tuareg-cache-local)))
 566             (setq tuareg-cache-last-local tuareg-cache-local
 567                   tuareg-cache-local (cdr tuareg-cache-local)))
 568           (setq tuareg-last-loc
 569                 (if tuareg-cache-local
 570                     (cons (eq (cadar tuareg-cache-local) 'b)
 571                           (> (cddar tuareg-cache-local) 0))
 572                   (cons nil nil))))
 573       (let ((flag t) (op (point)) (mp (min (point) (1- (point-max))))
 574             (balance 0) (end-of-comment nil))
 575         (while (and tuareg-cache (<= tuareg-cache-stop (caar tuareg-cache)))
 576           (setq tuareg-cache (cdr tuareg-cache)))
 577         (if tuareg-cache
 578             (if (eq (cadar tuareg-cache) 'b)
 579                 (progn
 580                   (setq tuareg-cache-stop (1- (caar tuareg-cache)))
 581                   (goto-char tuareg-cache-stop)
 582                   (setq balance (cddar tuareg-cache))
 583                   (setq tuareg-cache (cdr tuareg-cache)))
 584               (setq balance (cddar tuareg-cache))
 585               (setq tuareg-cache-stop (caar tuareg-cache))
 586               (goto-char tuareg-cache-stop)
 587               (skip-chars-forward "("))
 588           (goto-char (point-min)))
 589         (skip-chars-backward "\\\\*")
 590         (while flag
 591           (if end-of-comment (setq balance 0 end-of-comment nil))
 592           (skip-chars-forward "^\\\\'`\"(\\*")
 593           (cond
 594            ((looking-at "\\\\")
 595             (tuareg-forward-char 2))
 596            ((looking-at "'\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)'")
 597             (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance))
 598                                      tuareg-cache))
 599             (goto-char (match-end 0))
 600             (setq tuareg-cache (cons (cons (point) (cons 'e balance))
 601                                      tuareg-cache)))
 602            ((and
 603              tuareg-support-camllight
 604              (looking-at "`\\([^\n\\']\\|\\\\[^ \t\n][^ \t\n]?[^ \t\n]?\\)`"))
 605             (setq tuareg-cache (cons (cons (1+ (point)) (cons 'b balance))
 606                                      tuareg-cache))
 607             (goto-char (match-end 0))
 608             (setq tuareg-cache (cons (cons (point) (cons 'e balance))
 609                                      tuareg-cache)))
 610            ((looking-at "\"")
 611             (tuareg-forward-char)
 612             (setq tuareg-cache (cons (cons (point) (cons 'b balance))
 613                                      tuareg-cache))
 614             (skip-chars-forward "^\\\\\"")
 615             (while (looking-at "\\\\")
 616               (tuareg-forward-char 2) (skip-chars-forward "^\\\\\""))
 617             (tuareg-forward-char)
 618             (setq tuareg-cache (cons (cons (point) (cons 'e balance))
 619                                      tuareg-cache)))
 620            ((looking-at "(\\*")
 621             (setq balance (1+ balance))
 622             (setq tuareg-cache (cons (cons (point) (cons nil balance))
 623                                      tuareg-cache))
 624             (tuareg-forward-char 2))
 625            ((looking-at "\\*)")
 626             (tuareg-forward-char 2)
 627             (if (> balance 1)
 628                 (progn
 629                   (setq balance (1- balance))
 630                   (setq tuareg-cache (cons (cons (point) (cons nil balance))
 631                                            tuareg-cache)))
 632               (setq end-of-comment t)
 633               (setq tuareg-cache (cons (cons (point) (cons nil 0))
 634                                        tuareg-cache))))
 635            (t (tuareg-forward-char)))
 636           (setq flag (<= (point) mp)))
 637         (setq tuareg-cache-local tuareg-cache
 638               tuareg-cache-stop (point))
 639         (goto-char op)
 640         (if tuareg-cache (tuareg-in-literal-or-comment)
 641           (setq tuareg-last-loc (cons nil nil))
 642           tuareg-last-loc))))
 643
 644   (defun tuareg-beginning-of-literal-or-comment ()
 645     "Skips to the beginning of the current literal or comment (or buffer)."
 646     (interactive)
 647     (if (tuareg-in-literal-or-comment-p)
 648         (tuareg-beginning-of-literal-or-comment-fast)))
 649
 650   (defun tuareg-beginning-of-literal-or-comment-fast ()
 651     (while (and tuareg-cache-local
 652                 (or (eq 'b (cadar tuareg-cache-local))
 653                     (> (cddar tuareg-cache-local) 0)))
 654       (setq tuareg-cache-last-local tuareg-cache-local
 655             tuareg-cache-local (cdr tuareg-cache-local)))
 656     (if tuareg-cache-last-local
 657         (goto-char (caar tuareg-cache-last-local))
 658       (goto-char (point-min)))
 659     (if (eq 'b (cadar tuareg-cache-last-local)) (tuareg-backward-char)))
 660
 661   (defun tuareg-backward-up-list ()
 662     "Safe up-list regarding comments, literals and errors."
 663     (let ((balance 1) (op (point)) (oc nil))
 664       (tuareg-in-literal-or-comment)
 665       (while (and (> (point) (point-min)) (> balance 0))
 666         (setq oc (if tuareg-cache-local (caar tuareg-cache-local) (point-min)))
 667         (condition-case nil (up-list -1) (error (goto-char (point-min))))
 668         (if (>= (point) oc) (setq balance (1- balance))
 669           (goto-char op)
 670           (skip-chars-backward "^[]{}()") (tuareg-backward-char)
 671           (if (not (tuareg-in-literal-or-comment-p))
 672               (cond
 673                ((looking-at "[[{(]")
 674                 (setq balance (1- balance)))
 675                ((looking-at "[]})]")
 676                 (setq balance (1+ balance))))
 677             (tuareg-beginning-of-literal-or-comment-fast)))
 678         (setq op (point)))))) ;; End of (if tuareg-use-syntax-ppss
 679
 680 (defun tuareg-false-=-p ()
 681   "Is the underlying `=' the first/second letter of an operator?"
 682   (or (memq (preceding-char) '(?: ?> ?< ?=))
 683       (char-equal ?= (char-after (1+ (point))))))
 684
 685 (defun tuareg-at-phrase-break-p ()
 686   "Is the underlying `;' a phrase break?"
 687   (and (char-equal ?\; (following-char))
 688        (or (and (not (eobp))
 689                 (char-equal ?\; (char-after (1+ (point)))))
 690            (char-equal ?\; (preceding-char)))))
 691
 692 (defun tuareg-assoc-indent (kwop &optional look-for-let-or-and)
 693   "Return relative indentation of the keyword given in argument."
 694   (let ((ind (symbol-value (cdr (assoc kwop tuareg-keyword-alist))))
 695         (looking-let-or-and (and look-for-let-or-and
 696                                  (looking-at "\\<\\(let\\|and\\)\\>"))))
 697     (if (string-match "\\<\\(with\\|function\\|parser?\\)\\>" kwop)
 698         (+ (if (and tuareg-let-always-indent
 699                     looking-let-or-and (< ind tuareg-let-indent))
 700                tuareg-let-indent ind)
 701            tuareg-|-extra-unindent)
 702       ind)))
 703
 704 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 705 ;;                           Sym-lock in Emacs
 706
 707 ;; By Stefan Monnier
 708
 709 (defcustom tuareg-font-lock-symbols nil
 710   "Display fun and -> and such using symbols in fonts.
 711 This may sound like a neat trick, but note that it can change the
 712 alignment and can thus lead to surprises."
 713   :type 'bool)
 714
 715 (defvar tuareg-font-lock-symbols-alist
 716   (append
 717    ;; The symbols can come from a JIS0208 font.
 718    (and (fboundp 'make-char) (fboundp 'charsetp) (charsetp 'japanese-jisx0208)
 719         (list (cons "fun" (make-char 'japanese-jisx0208 38 75))
 720               (cons "sqrt" (make-char 'japanese-jisx0208 34 101))
 721               (cons "not" (make-char 'japanese-jisx0208 34 76))
 722               (cons "or" (make-char 'japanese-jisx0208 34 75))
 723               (cons "||" (make-char 'japanese-jisx0208 34 75))
 724               (cons "&&" (make-char 'japanese-jisx0208 34 74))
 725               ;; (cons "*." (make-char 'japanese-jisx0208 33 95))
 726               ;; (cons "/." (make-char 'japanese-jisx0208 33 96))
 727               (cons "->" (make-char 'japanese-jisx0208 34 42))
 728               (cons "=>" (make-char 'japanese-jisx0208 34 77))
 729               (cons "<-" (make-char 'japanese-jisx0208 34 43))
 730               (cons "<>" (make-char 'japanese-jisx0208 33 98))
 731               (cons "==" (make-char 'japanese-jisx0208 34 97))
 732               (cons ">=" (make-char 'japanese-jisx0208 33 102))
 733               (cons "<=" (make-char 'japanese-jisx0208 33 101))
 734               ;; Some greek letters for type parameters.
 735               (cons "'a" (make-char 'japanese-jisx0208 38 65))
 736               (cons "'b" (make-char 'japanese-jisx0208 38 66))
 737               (cons "'c" (make-char 'japanese-jisx0208 38 67))
 738               (cons "'d" (make-char 'japanese-jisx0208 38 68))))
 739    ;; Or a unicode font.
 740    (and (fboundp 'decode-char)
 741         (list (cons "fun" (decode-char 'ucs 955))
 742               (cons "sqrt" (decode-char 'ucs 8730))
 743               (cons "not" (decode-char 'ucs 172))
 744               (cons "or" (decode-char 'ucs 8897))
 745               (cons "&&" (decode-char 'ucs 8896))
 746               (cons "||" (decode-char 'ucs 8897))
 747               ;; (cons "*." (decode-char 'ucs 215))
 748               ;; (cons "/." (decode-char 'ucs 247))
 749               (cons "->" (decode-char 'ucs 8594))
 750               (cons "<-" (decode-char 'ucs 8592))
 751               (cons "<=" (decode-char 'ucs 8804))
 752               (cons ">=" (decode-char 'ucs 8805))
 753               (cons "<>" (decode-char 'ucs 8800))
 754               (cons "==" (decode-char 'ucs 8801))
 755               ;; Some greek letters for type parameters.
 756               (cons "'a" (decode-char 'ucs 945))
 757               (cons "'b" (decode-char 'ucs 946))
 758               (cons "'c" (decode-char 'ucs 947))
 759               (cons "'d" (decode-char 'ucs 948))
 760               ))))
 761
 762 (defun tuareg-font-lock-compose-symbol (alist)
 763   "Compose a sequence of ascii chars into a symbol.
 764 Regexp match data 0 points to the chars."
 765   ;; Check that the chars should really be composed into a symbol.
 766   (let* ((start (match-beginning 0))
 767          (end (match-end 0))
 768          (syntaxes (if (eq (char-syntax (char-after start)) ?w)
 769                        '(?w) '(?. ?\\))))
 770     (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
 771             (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
 772             (memq (get-text-property start 'face)
 773                   '(tuareg-doc-face font-lock-string-face
 774                     font-lock-comment-face)))
 775         ;; No composition for you. Let's actually remove any composition
 776         ;; we may have added earlier and which is now incorrect.
 777         (remove-text-properties start end '(composition))
 778       ;; That's a symbol alright, so add the composition.
 779       (compose-region start end (cdr (assoc (match-string 0) alist)))))
 780   ;; Return nil because we're not adding any face property.
 781   nil)
 782
 783 (defun tuareg-font-lock-symbols-keywords ()
 784   (when (fboundp 'compose-region)
 785     (let ((alist nil))
 786       (dolist (x tuareg-font-lock-symbols-alist)
 787         (when (and (if (fboundp 'char-displayable-p)
 788                        (char-displayable-p (cdr x))
 789                      t)
 790                    (not (assoc (car x) alist))) ;Not yet in alist.
 791           (push x alist)))
 792       (when alist
 793         `((,(regexp-opt (mapcar 'car alist) t)
 794            (0 (tuareg-font-lock-compose-symbol ',alist))))))))
 795
 796 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 797 ;;                                  Font-Lock
 798
 799 (unless tuareg-use-syntax-ppss
 800
 801 (defun tuareg-fontify-buffer ()
 802   (font-lock-default-fontify-buffer)
 803   (tuareg-fontify (point-min) (point-max)))
 804
 805 (defun tuareg-fontify-region (begin end &optional verbose)
 806   (font-lock-default-fontify-region begin end verbose)
 807   (tuareg-fontify begin end))
 808
 809 (defun tuareg-fontify (begin end)
 810   (if (eq major-mode 'tuareg-mode)
 811       (save-excursion
 812         (let ((modified (buffer-modified-p))) ; Emacs hack (see below)
 813           (goto-char begin)
 814           (beginning-of-line)
 815           (setq begin (point))
 816           (goto-char (1- end))
 817           (end-of-line)
 818           ;; Dirty hack to trick `font-lock-default-unfontify-region'
 819           (if (not tuareg-with-xemacs) (forward-line 2))
 820           (setq end (point))
 821           (while (> end begin)
 822             (goto-char (1- end))
 823             (tuareg-in-literal-or-comment)
 824             (cond
 825              ((cdr tuareg-last-loc)
 826               (tuareg-beginning-of-literal-or-comment)
 827               (put-text-property (max begin (point)) end 'face
 828                                  (if (looking-at
 829                                       "(\\*[Tt][Ee][Xx]\\|(\\*\\*[^*]")
 830                                      tuareg-doc-face
 831                                    'font-lock-comment-face))
 832               (setq end (1- (point))))
 833              ((car tuareg-last-loc)
 834               (tuareg-beginning-of-literal-or-comment)
 835               (put-text-property (max begin (point)) end 'face
 836                                  'font-lock-string-face)
 837               (setq end (point)))
 838              (t (while (and tuareg-cache-local
 839                             (or (> (caar tuareg-cache-local) end)
 840                                 (eq 'b (cadar tuareg-cache-local))))
 841                   (setq tuareg-cache-local (cdr tuareg-cache-local)))
 842                 (setq end (if tuareg-cache-local
 843                               (caar tuareg-cache-local) begin)))))
 844           (if (not (or tuareg-with-xemacs modified)) ; properties taken
 845               (set-buffer-modified-p nil))))))       ; too seriously...
 846
 847 ;; XEmacs and Emacs have different documentation faces...
 848 (defvar tuareg-doc-face (if (facep 'font-lock-doc-face)
 849                             'font-lock-doc-face
 850                           'font-lock-doc-string-face))
 851
 852 ) ;; End of (unless tuareg-use-syntax-ppss
 853
 854 ;; By Stefan Monnier: redesigned font-lock installation and use char classes
 855
 856 ;; When char classes are not available, character ranges only span
 857 ;; ASCII characters for MULE compatibility
 858 (defconst tuareg-use-char-classes (string-match "[[:alpha:]]" "x"))
 859 (defconst tuareg-lower (if tuareg-use-char-classes "[:lower:]" "a-z"))
 860 (defconst tuareg-alpha (if tuareg-use-char-classes "[:alpha:]" "a-zA-Z"))
 861
 862 (defconst tuareg-font-lock-syntactic-keywords
 863   ;; Char constants start with ' but ' can also appear in identifiers.
 864   ;; Beware not to match things like '*)hel' or '"hel' since the first '
 865   ;; might be inside a string or comment.
 866   '(("\\<\\('\\)\\([^'\\\n]\\|\\\\.[^\\'\n \")]*\\)\\('\\)"
 867      (1 '(7)) (3 '(7)))))
 868
 869 (defun tuareg-font-lock-syntactic-face-function (state)
 870   (if (nth 3 state) font-lock-string-face
 871     (let ((start (nth 8 state)))
 872       (if (and (> (point-max) (+ start 2))
 873                (eq (char-after (+ start 2)) ?*)
 874                (not (eq (char-after (+ start 3)) ?*)))
 875           ;; This is a documentation comment
 876           tuareg-doc-face
 877         font-lock-comment-face))))
 878
 879 (when (facep 'font-lock-reference-face)
 880   (defvar font-lock-constant-face)
 881   (if (facep 'font-lock-constant-face) ()
 882     (defvar font-lock-constant-face font-lock-reference-face)
 883     (copy-face font-lock-reference-face 'font-lock-constant-face)))
 884 (when (facep 'font-lock-keyword-face)
 885   (defvar font-lock-preprocessor-face)
 886   (if (facep 'font-lock-preprocessor-face) ()
 887     (defvar font-lock-preprocessor-face font-lock-keyword-face)
 888     (copy-face font-lock-keyword-face 'font-lock-preprocessor-face)))
 889
 890 ;; Initially empty, set in `tuareg-install-font-lock'
 891 (defvar tuareg-font-lock-keywords
 892   ()
 893   "Font-Lock patterns for Tuareg mode.")
 894
 895 (when (featurep 'sym-lock)
 896   (make-face 'tuareg-font-lock-lambda-face
 897              "Face description for fun keywords (lambda operator).")
 898   (set-face-parent 'tuareg-font-lock-lambda-face
 899                    font-lock-function-name-face)
 900   (set-face-font 'tuareg-font-lock-lambda-face
 901                  sym-lock-font-name)
 902
 903   ;; To change this table, xfd -fn '-adobe-symbol-*--12-*' may be
 904   ;; used to determine the symbol character codes.
 905   (defvar tuareg-sym-lock-keywords
 906     '(("<-" 0 1 172 nil)
 907       ("->" 0 1 174 nil)
 908       ("<=" 0 1 163 nil)
 909       (">=" 0 1 179 nil)
 910       ("<>" 0 1 185 nil)
 911       ("==" 0 1 186 nil)
 912       ("||" 0 1 218 nil)
 913       ("&&" 0 1 217 nil)
 914       ("[^*]\\(\\*\\)\\." 1 8 180 nil)
 915       ("\\(/\\)\\." 1 3 184 nil)
 916       (";;" 0 1 191 nil)
 917       ("\\<sqrt\\>" 0 3 214 nil)
 918       ("\\<fun\\>" 0 3 108 tuareg-font-lock-lambda-face)
 919       ("\\<or\\>" 0 3 218 nil)
 920       ("\\<not\\>" 0 3 216 nil))
 921     "If non nil: Overrides default Sym-Lock patterns for Tuareg."))
 922
 923 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 924 ;;                                    Keymap
 925
 926 (defvar tuareg-mode-map
 927   (let ((map (make-sparse-keymap)))
 928     (define-key map "|" 'tuareg-electric)
 929     (define-key map ")" 'tuareg-electric-rp)
 930     (define-key map "}" 'tuareg-electric-rc)
 931     (define-key map "]" 'tuareg-electric-rb)
 932     (define-key map "\M-q" 'tuareg-indent-phrase)
 933     (define-key map "\C-c\C-q" 'tuareg-indent-phrase)
 934     (define-key map "\M-\C-\\" 'indent-region)
 935     (define-key map "\C-c\C-a" 'tuareg-find-alternate-file)
 936     (define-key map "\C-c\C-c" 'compile)
 937     (define-key map "\C-xnd" 'tuareg-narrow-to-phrase)
 938     (define-key map "\M-\C-x" 'tuareg-eval-phrase)
 939     (define-key map "\C-x\C-e" 'tuareg-eval-phrase)
 940     (define-key map "\C-c\C-e" 'tuareg-eval-phrase)
 941     (define-key map "\C-c\C-r" 'tuareg-eval-region)
 942     (define-key map "\C-c\C-b" 'tuareg-eval-buffer)
 943     (define-key map "\C-c\C-s" 'tuareg-run-caml)
 944     (define-key map "\C-c\C-i" 'tuareg-interrupt-caml)
 945     (define-key map "\C-c\C-k" 'tuareg-kill-caml)
 946     (define-key map "\C-c\C-n" 'tuareg-next-phrase)
 947     (define-key map "\C-c\C-p" 'tuareg-previous-phrase)
 948     (define-key map [(control c) (home)] 'tuareg-move-inside-block-opening)
 949     (define-key map [(control c) (control down)] 'tuareg-next-phrase)
 950     (define-key map [(control c) (control up)] 'tuareg-previous-phrase)
 951     (define-key map [(meta control down)]  'tuareg-next-phrase)
 952     (define-key map [(meta control up)] 'tuareg-previous-phrase)
 953     (define-key map [(meta control h)] 'tuareg-mark-phrase)
 954     (define-key map "\C-c`" 'tuareg-interactive-next-error-source)
 955     (define-key map "\C-c?" 'tuareg-interactive-next-error-source)
 956     (define-key map "\C-c.c" 'tuareg-insert-class-form)
 957     (define-key map "\C-c.b" 'tuareg-insert-begin-form)
 958     (define-key map "\C-c.f" 'tuareg-insert-for-form)
 959     (define-key map "\C-c.w" 'tuareg-insert-while-form)
 960     (define-key map "\C-c.i" 'tuareg-insert-if-form)
 961     (define-key map "\C-c.l" 'tuareg-insert-let-form)
 962     (define-key map "\C-c.m" 'tuareg-insert-match-form)
 963     (define-key map "\C-c.t" 'tuareg-insert-try-form)
 964     (when tuareg-with-caml-mode-p
 965       ;; Trigger caml-types
 966       (define-key map [?\C-c ?\C-t] 'caml-types-show-type)
 967       ;; To prevent misbehavior in case of error during exploration.
 968       (define-key map [(control mouse-2)] 'caml-types-mouse-ignore)
 969       (define-key map [(control down-mouse-2)] 'caml-types-explore)
 970       ;; Trigger caml-help
 971       (define-key map [?\C-c ?i] 'ocaml-add-path)
 972       (define-key map [?\C-c ?\[] 'ocaml-open-module)
 973       (define-key map [?\C-c ?\]] 'ocaml-close-module)
 974       (define-key map [?\C-c ?h] 'caml-help)
 975       (define-key map [?\C-c ?\t] 'caml-complete))
 976     map)
 977   "Keymap used in Tuareg mode.")
 978
 979 (defvar tuareg-mode-syntax-table
 980   (let ((st (make-syntax-table)))
 981     (modify-syntax-entry ?_ "_" st)
 982     (modify-syntax-entry ?? ". p" st)
 983     (modify-syntax-entry ?~ ". p" st)
 984     (modify-syntax-entry ?: "." st)
 985     (modify-syntax-entry ?' "w" st)     ; ' is part of words (for primes).
 986     (modify-syntax-entry
 987      ;; ` is punctuation or character delimiter (Caml Light compatibility).
 988      ?` (if tuareg-support-camllight "\"" ".") st)
 989     (modify-syntax-entry ?\" "\"" st)   ; " is a string delimiter
 990     (modify-syntax-entry ?\\ "\\" st)
 991     (modify-syntax-entry ?*  ". 23" st)
 992     (condition-case nil
 993         (progn
 994           (modify-syntax-entry ?\( "()1n" st)
 995           (modify-syntax-entry ?\) ")(4n" st))
 996       (error               ;XEmacs signals an error instead of ignoring `n'.
 997        (modify-syntax-entry ?\( "()1" st)
 998        (modify-syntax-entry ?\) ")(4" st)))
 999     st)
1000   "Syntax table in use in Tuareg mode buffers.")
1001
1002 (defconst tuareg-font-lock-syntax
1003   `((?_ . "w") (?` . ".")
1004     ,@(unless tuareg-use-syntax-ppss
1005         '((?\" . ".") (?\( . ".") (?\) . ".") (?* . "."))))
1006   "Syntax changes for Font-Lock.")
1007
1008 (defvar tuareg-mode-abbrev-table ()
1009   "Abbrev table used for Tuareg mode buffers.")
1010 (defun tuareg-define-abbrev (keyword)
1011   (define-abbrev tuareg-mode-abbrev-table keyword keyword 'tuareg-abbrev-hook))
1012 (if tuareg-mode-abbrev-table ()
1013   (setq tuareg-mode-abbrev-table (make-abbrev-table))
1014   (mapcar 'tuareg-define-abbrev
1015           '("module" "class" "functor" "object" "type" "val" "inherit"
1016             "include" "virtual" "constraint" "exception" "external" "open"
1017             "method" "and" "initializer" "to" "downto" "do" "done" "else"
1018             "begin" "end" "let" "in" "then" "with"))
1019   (setq abbrevs-changed nil))
1020
1021 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1022 ;;                              The major mode
1023
1024 ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ml[ily]?\\'" . tuareg-mode))
1025
1026 ;;;###autoload
1027 (defun tuareg-mode ()
1028   "Major mode for editing Caml code.
1029
1030 Dedicated to Emacs and XEmacs, version 21 and higher. Provides
1031 automatic indentation and compilation interface. Performs font/color
1032 highlighting using Font-Lock. It is designed for Objective Caml but
1033 handles Objective Labl and Caml Light as well.
1034
1035 Report bugs, remarks and questions to Albert.Cohen@prism.uvsq.fr.
1036
1037 The Font-Lock minor-mode is used according to your customization
1038 options. Within XEmacs (non-MULE versions only) you may also want to
1039 use Sym-Lock:
1040
1041 \(if (and (boundp 'window-system) window-system)
1042     (when (string-match \"XEmacs\" emacs-version)
1043        (if (not (and (boundp 'mule-x-win-initted) mule-x-win-initted))
1044             (require 'sym-lock))
1045        (require 'font-lock)))
1046
1047 You have better byte-compile tuareg.el (and sym-lock.el if you use it)
1048 because symbol highlighting is very time consuming.
1049
1050 For customization purposes, you should use `tuareg-mode-hook'
1051 \(run for every file) or `tuareg-load-hook' (run once) and not patch
1052 the mode itself. You should add to your configuration file something like:
1053   (add-hook 'tuareg-mode-hook
1054             (lambda ()
1055                ... ; your customization code
1056             ))
1057 For example you can change the indentation of some keywords, the
1058 `electric' flags, Font-Lock colors... Every customizable variable is
1059 documented, use `C-h-v' or look at the mode's source code.
1060
1061 A special case is Sym-Lock customization: You may set
1062 `tuareg-sym-lock-keywords' in your `.emacs' configuration file
1063 to override default Sym-Lock patterns.
1064
1065 `custom-tuareg.el' is a sample customization file for standard changes.
1066 You can append it to your `.emacs' or use it as a tutorial.
1067
1068 `M-x camldebug' FILE starts the Caml debugger camldebug on the executable
1069 FILE, with input and output in an Emacs buffer named *camldebug-FILE*.
1070
1071 A Tuareg Interactive Mode to evaluate expressions in a toplevel is included.
1072 Type `M-x tuareg-run-caml' or see special-keys below.
1073
1074 Some elementary rules have to be followed in order to get the best of
1075 indentation facilities.
1076   - Because the `function' keyword has a special indentation (to handle
1077     case matches) use the `fun' keyword when no case match is performed.
1078   - In OCaml, `;;' is no longer necessary for correct indentation,
1079     except before top level phrases not introduced by `type', `val', `let'
1080     etc. (i.e., phrases used for their side-effects or to be executed
1081     in a top level.)
1082   - Long sequences of `and's may slow down indentation slightly, since
1083     some computations (few) require to go back to the beginning of the
1084     sequence. Some very long nested blocks may also lead to slow
1085     processing of `end's, `else's, `done's...
1086   - Multiline strings are handled properly, but the string concatenation `^'
1087     is preferred to break long strings (the C-j keystroke can help).
1088
1089 Known bugs:
1090   - When writting a line with mixed code and comments, avoid putting
1091     comments at the beginning or middle of the text. More precisely,
1092     writing comments immediately after `=' or parentheses then writing
1093     some more code on the line leads to indentation errors. You may write
1094     `let x (* blah *) = blah' but should avoid `let x = (* blah *) blah'.
1095
1096 Special keys for Tuareg mode:\\{tuareg-mode-map}"
1097   (interactive)
1098   (kill-all-local-variables)
1099   (setq major-mode 'tuareg-mode)
1100   (setq mode-name "Tuareg")
1101   (use-local-map tuareg-mode-map)
1102   (set-syntax-table tuareg-mode-syntax-table)
1103   (setq local-abbrev-table tuareg-mode-abbrev-table)
1104
1105   (tuareg-build-menu)
1106
1107   (make-local-variable 'paragraph-start)
1108   (setq paragraph-start (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter))
1109   (make-local-variable 'paragraph-separate)
1110   (setq paragraph-separate paragraph-start)
1111   (make-local-variable 'require-final-newline)
1112   (setq require-final-newline t)
1113   (make-local-variable 'comment-start)
1114   (setq comment-start "(* ")
1115   (make-local-variable 'comment-end)
1116   (setq comment-end " *)")
1117   (make-local-variable 'comment-column)
1118   (setq comment-column 40)
1119   (make-local-variable 'comment-start-skip)
1120   (setq comment-start-skip "(\\*+[ \t]*")
1121   (make-local-variable 'comment-multi-line)
1122   (setq comment-multi-line t)
1123   (make-local-variable 'parse-sexp-ignore-comments)
1124   (setq parse-sexp-ignore-comments nil)
1125   (make-local-variable 'indent-line-function)
1126   (setq indent-line-function 'tuareg-indent-command)
1127   (unless tuareg-use-syntax-ppss
1128     (make-local-hook 'before-change-functions)
1129     (add-hook 'before-change-functions 'tuareg-before-change-function nil t))
1130   (make-local-variable 'normal-auto-fill-function)
1131   (setq normal-auto-fill-function 'tuareg-auto-fill-function)
1132
1133   ;; Hooks for tuareg-mode, use them for tuareg-mode configuration
1134   (tuareg-install-font-lock)
1135   (run-hooks 'tuareg-mode-hook)
1136   (if tuareg-use-abbrev-mode (abbrev-mode 1))
1137   (message
1138    (concat "Major mode for editing and running Caml programs, "
1139            tuareg-mode-version ".")))
1140
1141 (defun tuareg-install-font-lock (&optional no-sym-lock)
1142   (setq
1143    tuareg-font-lock-keywords
1144    (append
1145     (list
1146      (list "\\<\\(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\\|and\\|begin\\|object\\|end\\)\\>"
1147            0 'tuareg-font-lock-governing-face nil nil))
1148     (if tuareg-support-metaocaml
1149         (list (list "\\.<\\|>\\.\\|\\.~\\|\\.!"
1150                     0 'tuareg-font-lock-multistage-face nil nil))
1151       ())
1152     (list
1153      (list "\\<\\(false\\|true\\)\\>"
1154            0 'font-lock-constant-face nil nil)
1155      (list "\\<\\(as\\|do\\(ne\\|wnto\\)?\\|else\\|for\\|if\\|m\\(atch\\|utable\\)\\|new\\|p\\(arser\\|rivate\\)\\|t\\(hen\\|o\\|ry\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|lazy\\|exception\\|raise\\|failwith\\|exit\\|assert\\|fun\\(ction\\)?\\)\\>"
1156            0 'font-lock-keyword-face nil nil)
1157      (list "[][;,()|{}]\\|[@^!:*=<>&/%+~?#---]\\.?\\|\\.\\.\\.*\\|\\<\\(asr\\|asl\\|lsr\\|lsl\\|l?or\\|l?and\\|xor\\|not\\|mod\\|of\\|ref\\)\\>"
1158            0 'tuareg-font-lock-operator-face nil nil)
1159      (list (concat "\\<\\(\\(method\\([ \t\n]+\\(private\\|virtual\\)\\)?\\)\\([ \t\n]+virtual\\)?\\|val\\([ \t\n]+mutable\\)?\\|external\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(['_" tuareg-lower "]\\(\\w\\|[._]\\)*\\)\\>[ \t\n]*\\(\\(\\w\\|[()_?~.'*:--->]\\)+\\|=[ \t\n]*fun\\(ction\\)?\\>\\)")
1160            8 'font-lock-function-name-face 'keep nil)
1161      (list "\\<method\\([ \t\n]+\\(private\\|virtual\\)\\)?\\>[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)"
1162            3 'font-lock-function-name-face 'keep nil)
1163      (list "\\<\\(fun\\(ction\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_ \t()*,]\\)+\\)"
1164            3 'font-lock-variable-name-face 'keep nil)
1165      (list "\\<\\(val\\([ \t\n]+mutable\\)?\\|external\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)"
1166            4 'font-lock-variable-name-face 'keep nil)
1167      (list "\\<\\(val\\([ \t\n]+mutable\\)?\\|external\\|method\\|and\\|class\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t\n]*\\(\\(\\w\\|[_,?~.]\\)*\\)\\>\\(\\(\\w\\|[->_ \t,?~.]\\|(\\(\\w\\|[--->_ \t,?~.=]\\)*)\\)*\\)"
1168            6 'font-lock-variable-name-face 'keep nil)
1169      (list "\\<\\(open\\|\\(class\\([ \t\n]+type\\)?\\)\\([ \t\n]+virtual\\)?\\|inherit\\|include\\|module\\([ \t\n]+\\(type\\|rec\\)\\)?\\|type\\)\\>[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)"
1170            7 'font-lock-type-face 'keep nil)
1171      (list "[^:>=]:[ \t\n]*\\(['~?]*\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)"
1172            1 'font-lock-type-face 'keep nil)
1173      (list "\\<\\([A-Z]\\w*\\>\\)[ \t]*\\."
1174            1 'font-lock-type-face 'keep nil)
1175      (list (concat "\\<\\([?~]?[_" tuareg-alpha "]\\w*\\)[ \t\n]*:[^:>=]")
1176            1 'font-lock-variable-name-face 'keep nil)
1177      (list (concat "\\<exception\\>[ \t\n]*\\(\\<[_" tuareg-alpha "]\\w*\\>\\)")
1178            1 'font-lock-variable-name-face 'keep nil)
1179      (list "^#\\w+\\>"
1180            0 'font-lock-preprocessor-face t nil))
1181     (if tuareg-font-lock-symbols
1182         (tuareg-font-lock-symbols-keywords)
1183       ())))
1184   (if (and (not no-sym-lock)
1185            (featurep 'sym-lock))
1186       (progn
1187         (setq sym-lock-color
1188               (face-foreground 'tuareg-font-lock-operator-face))
1189         (if (not sym-lock-keywords)
1190             (sym-lock tuareg-sym-lock-keywords))))
1191   (setq font-lock-defaults
1192         (list*
1193          'tuareg-font-lock-keywords (not tuareg-use-syntax-ppss) nil
1194          tuareg-font-lock-syntax nil
1195          '(font-lock-syntactic-keywords
1196            . tuareg-font-lock-syntactic-keywords)
1197          '(parse-sexp-lookup-properties
1198            . t)
1199          '(font-lock-syntactic-face-function
1200            . tuareg-font-lock-syntactic-face-function)
1201          (unless tuareg-use-syntax-ppss
1202            '((font-lock-fontify-region-function
1203               . tuareg-fontify-region)))))
1204   (when (and (boundp 'font-lock-fontify-region-function)
1205              (not tuareg-use-syntax-ppss))
1206   (make-local-variable 'font-lock-fontify-region-function)
1207       (setq font-lock-fontify-region-function 'tuareg-fontify-region)))
1208
1209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1210 ;;                               Error processing
1211
1212 (require 'compile)
1213
1214 ;; In some versions of Emacs, the regexps in
1215 ;; compilation-error-regexp-alist do not match the error messages when
1216 ;; the language is not English. Hence we add a regexp.
1217
1218 (defconst tuareg-error-regexp
1219   "^[^\0-@]+ \"\\([^\"\n]+\\)\", [^\0-@]+ \\([0-9]+\\)[-,:]"
1220   "Regular expression matching the error messages produced by (o)camlc.")
1221
1222 (if (boundp 'compilation-error-regexp-alist)
1223     (or (assoc tuareg-error-regexp
1224                compilation-error-regexp-alist)
1225         (setq compilation-error-regexp-alist
1226               (cons (list tuareg-error-regexp 1 2)
1227                compilation-error-regexp-alist))))
1228
1229 ;; A regexp to extract the range info.
1230
1231 (defconst tuareg-error-chars-regexp
1232   ".*, .*, [^\0-@]+ \\([0-9]+\\)-\\([0-9]+\\):"
1233   "Regexp matching the char numbers in an error message produced by (o)camlc.")
1234
1235 ;; Wrapper around next-error.
1236
1237 ;; itz 04-21-96 instead of defining a new function, use defadvice
1238 ;; that way we get our effect even when we do \C-x` in compilation buffer
1239
1240 (defadvice next-error (after tuareg-next-error activate)
1241  "Read the extra positional information provided by the Caml compiler.
1242
1243 Puts the point and the mark exactly around the erroneous program
1244 fragment. The erroneous fragment is also temporarily highlighted if
1245 possible."
1246  (if (eq major-mode 'tuareg-mode)
1247      (let ((beg nil) (end nil))
1248        (save-excursion
1249          (set-buffer compilation-last-buffer)
1250          (save-excursion
1251            (goto-char (window-point (get-buffer-window (current-buffer) t)))
1252            (if (looking-at tuareg-error-chars-regexp)
1253                (setq beg (string-to-number (tuareg-match-string 1))
1254                      end (string-to-number (tuareg-match-string 2))))))
1255        (beginning-of-line)
1256        (if beg
1257            (progn
1258              (setq beg (+ (point) beg) end (+ (point) end))
1259              (goto-char beg) (push-mark end t t))))))
1260
1261 (defvar tuareg-interactive-error-regexp
1262   (concat "\\(\\("
1263           "Toplevel input:"
1264           "\\|Entr.e interactive:"
1265           "\\|Characters [0-9-]*:"
1266           "\\|The global value [^ ]* is referenced before being defined."
1267           "\\|La valeur globale [^ ]* est utilis.e avant d'.tre d.finie."
1268           "\\|Reference to undefined global"
1269           "\\|The C primitive \"[^\"]*\" is not available."
1270           "\\|La primitive C \"[^\"]*\" est inconnue."
1271           "\\|Cannot find \\(the compiled interface \\)?file"
1272           "\\|L'interface compil.e [^ ]* est introuvable."
1273           "\\|Le fichier [^ ]* est introuvable."
1274           "\\|Exception non rattrap.e:"
1275           "\\|Uncaught exception:"
1276           "\\)[^#]*\\)" )
1277   "Regular expression matching the error messages produced by Caml.")
1278
1279 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1280 ;;                               Indentation stuff
1281
1282 (defconst tuareg-keyword-regexp "\\<\\(object\\|initializer\\|and\\|c\\(onstraint\\|lass\\)\\|m\\(atch\\|odule\\|ethod\\|utable\\)\\|s\\(ig\\|truct\\)\\|begin\\|e\\(lse\\|x\\(ception\\|ternal\\)\\)\\|t\\(o\\|hen\\|ry\\|ype\\)\\|v\\(irtual\\|al\\)\\|w\\(h\\(ile\\|en\\)\\|ith\\)\\|i\\(f\\|n\\(herit\\)?\\)\\|f\\(or\\|un\\(ct\\(or\\|ion\\)\\)?\\)\\|let\\|do\\(wnto\\)?\\|parser?\\|rule\\|of\\)\\>\\|->\\|[;,|]"
1283   "Regexp for all recognized keywords.")
1284
1285 (defconst tuareg-match-|-keyword-regexp
1286   "\\<\\(and\\|fun\\(ction\\)?\\|type\\|with\\|parser?\\)\\>\\|[[({|=]"
1287   "Regexp for keywords supporting case match.")
1288
1289 (defconst tuareg-operator-regexp "[---+*/=<>@^&|]\\|:>\\|::\\|\\<\\(or\\|l\\(and\\|x?or\\|s[lr]\\)\\|as[lr]\\|mod\\)\\>"
1290   "Regexp for all operators.")
1291
1292 (defconst tuareg-kwop-regexp (concat tuareg-keyword-regexp "\\|=")
1293   "Regexp for all keywords, and the = operator which is generally
1294 considered as a special keyword.")
1295
1296 (defconst tuareg-matching-keyword-regexp
1297   "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|>\\."
1298   "Regexp matching Caml keywords which act as end block delimiters.")
1299
1300 (defconst tuareg-leading-kwop-regexp
1301   (concat tuareg-matching-keyword-regexp "\\|\\<with\\>\\|[|>]?\\]\\|>?}\\|[|)]\\|;;")
1302   "Regexp matching Caml keywords which need special indentation.")
1303
1304 (defconst tuareg-governing-phrase-regexp
1305   "\\<\\(val\\|type\\|m\\(ethod\\|odule\\)\\|c\\(onstraint\\|lass\\)\\|in\\(herit\\|itializer\\)\\|ex\\(ternal\\|ception\\)\\|open\\|let\\|object\\|include\\)\\>"
1306   "Regexp matching tuareg phrase delimitors.")
1307
1308 (defconst tuareg-governing-phrase-regexp-with-break
1309   (concat tuareg-governing-phrase-regexp "\\|;;"))
1310
1311 (defconst tuareg-keyword-alist
1312   '(("module" . tuareg-default-indent)
1313     ("class" . tuareg-class-indent)
1314     ("sig" . tuareg-sig-struct-indent)
1315     ("struct" . tuareg-sig-struct-indent)
1316     ("method" . tuareg-method-indent)
1317     ("object" . tuareg-begin-indent)
1318     ("begin" . tuareg-begin-indent)
1319     (".<" . tuareg-begin-indent)
1320     ("for" . tuareg-for-while-indent)
1321     ("while" . tuareg-for-while-indent)
1322     ("do" . tuareg-do-indent)
1323     ("type" . tuareg-type-indent) ; in some cases, `type' acts like a match
1324     ("val" . tuareg-val-indent)
1325     ("fun" . tuareg-fun-indent)
1326     ("if" . tuareg-if-then-else-indent)
1327     ("then" . tuareg-if-then-else-indent)
1328     ("else" . tuareg-if-then-else-indent)
1329     ("let" . tuareg-let-indent)
1330     ("match" . tuareg-match-indent)
1331     ("try" . tuareg-try-indent)
1332     ("rule" . tuareg-rule-indent)
1333
1334     ;; Case match keywords
1335     ("function" . tuareg-function-indent)
1336     ("with" . tuareg-with-indent)
1337     ("parse" . tuareg-parse-indent)
1338     ("parser" . tuareg-parser-indent)
1339
1340     ;; Default indentation keywords
1341     ("when" . tuareg-default-indent)
1342     ("functor" . tuareg-default-indent)
1343     ("exception" . tuareg-default-indent)
1344     ("inherit" . tuareg-default-indent)
1345     ("initializer" . tuareg-default-indent)
1346     ("constraint" . tuareg-default-indent)
1347     ("virtual" . tuareg-default-indent)
1348     ("mutable" . tuareg-default-indent)
1349     ("external" . tuareg-default-indent)
1350     ("in" . tuareg-in-indent)
1351     ("of" . tuareg-default-indent)
1352     ("to" . tuareg-default-indent)
1353     ("downto" . tuareg-default-indent)
1354     (".<" . tuareg-default-indent)
1355     ("[" . tuareg-default-indent)
1356     ("(" . tuareg-default-indent)
1357     ("{" . tuareg-default-indent)
1358     ("->" . tuareg-default-indent)
1359     ("|" . tuareg-default-indent))
1360 "Association list of indentation values based on governing keywords.")
1361
1362 (defconst tuareg-leading-kwop-alist
1363   '(("|" . tuareg-find-|-match)
1364     ("}" . tuareg-find-match)
1365     (">}" . tuareg-find-match)
1366     (">." . tuareg-find-match)
1367     (")" . tuareg-find-match)
1368     ("]" . tuareg-find-match)
1369     ("|]" . tuareg-find-match)
1370     (">]" . tuareg-find-match)
1371     ("end" . tuareg-find-match)
1372     ("done" . tuareg-find-done-match)
1373     ("in"  . tuareg-find-in-match)
1374     ("with" . tuareg-find-with-match)
1375     ("else" . tuareg-find-else-match)
1376     ("then" . tuareg-find-match)
1377     ("do" . tuareg-find-do-match)
1378     ("to" . tuareg-find-match)
1379     ("downto" . tuareg-find-match)
1380     ("and" . tuareg-find-and-match))
1381   "Association list used in Tuareg mode for skipping back over nested blocks.")
1382
1383 (defun tuareg-find-meaningful-word ()
1384   "Look back for a word, skipping comments and blanks.
1385 Returns the actual text of the word, if found."
1386   (let ((found nil) (kwop nil))
1387     (while
1388         (and (not found)
1389              (re-search-backward
1390               (concat
1391                "[^ \t\n_0-9" tuareg-alpha "]\\|\\<\\(\\w\\|_\\)+\\>\\|\\*)")
1392               (point-min) t))
1393       (setq kwop (tuareg-match-string 0))
1394       (if kwop
1395           (if (tuareg-in-comment-p)
1396               (tuareg-beginning-of-literal-or-comment-fast)
1397             (setq found t))
1398         (setq found t)))
1399     (if found kwop (goto-char (point-min)) nil)))
1400
1401 (defconst tuareg-find-kwop-regexp
1402   (concat tuareg-matching-keyword-regexp
1403           "\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|object\\)\\>\\|[][(){}]\\|\\*)"))
1404
1405 (defun tuareg-make-find-kwop-regexp (kwop-regexp)
1406   (concat tuareg-find-kwop-regexp "\\|" kwop-regexp))
1407
1408 (defun tuareg-find-kwop (kr &optional do-not-skip-regexp)
1409   "Look back for a Caml keyword or operator matching KWOP-REGEXP.
1410 Skips blocks etc...
1411
1412 Ignore occurences inside literals and comments.
1413 If found, return the actual text of the keyword or operator."
1414   (let ((found nil)
1415         (kwop nil)
1416         (kwop-regexp (if tuareg-support-metaocaml
1417                          (concat kr "\\|\\.<\\|>\\.") kr)))
1418     (while (and (not found)
1419                 (re-search-backward kwop-regexp (point-min) t)
1420                 (setq kwop (tuareg-match-string 0)))
1421       (cond
1422        ((tuareg-in-literal-or-comment-p)
1423         (tuareg-beginning-of-literal-or-comment-fast))
1424        ((looking-at "[]})]")
1425         (tuareg-backward-up-list))
1426        ((tuareg-at-phrase-break-p)
1427         (setq found t))
1428        ((and do-not-skip-regexp (looking-at do-not-skip-regexp))
1429         (if (and (string= kwop "|") (char-equal ?| (preceding-char)))
1430             (backward-char)
1431           (setq found t)))
1432        ((looking-at tuareg-matching-keyword-regexp)
1433         (funcall (cdr (assoc (tuareg-match-string 0)
1434                              tuareg-leading-kwop-alist))))
1435        (t (setq found t))))
1436     (if found kwop (goto-char (point-min)) nil)))
1437
1438 (defun tuareg-find-match ()
1439   (tuareg-find-kwop tuareg-find-kwop-regexp))
1440
1441 (defconst tuareg-find-,-match-regexp
1442   (tuareg-make-find-kwop-regexp
1443    "\\<\\(and\\|match\\|begin\\|else\\|exception\\|then\\|try\\|with\\|or\\|fun\\|function\\|let\\|do\\)\\>\\|->\\|[[{(]"))
1444 (defun tuareg-find-,-match ()
1445   (tuareg-find-kwop tuareg-find-,-match-regexp))
1446
1447 (defconst tuareg-find-with-match-regexp
1448   (tuareg-make-find-kwop-regexp
1449    "\\<\\(match\\|try\\|module\\|begin\\|with\\)\\>\\|[[{(]"))
1450 (defun tuareg-find-with-match ()
1451   (let ((kwop (tuareg-find-kwop tuareg-find-with-match-regexp
1452                                 "\\<with\\>")))
1453     (if (string= kwop "with")
1454         (progn
1455           (tuareg-find-with-match)
1456           (tuareg-find-with-match)))
1457     kwop))
1458
1459 (defconst tuareg-find-in-match-regexp
1460   (tuareg-make-find-kwop-regexp "\\<let\\>"))
1461 (defun tuareg-find-in-match ()
1462   (let ((kwop (tuareg-find-kwop tuareg-find-in-match-regexp "\\<and\\>")))
1463     (cond ((string= kwop "and") (tuareg-find-in-match))
1464           (t kwop))))
1465
1466 (defconst tuareg-find-else-match-regexp
1467   (tuareg-make-find-kwop-regexp ";\\|->\\|\\<with\\>"))
1468 (defun tuareg-find-else-match ()
1469   (let ((kwop (tuareg-find-kwop tuareg-find-else-match-regexp
1470                                 "->\\|\\<\\(with\\|then\\)\\>")))
1471     (cond
1472      ((string= kwop "then")
1473       (tuareg-find-match))
1474      ((string= kwop "with")
1475       (tuareg-find-with-match))
1476      ((string= kwop "->")
1477       (setq kwop (tuareg-find-->-match))
1478       (while (string= kwop "|")
1479         (setq kwop (tuareg-find-|-match)))
1480       (if (string= kwop "with")
1481           (tuareg-find-with-match))
1482       (tuareg-find-else-match))
1483      ((string= kwop ";")
1484       (tuareg-find-semi-colon-match)
1485       (tuareg-find-else-match)))
1486     kwop))
1487
1488 (defun tuareg-find-do-match ()
1489   (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp
1490                                    "\\<\\(down\\)?to\\>")))
1491     (if (or (string= kwop "to") (string= kwop "downto"))
1492         (tuareg-find-match) kwop)))
1493
1494 (defun tuareg-find-done-match ()
1495   (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp "\\<do\\>")))
1496     (if (string= kwop "do")
1497         (tuareg-find-do-match) kwop)))
1498
1499 (defconst tuareg-find-and-match-regexp
1500   "\\<\\(do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|class\\)\\>\\|[][(){}]\\|\\*)\\|\\<\\(rule\\|exception\\|let\\|in\\|type\\|val\\|module\\)\\>")
1501 (defconst tuareg-find-and-match-regexp-dnr
1502   (concat tuareg-find-and-match-regexp "\\|\\<and\\>"))
1503 (defun tuareg-find-and-match (&optional do-not-recurse)
1504   (let* ((kwop (tuareg-find-kwop (if do-not-recurse
1505                                      tuareg-find-and-match-regexp-dnr
1506                                    tuareg-find-and-match-regexp)
1507                                  "\\<and\\>"))
1508          (old-point (point)))
1509     (cond ((or (string= kwop "type") (string= kwop "module"))
1510            (let ((kwop2 (tuareg-find-meaningful-word)))
1511              (cond ((string= kwop2 "with")
1512                     kwop2)
1513                    ((string= kwop2 "and")
1514                     (tuareg-find-and-match))
1515                    ((and (string= kwop "module")
1516                         (string= kwop2 "let"))
1517                     kwop2)
1518                    (t (goto-char old-point) kwop))))
1519           (t kwop))))
1520
1521 (defconst tuareg-find-=-match-regexp
1522   (tuareg-make-find-kwop-regexp "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|type\\|class\\|when\\|i[fn]\\)\\>\\|="))
1523 (defun tuareg-find-=-match ()
1524   (let ((kwop (tuareg-find-kwop tuareg-find-=-match-regexp
1525                                 "\\<\\(and\\|in\\)\\>\\|=")))
1526     (cond
1527      ((string= kwop "and")
1528       (tuareg-find-and-match))
1529      ((and (string= kwop "=")
1530            (not (tuareg-false-=-p)))
1531       (while (and (string= kwop "=")
1532                   (not (tuareg-false-=-p)))
1533         (setq kwop (tuareg-find-=-match)))
1534       kwop)
1535      (t kwop))))
1536
1537 (defun tuareg-if-when-= ()
1538   (save-excursion
1539     (tuareg-find-=-match)
1540     (looking-at "\\<\\(if\\|when\\)\\>")))
1541
1542 (defun tuareg-captive-= ()
1543   (save-excursion
1544     (tuareg-find-=-match)
1545     (looking-at "\\<\\(let\\|if\\|when\\|module\\|type\\|class\\)\\>")))
1546
1547 (defconst tuareg-find-|-match-regexp
1548   (tuareg-make-find-kwop-regexp
1549    "\\<\\(with\\|fun\\(ction\\)?\\|type\\|parser?\\)\\>\\|[=|]"))
1550 (defun tuareg-find-|-match ()
1551   (let* ((kwop (tuareg-find-kwop tuareg-find-|-match-regexp
1552                                  "\\<\\(and\\|with\\)\\>\\||"))
1553          (old-point (point)))
1554     (cond ((string= kwop "and")
1555            (setq old-point (point))
1556            (setq kwop (tuareg-find-and-match))
1557            (goto-char old-point)
1558            kwop)
1559           ((and (string= kwop "|")
1560                 (looking-at "|[^|]")
1561                 (tuareg-in-indentation-p))
1562            kwop)
1563           ((string= kwop "|") (tuareg-find-|-match))
1564           ((and (string= kwop "=")
1565                 (or (looking-at "=[ \t]*\\((\\*\\|$\\)")
1566                     (tuareg-false-=-p)
1567                     (not (string= (save-excursion (tuareg-find-=-match))
1568                                   "type"))))
1569            (tuareg-find-|-match))
1570           ((string= kwop "parse")
1571            (if (and (string-match "\\.mll" (buffer-name))
1572                     (save-excursion
1573                       (string= (tuareg-find-meaningful-word) "=")))
1574                kwop (tuareg-find-|-match)))
1575           (t kwop))))
1576
1577 (defconst tuareg-find-->-match-regexp
1578   (tuareg-make-find-kwop-regexp "\\<\\(external\\|val\\|method\\|let\\|with\\|fun\\(ction\\|ctor\\)?\\|parser\\)\\>\\|[|:;]"))
1579 (defun tuareg-find-->-match ()
1580   (let ((kwop (tuareg-find-kwop tuareg-find-->-match-regexp "\\<with\\>")))
1581     (cond
1582      ((string= kwop "|")
1583       (if (tuareg-in-indentation-p)
1584           kwop
1585         (progn (forward-char -1) (tuareg-find-->-match))))
1586      ((not (string= kwop ":")) kwop)
1587      ;; If we get this far, we know we're looking at a colon.
1588      ((or (char-equal (char-before) ?:)
1589           (char-equal (char-after (1+ (point))) ?:)
1590           (char-equal (char-after (1+ (point))) ?>))
1591       (tuareg-find-->-match))
1592      ;; Patch by T. Freeman
1593      (t (let ((oldpoint (point))
1594               (match (tuareg-find-->-match)))
1595           (if (looking-at ":")
1596               match
1597             (progn
1598               ;; Go back to where we were before the recursive call.
1599               (goto-char oldpoint)
1600               kwop)))))))
1601
1602 (defconst tuareg-find-semi-colon-match-regexp
1603   (tuareg-make-find-kwop-regexp ";[ \t]*\\((\\*\\|$\\)\\|->\\|\\<\\(let\\|method\\|with\\|try\\|initializer\\)\\>"))
1604 (defun tuareg-find-semi-colon-match (&optional leading-semi-colon)
1605   (tuareg-find-kwop tuareg-find-semi-colon-match-regexp
1606                          "\\<\\(in\\|end\\|and\\|do\\|with\\)\\>")
1607   ;; We don't need to find the keyword matching `and' since we know it's `let'!
1608   (cond
1609    ((looking-at ";[ \t]*\\((\\*\\|$\\)")
1610     (forward-line 1)
1611     (while (or (tuareg-in-comment-p)
1612                (looking-at "^[ \t]*\\((\\*\\|$\\)"))
1613       (forward-line 1))
1614     (back-to-indentation)
1615     (current-column))
1616    ((and leading-semi-colon
1617          (looking-at "\\((\\|\\[[<|]?\\|{<?\\)[ \t]*[^ \t\n]")
1618          (not (looking-at "[[{(][|<]?[ \t]*\\((\\*\\|$\\)")))
1619     (current-column))
1620    ((looking-at "\\((\\|\\[[<|]?\\|{<?\\)[ \t]*\\((\\*\\|$\\)")
1621     (tuareg-back-to-paren-or-indentation t)
1622     (+ (current-column) tuareg-default-indent))
1623    ((looking-at "\\(\\.<\\|(\\|\\[[<|]?\\|{<?\\)[ \t]*[^ \t\n]")
1624     (tuareg-search-forward-paren)
1625     (current-column))
1626    ((looking-at "\\<method\\>[ \t]*\\((\\*\\|$\\)")
1627     (tuareg-back-to-paren-or-indentation)
1628     (+ (current-column) tuareg-method-indent))
1629    ((looking-at "\\<begin\\>[ \t]*\\((\\*\\|$\\)")
1630     (tuareg-back-to-paren-or-indentation t)
1631     (+ (current-column) tuareg-begin-indent))
1632    ((looking-at "->")
1633     (if (save-excursion
1634           (tuareg-find-->-match)
1635           (looking-at "\\<\\(with\\|fun\\(ction\\)?\\|parser\\)\\>\\||"))
1636         (progn
1637           (tuareg-back-to-paren-or-indentation)
1638           (+ (current-column) tuareg-default-indent))
1639       (tuareg-find-semi-colon-match)))
1640    ((looking-at "\\<end\\>")
1641     (tuareg-find-match)
1642     (tuareg-find-semi-colon-match))
1643    ((looking-at "\\<in\\>")
1644     (tuareg-find-in-match)
1645     (tuareg-back-to-paren-or-indentation)
1646     (+ (current-column) tuareg-in-indent))
1647    ((looking-at "\\<let\\>")
1648     (+ (current-column) tuareg-let-indent))
1649    (t (tuareg-back-to-paren-or-indentation t)
1650       (+ (current-column) tuareg-default-indent))))
1651
1652 (defconst tuareg-find-phrase-indentation-regexp
1653   (tuareg-make-find-kwop-regexp (concat tuareg-governing-phrase-regexp
1654                                         "\\|\\<and\\>")))
1655 (defconst tuareg-find-phrase-indentation-regexp-pb
1656   (concat tuareg-find-phrase-indentation-regexp "\\|;;"))
1657 (defconst tuareg-find-phrase-indentation-class-regexp
1658   (concat tuareg-matching-keyword-regexp "\\|\\<class\\>"))
1659 (defun tuareg-find-phrase-indentation (&optional phrase-break)
1660   (if (and (looking-at "\\<\\(type\\|module\\)\\>") (> (point) (point-min))
1661            (save-excursion
1662              (tuareg-find-meaningful-word)
1663              (looking-at "\\<\\(module\\|with\\|and\\|let\\)\\>")))
1664       (progn
1665         (tuareg-find-meaningful-word)
1666         (+ (current-column) tuareg-default-indent))
1667     (let ((looking-at-and (looking-at "\\<and\\>"))
1668           (kwop (tuareg-find-kwop
1669                  (if phrase-break
1670                      tuareg-find-phrase-indentation-regexp-pb
1671                    tuareg-find-phrase-indentation-regexp)
1672                  "\\<\\(end\\|and\\|with\\|in\\)\\>"))
1673           (tmpkwop nil) (curr nil))
1674       (if (and kwop (string= kwop "and"))
1675           (setq kwop (tuareg-find-and-match)))
1676       (if (not kwop) (current-column)
1677         (cond
1678          ((string= kwop "end")
1679           (if (not (save-excursion
1680                      (setq tmpkwop (tuareg-find-match))
1681                      (setq curr (point))
1682                      (string= tmpkwop "object")))
1683               (progn
1684                 (tuareg-find-match)
1685                 (tuareg-find-phrase-indentation phrase-break))
1686             (tuareg-find-kwop tuareg-find-phrase-indentation-class-regexp)
1687             (current-column)))
1688          ((and (string= kwop "with")
1689                (not (save-excursion
1690                       (setq tmpkwop (tuareg-find-with-match))
1691                       (setq curr (point))
1692                       (string= tmpkwop "module"))))
1693           (goto-char curr)
1694           (tuareg-find-phrase-indentation phrase-break))
1695          ((and (string= kwop "in")
1696                (not (save-excursion
1697                       (setq tmpkwop (tuareg-find-in-match))
1698                       (if (string= tmpkwop "and")
1699                           (setq tmpkwop (tuareg-find-and-match)))
1700                       (setq curr (point))
1701                       (and (string= tmpkwop "let")
1702                            (not (tuareg-looking-at-expression-let))))))
1703           (goto-char curr)
1704           (tuareg-find-phrase-indentation phrase-break))
1705          ((tuareg-at-phrase-break-p)
1706           (end-of-line)
1707           (tuareg-skip-blank-and-comments)
1708           (current-column))
1709          ((string= kwop "let")
1710           (if (tuareg-looking-at-expression-let)
1711               (tuareg-find-phrase-indentation phrase-break)
1712             (current-column)))
1713          ((string= kwop "with")
1714           (current-column))
1715          ((string= kwop "end")
1716           (current-column))
1717          ((string= kwop "in")
1718           (tuareg-find-in-match)
1719           (current-column))
1720          ((string= kwop "class")
1721           (tuareg-back-to-paren-or-indentation)
1722           (current-column))
1723          ((looking-at "\\<\\(object\\|s\\(ig\\|truct\\)\\)\\>")
1724           (tuareg-back-to-paren-or-indentation t)
1725           (+ (tuareg-assoc-indent kwop) (current-column)))
1726          ((or (string= kwop "type") (string= kwop "module"))
1727           (if (or (tuareg-looking-at-false-type)
1728                   (tuareg-looking-at-false-module))
1729               (if looking-at-and (current-column)
1730                 (tuareg-find-meaningful-word)
1731                 (if (looking-at "\\<and\\>")
1732                     (progn
1733                       (tuareg-find-and-match)
1734                       (tuareg-find-phrase-indentation phrase-break))
1735                   (tuareg-find-phrase-indentation phrase-break)))
1736             (current-column)))
1737          ((looking-at
1738            "\\(\\.<\\|(\\|\\[[<|]?\\|{<?\\)[ \t]*\\((\\*\\|$\\)")
1739           (tuareg-back-to-paren-or-indentation)
1740           (+ (current-column) tuareg-default-indent))
1741          ((looking-at "\\(\\.<\\|(\\|\\[[<|]?\\|{<?\\)[ \t]*[^ \t\n]")
1742           (tuareg-search-forward-paren)
1743           (current-column))
1744          ((string= kwop "open") ; compatible with Caml Light `#open'
1745           (tuareg-back-to-paren-or-indentation) (current-column))
1746          (t (current-column)))))))
1747
1748 (defconst tuareg-back-to-paren-or-indentation-regexp
1749   "[][(){}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)")
1750 (defconst tuareg-back-to-paren-or-indentation-in-regexp
1751   (concat "\\<in\\>\\|" tuareg-back-to-paren-or-indentation-regexp))
1752 (defconst tuareg-back-to-paren-or-indentation-lazy-regexp
1753   "[])}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)")
1754 (defconst tuareg-back-to-paren-or-indentation-lazy-in-regexp
1755   (concat "\\<in\\>\\|" tuareg-back-to-paren-or-indentation-regexp))
1756 (defun tuareg-back-to-paren-or-indentation (&optional forward-in)
1757   "Search backwards for the first open paren in line, or skip to indentation.
1758 Returns t iff skipped to indentation."
1759   (if (or (bolp) (tuareg-in-indentation-p)) (progn (back-to-indentation) t)
1760     (let ((kwop (tuareg-find-kwop
1761                  (if tuareg-lazy-paren
1762                      (if forward-in
1763                          tuareg-back-to-paren-or-indentation-lazy-in-regexp
1764                        tuareg-back-to-paren-or-indentation-lazy-regexp)
1765                    (if forward-in
1766                        tuareg-back-to-paren-or-indentation-in-regexp
1767                      tuareg-back-to-paren-or-indentation-regexp))
1768                  "\\<and\\|with\\|in\\>"))
1769           (retval))
1770       (if (string= kwop "with")
1771           (let ((with-point (point)))
1772             (setq kwop (tuareg-find-with-match))
1773             (if (or (string= kwop "match") (string= kwop "try"))
1774                 (tuareg-find-kwop
1775                  tuareg-back-to-paren-or-indentation-regexp
1776                  "\\<and\\>")
1777               (setq kwop "with") (goto-char with-point))))
1778       (setq retval
1779             (cond
1780              ((string= kwop "with") nil)
1781              ((string= kwop "in") (tuareg-in-indentation-p))
1782              ((looking-at "[[{(]") (tuareg-search-forward-paren) nil)
1783              ((looking-at "\\.<")
1784               (if tuareg-support-metaocaml
1785                   (progn
1786                     (tuareg-search-forward-paren) nil)
1787                 (tuareg-back-to-paren-or-indentation forward-in)))
1788              (t (back-to-indentation) t)))
1789       (cond
1790        ((looking-at "|[^|]")
1791         (re-search-forward "|[^|][ \t]*") nil)
1792        ((and forward-in (string= kwop "in"))
1793         (tuareg-find-in-match)
1794         (tuareg-back-to-paren-or-indentation forward-in)
1795         (if (looking-at "\\<\\(let\\|and\\)\\>")
1796             (forward-char tuareg-in-indent)) nil)
1797        (t retval)))))
1798
1799 (defun tuareg-search-forward-paren ()
1800   (if tuareg-lazy-paren (tuareg-back-to-paren-or-indentation)
1801     (re-search-forward "\\(\\.<\\|(\\|\\[[<|]?\\|{<?\\)[ \t]*")))
1802
1803 (defun tuareg-add-default-indent (leading-operator)
1804   (if leading-operator 0 tuareg-default-indent))
1805
1806 (defconst tuareg-compute-argument-indent-regexp
1807   (tuareg-make-find-kwop-regexp tuareg-kwop-regexp))
1808 (defun tuareg-compute-argument-indent (leading-operator)
1809   (let ((old-point (save-excursion (beginning-of-line) (point)))
1810         (match-end-point) (kwop))
1811     (setq kwop (tuareg-find-kwop tuareg-compute-argument-indent-regexp
1812                                  tuareg-keyword-regexp))
1813     (setq match-end-point (+ (point) (length kwop))) ; match-end is invalid !
1814     (cond
1815      ((and (string= kwop "->")
1816            (not (looking-at "->[ \t]*\\((\\*.*\\)?$")))
1817       (let* (matching-kwop matching-pos)
1818         (save-excursion
1819           (setq matching-kwop (tuareg-find-->-match))
1820           (setq matching-pos (point)))
1821         (cond
1822          ((string= matching-kwop ":")
1823           (goto-char matching-pos)
1824           (tuareg-find-->-match) ; matching `val' or `let'
1825           (+ (current-column) tuareg-val-indent))
1826          ((string= matching-kwop "|")
1827           (goto-char matching-pos)
1828           (+ (tuareg-add-default-indent leading-operator)
1829              (current-column) tuareg-|-extra-unindent tuareg-default-indent))
1830          (t
1831           (tuareg-back-to-paren-or-indentation)
1832           (+ (tuareg-add-default-indent leading-operator) (current-column))))))
1833      ((string= kwop "fun")
1834       (tuareg-back-to-paren-or-indentation t)
1835       (+ (current-column)
1836          (tuareg-assoc-indent kwop)))
1837      ((<= old-point (point))
1838       (+ (tuareg-add-default-indent leading-operator) (current-column)))
1839      (t
1840       (forward-line 1)
1841       (beginning-of-line)
1842       (while (or (tuareg-in-comment-p) (looking-at "^[ \t]*\\((\\*.*\\)?$"))
1843         (forward-line 1))
1844       (tuareg-back-to-paren-or-indentation)
1845       (if (save-excursion (goto-char match-end-point)
1846                           (looking-at "[ \t]*\\((\\*.*\\)?$"))
1847           (+ (tuareg-add-default-indent leading-operator)
1848              (current-column))
1849         (current-column))))))
1850
1851 (defun tuareg-indent-from-paren (&optional leading-operator)
1852   (if (looking-at
1853        "\\(\\.<\\|(\\|\\[[<|]?\\|{<?\\)[ \t]*\\((\\*\\|$\\)")
1854       (progn
1855         (tuareg-back-to-paren-or-indentation t)
1856         (+ tuareg-default-indent
1857            (current-column))) ; parens do not operate
1858     (tuareg-search-forward-paren)
1859     (+ (tuareg-add-default-indent leading-operator)
1860        (current-column))))
1861
1862 (defconst tuareg-compute-normal-indent-regexp
1863   (concat tuareg-compute-argument-indent-regexp "\\|^.[ \t]*"))
1864 (defun tuareg-compute-normal-indent ()
1865   (let ((leading-operator (looking-at tuareg-operator-regexp)))
1866     (beginning-of-line)
1867     ;; Operator ending previous line used to be considered leading
1868     ;; (save-excursion
1869     ;;  (tuareg-find-meaningful-word)
1870     ;;  (if (looking-at tuareg-operator-regexp)
1871     ;;    (setq leading-operator t)))
1872     (save-excursion
1873       (let ((kwop (tuareg-find-kwop (if leading-operator
1874                                         tuareg-compute-argument-indent-regexp
1875                                       tuareg-compute-normal-indent-regexp)
1876                                     tuareg-keyword-regexp)))
1877         (if (string= kwop "and") (setq kwop (tuareg-find-and-match)))
1878         (while (or (and (string= kwop "=")
1879                         (tuareg-false-=-p))
1880                    (and (looking-at "^[ \t]*\\((\\*.*\\)?$")
1881                         (not (= (point) (point-min)))))
1882           (setq kwop (tuareg-find-kwop tuareg-compute-normal-indent-regexp
1883                                        tuareg-keyword-regexp))
1884           (if (string= kwop "and") (setq kwop (tuareg-find-and-match))))
1885         (if (not kwop) (current-column)
1886           (cond
1887            ((tuareg-at-phrase-break-p)
1888             (tuareg-find-phrase-indentation t))
1889            ((and (string= kwop "|") (not  (char-equal ?\[ (preceding-char))))
1890             (tuareg-backward-char)
1891             (tuareg-back-to-paren-or-indentation)
1892             (+ (current-column) tuareg-default-indent
1893                (tuareg-add-default-indent leading-operator)))
1894            ((or (looking-at "[[{(]")
1895                 (and (looking-at "[<|]")
1896                      (char-equal ?\[ (preceding-char))
1897                      (progn (tuareg-backward-char) t))
1898                 (and (looking-at "<")
1899                      (char-equal ?\{ (preceding-char))
1900                      (progn (tuareg-backward-char) t)))
1901             (tuareg-indent-from-paren leading-operator))
1902            ((looking-at "\\.<")
1903             (tuareg-indent-from-paren leading-operator))
1904            ((looking-at "->")
1905             (let ((keyword-->-match (save-excursion (tuareg-find-->-match))))
1906               (cond ((string= keyword-->-match "|")
1907                      (tuareg-find-->-match)
1908                      (re-search-forward "|[ \t]*")
1909                      (+ (current-column) tuareg-default-indent))
1910                     ((string= keyword-->-match ":")
1911                      (tuareg-find-->-match) ; slow, better to save the column
1912                      (tuareg-find-->-match) ; matching `val' or `let'
1913                      (+ (current-column) tuareg-val-indent))
1914                     (t (tuareg-back-to-paren-or-indentation)
1915                        (+ tuareg-default-indent (current-column))))))
1916            ((looking-at tuareg-keyword-regexp)
1917             (cond ((string= kwop ";")
1918                    (if (looking-at ";[ \t]*\\((\\*\\|$\\)")
1919                        (tuareg-find-semi-colon-match)
1920                      (tuareg-back-to-paren-or-indentation t)
1921                      (+ (current-column) tuareg-default-indent)))
1922                   ((string= kwop ",")
1923                    (if (looking-at ",[ \t]*\\((\\*\\|$\\)")
1924                        (progn
1925                          (setq kwop (tuareg-find-,-match))
1926                          (if (or (looking-at "[[{(]\\|\\.<")
1927                                  (and (looking-at "[<|]")
1928                                       (char-equal ?\[ (preceding-char))
1929                                       (progn (tuareg-backward-char) t))
1930                                  (and (looking-at "<")
1931                                       (char-equal ?\{ (preceding-char))
1932                                       (progn (tuareg-backward-char) t)))
1933                              (tuareg-indent-from-paren t)
1934                            (tuareg-back-to-paren-or-indentation t)
1935                            (+ (current-column)
1936                               (tuareg-assoc-indent kwop))))
1937                      (tuareg-back-to-paren-or-indentation t)
1938                      (+ (current-column) tuareg-default-indent)))
1939                   ((and (looking-at "\\<\\(in\\|begin\\|do\\)\\>\\|->")
1940                         (not (looking-at
1941                               "\\([a-z]+\\|->\\)[ \t]*\\((\\*\\|$\\)")))
1942                    (if (string= kwop "in")
1943                        (re-search-forward "\\<in\\>[ \t]*")
1944                      (tuareg-back-to-paren-or-indentation t))
1945                    (+ (current-column)
1946                       (tuareg-add-default-indent leading-operator)
1947                       (if (string= kwop "in") 0 ; aligned, do not indent
1948                         (tuareg-assoc-indent kwop))))
1949                   ((string= kwop "with")
1950                    (if (save-excursion
1951                          (let ((tmpkwop (tuareg-find-with-match)))
1952                            (or (string= tmpkwop "module")
1953                                (string= tmpkwop "{"))))
1954                        (progn
1955                          (tuareg-back-to-paren-or-indentation)
1956                          (+ (current-column) tuareg-default-indent))
1957                      (tuareg-back-to-paren-or-indentation)
1958                      (+ (current-column)
1959                         (tuareg-assoc-indent kwop t))))
1960                   ((string= kwop "in")
1961                    (tuareg-find-in-match)
1962                    (tuareg-back-to-paren-or-indentation)
1963                    (+ (current-column) tuareg-in-indent))
1964                   ((or (string= kwop "let") (string= kwop "and"))
1965                    (tuareg-back-to-paren-or-indentation t)
1966                    (+ (current-column)
1967                       tuareg-default-indent
1968                       (tuareg-assoc-indent kwop t)))
1969                   (t (tuareg-back-to-paren-or-indentation t)
1970                      (+ (current-column)
1971                         (tuareg-assoc-indent kwop t)))))
1972            ((and (looking-at "=") (not (tuareg-false-=-p)))
1973             (let ((current-column-module-type nil))
1974               (+
1975                (progn
1976                  (tuareg-find-=-match)
1977                  (save-excursion
1978                    (if (looking-at "\\<and\\>") (tuareg-find-and-match))
1979                    (cond
1980                     ((looking-at "\\<type\\>")
1981                      (tuareg-find-meaningful-word)
1982                      (if (looking-at "\\<module\\>")
1983                          (progn
1984                            (setq current-column-module-type (current-column))
1985                            tuareg-default-indent)
1986                        (if (looking-at "\\<\\(with\\|and\\)\\>")
1987                            (progn
1988                              (tuareg-find-with-match)
1989                              (setq current-column-module-type (current-column))
1990                              tuareg-default-indent)
1991                          (re-search-forward "\\<type\\>")
1992                          (beginning-of-line)
1993                          (+ tuareg-type-indent
1994                             tuareg-|-extra-unindent))))
1995                     ((looking-at
1996                       "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|class\\|when\\|\\|for\\|if\\)\\>")
1997                      (let ((matched-string (tuareg-match-string 0)))
1998                        (tuareg-back-to-paren-or-indentation t)
1999                        (setq current-column-module-type (current-column))
2000                        (tuareg-assoc-indent matched-string)))
2001                     ((looking-at "\\<object\\>")
2002                      (tuareg-back-to-paren-or-indentation t)
2003                      (setq current-column-module-type (current-column))
2004                      (+ (tuareg-assoc-indent "object")
2005                         tuareg-default-indent))
2006                     (t (tuareg-back-to-paren-or-indentation t)
2007                        (setq current-column-module-type
2008                              (+ (current-column) tuareg-default-indent))
2009                        tuareg-default-indent))))
2010                (if current-column-module-type
2011                    current-column-module-type
2012                  (current-column)))))
2013            (nil 0)
2014            (t (tuareg-compute-argument-indent leading-operator))))))))
2015
2016 (defun tuareg-looking-at-expression-let ()
2017   (save-excursion
2018     (tuareg-find-meaningful-word)
2019     (and (not (tuareg-at-phrase-break-p))
2020          (not (and tuareg-support-metaocaml
2021                    (looking-at "\\.")
2022                    (char-equal ?> (preceding-char))))
2023          (or (looking-at "[[({;=]\\|\\<\\(begin\\|i[fn]\\|do\\|t\\(ry\\|hen\\)\\|else\\|match\\|wh\\(ile\\|en\\)\\)\\>")
2024              (looking-at tuareg-operator-regexp)))))
2025
2026 (defun tuareg-looking-at-false-module ()
2027   (save-excursion (tuareg-find-meaningful-word)
2028                   (looking-at "\\<\\(let\\|with\\|and\\)\\>")))
2029
2030 (defun tuareg-looking-at-false-sig-struct ()
2031   (save-excursion (tuareg-find-module)
2032                   (looking-at "\\<module\\>")))
2033
2034 (defun tuareg-looking-at-false-type ()
2035   (save-excursion (tuareg-find-meaningful-word)
2036                   (looking-at "\\<\\(class\\|with\\|module\\|and\\)\\>")))
2037
2038 (defun tuareg-looking-at-in-let ()
2039   (save-excursion (string= (tuareg-find-meaningful-word) "in")))
2040
2041 (defconst tuareg-find-module-regexp
2042   (tuareg-make-find-kwop-regexp "\\<module\\>"))
2043 (defun tuareg-find-module ()
2044   (tuareg-find-kwop tuareg-find-module-regexp))
2045
2046 (defun tuareg-modify-syntax ()
2047   "Switch to modified internal syntax."
2048   (modify-syntax-entry ?. "w" tuareg-mode-syntax-table)
2049   (modify-syntax-entry ?_ "w" tuareg-mode-syntax-table))
2050
2051 (defun tuareg-restore-syntax ()
2052   "Switch back to interactive syntax."
2053   (modify-syntax-entry ?. "." tuareg-mode-syntax-table)
2054   (modify-syntax-entry ?_ "_" tuareg-mode-syntax-table))
2055
2056 (defun tuareg-indent-command (&optional from-leading-star)
2057   "Indent the current line in Tuareg mode.
2058
2059 Compute new indentation based on Caml syntax."
2060   (interactive "*")
2061     (if (not from-leading-star)
2062         (tuareg-auto-fill-insert-leading-star))
2063   (let ((case-fold-search nil))
2064     (tuareg-modify-syntax)
2065     (save-excursion
2066       (back-to-indentation)
2067       (indent-line-to (tuareg-compute-indent)))
2068     (if (tuareg-in-indentation-p) (back-to-indentation))
2069     (tuareg-restore-syntax)))
2070
2071 (defun tuareg-compute-indent ()
2072   (save-excursion
2073     (cond
2074      ((tuareg-in-comment-p)
2075       (cond
2076        ((looking-at "(\\*")
2077         (if tuareg-indent-leading-comments
2078             (save-excursion
2079               (while (and (progn (beginning-of-line)
2080                                  (> (point) 1))
2081                           (progn (forward-line -1)
2082                                  (back-to-indentation)
2083                                  (tuareg-in-comment-p))))
2084               (if (looking-at "[ \t]*$")
2085                   (progn
2086                     (tuareg-skip-blank-and-comments)
2087                     (if (or (looking-at "$") (tuareg-in-comment-p))
2088                         0
2089                       (tuareg-compute-indent)))
2090                 (forward-line 1)
2091                 (tuareg-compute-normal-indent)))
2092           (current-column)))
2093        ((looking-at "\\*\\**)")
2094         (tuareg-beginning-of-literal-or-comment-fast)
2095         (if (tuareg-leading-star-p)
2096             (+ (current-column)
2097                (if (save-excursion
2098                      (forward-line 1)
2099                      (back-to-indentation)
2100                      (looking-at "*")) 1
2101                  tuareg-comment-end-extra-indent))
2102           (+ (current-column) tuareg-comment-end-extra-indent)))
2103        (tuareg-indent-comments
2104         (let ((star (and (tuareg-leading-star-p)
2105                          (looking-at "\\*"))))
2106           (tuareg-beginning-of-literal-or-comment-fast)
2107           (if star (re-search-forward "(") (re-search-forward "(\\*+[ \t]*"))
2108           (current-column)))
2109        (t (current-column))))
2110      ((tuareg-in-literal-p)
2111       (current-column))
2112      ((looking-at "\\<let\\>")
2113       (if (tuareg-looking-at-expression-let)
2114           (if (tuareg-looking-at-in-let)
2115               (progn
2116                 (tuareg-find-meaningful-word)
2117                 (tuareg-find-in-match)
2118                 (tuareg-back-to-paren-or-indentation)
2119                 (current-column))
2120             (tuareg-compute-normal-indent))
2121         (tuareg-find-phrase-indentation)))
2122      ((looking-at tuareg-governing-phrase-regexp-with-break)
2123       (tuareg-find-phrase-indentation))
2124      ((and tuareg-sig-struct-align (looking-at "\\<\\(sig\\|struct\\)\\>"))
2125       (if (string= (tuareg-find-module) "module") (current-column)
2126         (tuareg-back-to-paren-or-indentation)
2127         (+ tuareg-default-indent (current-column))))
2128      ((looking-at ";") (tuareg-find-semi-colon-match t))
2129      ((or (looking-at "%\\|;;")
2130           (and tuareg-support-camllight (looking-at "#"))
2131           (looking-at "#\\<\\(open\\|load\\|use\\)\\>")) 0)
2132      ((or (looking-at tuareg-leading-kwop-regexp)
2133           (and tuareg-support-metaocaml
2134                (looking-at ">\\.")))
2135       (let ((kwop (tuareg-match-string 0)))
2136         (let* ((old-point (point))
2137                (paren-match-p (looking-at "[|>]?[]})]\\|>\\."))
2138                (need-not-back-kwop (string= kwop "and"))
2139                (real-| (looking-at "|\\([^|]\\|$\\)"))
2140                (matching-kwop
2141                 (if (string= kwop "and")
2142                     (tuareg-find-and-match t)
2143                   (funcall (cdr (assoc kwop tuareg-leading-kwop-alist)))))
2144                (match-|-keyword-p
2145                 (and matching-kwop
2146                      (looking-at tuareg-match-|-keyword-regexp))))
2147           (cond
2148            ((and (string= kwop "|") real-|)
2149             (cond
2150              ((string= matching-kwop "|")
2151               (if (not need-not-back-kwop)
2152                   (tuareg-back-to-paren-or-indentation))
2153               (current-column))
2154              ((and (string= matching-kwop "=")
2155                    (not (tuareg-false-=-p)))
2156               (re-search-forward "=[ \t]*")
2157               (current-column))
2158              (match-|-keyword-p
2159               (if (not need-not-back-kwop)
2160                   (tuareg-back-to-paren-or-indentation))
2161               (- (+ (tuareg-assoc-indent
2162                      matching-kwop t)
2163                     (current-column))
2164                  (if (string= matching-kwop "type") 0
2165                    tuareg-|-extra-unindent)))
2166              (t (goto-char old-point)
2167                 (tuareg-compute-normal-indent))))
2168            ((and (string= kwop "|") (not real-|))
2169             (goto-char old-point)
2170             (tuareg-compute-normal-indent))
2171            ((and
2172              (looking-at "\\(\\[|?\\|{<?\\|(\\|\\.<\\)[ \t]*[^ \t\n]")
2173              (not (looking-at "\\([[{(][|<]?\\|\\.<\\)[ \t]*\\((\\*\\|$\\)")))
2174             (if (and (string= kwop "|") real-|)
2175                 (current-column)
2176               (if (not paren-match-p)
2177                   (tuareg-search-forward-paren))
2178               (if tuareg-lazy-paren
2179                   (tuareg-back-to-paren-or-indentation))
2180               (current-column)))
2181            ((and (string= kwop "with")
2182                  (or (string= matching-kwop "module")
2183                      (string= matching-kwop "struct")))
2184             (tuareg-back-to-paren-or-indentation nil)
2185             (+ (current-column) tuareg-default-indent))
2186            ((not need-not-back-kwop)
2187             (tuareg-back-to-paren-or-indentation (not (string= kwop "in")))
2188             (current-column))
2189            (t (current-column))))))
2190      (t (tuareg-compute-normal-indent)))))
2191
2192 (defun tuareg-split-string ()
2193   "Called whenever a line is broken inside a Caml string literal."
2194   (insert-before-markers "\" ^\"")
2195   (tuareg-backward-char))
2196
2197 (defadvice newline-and-indent (around
2198                                tuareg-newline-and-indent
2199                                activate)
2200   "Handle multi-line strings in Tuareg mode."
2201     (let ((hooked (and (eq major-mode 'tuareg-mode) (tuareg-in-literal-p)))
2202           (split-mark))
2203       (if (not hooked) nil
2204         (setq split-mark (set-marker (make-marker) (point)))
2205         (tuareg-split-string))
2206       ad-do-it
2207       (if (not hooked) nil
2208         (goto-char split-mark)
2209         (set-marker split-mark nil))))
2210
2211 (defun tuareg-electric ()
2212   "If inserting a | operator at beginning of line, reindent the line."
2213   (interactive "*")
2214   (let ((electric (and tuareg-electric-indent
2215                        (tuareg-in-indentation-p)
2216                        (not (tuareg-in-literal-p))
2217                        (not (tuareg-in-comment-p)))))
2218     (self-insert-command 1)
2219     (if (and electric
2220              (not (and (char-equal ?| (preceding-char))
2221                        (save-excursion
2222                          (tuareg-backward-char)
2223                          (tuareg-find-|-match)
2224                          (not (looking-at tuareg-match-|-keyword-regexp))))))
2225         (indent-according-to-mode))))
2226
2227 (defun tuareg-electric-rp ()
2228   "If inserting a ) operator or a comment-end at beginning of line,
2229 reindent the line."
2230   (interactive "*")
2231   (let ((electric (and tuareg-electric-indent
2232                        (or (tuareg-in-indentation-p)
2233                            (char-equal ?* (preceding-char)))
2234                        (not (tuareg-in-literal-p))
2235                        (or (not (tuareg-in-comment-p))
2236                            (save-excursion
2237                              (back-to-indentation)
2238                              (looking-at "\\*"))))))
2239     (self-insert-command 1)
2240     (if electric
2241         (indent-according-to-mode))))
2242
2243 (defun tuareg-electric-rc ()
2244   "If inserting a } operator at beginning of line, reindent the line.
2245
2246 Reindent also if } is inserted after a > operator at beginning of line.
2247 Also, if the matching { is followed by a < and this } is not preceded
2248 by >, insert one >."
2249   (interactive "*")
2250   (let* ((prec (preceding-char))
2251          (look-bra (and tuareg-electric-close-vector
2252                         (not (tuareg-in-literal-or-comment-p))
2253                         (not (char-equal ?> prec))))
2254          (electric (and tuareg-electric-indent
2255                         (or (tuareg-in-indentation-p)
2256                             (and (char-equal ?> prec)
2257                                  (save-excursion (tuareg-backward-char)
2258                                                  (tuareg-in-indentation-p))))
2259                         (not (tuareg-in-literal-or-comment-p)))))
2260     (self-insert-command 1)
2261     (if look-bra
2262         (save-excursion
2263           (let ((inserted-char
2264                  (save-excursion
2265                    (tuareg-backward-char)
2266                    (tuareg-backward-up-list)
2267                    (cond ((looking-at "{<") ">")
2268                          (t "")))))
2269             (tuareg-backward-char)
2270             (insert inserted-char))))
2271     (if electric (indent-according-to-mode))))
2272
2273 (defun tuareg-electric-rb ()
2274   "If inserting a ] operator at beginning of line, reindent the line.
2275
2276 Reindent also if ] is inserted after a | operator at beginning of line.
2277 Also, if the matching [ is followed by a | and this ] is not preceded
2278 by |, insert one |."
2279   (interactive "*")
2280   (let* ((prec (preceding-char))
2281          (look-|-or-bra (and tuareg-electric-close-vector
2282                              (not (tuareg-in-literal-or-comment-p))
2283                              (not (and (char-equal ?| prec)
2284                                        (not (char-equal
2285                                              (save-excursion
2286                                                (tuareg-backward-char)
2287                                                (preceding-char)) ?\[))))))
2288          (electric (and tuareg-electric-indent
2289                         (or (tuareg-in-indentation-p)
2290                             (and (char-equal ?| prec)
2291                                  (save-excursion (tuareg-backward-char)
2292                                                  (tuareg-in-indentation-p))))
2293                         (not (tuareg-in-literal-or-comment-p)))))
2294     (self-insert-command 1)
2295     (if look-|-or-bra
2296         (save-excursion
2297           (let ((inserted-char
2298                  (save-excursion
2299                    (tuareg-backward-char)
2300                    (tuareg-backward-up-list)
2301                    (cond ((looking-at "\\[|") "|")
2302                          (t "")))))
2303             (tuareg-backward-char)
2304             (insert inserted-char))))
2305     (if electric (indent-according-to-mode))))
2306
2307 (defun tuareg-abbrev-hook ()
2308   "If inserting a leading keyword at beginning of line, reindent the line."
2309   (if (not (tuareg-in-literal-or-comment-p))
2310       (let* ((bol (save-excursion (beginning-of-line) (point)))
2311              (kw (save-excursion
2312                    (and (re-search-backward "^[ \t]*\\(\\w\\|_\\)+\\=" bol t)
2313                         (tuareg-match-string 1)))))
2314         (if kw (progn
2315                    (insert " ")
2316                    (indent-according-to-mode)
2317                    (backward-delete-char-untabify 1))))))
2318
2319 (defun tuareg-skip-to-end-of-phrase ()
2320   (let ((old-point (point)))
2321     (if (and (string= (tuareg-find-meaningful-word) ";")
2322              (char-equal (preceding-char) ?\;))
2323         (setq old-point (1- (point))))
2324     (goto-char old-point)
2325     (let ((kwop (tuareg-find-meaningful-word)))
2326       (goto-char (+ (point) (length kwop))))))
2327
2328 (defun tuareg-skip-blank-and-comments ()
2329   (skip-chars-forward " \t\n")
2330   (while (and (not (eobp)) (tuareg-in-comment-p)
2331               (search-forward "*)" nil t))
2332     (skip-chars-forward " \t\n")))
2333
2334 (defun tuareg-skip-back-blank-and-comments ()
2335   (skip-chars-backward " \t\n")
2336   (while (save-excursion (tuareg-backward-char)
2337                          (and (> (point) (point-min)) (tuareg-in-comment-p)))
2338     (tuareg-backward-char)
2339     (tuareg-beginning-of-literal-or-comment) (skip-chars-backward " \t\n")))
2340
2341 (defconst tuareg-beginning-phrase-regexp
2342   "^#[ \t]*[a-z][_a-z]*\\>\\|\\<\\(end\\|type\\|module\\|sig\\|struct\\|class\\|exception\\|open\\|let\\)\\>\\|;;"
2343   "Regexp matching tuareg phrase delimitors.")
2344 (defun tuareg-find-phrase-beginning ()
2345   "Find `real' phrase beginning and return point."
2346   (beginning-of-line)
2347   (tuareg-skip-blank-and-comments)
2348   (end-of-line)
2349   (tuareg-skip-to-end-of-phrase)
2350   (let ((old-point (point)))
2351     (tuareg-find-kwop tuareg-beginning-phrase-regexp)
2352     (while (and (> (point) (point-min)) (< (point) old-point)
2353                 (or (not (looking-at tuareg-beginning-phrase-regexp))
2354                     (and (looking-at "\\<let\\>")
2355                          (tuareg-looking-at-expression-let))
2356                     (and (looking-at "\\<module\\>")
2357                          (tuareg-looking-at-false-module))
2358                     (and (looking-at "\\<\\(sig\\|struct\\)\\>")
2359                          (tuareg-looking-at-false-sig-struct))
2360                     (and (looking-at "\\<type\\>")
2361                          (tuareg-looking-at-false-type))))
2362       (if (looking-at "\\<end\\>")
2363           (tuareg-find-match)
2364         (if (not (bolp)) (tuareg-backward-char))
2365         (setq old-point (point))
2366         (tuareg-find-kwop tuareg-beginning-phrase-regexp)))
2367     (if (tuareg-at-phrase-break-p)
2368         (progn (end-of-line) (tuareg-skip-blank-and-comments)))
2369     (back-to-indentation)
2370     (point)))
2371
2372 (defun tuareg-search-forward-end-iter (begin current)
2373   (let ((found) (move t))
2374     (while (and move (> (point) current))
2375       (if (re-search-forward "\\<end\\>" (point-max) t)
2376           (when (not (tuareg-in-literal-or-comment-p))
2377             (let ((kwop) (iter))
2378               (save-excursion
2379                 (tuareg-backward-char 3)
2380                 (setq kwop (tuareg-find-match))
2381                 (cond
2382                  ((looking-at "\\<\\(object\\)\\>")
2383                   (tuareg-find-phrase-beginning))
2384                  ((and (looking-at "\\<\\(struct\\|sig\\)\\>")
2385                        (tuareg-looking-at-false-sig-struct))
2386                   (tuareg-find-phrase-beginning)))
2387                 (if (> (point) begin)
2388                     (setq iter t)))
2389               (cond
2390                ((or iter
2391                     (and
2392                      (string= kwop "sig")
2393                      (looking-at "[ \t\n]*\\(\\<with\\>[ \t\n]*\\<type\\>\\|=\\)")))
2394                 (if (> (point) current)
2395                     (setq current (point))
2396                   (setq found nil move nil)))
2397                (t (setq found t move nil)))))
2398         (setq found nil move nil)))
2399     found))
2400
2401 (defun tuareg-search-forward-end ()
2402   (tuareg-search-forward-end-iter (point) -1))
2403
2404 (defconst tuareg-inside-block-opening "\\<\\(struct\\|sig\\|object\\)\\>")
2405 (defconst tuareg-inside-block-opening-full
2406   (concat tuareg-inside-block-opening "\\|\\<\\(module\\|class\\)\\>"))
2407 (defconst tuareg-inside-block-regexp
2408   (concat tuareg-matching-keyword-regexp "\\|" tuareg-inside-block-opening))
2409 (defun tuareg-inside-block-find-kwop ()
2410   (let ((kwop (tuareg-find-kwop tuareg-inside-block-regexp
2411                                 "\\<\\(and\\|end\\)\\>")))
2412     (if (string= kwop "and") (setq kwop (tuareg-find-and-match)))
2413     (if (string= kwop "with") (setq kwop nil))
2414     (if (string= kwop "end")
2415         (progn
2416           (tuareg-find-match)
2417           (tuareg-find-kwop tuareg-inside-block-regexp)
2418           (tuareg-inside-block-find-kwop))
2419       kwop)))
2420
2421 (defun tuareg-inside-block-p ()
2422   (if (tuareg-in-literal-or-comment-p)
2423       (tuareg-beginning-of-literal-or-comment))
2424   (let ((begin) (end) (and-end) (and-iter t) (kwop t))
2425     (save-excursion
2426       (if (looking-at "\\<and\\>")
2427           (tuareg-find-and-match))
2428       (setq begin (point))
2429       (if (or (and (looking-at "\\<class\\>")
2430                    (save-excursion
2431                      (re-search-forward "\\<object\\>"
2432                                         (point-max) t)
2433                      (while (tuareg-in-literal-or-comment-p)
2434                        (re-search-forward "\\<object\\>"
2435                                           (point-max) t))
2436                      (tuareg-find-phrase-beginning)
2437                      (> (point) begin)))
2438               (and (looking-at "\\<module\\>")
2439                    (save-excursion
2440                      (re-search-forward "\\<\\(sig\\|struct\\)\\>"
2441                                         (point-max) t)
2442                      (while (tuareg-in-literal-or-comment-p)
2443                        (re-search-forward "\\<\\(sig\\|struct\\)\\>"
2444                                           (point-max) t))
2445                      (tuareg-find-phrase-beginning)
2446                      (> (point) begin)))) ()
2447         (if (not (looking-at tuareg-inside-block-opening-full))
2448             (setq kwop (tuareg-inside-block-find-kwop)))
2449         (if (not kwop) ()
2450           (setq begin (point))
2451           (if (not (tuareg-search-forward-end)) ()
2452             (tuareg-backward-char 3)
2453             (if (not (looking-at "\\<end\\>")) ()
2454               (tuareg-forward-char 3)
2455               (setq end (point))
2456               (setq and-end (point))
2457               (tuareg-skip-blank-and-comments)
2458               (while (and and-iter (looking-at "\\<and\\>"))
2459                 (setq and-end (point))
2460                 (if (not (tuareg-search-forward-end)) ()
2461                   (tuareg-backward-char 3)
2462                   (if (not (looking-at "\\<end\\>")) ()
2463                     (tuareg-forward-char 3)
2464                     (setq and-end (point))
2465                     (tuareg-skip-blank-and-comments)))
2466                 (if (<= (point) and-end)
2467                     (setq and-iter nil)))
2468               (list begin end and-end))))))))
2469
2470 (defun tuareg-move-inside-block-opening ()
2471   "Go to the beginning of the enclosing module or class.
2472
2473 Notice that white-lines (or comments) located immediately before a
2474 module/class are considered enclosed in this module/class."
2475   (interactive)
2476   (let* ((old-point (point))
2477          (kwop (tuareg-inside-block-find-kwop)))
2478     (if (not kwop)
2479         (goto-char old-point))
2480     (tuareg-find-phrase-beginning)))
2481
2482 (defun tuareg-discover-phrase (&optional quiet)
2483   (end-of-line)
2484   (let ((end (point)) (case-fold-search nil))
2485     (tuareg-modify-syntax)
2486     (tuareg-find-phrase-beginning)
2487     (if (> (point) end) (setq end (point)))
2488     (save-excursion
2489       (let ((begin (point)) (cpt 0) (lines-left 0) (stop)
2490             (inside-block (tuareg-inside-block-p))
2491             (looking-block (looking-at tuareg-inside-block-opening-full)))
2492         (if (and looking-block inside-block)
2493             (progn
2494               (setq begin (nth 0 inside-block))
2495               (setq end (nth 2 inside-block))
2496               (goto-char end))
2497           (if inside-block
2498               (progn
2499                 (setq stop (save-excursion (goto-char (nth 1 inside-block))
2500                                            (beginning-of-line) (point)))
2501                 (if (< stop end) (setq stop (point-max))))
2502             (setq stop (point-max)))
2503           (save-restriction
2504             (goto-char end)
2505             (while (and (= lines-left 0)
2506                         (or (not inside-block) (< (point) stop))
2507                         (<= (save-excursion
2508                               (tuareg-find-phrase-beginning)) end))
2509               (if (not quiet)
2510                   (progn
2511                     (setq cpt (1+ cpt))
2512                     (if (= 8 cpt)
2513                         (message "Looking for enclosing phrase..."))))
2514               (setq end (point))
2515               (tuareg-skip-to-end-of-phrase)
2516               (beginning-of-line)
2517               (narrow-to-region (point) (point-max))
2518               (goto-char end)
2519               (setq lines-left (forward-line 1)))))
2520         (if (>= cpt 8) (message "Looking for enclosing phrase... done."))
2521         (save-excursion (tuareg-skip-blank-and-comments) (setq end (point)))
2522         (tuareg-skip-back-blank-and-comments)
2523         (tuareg-restore-syntax)
2524         (list begin (point) end)))))
2525
2526 (defun tuareg-mark-phrase ()
2527   "Put mark at end of this Caml phrase, point at beginning.
2528 The Caml phrase is the phrase just before the point."
2529   (interactive)
2530   (let ((pair (tuareg-discover-phrase)))
2531     (goto-char (nth 1 pair)) (push-mark (nth 0 pair) t t)))
2532
2533 (defun tuareg-next-phrase (&optional quiet)
2534   "Skip to the beginning of the next phrase."
2535   (interactive "i")
2536   (goto-char (save-excursion (nth 2 (tuareg-discover-phrase quiet))))
2537   (if (looking-at "\\<end\\>")
2538       (tuareg-next-phrase quiet))
2539   (if (looking-at ";;")
2540       (progn
2541         (forward-char 2)
2542         (tuareg-skip-blank-and-comments))))
2543
2544 (defun tuareg-previous-phrase ()
2545   "Skip to the beginning of the previous phrase."
2546   (interactive)
2547   (beginning-of-line)
2548   (tuareg-skip-to-end-of-phrase)
2549   (tuareg-discover-phrase))
2550
2551 (defun tuareg-indent-phrase ()
2552   "Depending of the context: justify and indent a comment,
2553 or indent all lines in the current phrase."
2554   (interactive)
2555   (save-excursion
2556     (back-to-indentation)
2557     (if (tuareg-in-comment-p)
2558         (let* ((cobpoint (save-excursion
2559                            (tuareg-beginning-of-literal-or-comment)
2560                            (point)))
2561                (begpoint (save-excursion
2562                            (while (and (> (point) cobpoint)
2563                                        (tuareg-in-comment-p)
2564                                        (not (looking-at "^[ \t]*$")))
2565                              (forward-line -1))
2566                            (max cobpoint (point))))
2567                (coepoint (save-excursion
2568                            (while (tuareg-in-comment-p)
2569                              (re-search-forward "\\*)"))
2570                            (point)))
2571                (endpoint (save-excursion
2572                            (re-search-forward "^[ \t]*$" coepoint 'end)
2573                            (beginning-of-line)
2574                            (forward-line 1)
2575                            (point)))
2576                (leading-star (tuareg-leading-star-p)))
2577           (goto-char begpoint)
2578           (while (and leading-star
2579                       (< (point) endpoint)
2580                       (not (looking-at "^[ \t]*$")))
2581             (forward-line 1)
2582             (back-to-indentation)
2583             (if (looking-at "\\*\\**\\([^)]\\|$\\)")
2584                 (progn
2585                   (delete-char 1)
2586                   (setq endpoint (1- endpoint)))))
2587           (goto-char (min (point) endpoint))
2588           (fill-region begpoint endpoint)
2589           (re-search-forward "\\*)")
2590           (setq endpoint (point))
2591           (if leading-star
2592               (progn
2593                 (goto-char begpoint)
2594                 (forward-line 1)
2595                 (if (< (point) endpoint)
2596                     (tuareg-auto-fill-insert-leading-star t))))
2597           (indent-region begpoint endpoint nil))
2598       (let ((pair (tuareg-discover-phrase)))
2599         (indent-region (nth 0 pair) (nth 1 pair) nil)))))
2600
2601 (defun tuareg-find-alternate-file ()
2602   "Switch Implementation/Interface."
2603   (interactive)
2604   (let ((name (buffer-file-name)))
2605     (if (string-match "\\`\\(.*\\)\\.ml\\(i\\)?\\'" name)
2606         (find-file (concat (tuareg-match-string 1 name)
2607                            (if (match-beginning 2) ".ml" ".mli"))))))
2608
2609 (defun tuareg-insert-class-form ()
2610   "Insert a nicely formatted class-end form, leaving a mark after end."
2611   (interactive "*")
2612   (let ((prec (preceding-char)))
2613     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2614         (insert " ")))
2615   (let ((old (point)))
2616     (insert "class  = object (self)\ninherit  as super\nend;;\n")
2617     (end-of-line)
2618     (indent-region old (point) nil)
2619     (indent-according-to-mode)
2620     (push-mark)
2621     (forward-line -2)
2622     (indent-according-to-mode)))
2623
2624 (defun tuareg-insert-begin-form ()
2625   "Insert a nicely formatted begin-end form, leaving a mark after end."
2626   (interactive "*")
2627   (let ((prec (preceding-char)))
2628     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2629         (insert " ")))
2630   (let ((old (point)))
2631     (insert "begin\n\nend\n")
2632     (end-of-line)
2633     (indent-region old (point) nil)
2634     (push-mark)
2635     (forward-line -2)
2636     (indent-according-to-mode)))
2637
2638 (defun tuareg-insert-for-form ()
2639   "Insert a nicely formatted for-to-done form, leaving a mark after done."
2640   (interactive "*")
2641   (let ((prec (preceding-char)))
2642     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2643         (insert " ")))
2644   (let ((old (point)))
2645     (insert "for  do\n\ndone\n")
2646     (end-of-line)
2647     (indent-region old (point) nil)
2648     (push-mark)
2649     (forward-line -2)
2650     (indent-according-to-mode)
2651     (beginning-of-line 1)
2652     (backward-char 4)))
2653
2654 (defun tuareg-insert-while-form ()
2655   "Insert a nicely formatted for-to-done form, leaving a mark after done."
2656   (interactive "*")
2657   (let ((prec (preceding-char)))
2658     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2659         (insert " ")))
2660   (let ((old (point)))
2661     (insert "while  do\n\ndone\n")
2662     (end-of-line)
2663     (indent-region old (point) nil)
2664     (push-mark)
2665     (forward-line -2)
2666     (indent-according-to-mode)
2667     (beginning-of-line 1)
2668     (backward-char 4)))
2669
2670 (defun tuareg-insert-if-form ()
2671   "Insert a nicely formatted if-then-else form, leaving a mark after else."
2672   (interactive "*")
2673   (let ((prec (preceding-char)))
2674     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2675         (insert " ")))
2676   (let ((old (point)))
2677     (insert "if\n\nthen\n\nelse\n")
2678     (end-of-line)
2679     (indent-region old (point) nil)
2680     (indent-according-to-mode)
2681     (push-mark)
2682     (forward-line -2)
2683     (indent-according-to-mode)
2684     (forward-line -2)
2685     (indent-according-to-mode)))
2686
2687 (defun tuareg-insert-match-form ()
2688   "Insert a nicely formatted math-with form, leaving a mark after with."
2689   (interactive "*")
2690   (let ((prec (preceding-char)))
2691     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2692         (insert " ")))
2693   (let ((old (point)))
2694     (insert "match\n\nwith\n")
2695     (end-of-line)
2696     (indent-region old (point) nil)
2697     (indent-according-to-mode)
2698     (push-mark)
2699     (forward-line -2)
2700     (indent-according-to-mode)))
2701
2702 (defun tuareg-insert-let-form ()
2703   "Insert a nicely formatted let-in form, leaving a mark after in."
2704   (interactive "*")
2705   (let ((prec (preceding-char)))
2706     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2707         (insert " ")))
2708   (let ((old (point)))
2709     (insert "let  in\n")
2710     (end-of-line)
2711     (indent-region old (point) nil)
2712     (indent-according-to-mode)
2713     (push-mark)
2714     (beginning-of-line)
2715     (backward-char 4)
2716     (indent-according-to-mode)))
2717
2718 (defun tuareg-insert-try-form ()
2719   "Insert a nicely formatted try-with form, leaving a mark after with."
2720   (interactive "*")
2721   (let ((prec (preceding-char)))
2722     (if (and prec (not (char-equal ?\  (char-syntax prec))))
2723         (insert " ")))
2724   (let ((old (point)))
2725     (insert "try\n\nwith\n")
2726     (end-of-line)
2727     (indent-region old (point) nil)
2728     (indent-according-to-mode)
2729     (push-mark)
2730     (forward-line -2)
2731     (indent-according-to-mode)))
2732
2733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2734 ;;                            Tuareg interactive mode
2735
2736 ;; Augment Tuareg mode with a Caml toplevel.
2737
2738 (require 'comint)
2739
2740 (defvar tuareg-interactive-mode-map
2741   (let ((map (copy-keymap comint-mode-map)))
2742     (define-key map "|" 'tuareg-electric)
2743     (define-key map ")" 'tuareg-electric-rp)
2744     (define-key map "}" 'tuareg-electric-rc)
2745     (define-key map "]" 'tuareg-electric-rb)
2746     (define-key map "\C-c\C-i" 'tuareg-interrupt-caml)
2747     (define-key map "\C-c\C-k" 'tuareg-kill-caml)
2748     (define-key map "\C-c`" 'tuareg-interactive-next-error-toplevel)
2749     (define-key map "\C-c?" 'tuareg-interactive-next-error-toplevel)
2750     (define-key map "\C-m" 'tuareg-interactive-send-input)
2751     (define-key map "\C-j" 'tuareg-interactive-send-input-or-indent)
2752     (define-key map "\M-\C-m" 'tuareg-interactive-send-input-end-of-phrase)
2753     (define-key map [kp-enter] 'tuareg-interactive-send-input-end-of-phrase)
2754     map))
2755
2756 (defconst tuareg-interactive-buffer-name "*caml-toplevel*")
2757
2758 (defconst tuareg-interactive-toplevel-error-regexp
2759   "[ \t]*Characters \\([0-9]+\\)-\\([0-9]+\\):"
2760   "Regexp matching the char numbers in ocaml toplevel's error messages.")
2761 (defvar tuareg-interactive-last-phrase-pos-in-source 0)
2762 (defvar tuareg-interactive-last-phrase-pos-in-toplevel 0)
2763
2764 (defun tuareg-interactive-filter (text)
2765   (when (eq major-mode 'tuareg-interactive-mode)
2766     (save-excursion
2767       (when (>= comint-last-input-end comint-last-input-start)
2768         (if tuareg-interactive-read-only-input
2769             (add-text-properties
2770              comint-last-input-start comint-last-input-end
2771              (list 'read-only t)))
2772         (if (and font-lock-mode tuareg-interactive-input-font-lock)
2773             (progn
2774               (font-lock-fontify-region comint-last-input-start
2775                                         comint-last-input-end)
2776               (if (featurep 'sym-lock)
2777                   (sym-lock-make-symbols-atomic comint-last-input-start
2778                                                 comint-last-input-end))))
2779         (if tuareg-interactive-output-font-lock
2780             (save-excursion
2781               (goto-char (point-max))
2782               (re-search-backward comint-prompt-regexp
2783                                   comint-last-input-end t)
2784               (add-text-properties
2785                comint-last-input-end (point)
2786                '(face tuareg-font-lock-interactive-output-face))))
2787         (if tuareg-interactive-error-font-lock
2788             (save-excursion
2789               (goto-char comint-last-input-end)
2790               (while (re-search-forward tuareg-interactive-error-regexp () t)
2791                 (let ((matchbeg (match-beginning 1))
2792                       (matchend (match-end 1)))
2793                   (save-excursion
2794                     (goto-char matchbeg)
2795                     (put-text-property
2796                      matchbeg matchend
2797                      'face 'tuareg-font-lock-interactive-error-face)
2798                     (if (looking-at tuareg-interactive-toplevel-error-regexp)
2799                         (let ((beg (string-to-number (tuareg-match-string 1)))
2800                               (end (string-to-number (tuareg-match-string 2))))
2801                           (put-text-property
2802                            (+ comint-last-input-start beg)
2803                            (+ comint-last-input-start end)
2804                            'face 'tuareg-font-lock-error-face)
2805                           )))))))))))
2806
2807 (define-derived-mode tuareg-interactive-mode comint-mode "Tuareg-Interactive"
2808   "Major mode for interacting with a Caml process.
2809 Runs a Caml toplevel as a subprocess of Emacs, with I/O through an
2810 Emacs buffer. A history of input phrases is maintained. Phrases can
2811 be sent from another buffer in Caml mode.
2812
2813 Special keys for Tuareg interactive mode:\\{tuareg-interactive-mode-map}"
2814   (tuareg-install-font-lock t)
2815   (if (or tuareg-interactive-input-font-lock
2816           tuareg-interactive-output-font-lock
2817           tuareg-interactive-error-font-lock)
2818       (font-lock-mode 1))
2819   (add-hook 'comint-output-filter-functions 'tuareg-interactive-filter)
2820   (if (not (boundp 'after-change-functions)) ()
2821     (make-local-hook 'after-change-functions)
2822     (remove-hook 'after-change-functions 'font-lock-after-change-function t))
2823   (if (not (boundp 'pre-idle-hook)) ()
2824     (make-local-hook 'pre-idle-hook)
2825     (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook t))
2826   (setq comint-prompt-regexp "^#  *")
2827   (setq comint-process-echoes nil)
2828   (setq comint-get-old-input 'tuareg-interactive-get-old-input)
2829   (setq comint-scroll-to-bottom-on-output t)
2830   (set-syntax-table tuareg-mode-syntax-table)
2831   (setq local-abbrev-table tuareg-mode-abbrev-table)
2832
2833   (make-local-variable 'indent-line-function)
2834   (setq indent-line-function 'tuareg-indent-command)
2835
2836   (easy-menu-add tuareg-interactive-mode-menu)
2837   (tuareg-update-options-menu))
2838
2839 (defun tuareg-run-caml ()
2840   "Run a Caml toplevel process. I/O via buffer `*caml-toplevel*'."
2841   (interactive)
2842   (tuareg-run-process-if-needed)
2843   (when tuareg-display-buffer-on-eval
2844     (display-buffer tuareg-interactive-buffer-name)))
2845
2846 (defun tuareg-run-process-if-needed (&optional cmd)
2847   "Run a Caml toplevel process if needed, with an optional command name.
2848 I/O via buffer `*caml-toplevel*'."
2849   (if cmd
2850       (setq tuareg-interactive-program cmd)
2851     (if (not (comint-check-proc tuareg-interactive-buffer-name))
2852         (setq tuareg-interactive-program
2853               (read-shell-command "Caml toplevel to run: "
2854                                   tuareg-interactive-program))))
2855   (if (not (comint-check-proc tuareg-interactive-buffer-name))
2856       (let ((cmdlist (tuareg-args-to-list tuareg-interactive-program))
2857             (process-connection-type nil))
2858         (set-buffer (apply (function make-comint) "caml-toplevel"
2859                            (car cmdlist) nil (cdr cmdlist)))
2860         (tuareg-interactive-mode)
2861         (sleep-for 1))))
2862
2863 (defun tuareg-args-to-list (string)
2864   (let ((where (string-match "[ \t]" string)))
2865     (cond ((null where) (list string))
2866           ((not (= where 0))
2867            (cons (substring string 0 where)
2868                  (tuareg-args-to-list (substring string (+ 1 where)
2869                                                  (length string)))))
2870           (t (let ((pos (string-match "[^ \t]" string)))
2871                (if (null pos)
2872                    nil
2873                  (tuareg-args-to-list (substring string pos
2874                                                  (length string)))))))))
2875
2876 (defun tuareg-interactive-get-old-input ()
2877   (save-excursion
2878     (let ((end (point)))
2879       (re-search-backward comint-prompt-regexp (point-min) t)
2880       (if (looking-at comint-prompt-regexp)
2881           (re-search-forward comint-prompt-regexp))
2882       (buffer-substring-no-properties (point) end))))
2883
2884 (defun tuareg-interactive-end-of-phrase ()
2885   (save-excursion
2886     (end-of-line)
2887     (tuareg-find-meaningful-word)
2888     (tuareg-find-meaningful-word)
2889     (looking-at ";;")))
2890
2891 (defun tuareg-interactive-send-input-end-of-phrase ()
2892   (interactive)
2893   (goto-char (point-max))
2894   (if (not (tuareg-interactive-end-of-phrase))
2895       (insert ";;"))
2896   (comint-send-input))
2897
2898 (defconst tuareg-interactive-send-warning
2899   "Note: toplevel processing requires a terminating `;;'")
2900
2901 (defun tuareg-interactive-send-input ()
2902   "Process if the current line ends with `;;' then send the
2903 current phrase else insert a newline."
2904   (interactive)
2905   (if (tuareg-interactive-end-of-phrase)
2906       (progn
2907         (comint-send-input)
2908         (goto-char (point-max)))
2909     (insert "\n")
2910     (message tuareg-interactive-send-warning)))
2911
2912 (defun tuareg-interactive-send-input-or-indent ()
2913   "Process if the current line ends with `;;' then send the
2914 current phrase else insert a newline and indent."
2915   (interactive)
2916   (if (tuareg-interactive-end-of-phrase)
2917       (progn
2918         (goto-char (point-max))
2919         (comint-send-input))
2920     (insert "\n")
2921     (indent-according-to-mode)
2922     (message tuareg-interactive-send-warning)))
2923
2924 (defun tuareg-eval-region (start end)
2925   "Eval the current region in the Caml toplevel."
2926   (interactive "r")
2927   (save-excursion (tuareg-run-process-if-needed))
2928   (comint-preinput-scroll-to-bottom)
2929   (setq tuareg-interactive-last-phrase-pos-in-source start)
2930   (save-excursion
2931     (goto-char start)
2932     (tuareg-skip-blank-and-comments)
2933     (setq start (point))
2934     (goto-char end)
2935     (tuareg-skip-to-end-of-phrase)
2936     (setq end (point))
2937     (let ((text (buffer-substring-no-properties start end)))
2938       (goto-char end)
2939       (if (string= text "")
2940           (message "Cannot send empty commands to Caml toplevel!")
2941         (set-buffer tuareg-interactive-buffer-name)
2942         (goto-char (point-max))
2943         (setq tuareg-interactive-last-phrase-pos-in-toplevel (point))
2944         (comint-send-string tuareg-interactive-buffer-name
2945                             (concat text ";;"))
2946         (let ((pos (point)))
2947           (comint-send-input)
2948           (if tuareg-interactive-echo-phrase
2949               (save-excursion
2950                 (goto-char pos)
2951                 (insert (concat text ";;")))))))
2952     (when tuareg-display-buffer-on-eval
2953       (display-buffer tuareg-interactive-buffer-name))))
2954
2955 (defun tuareg-narrow-to-phrase ()
2956   "Narrow the editting window to the surrounding Caml phrase (or block)."
2957   (interactive)
2958   (save-excursion
2959     (let ((pair (tuareg-discover-phrase)))
2960       (narrow-to-region (nth 0 pair) (nth 1 pair)))))
2961
2962 (defun tuareg-eval-phrase ()
2963   "Eval the surrounding Caml phrase (or block) in the Caml toplevel."
2964   (interactive)
2965   (let ((end))
2966     (save-excursion
2967       (let ((pair (tuareg-discover-phrase)))
2968         (setq end (nth 2 pair))
2969         (tuareg-eval-region (nth 0 pair) (nth 1 pair))))
2970     (if tuareg-skip-after-eval-phrase
2971         (goto-char end))))
2972
2973 (defun tuareg-eval-buffer ()
2974   "Send the buffer to the Tuareg Interactive process."
2975   (interactive)
2976   (tuareg-eval-region (point-min) (point-max)))
2977
2978 (defun tuareg-interactive-next-error-source ()
2979   (interactive)
2980   (let ((error-pos) (beg 0) (end 0))
2981     (save-excursion
2982       (set-buffer tuareg-interactive-buffer-name)
2983       (goto-char tuareg-interactive-last-phrase-pos-in-toplevel)
2984       (setq error-pos
2985             (re-search-forward tuareg-interactive-toplevel-error-regexp
2986                                (point-max) t))
2987       (if error-pos
2988           (progn
2989             (setq beg (string-to-number (tuareg-match-string 1))
2990                   end (string-to-number (tuareg-match-string 2))))))
2991     (if (not error-pos)
2992         (message "No syntax or typing error in last phrase.")
2993       (setq beg (+ tuareg-interactive-last-phrase-pos-in-source beg)
2994             end (+ tuareg-interactive-last-phrase-pos-in-source end))
2995       (goto-char beg)
2996       (put-text-property beg end 'face 'tuareg-font-lock-error-face))))
2997
2998 (defun tuareg-interactive-next-error-toplevel ()
2999   (interactive)
3000   (let ((error-pos) (beg 0) (end 0))
3001     (save-excursion
3002       (goto-char tuareg-interactive-last-phrase-pos-in-toplevel)
3003       (setq error-pos
3004             (re-search-forward tuareg-interactive-toplevel-error-regexp
3005                                (point-max) t))
3006       (if error-pos
3007           (setq beg (string-to-number (tuareg-match-string 1))
3008                 end (string-to-number (tuareg-match-string 2)))))
3009     (if (not error-pos)
3010         (message "No syntax or typing error in last phrase.")
3011       (setq beg (+ tuareg-interactive-last-phrase-pos-in-toplevel beg)
3012             end (+ tuareg-interactive-last-phrase-pos-in-toplevel end))
3013       (put-text-property beg end 'face 'tuareg-font-lock-error-face)
3014       (goto-char beg))))
3015
3016 (defun tuareg-interrupt-caml ()
3017   (interactive)
3018   (if (comint-check-proc tuareg-interactive-buffer-name)
3019       (save-excursion
3020         (set-buffer tuareg-interactive-buffer-name)
3021         (comint-interrupt-subjob))))
3022
3023 (defun tuareg-kill-caml ()
3024   (interactive)
3025   (if (comint-check-proc tuareg-interactive-buffer-name)
3026       (save-excursion
3027         (set-buffer tuareg-interactive-buffer-name)
3028         (comint-kill-subjob))))
3029
3030 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3031 ;;                               Menu support
3032
3033 (defun tuareg-about () (interactive)
3034   (describe-variable 'tuareg-mode-version))
3035 (defun tuareg-help () (interactive)
3036   (describe-function 'tuareg-mode))
3037 (defun tuareg-interactive-help () (interactive)
3038   (describe-function 'tuareg-interactive-mode))
3039
3040 (defvar tuareg-definitions-menu-last-buffer nil)
3041 (defvar tuareg-definitions-keymaps nil)
3042
3043 (defun tuareg-build-menu ()
3044   (easy-menu-define
3045    tuareg-mode-menu (list tuareg-mode-map)
3046    "Tuareg Mode Menu."
3047    '("Tuareg"
3048      ("Interactive Mode"
3049       ["Run Caml Toplevel" tuareg-run-caml t]
3050       ["Interrupt Caml Toplevel" tuareg-interrupt-caml
3051        :active (comint-check-proc tuareg-interactive-buffer-name)]
3052       ["Kill Caml Toplevel" tuareg-kill-caml
3053        :active (comint-check-proc tuareg-interactive-buffer-name)]
3054       ["Evaluate Region" tuareg-eval-region
3055        ;; Region-active-p for XEmacs and mark-active for Emacs
3056        :active (if (fboundp 'region-active-p) (region-active-p) mark-active)]
3057       ["Evaluate Phrase" tuareg-eval-phrase t]
3058       ["Evaluate Buffer" tuareg-eval-buffer t])
3059      ("Caml Forms"
3060       ["try .. with .." tuareg-insert-try-form t]
3061       ["match .. with .." tuareg-insert-match-form t]
3062       ["let .. in .." tuareg-insert-let-form t]
3063       ["if .. then .. else .." tuareg-insert-if-form t]
3064       ["while .. do .. done" tuareg-insert-while-form t]
3065       ["for .. do .. done" tuareg-insert-for-form t]
3066       ["begin .. end" tuareg-insert-begin-form t])
3067      ["Switch .ml/.mli" tuareg-find-alternate-file t]
3068      "---"
3069      ["Compile..." compile t]
3070      ["Reference Manual..." tuareg-browse-manual t]
3071      ["Caml Library..." tuareg-browse-library t]
3072      ("Definitions"
3073       ["Scan..." tuareg-list-definitions t])
3074      "---"
3075      [ "Show type at point" caml-types-show-type
3076        tuareg-with-caml-mode-p]
3077      "---"
3078      [ "Complete identifier" caml-complete
3079        tuareg-with-caml-mode-p]
3080      [ "Help for identifier" caml-help
3081        tuareg-with-caml-mode-p]
3082      [ "Add path for documentation" ocaml-add-path
3083        tuareg-with-caml-mode-p]
3084      [ "Open module for documentation" ocaml-open-module
3085        tuareg-with-caml-mode-p]
3086      [ "Close module for documentation" ocaml-close-module
3087        tuareg-with-caml-mode-p]
3088      "---"
3089      ["Customize Tuareg Mode..." (customize-group 'tuareg) t]
3090      ("Tuareg Options" ["Dummy" nil t])
3091      ("Tuareg Interactive Options" ["Dummy" nil t])
3092      "---"
3093      ["About" tuareg-about t]
3094      ["Help" tuareg-help t]))
3095   (easy-menu-add tuareg-mode-menu)
3096   (tuareg-update-options-menu)
3097   ;; Save and update definitions menu
3098   (if tuareg-with-xemacs
3099       (add-hook 'activate-menubar-hook 'tuareg-update-definitions-menu)
3100     (if (not (functionp 'easy-menu-create-keymaps)) ()
3101       ;; Patch for Emacs
3102       (add-hook 'menu-bar-update-hook
3103                 'tuareg-with-emacs-update-definitions-menu)
3104       (make-local-variable 'tuareg-definitions-keymaps)
3105       (setq tuareg-definitions-keymaps
3106             (cdr (easy-menu-create-keymaps
3107                   "Definitions" tuareg-definitions-menu)))
3108       (setq tuareg-definitions-menu-last-buffer nil))))
3109
3110 (easy-menu-define
3111   tuareg-interactive-mode-menu tuareg-interactive-mode-map
3112   "Tuareg Interactive Mode Menu."
3113   '("Tuareg"
3114     ("Interactive Mode"
3115      ["Run Caml Toplevel" tuareg-run-caml t]
3116      ["Interrupt Caml Toplevel" tuareg-interrupt-caml
3117       :active (comint-check-proc tuareg-interactive-buffer-name)]
3118      ["Kill Caml Toplevel" tuareg-kill-caml
3119       :active (comint-check-proc tuareg-interactive-buffer-name)]
3120      ["Evaluate Region" tuareg-eval-region :active (region-active-p)]
3121      ["Evaluate Phrase" tuareg-eval-phrase t]
3122      ["Evaluate Buffer" tuareg-eval-buffer t])
3123     "---"
3124     ["Customize Tuareg Mode..." (customize-group 'tuareg) t]
3125     ("Tuareg Options" ["Dummy" nil t])
3126     ("Tuareg Interactive Options" ["Dummy" nil t])
3127     "---"
3128     ["About" tuareg-about t]
3129     ["Help" tuareg-interactive-help t]))
3130
3131 (defun tuareg-update-definitions-menu ()
3132   (if (eq major-mode 'tuareg-mode)
3133       (easy-menu-change
3134        '("Tuareg") "Definitions"
3135        tuareg-definitions-menu)))
3136
3137 (defun tuareg-with-emacs-update-definitions-menu ()
3138   (if (current-local-map)
3139       (let ((keymap
3140              (lookup-key (current-local-map) [menu-bar Tuareg Definitions])))
3141         (if (and
3142              (keymapp keymap)
3143              (not (eq tuareg-definitions-menu-last-buffer (current-buffer))))
3144             (setcdr keymap tuareg-definitions-keymaps)
3145           (setq tuareg-definitions-menu-last-buffer (current-buffer))))))
3146
3147 (defun tuareg-toggle-option (symbol)
3148   (interactive)
3149   (set symbol (not (symbol-value symbol)))
3150   (if (eq 'tuareg-use-abbrev-mode symbol)
3151       (abbrev-mode tuareg-use-abbrev-mode)) ; toggle abbrev minor mode
3152   (if tuareg-with-xemacs nil (tuareg-update-options-menu)))
3153
3154 (defun tuareg-update-options-menu ()
3155   (easy-menu-change
3156    '("Tuareg") "Tuareg Options"
3157    (mapcar (lambda (pair)
3158              (if (consp pair)
3159                  (vector (car pair)
3160                          (list 'tuareg-toggle-option (cdr pair))
3161                          ':style 'toggle
3162                          ':selected (nth 1 (cdr pair))
3163                          ':active t)
3164                pair)) tuareg-options-list))
3165   (easy-menu-change
3166    '("Tuareg") "Tuareg Interactive Options"
3167    (mapcar (lambda (pair)
3168              (if (consp pair)
3169                  (vector (car pair)
3170                          (list 'tuareg-toggle-option (cdr pair))
3171                          ':style 'toggle
3172                          ':selected (nth 1 (cdr pair))
3173                          ':active t)
3174                pair)) tuareg-interactive-options-list)))
3175
3176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3177 ;;                             Browse Manual
3178
3179 ;; From M. Quercia
3180
3181 (defun tuareg-browse-manual ()
3182   "*Browse Caml reference manual."
3183   (interactive)
3184   (setq tuareg-manual-url (read-from-minibuffer "URL: " tuareg-manual-url))
3185   (funcall tuareg-browser tuareg-manual-url))
3186
3187 (defun tuareg-xemacs-w3-manual (url)
3188   "*Browse Caml reference manual."
3189   (w3-fetch-other-frame url))
3190
3191 (defun tuareg-netscape-manual (url)
3192   "*Browse Caml reference manual."
3193   (start-process-shell-command
3194    "netscape" nil
3195    (concat "netscape -remote 'openURL ("
3196            url ", newwindow)' || netscape " url)))
3197
3198 (defun tuareg-mmm-manual (url)
3199   "*Browse Caml reference manual."
3200   (start-process-shell-command
3201    "mmm" nil
3202    (concat "mmm_remote " url " || mmm -external " url)))
3203
3204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3205 ;;                             Browse Library
3206
3207 ;; From M. Quercia
3208
3209 (defun tuareg-browse-library()
3210   "Browse the Caml library."
3211   (interactive)
3212   (let ((buf-name "*caml-library*") (opoint)
3213         (dir (read-from-minibuffer "Library path: " tuareg-library-path)))
3214     (if (and (file-directory-p dir) (file-readable-p dir))
3215         (progn
3216           (setq tuareg-library-path dir)
3217           ;; List *.ml and *.mli files
3218           (with-output-to-temp-buffer buf-name
3219             (buffer-disable-undo standard-output)
3220             (save-excursion
3221               (set-buffer buf-name)
3222               (kill-all-local-variables)
3223               (make-local-variable 'tuareg-library-path)
3224               (setq tuareg-library-path dir)
3225               ;; Help
3226               (insert "Directory \"" dir "\".\n")
3227               (insert "Select a file with middle mouse button or RETURN.\n\n")
3228               (insert "Interface files (.mli):\n\n")
3229               (insert-directory (concat dir "/*.mli") "-C" t nil)
3230               (insert "\n\nImplementation files (.ml):\n\n")
3231               (insert-directory (concat dir "/*.ml") "-C" t nil)
3232               ;; '.', '-' and '_' are now letters
3233               (modify-syntax-entry ?. "w")
3234               (modify-syntax-entry ?_ "w")
3235               (modify-syntax-entry ?- "w")
3236               ;; Every file name is now mouse-sensitive
3237               (goto-char (point-min))
3238               (while (< (point) (point-max))
3239                 (re-search-forward "\\.ml.?\\>")
3240                 (setq opoint (point))
3241                 (re-search-backward "\\<" (point-min) 1)
3242                 (put-text-property (point) opoint 'mouse-face 'highlight)
3243                 (goto-char (+ 1 opoint)))
3244               ;; Activate tuareg-library mode
3245               (setq major-mode 'tuareg-library-mode)
3246               (setq mode-name "tuareg-library")
3247               (use-local-map tuareg-library-mode-map)
3248               (setq buffer-read-only t)))))))
3249
3250 (defvar tuareg-library-mode-map
3251   (let ((map (make-keymap)))
3252     (suppress-keymap map)
3253     (define-key map [return] 'tuareg-library-find-file)
3254     (define-key map [mouse-2] 'tuareg-library-mouse-find-file)
3255     map))
3256
3257 (defun tuareg-library-find-file ()
3258   "Load the file whose name is near point."
3259   (interactive)
3260   (save-excursion
3261     (if (text-properties-at (point))
3262         (let (beg)
3263           (re-search-backward "\\<") (setq beg (point))
3264           (re-search-forward "\\>")
3265           (find-file-read-only (concat tuareg-library-path "/"
3266                                        (buffer-substring-no-properties
3267                                         beg (point))))))))
3268
3269 (defun tuareg-library-mouse-find-file (event)
3270   "Visit the file name you click on."
3271   (interactive "e")
3272   (let ((owindow (selected-window)))
3273     (mouse-set-point event)
3274     (tuareg-library-find-file)
3275     (select-window owindow)))
3276
3277 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3278 ;;                             Definitions List
3279
3280 ;; Designed from original code by M. Quercia
3281
3282 (defconst tuareg-definitions-regexp
3283   "\\<\\(and\\|val\\|type\\|module\\|class\\|exception\\|let\\)\\>"
3284   "Regexp matching definition phrases.")
3285
3286 (defconst tuareg-definitions-bind-skip-regexp
3287   (concat "\\<\\(rec\\|type\\|virtual\\)\\>\\|'[" tuareg-alpha "][0-9_'"
3288           tuareg-alpha "]*\\|('.*)")
3289   "Regexp matching stuff to ignore after a binding keyword.")
3290
3291 (defvar tuareg-definitions-menu (list ["Scan..." tuareg-list-definitions t])
3292   "Initial content of the definitions menu.")
3293 (make-variable-buffer-local 'tuareg-definitions-menu)
3294
3295 (defun tuareg-list-definitions ()
3296   "Parse the buffer and gather toplevel definitions for quick
3297 jump via the definitions menu."
3298   (interactive)
3299   (message "Searching definitions...")
3300   (save-excursion
3301     (let ((cpt 0) (kw) (menu) (scan-error)
3302           (value-list) (type-list) (module-list) (class-list) (misc-list))
3303       (goto-char (point-min))
3304       (tuareg-skip-blank-and-comments)
3305       (while (and (< (point) (point-max)) (not scan-error))
3306         (if (looking-at tuareg-definitions-regexp)
3307             (progn
3308               (setq kw (tuareg-match-string 0))
3309               (if (string= kw "and")
3310                   (setq kw (save-match-data
3311                              (save-excursion (tuareg-find-and-match)))))
3312               (if (or (string= kw "exception")
3313                       (string= kw "val")) (setq kw "let"))
3314               ;; Skip optional elements
3315               (goto-char (match-end 0))
3316               (tuareg-skip-blank-and-comments)
3317               (if (looking-at tuareg-definitions-bind-skip-regexp)
3318                   (goto-char (match-end 0)))
3319               (tuareg-skip-blank-and-comments)
3320               (if (looking-at
3321                    (concat "\\<[" tuareg-alpha "][0-9_'" tuareg-alpha "]*\\>"))
3322                   ;; Menu item : [name (goto-char ...) t]
3323                   (let* ((p (make-marker))
3324                          (ref (vector (tuareg-match-string 0)
3325                                       (list 'tuareg-goto p) t)))
3326                     (setq cpt (1+ cpt))
3327                     (message (concat "Searching definitions... ("
3328                                      (number-to-string cpt) ")"))
3329                     (set-marker p (point))
3330                     (cond
3331                      ((string= kw "let")
3332                       (setq value-list (cons ref value-list)))
3333                      ((string= kw "type")
3334                       (setq type-list (cons ref type-list)))
3335                      ((string= kw "module")
3336                       (setq module-list (cons ref module-list)))
3337                      ((string= kw "class")
3338                       (setq class-list (cons ref class-list)))
3339                      (t (setq misc-list (cons ref misc-list))))))))
3340         ;; Skip to next phrase or next top-level `and'
3341         (tuareg-forward-char)
3342         (let ((old-point (point)) (last-and))
3343           (tuareg-next-phrase t)
3344           (setq last-and (point))
3345           (if (< last-and old-point)
3346               (setq scan-error t)
3347             (save-excursion
3348               (while (and (re-search-backward "\\<and\\>" old-point t)
3349                           (not (tuareg-in-literal-or-comment-p))
3350                           (save-excursion (tuareg-find-and-match)
3351                                           (>= old-point (point))))
3352                 (setq last-and (point)))))
3353           (goto-char last-and)))
3354       (if scan-error
3355           (message "Parse error when scanning definitions: line %s!"
3356                    (if tuareg-with-xemacs
3357                        (line-number)
3358                      (1+ (count-lines 1 (point)))))
3359         ;; Sort and build lists
3360         (mapcar (lambda (pair)
3361                   (if (cdr pair)
3362                       (setq menu
3363                             (append (tuareg-split-long-list
3364                                      (car pair) (tuareg-sort-definitions (cdr pair)))
3365                                     menu))))
3366                 (list (cons "Miscellaneous" misc-list)
3367                       (cons "Values" value-list)
3368                       (cons "Classes" class-list)
3369                       (cons "Types" type-list)
3370                       (cons "Modules" module-list)))
3371         ;; Update definitions menu
3372         (setq tuareg-definitions-menu
3373               (append menu (list "---"
3374                                  ["Rescan..." tuareg-list-definitions t])))
3375         (if (or tuareg-with-xemacs
3376                 (not (functionp 'easy-menu-create-keymaps))) ()
3377           ;; Patch for Emacs
3378           (setq tuareg-definitions-keymaps
3379                 (cdr (easy-menu-create-keymaps
3380                       "Definitions" tuareg-definitions-menu)))
3381           (setq tuareg-definitions-menu-last-buffer nil))
3382         (message "Searching definitions... done"))))
3383   (tuareg-update-definitions-menu))
3384
3385 (defun tuareg-goto (pos)
3386   (goto-char pos)
3387   (recenter))
3388
3389 (defun tuareg-sort-definitions (list)
3390   (let* ((last "") (cpt 1)
3391          (list (sort (nreverse list)
3392                      (lambda (p q) (string< (elt p 0) (elt q 0)))))
3393          (tail list))
3394     (while tail
3395       (if (string= (elt (car tail) 0) last)
3396           (progn
3397             (setq cpt (1+ cpt))
3398             (aset (car tail) 0 (format "%s (%d)" last cpt)))
3399         (setq cpt 1)
3400         (setq last (elt (car tail) 0)))
3401       (setq tail (cdr tail)))
3402     list))
3403
3404 ;; Look for the (n-1)th or last element of a list
3405 (defun tuareg-nth (n list)
3406   (if (or (<= n 1) (null list) (null (cdr list))) list
3407     (tuareg-nth (1- n) (cdr list))))
3408
3409 ;; Split a definition list if it is too long
3410 (defun tuareg-split-long-list (title list)
3411   (let ((tail (tuareg-nth tuareg-definitions-max-items list)))
3412     (if (or (null tail) (null (cdr tail)))
3413         ;; List not too long, cons the title
3414         (list (cons title list))
3415       ;; List too long, split and add initials to the title
3416       (let (lists)
3417         (while list
3418           (let ((beg (substring (elt (car list) 0) 0 1))
3419                 (end (substring (elt (car tail) 0) 0 1)))
3420             (setq lists (cons
3421                          (cons (format "%s %s-%s" title beg end) list)
3422                          lists))
3423             (setq list (cdr tail))
3424             (setcdr tail nil)
3425             (setq tail (tuareg-nth tuareg-definitions-max-items list))))
3426         (nreverse lists)))))
3427
3428 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3429 ;;                             Hooks and Exit
3430
3431 (condition-case nil
3432     (progn (require 'speedbar)
3433            (speedbar-add-supported-extension
3434             '(".ml" ".mli" ".mll" ".mly")))
3435   (error nil))
3436
3437 (defvar tuareg-load-hook nil
3438   "This hook is run when Tuareg is loaded in. It is a good place to put
3439 key-bindings or hack Font-Lock keywords...")
3440
3441 (run-hooks 'tuareg-load-hook)
3442
3443 (provide 'tuareg)
3444 ;; For compatibility with caml support modes
3445 ;; you may also link caml.el to tuareg.el
3446 (provide 'caml)
3447
3448 ;;; tuareg.el ends here