emacs-tuareg.el

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