l4/pkg/ocaml/contrib/emacs/caml.el

   1 ;(***********************************************************************)
   2 ;(*                                                                     *)
   3 ;(*                           Objective Caml                            *)
   4 ;(*                                                                     *)
   5 ;(*                Jacques Garrigue and Ian T Zimmerman                 *)
   6 ;(*                                                                     *)
   7 ;(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
   8 ;(*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 ;(*  under the terms of the GNU General Public License.                 *)
  10 ;(*                                                                     *)
  11 ;(***********************************************************************)
  12
  13 ;(* $Id: caml.el 9150 2008-12-03 16:16:43Z doligez $ *)
  14
  15 ;;; caml.el --- O'Caml code editing commands for Emacs
  16
  17 ;; Xavier Leroy, july 1993.
  18
  19 ;;indentation code is Copyright (C) 1996 by Ian T Zimmerman <itz@rahul.net>
  20 ;;copying: covered by the current FSF General Public License.
  21
  22 ;; indentation code adapted for Objective Caml by Jacques Garrigue,
  23 ;; july 1997. <garrigue@kurims.kyoto-u.ac.jp>
  24
  25 ;;user customizable variables
  26 (defvar caml-quote-char "'"
  27   "*Quote for character constants. \"'\" for Objective Caml, \"`\" for Caml-Light.")
  28
  29 (defvar caml-imenu-enable nil
  30   "*Enable Imenu support.")
  31
  32 (defvar caml-mode-indentation 2
  33   "*Used for \\[caml-unindent-command].")
  34
  35 (defvar caml-lookback-limit 5000
  36   "*How far to look back for syntax things in caml mode.")
  37
  38 (defvar caml-max-indent-priority 8
  39   "*Bounds priority of operators permitted to affect caml indentation.
  40
  41 Priorities are assigned to `interesting' caml operators as follows:
  42
  43         all keywords 0 to 7     8
  44         type, val, ... + 0      7
  45         :: ^                    6
  46         @                       5
  47         := <-                   4
  48         if                      3
  49         fun, let, match ...     2
  50         module                  1
  51         opening keywords        0.")
  52
  53 (defvar caml-apply-extra-indent 2
  54   "*How many spaces to add to indentation for an application in caml mode.")
  55 (make-variable-buffer-local 'caml-apply-extra-indent)
  56
  57 (defvar caml-begin-indent 2
  58   "*How many spaces to indent from a begin keyword in caml mode.")
  59 (make-variable-buffer-local 'caml-begin-indent)
  60
  61 (defvar caml-class-indent 2
  62   "*How many spaces to indent from a class keyword in caml mode.")
  63 (make-variable-buffer-local 'caml-class-indent)
  64
  65 (defvar caml-exception-indent 2
  66   "*How many spaces to indent from a exception keyword in caml mode.")
  67 (make-variable-buffer-local 'caml-exception-indent)
  68
  69 (defvar caml-for-indent 2
  70   "*How many spaces to indent from a for keyword in caml mode.")
  71 (make-variable-buffer-local 'caml-for-indent)
  72
  73 (defvar caml-fun-indent 2
  74   "*How many spaces to indent from a fun keyword in caml mode.")
  75 (make-variable-buffer-local 'caml-fun-indent)
  76
  77 (defvar caml-function-indent 4
  78   "*How many spaces to indent from a function keyword in caml mode.")
  79 (make-variable-buffer-local 'caml-function-indent)
  80
  81 (defvar caml-if-indent  2
  82   "*How many spaces to indent from a if keyword in caml mode.")
  83 (make-variable-buffer-local 'caml-if-indent)
  84
  85 (defvar caml-if-else-indent 0
  86   "*How many spaces to indent from an if .. else line in caml mode.")
  87 (make-variable-buffer-local 'caml-if-else-indent)
  88
  89 (defvar caml-inherit-indent 2
  90   "*How many spaces to indent from a inherit keyword in caml mode.")
  91 (make-variable-buffer-local 'caml-inherit-indent)
  92
  93 (defvar caml-initializer-indent 2
  94   "*How many spaces to indent from a initializer keyword in caml mode.")
  95 (make-variable-buffer-local 'caml-initializer-indent)
  96
  97 (defvar caml-include-indent 2
  98   "*How many spaces to indent from a include keyword in caml mode.")
  99 (make-variable-buffer-local 'caml-include-indent)
 100
 101 (defvar caml-let-indent 2
 102   "*How many spaces to indent from a let keyword in caml mode.")
 103 (make-variable-buffer-local 'caml-let-indent)
 104
 105 (defvar caml-let-in-indent 0
 106   "*How many spaces to indent from a let .. in keyword in caml mode.")
 107 (make-variable-buffer-local 'caml-let-in-indent)
 108
 109 (defvar caml-match-indent 2
 110   "*How many spaces to indent from a match keyword in caml mode.")
 111 (make-variable-buffer-local 'caml-match-indent)
 112
 113 (defvar caml-method-indent 2
 114   "*How many spaces to indent from a method keyword in caml mode.")
 115 (make-variable-buffer-local 'caml-method-indent)
 116
 117 (defvar caml-module-indent 2
 118   "*How many spaces to indent from a module keyword in caml mode.")
 119 (make-variable-buffer-local 'caml-module-indent)
 120
 121 (defvar caml-object-indent 2
 122   "*How many spaces to indent from a object keyword in caml mode.")
 123 (make-variable-buffer-local 'caml-object-indent)
 124
 125 (defvar caml-of-indent 2
 126   "*How many spaces to indent from a of keyword in caml mode.")
 127 (make-variable-buffer-local 'caml-of-indent)
 128
 129 (defvar caml-parser-indent 4
 130   "*How many spaces to indent from a parser keyword in caml mode.")
 131 (make-variable-buffer-local 'caml-parser-indent)
 132
 133 (defvar caml-sig-indent 2
 134   "*How many spaces to indent from a sig keyword in caml mode.")
 135 (make-variable-buffer-local 'caml-sig-indent)
 136
 137 (defvar caml-struct-indent 2
 138   "*How many spaces to indent from a struct keyword in caml mode.")
 139 (make-variable-buffer-local 'caml-struct-indent)
 140
 141 (defvar caml-try-indent 2
 142   "*How many spaces to indent from a try keyword in caml mode.")
 143 (make-variable-buffer-local 'caml-try-indent)
 144
 145 (defvar caml-type-indent 4
 146   "*How many spaces to indent from a type keyword in caml mode.")
 147 (make-variable-buffer-local 'caml-type-indent)
 148
 149 (defvar caml-val-indent 2
 150   "*How many spaces to indent from a val keyword in caml mode.")
 151 (make-variable-buffer-local 'caml-val-indent)
 152
 153 (defvar caml-while-indent 2
 154   "*How many spaces to indent from a while keyword in caml mode.")
 155 (make-variable-buffer-local 'caml-while-indent)
 156
 157 (defvar caml-::-indent  2
 158   "*How many spaces to indent from a :: operator in caml mode.")
 159 (make-variable-buffer-local 'caml-::-indent)
 160
 161 (defvar caml-@-indent   2
 162   "*How many spaces to indent from a @ operator in caml mode.")
 163 (make-variable-buffer-local 'caml-@-indent)
 164
 165 (defvar caml-:=-indent  2
 166   "*How many spaces to indent from a := operator in caml mode.")
 167 (make-variable-buffer-local 'caml-:=-indent)
 168
 169 (defvar caml-<--indent  2
 170   "*How many spaces to indent from a <- operator in caml mode.")
 171 (make-variable-buffer-local 'caml-<--indent)
 172
 173 (defvar caml-->-indent  2
 174   "*How many spaces to indent from a -> operator in caml mode.")
 175 (make-variable-buffer-local 'caml-->-indent)
 176
 177 (defvar caml-lb-indent 2
 178   "*How many spaces to indent from a \[ operator in caml mode.")
 179 (make-variable-buffer-local 'caml-lb-indent)
 180
 181 (defvar caml-lc-indent 2
 182   "*How many spaces to indent from a \{ operator in caml mode.")
 183 (make-variable-buffer-local 'caml-lc-indent)
 184
 185 (defvar caml-lp-indent  1
 186   "*How many spaces to indent from a \( operator in caml mode.")
 187 (make-variable-buffer-local 'caml-lp-indent)
 188
 189 (defvar caml-and-extra-indent nil
 190   "*Extra indent for caml lines starting with the and keyword.
 191 Usually negative. nil is align on master.")
 192 (make-variable-buffer-local 'caml-and-extra-indent)
 193
 194 (defvar caml-do-extra-indent nil
 195   "*Extra indent for caml lines starting with the do keyword.
 196 Usually negative. nil is align on master.")
 197 (make-variable-buffer-local 'caml-do-extra-indent)
 198
 199 (defvar caml-done-extra-indent nil
 200   "*Extra indent for caml lines starting with the done keyword.
 201 Usually negative. nil is align on master.")
 202 (make-variable-buffer-local 'caml-done-extra-indent)
 203
 204 (defvar caml-else-extra-indent nil
 205   "*Extra indent for caml lines starting with the else keyword.
 206 Usually negative. nil is align on master.")
 207 (make-variable-buffer-local 'caml-else-extra-indent)
 208
 209 (defvar caml-end-extra-indent nil
 210   "*Extra indent for caml lines starting with the end keyword.
 211 Usually negative. nil is align on master.")
 212 (make-variable-buffer-local 'caml-end-extra-indent)
 213
 214 (defvar caml-in-extra-indent nil
 215   "*Extra indent for caml lines starting with the in keyword.
 216 Usually negative. nil is align on master.")
 217 (make-variable-buffer-local 'caml-in-extra-indent)
 218
 219 (defvar caml-then-extra-indent nil
 220   "*Extra indent for caml lines starting with the then keyword.
 221 Usually negative. nil is align on master.")
 222 (make-variable-buffer-local 'caml-then-extra-indent)
 223
 224 (defvar caml-to-extra-indent -1
 225   "*Extra indent for caml lines starting with the to keyword.
 226 Usually negative. nil is align on master.")
 227 (make-variable-buffer-local 'caml-to-extra-indent)
 228
 229 (defvar caml-with-extra-indent nil
 230   "*Extra indent for caml lines starting with the with keyword.
 231 Usually negative. nil is align on master.")
 232 (make-variable-buffer-local 'caml-with-extra-indent)
 233
 234 (defvar caml-comment-indent 3
 235   "*Indent inside comments.")
 236 (make-variable-buffer-local 'caml-comment-indent)
 237
 238 (defvar caml-|-extra-indent -2
 239   "*Extra indent for caml lines starting with the | operator.
 240 Usually negative. nil is align on master.")
 241 (make-variable-buffer-local 'caml-|-extra-indent)
 242
 243 (defvar caml-rb-extra-indent -2
 244   "*Extra indent for caml lines statring with ].
 245 Usually negative. nil is align on master.")
 246
 247 (defvar caml-rc-extra-indent -2
 248   "*Extra indent for caml lines starting with }.
 249 Usually negative. nil is align on master.")
 250
 251 (defvar caml-rp-extra-indent -1
 252   "*Extra indent for caml lines starting with ).
 253 Usually negative. nil is align on master.")
 254
 255 (defvar caml-electric-indent t
 256   "*Non-nil means electrically indent lines starting with |, ] or }.
 257
 258 Many people find eletric keys irritating, so you can disable them if
 259 you are one.")
 260
 261 (defvar caml-electric-close-vector t
 262   "*Non-nil means electrically insert a | before a vector-closing ].
 263
 264 Many people find eletric keys irritating, so you can disable them if
 265 you are one. You should probably have this on, though, if you also
 266 have caml-electric-indent on, which see.")
 267
 268 ;;code
 269 (if (or (not (fboundp 'indent-line-to))
 270         (not (fboundp 'buffer-substring-no-properties)))
 271     (require 'caml-compat))
 272
 273 (defvar caml-shell-active nil
 274   "Non nil when a subshell is running.")
 275
 276 (defvar running-xemacs  (string-match "XEmacs" emacs-version)
 277   "Non-nil if we are running in the XEmacs environment.")
 278
 279 (defvar caml-mode-map nil
 280   "Keymap used in Caml mode.")
 281 (if caml-mode-map
 282     ()
 283   (setq caml-mode-map (make-sparse-keymap))
 284   (define-key caml-mode-map "|" 'caml-electric-pipe)
 285   (define-key caml-mode-map "}" 'caml-electric-pipe)
 286   (define-key caml-mode-map "]" 'caml-electric-rb)
 287   (define-key caml-mode-map "\t" 'caml-indent-command)
 288   (define-key caml-mode-map [backtab] 'caml-unindent-command)
 289
 290 ;itz 04-21-96 instead of defining a new function, use defadvice
 291 ;that way we get out effect even when we do \C-x` in compilation buffer
 292 ;  (define-key caml-mode-map "\C-x`" 'caml-next-error)
 293
 294   (if running-xemacs
 295       (define-key caml-mode-map 'backspace 'backward-delete-char-untabify)
 296     (define-key caml-mode-map "\177" 'backward-delete-char-untabify))
 297
 298   ;; caml-types
 299   (define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type)  ; "type"
 300   (define-key caml-mode-map [?\C-c?\C-f] 'caml-types-show-call)  ; "function"
 301   (define-key caml-mode-map [?\C-c?\C-l] 'caml-types-show-ident) ; "let"
 302   ;; must be a mouse-down event. Can be any button and any prefix
 303   (define-key caml-mode-map [?\C-c down-mouse-1] 'caml-types-explore)
 304   ;; caml-help
 305   (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)
 306   (define-key caml-mode-map [?\C-c?]] 'ocaml-close-module)
 307   (define-key caml-mode-map [?\C-c?[] 'ocaml-open-module)
 308   (define-key caml-mode-map [?\C-c?\C-h] 'caml-help)
 309   (define-key caml-mode-map [?\C-c?\t] 'caml-complete)
 310   ;; others
 311   (define-key caml-mode-map "\C-cb" 'caml-insert-begin-form)
 312   (define-key caml-mode-map "\C-cf" 'caml-insert-for-form)
 313   (define-key caml-mode-map "\C-ci" 'caml-insert-if-form)
 314   (define-key caml-mode-map "\C-cl" 'caml-insert-let-form)
 315   (define-key caml-mode-map "\C-cm" 'caml-insert-match-form)
 316   (define-key caml-mode-map "\C-ct" 'caml-insert-try-form)
 317   (define-key caml-mode-map "\C-cw" 'caml-insert-while-form)
 318   (define-key caml-mode-map "\C-c`" 'caml-goto-phrase-error)
 319   (define-key caml-mode-map "\C-c\C-a" 'caml-find-alternate-file)
 320   (define-key caml-mode-map "\C-c\C-c" 'compile)
 321   (define-key caml-mode-map "\C-c\C-e" 'caml-eval-phrase)
 322   (define-key caml-mode-map "\C-c\C-\[" 'caml-backward-to-less-indent)
 323   (define-key caml-mode-map "\C-c\C-\]" 'caml-forward-to-less-indent)
 324   (define-key caml-mode-map "\C-c\C-q" 'caml-indent-phrase)
 325   (define-key caml-mode-map "\C-c\C-r" 'caml-eval-region)
 326   (define-key caml-mode-map "\C-c\C-s" 'caml-show-subshell)
 327   (define-key caml-mode-map "\M-\C-h" 'caml-mark-phrase)
 328   (define-key caml-mode-map "\M-\C-q" 'caml-indent-phrase)
 329   (define-key caml-mode-map "\M-\C-x" 'caml-eval-phrase)
 330
 331   (if running-xemacs nil ; if not running xemacs
 332     (let ((map (make-sparse-keymap "Caml"))
 333           (forms (make-sparse-keymap "Forms")))
 334       (define-key caml-mode-map "\C-c\C-d" 'caml-show-imenu)
 335       (define-key caml-mode-map [menu-bar] (make-sparse-keymap))
 336       (define-key caml-mode-map [menu-bar caml] (cons "Caml" map))
 337       ;; caml-help
 338
 339       (define-key map [open] '("Open add path" . ocaml-add-path ))
 340       (define-key map [close]
 341          '("Close module for help" . ocaml-close-module))
 342       (define-key map [open] '("Open module for help" . ocaml-open-module))
 343       (define-key map [help] '("Help for identifier" . caml-help))
 344       (define-key map [complete] '("Complete identifier" . caml-complete))
 345       (define-key map [separator-help] '("---"))
 346
 347       ;; caml-types
 348       (define-key map [show-type]
 349           '("Show type at point" . caml-types-show-type ))
 350       (define-key map [separator-types] '("---"))
 351
 352       ;; others
 353       (define-key map [camldebug] '("Call debugger..." . camldebug))
 354       (define-key map [run-caml] '("Start subshell..." . run-caml))
 355       (define-key map [compile] '("Compile..." . compile))
 356       (define-key map [switch-view]
 357         '("Switch view" . caml-find-alternate-file))
 358       (define-key map [separator-format] '("--"))
 359       (define-key map [forms] (cons "Forms" forms))
 360       (define-key map [show-imenu] '("Show index" . caml-show-imenu))
 361       (put 'caml-show-imenu 'menu-enable '(not caml-imenu-shown))
 362       (define-key map [show-subshell] '("Show subshell" . caml-show-subshell))
 363       (put 'caml-show-subshell 'menu-enable 'caml-shell-active)
 364       (define-key map [eval-phrase] '("Eval phrase" . caml-eval-phrase))
 365       (put 'caml-eval-phrase 'menu-enable 'caml-shell-active)
 366       (define-key map [indent-phrase] '("Indent phrase" . caml-indent-phrase))
 367       (define-key forms [while]
 368         '("while .. do .. done" . caml-insert-while-form))
 369       (define-key forms [try] '("try .. with .." . caml-insert-try-form))
 370       (define-key forms [match] '("match .. with .." . caml-insert-match-form))
 371       (define-key forms [let] '("let .. in .." . caml-insert-let-form))
 372       (define-key forms [if] '("if .. then .. else .." . caml-insert-if-form))
 373       (define-key forms [begin] '("for .. do .. done" . caml-insert-for-form))
 374       (define-key forms [begin] '("begin .. end" . caml-insert-begin-form)))))
 375
 376 (defvar caml-mode-xemacs-menu
 377   (if running-xemacs
 378       '("Caml"
 379         [ "Indent phrase" caml-indent-phrase :keys "C-M-q" ]
 380         [ "Eval phrase" caml-eval-phrase
 381           :active caml-shell-active :keys "C-M-x" ]
 382         [ "Show subshell" caml-show-subshell caml-shell-active ]
 383         ("Forms"
 384          [ "while .. do .. done" caml-insert-while-form t]
 385          [ "try .. with .." caml-insert-try-form t ]
 386          [ "match .. with .." caml-insert-match-form t ]
 387          [ "let .. in .." caml-insert-let-form t ]
 388          [ "if .. then .. else .." caml-insert-if-form t ]
 389          [ "for .. do .. done" caml-insert-for-form t ]
 390          [ "begin .. end" caml-insert-begin-form t ])
 391         "---"
 392         [ "Switch view" caml-find-alternate-file t ]
 393         [ "Compile..." compile t ]
 394         [ "Start subshell..." run-caml t ]
 395         "---"
 396         [ "Show type at point" caml-types-show-type t ]
 397         "---"
 398         [ "Complete identifier" caml-complete t ]
 399         [ "Help for identifier" caml-help t ]
 400         [ "Add path for documentation" ocaml-add-path t ]
 401         [ "Open module for documentation" ocaml-open t ]
 402         [ "Close module for documentation" ocaml-close t ]
 403         ))
 404   "Menu to add to the menubar when running Xemacs")
 405
 406 (defvar caml-mode-syntax-table nil
 407   "Syntax table in use in Caml mode buffers.")
 408 (if caml-mode-syntax-table
 409     ()
 410   (setq caml-mode-syntax-table (make-syntax-table))
 411   ; backslash is an escape sequence
 412   (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table)
 413   ; ( is first character of comment start
 414   (modify-syntax-entry ?\( "()1n" caml-mode-syntax-table)
 415   ; * is second character of comment start,
 416   ; and first character of comment end
 417   (modify-syntax-entry ?*  ". 23n" caml-mode-syntax-table)
 418   ; ) is last character of comment end
 419   (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table)
 420   ; backquote was a string-like delimiter (for character literals)
 421   ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table)
 422   ; quote and underscore are part of words
 423   (modify-syntax-entry ?' "w" caml-mode-syntax-table)
 424   (modify-syntax-entry ?_ "w" caml-mode-syntax-table)
 425   ; ISO-latin accented letters and EUC kanjis are part of words
 426   (let ((i 160))
 427     (while (< i 256)
 428       (modify-syntax-entry i "w" caml-mode-syntax-table)
 429       (setq i (1+ i)))))
 430
 431 (defvar caml-mode-abbrev-table nil
 432   "Abbrev table used for Caml mode buffers.")
 433 (if caml-mode-abbrev-table nil
 434   (setq caml-mode-abbrev-table (make-abbrev-table))
 435   (define-abbrev caml-mode-abbrev-table "and" "and" 'caml-abbrev-hook)
 436   (define-abbrev caml-mode-abbrev-table "do" "do" 'caml-abbrev-hook)
 437   (define-abbrev caml-mode-abbrev-table "done" "done" 'caml-abbrev-hook)
 438   (define-abbrev caml-mode-abbrev-table "else" "else" 'caml-abbrev-hook)
 439   (define-abbrev caml-mode-abbrev-table "end" "end" 'caml-abbrev-hook)
 440   (define-abbrev caml-mode-abbrev-table "in" "in" 'caml-abbrev-hook)
 441   (define-abbrev caml-mode-abbrev-table "then" "then" 'caml-abbrev-hook)
 442   (define-abbrev caml-mode-abbrev-table "with" "with" 'caml-abbrev-hook))
 443
 444 ;; Other internal variables
 445
 446 (defvar caml-last-noncomment-pos nil
 447   "Caches last buffer position determined not inside a caml comment.")
 448 (make-variable-buffer-local 'caml-last-noncomment-pos)
 449
 450 ;;last-noncomment-pos can be a simple position, because we nil it
 451 ;;anyway whenever buffer changes upstream. last-comment-start and -end
 452 ;;have to be markers, because we preserve them when the changes' end
 453 ;;doesn't overlap with the comment's start.
 454
 455 (defvar caml-last-comment-start nil
 456   "A marker caching last determined caml comment start.")
 457 (make-variable-buffer-local 'caml-last-comment-start)
 458
 459 (defvar caml-last-comment-end nil
 460   "A marker caching last determined caml comment end.")
 461 (make-variable-buffer-local 'caml-last-comment-end)
 462
 463 (make-variable-buffer-local 'before-change-function)
 464
 465 (defvar caml-imenu-shown nil
 466   "True if we have computed definition list.")
 467 (make-variable-buffer-local 'caml-imenu-shown)
 468
 469 (defconst caml-imenu-search-regexp
 470   (concat "\\<in\\>\\|"
 471           "^[ \t]*\\(let\\|class\\|type\\|m\\(odule\\|ethod\\)"
 472           "\\|functor\\|and\\|val\\)[ \t]+"
 473           "\\(\\('[a-zA-Z0-9]+\\|([^)]+)"
 474           "\\|mutable\\|private\\|rec\\|type\\)[ \t]+\\)?"
 475           "\\([a-zA-Z][a-zA-Z0-9_']*\\)"))
 476
 477 ;;; The major mode
 478 (eval-when-compile
 479   (if (and (boundp 'running-xemacs) running-xemacs) nil
 480     (require 'imenu)))
 481
 482 ;;
 483 (defvar caml-mode-hook nil
 484   "Hook for caml-mode")
 485
 486 (defun caml-mode ()
 487   "Major mode for editing Caml code.
 488
 489 \\{caml-mode-map}"
 490
 491   (interactive)
 492   (kill-all-local-variables)
 493   (setq major-mode 'caml-mode)
 494   (setq mode-name "caml")
 495   (use-local-map caml-mode-map)
 496   (set-syntax-table caml-mode-syntax-table)
 497   (setq local-abbrev-table caml-mode-abbrev-table)
 498   (make-local-variable 'paragraph-start)
 499   (setq paragraph-start (concat "^$\\|" page-delimiter))
 500   (make-local-variable 'paragraph-separate)
 501   (setq paragraph-separate paragraph-start)
 502   (make-local-variable 'paragraph-ignore-fill-prefix)
 503   (setq paragraph-ignore-fill-prefix t)
 504   (make-local-variable 'require-final-newline)
 505   (setq require-final-newline t)
 506   (make-local-variable 'comment-start)
 507   (setq comment-start "(*")
 508   (make-local-variable 'comment-end)
 509   (setq comment-end "*)")
 510   (make-local-variable 'comment-column)
 511   (setq comment-column 40)
 512   (make-local-variable 'comment-start-skip)
 513   (setq comment-start-skip "(\\*+ *")
 514   (make-local-variable 'parse-sexp-ignore-comments)
 515   (setq parse-sexp-ignore-comments nil)
 516   (make-local-variable 'indent-line-function)
 517   (setq indent-line-function 'caml-indent-command)
 518   ;itz Fri Sep 25 13:23:49 PDT 1998
 519   (make-local-variable 'add-log-current-defun-function)
 520   (setq add-log-current-defun-function 'caml-current-defun)
 521   ;itz 03-25-96
 522   (setq before-change-function 'caml-before-change-function)
 523   (setq caml-last-noncomment-pos nil)
 524   (setq caml-last-comment-start (make-marker))
 525   (setq caml-last-comment-end (make-marker))
 526   ;garrigue 27-11-96
 527   (setq case-fold-search nil)
 528   ;garrigue july 97
 529   (if running-xemacs ; from Xemacs lisp mode
 530       (if (and (featurep 'menubar)
 531                current-menubar)
 532           (progn
 533             ;; make a local copy of the menubar, so our modes don't
 534             ;; change the global menubar
 535             (set-buffer-menubar current-menubar)
 536             (add-submenu nil caml-mode-xemacs-menu)))
 537     ;imenu support (not for Xemacs)
 538     (make-local-variable 'imenu-create-index-function)
 539     (setq imenu-create-index-function 'caml-create-index-function)
 540     (make-local-variable 'imenu-generic-expression)
 541     (setq imenu-generic-expression caml-imenu-search-regexp)
 542     (if (and caml-imenu-enable (< (buffer-size) 10000))
 543         (caml-show-imenu)))
 544   (run-hooks 'caml-mode-hook))
 545
 546 (defun caml-set-compile-command ()
 547   "Hook to set compile-command locally, unless there is a Makefile or
 548    a _build directory or a _tags file in the current directory."
 549   (interactive)
 550   (unless (or (null buffer-file-name)
 551               (file-exists-p "makefile")
 552               (file-exists-p "Makefile")
 553               (file-exists-p "_build")
 554               (file-exists-p "_tags"))
 555     (let* ((filename (file-name-nondirectory buffer-file-name))
 556            (basename (file-name-sans-extension filename))
 557            (command nil))
 558       (cond
 559        ((string-match ".*\\.mli\$" filename)
 560         (setq command "ocamlc -c"))
 561        ((string-match ".*\\.ml\$" filename)
 562         (setq command "ocamlc -c") ; (concat "ocamlc -o " basename)
 563         )
 564        ((string-match ".*\\.mll\$" filename)
 565         (setq command "ocamllex"))
 566        ((string-match ".*\\.mll\$" filename)
 567         (setq command "ocamlyacc"))
 568        )
 569       (if command
 570           (progn
 571             (make-local-variable 'compile-command)
 572             (setq compile-command (concat command " " filename))))
 573       )))
 574
 575 (add-hook 'caml-mode-hook 'caml-set-compile-command)
 576
 577 ;;; Auxiliary function. Garrigue 96-11-01.
 578
 579 (defun caml-find-alternate-file ()
 580   (interactive)
 581   (let ((name (buffer-file-name)))
 582     (if (string-match "^\\(.*\\)\\.\\(ml\\|mli\\)$" name)
 583         (find-file
 584          (concat
 585           (caml-match-string 1 name)
 586           (if (string= "ml" (caml-match-string 2 name)) ".mli" ".ml"))))))
 587
 588 ;;; subshell support
 589
 590 (defun caml-eval-region (start end)
 591   "Send the current region to the inferior Caml process."
 592   (interactive"r")
 593   (require 'inf-caml)
 594   (inferior-caml-eval-region start end))
 595
 596 ;; old version ---to be deleted later
 597 ;
 598 ; (defun caml-eval-phrase ()
 599 ;   "Send the current Caml phrase to the inferior Caml process."
 600 ;   (interactive)
 601 ;   (save-excursion
 602 ;     (let ((bounds (caml-mark-phrase)))
 603 ;     (inferior-caml-eval-region (car bounds) (cdr bounds)))))
 604
 605 (defun caml-eval-phrase (arg &optional min max)
 606   "Send the phrase containing the point to the CAML process.
 607 With prefix-arg send as many phrases as its numeric value,
 608 If an error occurs during evalutaion, stop at this phrase and
 609 repport the error.
 610
 611 Return nil if noerror and position of error if any.
 612
 613 If arg's numeric value is zero or negative, evaluate the current phrase
 614 or as many as prefix arg, ignoring evaluation errors.
 615 This allows to jump other erroneous phrases.
 616
 617 Optional arguments min max defines a region within which the phrase
 618 should lies."
 619   (interactive "p")
 620   (require 'inf-caml)
 621   (inferior-caml-eval-phrase arg min max))
 622
 623 (defun caml-eval-buffer (arg)
 624   "Evaluate the buffer from the beginning to the phrase under the point.
 625 With prefix arg, evaluate past the whole buffer, no stopping at
 626 the current point."
 627   (interactive "p")
 628   (let ((here (point)) err)
 629     (goto-char (point-min))
 630     (setq err
 631           (caml-eval-phrase 500 (point-min) (if arg (point-max) here)))
 632     (if err (set-mark err))
 633     (goto-char here)))
 634
 635 (defun caml-show-subshell ()
 636   (interactive)
 637   (require 'inf-caml)
 638   (inferior-caml-show-subshell))
 639
 640
 641 ;;; Imenu support
 642 (defun caml-show-imenu ()
 643   (interactive)
 644   (require 'imenu)
 645   (switch-to-buffer (current-buffer))
 646   (imenu-add-to-menubar "Defs")
 647   (setq caml-imenu-shown t))
 648
 649 (defun caml-prev-index-position-function ()
 650   (let (found data)
 651     (while (and (setq found
 652                       (re-search-backward caml-imenu-search-regexp nil 'move))
 653                 (progn (setq data (match-data)) t)
 654                 (or (caml-in-literal-p)
 655                     (caml-in-comment-p)
 656                     (if (looking-at "in") (caml-find-in-match)))))
 657     (set-match-data data)
 658     found))
 659 (defun caml-create-index-function ()
 660   (let (value-alist
 661         type-alist
 662         class-alist
 663         method-alist
 664         module-alist
 665         and-alist
 666         all-alist
 667         menu-alist
 668         (prev-pos (point-max))
 669         index)
 670     (goto-char prev-pos)
 671     (imenu-progress-message prev-pos 0 t)
 672     ;; collect definitions
 673     (while (caml-prev-index-position-function)
 674       (setq index (cons (caml-match-string 5) (point)))
 675       (imenu-progress-message prev-pos nil t)
 676       (setq all-alist (cons index all-alist))
 677       (cond
 678        ((looking-at "[ \t]*and")
 679         (setq and-alist (cons index and-alist)))
 680        ((looking-at "[ \t]*let")
 681         (setq value-alist (cons index (append and-alist value-alist)))
 682         (setq and-alist nil))
 683        ((looking-at "[ \t]*type")
 684         (setq type-alist (cons index (append and-alist type-alist)))
 685         (setq and-alist nil))
 686        ((looking-at "[ \t]*class")
 687         (setq class-alist (cons index (append and-alist class-alist)))
 688         (setq and-alist nil))
 689        ((looking-at "[ \t]*val")
 690         (setq value-alist (cons index value-alist)))
 691        ((looking-at "[ \t]*\\(module\\|functor\\)")
 692         (setq module-alist (cons index module-alist)))
 693        ((looking-at "[ \t]*method")
 694         (setq method-alist (cons index method-alist)))))
 695     ;; build menu
 696     (mapcar
 697      '(lambda (pair)
 698         (if (symbol-value (cdr pair))
 699             (setq menu-alist
 700                   (cons
 701                    (cons (car pair)
 702                          (sort (symbol-value (cdr pair)) 'imenu--sort-by-name))
 703                    menu-alist))))
 704      '(("Values" . value-alist)
 705        ("Types" . type-alist)
 706        ("Modules" . module-alist)
 707        ("Methods" . method-alist)
 708        ("Classes" . class-alist)))
 709     (if all-alist (setq menu-alist (cons (cons "Index" all-alist) menu-alist)))
 710     (imenu-progress-message prev-pos 100 t)
 711     menu-alist))
 712
 713 ;;; Indentation stuff
 714
 715 (defun caml-in-indentation ()
 716   "Tests whether all characters between beginning of line and point
 717 are blanks."
 718   (save-excursion
 719     (skip-chars-backward " \t")
 720     (bolp)))
 721
 722 ;;; The command
 723 ;;; Sorry, I didn't like the previous behaviour... Garrigue 96/11/01
 724
 725 (defun caml-indent-command (&optional p)
 726   "Indent the current line in Caml mode.
 727
 728 Compute new indentation based on caml syntax. If prefixed, indent
 729 the line all the way to where point is."
 730
 731   (interactive "*p")
 732   (cond
 733    ((and p (> p 1)) (indent-line-to (current-column)))
 734    ((caml-in-indentation) (indent-line-to (caml-compute-final-indent)))
 735    (t (save-excursion
 736         (indent-line-to
 737          (caml-compute-final-indent))))))
 738
 739 (defun caml-unindent-command ()
 740
 741   "Decrease indentation by one level in Caml mode.
 742
 743 Works only if the point is at the beginning of an indented line
 744 \(i.e. all characters between beginning of line and point are
 745 blanks\).  Does nothing otherwise. The unindent size is given by the
 746 variable caml-mode-indentation."
 747
 748   (interactive "*")
 749   (let* ((begline
 750           (save-excursion
 751             (beginning-of-line)
 752             (point)))
 753          (current-offset
 754           (- (point) begline)))
 755     (if (and (>= current-offset caml-mode-indentation)
 756              (caml-in-indentation))
 757         (backward-delete-char-untabify caml-mode-indentation))))
 758
 759 ;;;
 760 ;;; Error processing
 761 ;;;
 762
 763 ;; Error positions are given in bytes, not in characters
 764 ;; This function switches to monobyte mode
 765
 766 (if (not (fboundp 'char-bytes))
 767     (defalias 'forward-byte 'forward-char)
 768   (defun caml-char-bytes (ch)
 769     (let ((l (char-bytes ch)))
 770       (if (> l 1) (- l 1) l)))
 771   (defun forward-byte (count)
 772     (if (> count 0)
 773         (while (> count 0)
 774           (let ((char (char-after)))
 775             (if (null char)
 776                 (setq count 0)
 777               (setq count (- count (caml-char-bytes (char-after))))
 778               (forward-char))))
 779       (while (< count 0)
 780         (let ((char (char-after)))
 781           (if (null char)
 782               (setq count 0)
 783             (setq count (+ count (caml-char-bytes (char-before))))
 784             (backward-char))))
 785     )))
 786
 787 (require 'compile)
 788
 789 ;; In Emacs 19, the regexps in compilation-error-regexp-alist do not
 790 ;; match the error messages when the language is not English.
 791 ;; Hence we add a regexp.
 792
 793 (defconst caml-error-regexp
 794   "^[ A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]"
 795   "Regular expression matching the error messages produced by camlc.")
 796
 797 (if (boundp 'compilation-error-regexp-alist)
 798     (or (assoc caml-error-regexp
 799                compilation-error-regexp-alist)
 800         (setq compilation-error-regexp-alist
 801               (cons (list caml-error-regexp 1 2)
 802                compilation-error-regexp-alist))))
 803
 804 ;; A regexp to extract the range info
 805
 806 (defconst caml-error-chars-regexp
 807   ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):?"
 808   "Regular expression extracting the character numbers
 809 from an error message produced by camlc.")
 810
 811 ;; Wrapper around next-error.
 812
 813 (defvar caml-error-overlay nil)
 814 (defvar caml-next-error-skip-warnings-flag nil)
 815
 816 (defun caml-string-to-int (x)
 817   (if (fboundp 'string-to-number) (string-to-number x) (string-to-int x)))
 818
 819 ;;itz 04-21-96 somebody didn't get the documentation for next-error
 820 ;;right. When the optional argument is a number n, it should move
 821 ;;forward n errors, not reparse.
 822
 823 ;itz 04-21-96 instead of defining a new function, use defadvice
 824 ;that way we get our effect even when we do \C-x` in compilation buffer
 825
 826 (defadvice next-error (after caml-next-error activate)
 827  "Reads the extra positional information provided by the Caml compiler.
 828
 829 Puts the point and the mark exactly around the erroneous program
 830 fragment. The erroneous fragment is also temporarily highlighted if
 831 possible."
 832
 833  (if (eq major-mode 'caml-mode)
 834      (let (skip bol beg end)
 835        (save-excursion
 836          (set-buffer
 837           (if (boundp 'compilation-last-buffer)
 838               compilation-last-buffer   ;Emacs 19
 839             "*compilation*"))           ;Emacs 18
 840          (save-excursion
 841            (goto-char (window-point (get-buffer-window (current-buffer))))
 842            (if (looking-at caml-error-chars-regexp)
 843                (setq beg
 844                      (caml-string-to-int
 845                       (buffer-substring (match-beginning 1) (match-end 1)))
 846                      end
 847                      (caml-string-to-int
 848                       (buffer-substring (match-beginning 2) (match-end 2)))))
 849            (next-line)
 850            (beginning-of-line)
 851            (if (and (looking-at "Warning")
 852                     caml-next-error-skip-warnings-flag)
 853                (setq skip 't))))
 854        (cond
 855         (skip (next-error))
 856         (beg
 857               (setq end (- end beg))
 858               (beginning-of-line)
 859               (forward-byte beg)
 860               (setq beg (point))
 861               (forward-byte end)
 862               (setq end (point))
 863               (goto-char beg)
 864               (push-mark end t)
 865               (cond ((fboundp 'make-overlay)
 866                      (if caml-error-overlay ()
 867                        (setq caml-error-overlay (make-overlay 1 1))
 868                        (overlay-put caml-error-overlay 'face 'region))
 869                      (unwind-protect
 870                          (progn
 871                            (move-overlay caml-error-overlay
 872                                          beg end (current-buffer))
 873                            (sit-for 60))
 874                        (delete-overlay caml-error-overlay)))))))))
 875
 876 (defun caml-next-error-skip-warnings (&rest args)
 877   (let ((old-flag caml-next-error-skip-warnings-flag))
 878     (unwind-protect
 879         (progn (setq caml-next-error-skip-warnings-flag 't)
 880                (apply 'next-error args))
 881       (setq caml-next-error-skip-warnings-flag old-flag))))
 882
 883
 884 ;; Usual match-string doesn't work properly with font-lock-mode
 885 ;; on some emacs.
 886
 887 (defun caml-match-string (num &optional string)
 888
 889   "Return string of text matched by last search, without properties.
 890
 891 NUM specifies which parenthesized expression in the last regexp.
 892 Value is nil if NUMth pair didn't match, or there were less than NUM
 893 pairs.  Zero means the entire text matched by the whole regexp or
 894 whole string."
 895
 896   (let* ((data (match-data))
 897          (begin (nth (* 2 num) data))
 898          (end (nth (1+ (* 2 num)) data)))
 899     (if string (substring string begin end)
 900       (buffer-substring-no-properties begin end))))
 901
 902 ;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of
 903 ;; comfort when sending phrases to the toplevel and getting errors.
 904 (defun caml-goto-phrase-error ()
 905   "Find the error location in current Caml phrase."
 906   (interactive)
 907   (require 'inf-caml)
 908   (let ((bounds (save-excursion (caml-mark-phrase))))
 909     (inferior-caml-goto-error (car bounds) (cdr bounds))))
 910
 911 ;;; Phrases
 912
 913 ;itz the heuristics used to see if we're `between two phrases'
 914 ;didn't seem right to me.
 915
 916 (defconst caml-phrase-start-keywords
 917   (concat "\\<\\(class\\|ex\\(ternal\\|ception\\)\\|functor"
 918           "\\|let\\|module\\|open\\|type\\|val\\)\\>")
 919   "Keywords starting phrases in files")
 920
 921 ;; a phrase starts when a toplevel keyword is at the beginning of a line
 922 (defun caml-at-phrase-start-p ()
 923   (and (bolp)
 924        (or (looking-at "#")
 925            (looking-at caml-phrase-start-keywords))))
 926
 927 (defun caml-skip-comments-forward ()
 928   (skip-chars-forward " \n\t")
 929   (while (or (looking-at comment-start-skip) (caml-in-comment-p))
 930     (if (= (following-char) ?\)) (forward-char)
 931       (search-forward comment-end))
 932     (skip-chars-forward " \n\t")))
 933
 934 (defun caml-skip-comments-backward ()
 935   (skip-chars-backward " \n\t")
 936   (while (and (eq (preceding-char) ?\)) (eq (char-after (- (point) 2)) ?*))
 937     (backward-char)
 938     (while (caml-in-comment-p) (search-backward comment-start))
 939     (skip-chars-backward " \n\t")))
 940
 941 (defconst caml-phrase-sep-keywords (concat ";;\\|" caml-phrase-start-keywords))
 942
 943 (defun caml-find-phrase (&optional min-pos max-pos)
 944   "Find the CAML phrase containing the point.
 945 Return the position of the beginning of the phrase, and move point
 946 to the end.
 947 "
 948   (interactive)
 949   (if (not min-pos) (setq min-pos (point-min)))
 950   (if (not max-pos) (setq max-pos (point-max)))
 951   (let (beg end use-semi kwop)
 952     ;(caml-skip-comments-backward)
 953     (cond
 954      ; shall we have special processing for semicolons?
 955      ;((and (eq (char-before (- (point) 1)) ?\;) (eq (char-before) ?\;))
 956      ; (forward-char)
 957      ; (caml-skip-comments-forward)
 958      ; (setq beg (point))
 959      ; (while (and (search-forward ";;" max-pos 'move)
 960      ;    (or (caml-in-comment-p) (caml-in-literal-p)))))
 961      (t
 962       (caml-skip-comments-forward)
 963       (if (caml-at-phrase-start-p) (forward-char))
 964       (while (and (cond
 965                    ((re-search-forward caml-phrase-sep-keywords max-pos 'move)
 966                     (goto-char (match-beginning 0)) t))
 967                   (or (not (or (bolp) (looking-at ";;")))
 968                       (caml-in-comment-p)
 969                       (caml-in-literal-p)))
 970         (forward-char))
 971       (setq end (+ (point) (if (looking-at ";;") 2 0)))
 972       (while (and
 973               (setq kwop (caml-find-kwop caml-phrase-sep-keywords min-pos))
 974               (not (string= kwop ";;"))
 975               (not (bolp))))
 976       (if (string= kwop ";;") (forward-char 2))
 977       (if (not kwop) (goto-char min-pos))
 978       (caml-skip-comments-forward)
 979       (setq beg (point))
 980       (if (>= beg end) (error "no phrase before point"))
 981       (goto-char end)))
 982     (caml-skip-comments-forward)
 983     beg))
 984
 985 (defun caml-mark-phrase (&optional min-pos max-pos)
 986   "Put mark at end of this Caml phrase, point at beginning.
 987 "
 988   (interactive)
 989   (let* ((beg (caml-find-phrase min-pos max-pos)) (end (point)))
 990     (push-mark)
 991     (goto-char beg)
 992     (cons beg end)))
 993
 994 ;;itz Fri Sep 25 12:58:13 PDT 1998 support for adding change-log entries
 995 (defun caml-current-defun ()
 996   (save-excursion
 997     (caml-mark-phrase)
 998     (if (not (looking-at caml-phrase-start-keywords)) nil
 999       (re-search-forward caml-phrase-start-keywords)
1000       (let ((done nil))
1001         (while (not done)
1002           (cond
1003            ((looking-at "\\s ")
1004             (skip-syntax-forward " "))
1005            ((char-equal (following-char) ?\( )
1006             (forward-sexp 1))
1007            ((char-equal (following-char) ?')
1008             (skip-syntax-forward "w_"))
1009            (t (setq done t)))))
1010       (re-search-forward "\\(\\sw\\|\\s_\\)+")
1011       (match-string 0))))
1012
1013 (defun caml-overlap (b1 e1 b2 e2)
1014   (<= (max b1 b2) (min e1 e2)))
1015
1016 ;this clears the last comment cache if necessary
1017 (defun caml-before-change-function (begin end)
1018   (if (and caml-last-noncomment-pos
1019            (> caml-last-noncomment-pos begin))
1020       (setq caml-last-noncomment-pos nil))
1021   (if (and (marker-position caml-last-comment-start)
1022            (marker-position caml-last-comment-end)
1023            (caml-overlap begin end
1024                          caml-last-comment-start
1025                          caml-last-comment-end))
1026       (prog2
1027           (set-marker caml-last-comment-start nil)
1028           (set-marker caml-last-comment-end nil)))
1029   (let ((orig-function (default-value 'before-change-function)))
1030     (if orig-function (funcall orig-function begin end))))
1031
1032 (defun caml-in-literal-p ()
1033   "Returns non-nil if point is inside a caml literal."
1034   (let* ((start-literal (concat "[\"" caml-quote-char "]"))
1035          (char-literal
1036           (concat "\\([^\\]\\|\\\\\\.\\|\\\\[0-9][0-9][0-9]\\)"
1037                   caml-quote-char))
1038          (pos (point))
1039          (eol (progn (end-of-line 1) (point)))
1040          state in-str)
1041     (beginning-of-line 1)
1042     (while (and (not state)
1043                 (re-search-forward start-literal eol t)
1044                 (<= (point) pos))
1045       (cond
1046        ((string= (caml-match-string 0) "\"")
1047         (setq in-str t)
1048         (while (and in-str (not state)
1049                     (re-search-forward "\"\\|\\\\\"" eol t))
1050           (if (> (point) pos) (setq state t))
1051           (if (string= (caml-match-string 0) "\"") (setq in-str nil)))
1052         (if in-str (setq state t)))
1053        ((looking-at char-literal)
1054         (if (and (>= pos (match-beginning 0)) (< pos (match-end 0)))
1055             (setq state t)
1056           (goto-char (match-end 0))))))
1057     (goto-char pos)
1058     state))
1059
1060 (defun caml-forward-comment ()
1061   "Skip one (eventually nested) comment."
1062   (let ((count 1) match)
1063     (while (> count 0)
1064       (if (not (re-search-forward "(\\*\\|\\*)" nil 'move))
1065           (setq count -1)
1066         (setq match (caml-match-string 0))
1067         (cond
1068          ((caml-in-literal-p)
1069           nil)
1070          ((string= match comment-start)
1071           (setq count (1+ count)))
1072          (t
1073           (setq count (1- count))))))
1074     (= count 0)))
1075
1076 (defun caml-backward-comment ()
1077   "Skip one (eventually nested) comment."
1078   (let ((count 1) match)
1079     (while (> count 0)
1080       (if (not (re-search-backward "(\\*\\|\\*)" nil 'move))
1081           (setq count -1)
1082         (setq match (caml-match-string 0))
1083         (cond
1084          ((caml-in-literal-p)
1085           nil)
1086          ((string= match comment-start)
1087           (setq count (1- count)))
1088          (t
1089           (setq count (1+ count))))))
1090     (= count 0)))
1091
1092 (defun caml-in-comment-p ()
1093   "Returns non-nil if point is inside a caml comment.
1094 Returns nil for the parenthesis openning a comment."
1095   ;;we look for comments differently than literals. there are two
1096   ;;reasons for this. first, caml has nested comments and it is not so
1097   ;;clear that parse-partial-sexp supports them; second, if proper
1098   ;;style is used, literals are never split across lines, so we don't
1099   ;;have to worry about bogus phrase breaks inside literals, while we
1100   ;;have to account for that possibility in comments.
1101   (if caml-last-comment-start
1102       (save-excursion
1103         (let* ((cached-pos caml-last-noncomment-pos)
1104                (cached-begin (marker-position caml-last-comment-start))
1105                (cached-end (marker-position caml-last-comment-end)))
1106           (cond
1107            ((and cached-begin cached-end
1108                  (< cached-begin (point)) (< (point) cached-end)) t)
1109            ((and cached-pos (= cached-pos (point))) nil)
1110            ((and cached-pos (> cached-pos (point))
1111                  (< (abs (- cached-pos (point))) caml-lookback-limit))
1112             (let (end found (here (point)))
1113                                         ; go back to somewhere sure
1114               (goto-char cached-pos)
1115               (while (> (point) here)
1116                                         ; look for the end of a comment
1117                 (while (and (if (search-backward comment-end (1- here) 'move)
1118                                 (setq end (match-end 0))
1119                               (setq end nil))
1120                             (caml-in-literal-p)))
1121                 (if end (setq found (caml-backward-comment))))
1122               (if (and found (= (point) here)) (setq end nil))
1123               (if (not end)
1124                   (setq caml-last-noncomment-pos here)
1125                 (set-marker caml-last-comment-start (point))
1126                 (set-marker caml-last-comment-end end))
1127               end))
1128            (t
1129             (let (begin found (here (point)))
1130             ;; go back to somewhere sure (or far enough)
1131               (goto-char
1132                (if cached-pos cached-pos (- (point) caml-lookback-limit)))
1133               (while (< (point) here)
1134                 ;; look for the beginning of a comment
1135                 (while (and (if (search-forward comment-start (1+ here) 'move)
1136                                 (setq begin (match-beginning 0))
1137                               (setq begin nil))
1138                             (caml-in-literal-p)))
1139                 (if begin (setq found (caml-forward-comment))))
1140               (if (and found (= (point) here)) (setq begin nil))
1141               (if (not begin)
1142                   (setq caml-last-noncomment-pos here)
1143                 (set-marker caml-last-comment-start begin)
1144                 (set-marker caml-last-comment-end (point)))
1145               begin)))))))
1146
1147 ;; Various constants and regexps
1148
1149 (defconst caml-before-expr-prefix
1150   (concat "\\<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else"
1151           "\\|i\\(f\\|n\\(herit\\|itializer\\)?\\)"
1152           "\\|f\\(or\\|un\\(ct\\(ion\\|or\\)\\)?\\)"
1153           "\\|l\\(and\\|or\\|s[lr]\\|xor\\)\\|m\\(atch\\|od\\)"
1154           "\\|o[fr]\\|parser\\|s\\(ig\\|truct\\)\\|t\\(hen\\|o\\|ry\\)"
1155           "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>\\|:begin\\>"
1156           "\\|[=<>@^|&+-*/$%][!$%*+-./:<=>?@^|~]*\\|:[:=]\\|[[({,;]")
1157
1158   "Keywords that may appear immediately before an expression.
1159 Used to distinguish it from toplevel let construct.")
1160
1161 (defconst caml-matching-kw-regexp
1162   (concat
1163    "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)"
1164    "\\|with\\)\\>\\|[^[|]|")
1165   "Regexp used in caml mode for skipping back over nested blocks.")
1166
1167 (defconst caml-matching-kw-alist
1168   '(("|" . caml-find-pipe-match)
1169     (";" . caml-find-semi-match)
1170     ("," . caml-find-comma-match)
1171     ("end" . caml-find-end-match)
1172     ("done" . caml-find-done-match)
1173     ("in"  . caml-find-in-match)
1174     ("with" . caml-find-with-match)
1175     ("else" . caml-find-else-match)
1176     ("then" . caml-find-then-match)
1177     ("to" . caml-find-done-match)
1178     ("do" . caml-find-done-match)
1179     ("and" . caml-find-and-match))
1180
1181   "Association list used in caml mode for skipping back over nested blocks.")
1182
1183 (defconst caml-kwop-regexps (make-vector 9 nil)
1184   "Array of regexps representing caml keywords of different priorities.")
1185
1186 (defun caml-in-expr-p ()
1187   (let ((pos (point)) (in-expr t))
1188     (caml-find-kwop
1189      (concat caml-before-expr-prefix "\\|"
1190              caml-matching-kw-regexp "\\|"
1191              (aref caml-kwop-regexps caml-max-indent-priority)))
1192     (cond
1193      ; special case for ;;
1194      ((and (> (point) 1) (= (preceding-char) ?\;) (= (following-char) ?\;))
1195       (setq in-expr nil))
1196      ((looking-at caml-before-expr-prefix)
1197       (if (not (looking-at "(\\*")) (goto-char (match-end 0)))
1198       (skip-chars-forward " \t\n")
1199       (while (looking-at "(\\*")
1200         (forward-char)
1201         (caml-forward-comment)
1202         (skip-chars-forward " \t\n"))
1203       (if (<= pos (point)) (setq in-expr nil))))
1204     (goto-char pos)
1205     in-expr))
1206
1207 (defun caml-at-sexp-close-p ()
1208   (or (char-equal ?\) (following-char))
1209       (char-equal ?\] (following-char))
1210       (char-equal ?} (following-char))))
1211
1212 (defun caml-find-kwop (kwop-regexp &optional min-pos)
1213   "Look back for a caml keyword or operator matching KWOP-REGEXP.
1214 Second optional argument MIN-POS bounds the search.
1215
1216 Ignore occurences inside literals. If found, return a list of two
1217 values: the actual text of the keyword or operator, and a boolean
1218 indicating whether the keyword was one we looked for explicitly
1219 {non-nil}, or on the other hand one of the block-terminating
1220 keywords."
1221
1222   (let ((start-literal (concat "[\"" caml-quote-char "]"))
1223         found kwop)
1224     (while (and (> (point) 1) (not found)
1225                 (re-search-backward kwop-regexp min-pos 'move))
1226       (setq kwop (caml-match-string 0))
1227       (cond
1228        ((looking-at "(\\*")
1229         (if (> (point) 1) (backward-char)))
1230        ((caml-in-comment-p)
1231         (search-backward "(" min-pos 'move))
1232        ((looking-at start-literal))
1233        ((caml-in-literal-p)
1234         (re-search-backward start-literal min-pos 'move))  ;ugly hack
1235        ((setq found t))))
1236     (if found
1237         (if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!!
1238             kwop
1239           (forward-char 1) "|") nil)))
1240
1241 ;  Association list of indentation values based on governing keywords.
1242 ;
1243 ;Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
1244 ;non-nil for operator-type nodes, which affect indentation in a
1245 ;different way from keywords: subsequent lines are indented to the
1246 ;actual occurrence of an operator, but relative to the indentation of
1247 ;the line where the governing keyword occurs.
1248
1249 (defconst caml-no-indent 0)
1250
1251 (defconst caml-kwop-alist
1252   '(("begin"            nil     6       caml-begin-indent)
1253     (":begin"           nil     6       caml-begin-indent) ; hack
1254     ("class"            nil     0       caml-class-indent)
1255     ("constraint"       nil     0       caml-val-indent)
1256     ("sig"              nil     1       caml-sig-indent)
1257     ("struct"           nil     1       caml-struct-indent)
1258     ("exception"        nil     0       caml-exception-indent)
1259     ("for"              nil     6       caml-for-indent)
1260     ("fun"              nil     3       caml-fun-indent)
1261     ("function"         nil     3       caml-function-indent)
1262     ("if"               nil     6       caml-if-indent)
1263     ("if-else"          nil     6       caml-if-else-indent)
1264     ("include"          nil     0       caml-include-indent)
1265     ("inherit"          nil     0       caml-inherit-indent)
1266     ("initializer"      nil     0       caml-initializer-indent)
1267     ("let"              nil     6       caml-let-indent)
1268     ("let-in"           nil     6       caml-let-in-indent)
1269     ("match"            nil     6       caml-match-indent)
1270     ("method"           nil     0       caml-method-indent)
1271     ("module"           nil     0       caml-module-indent)
1272     ("object"           nil     6       caml-object-indent)
1273     ("of"               nil     7       caml-of-indent)
1274     ("open"             nil     0       caml-no-indent)
1275     ("parser"           nil     3       caml-parser-indent)
1276     ("try"              nil     6       caml-try-indent)
1277     ("type"             nil     0       caml-type-indent)
1278     ("val"              nil     0       caml-val-indent)
1279     ("when"             nil     2       caml-if-indent)
1280     ("while"            nil     6       caml-while-indent)
1281     ("::"               t       5       caml-::-indent)
1282     ("@"                t       4       caml-@-indent)
1283     ("^"                t       4       caml-@-indent)
1284     (":="               nil     3       caml-:=-indent)
1285     ("<-"               nil     3       caml-<--indent)
1286     ("->"               nil     2       caml-->-indent)
1287     ("\["               t       8       caml-lb-indent)
1288     ("{"                t       8       caml-lc-indent)
1289     ("\("               t       8       caml-lp-indent)
1290     ("|"                nil     2       caml-no-indent)
1291     (";;"               nil     0       caml-no-indent))
1292 ; if-else and let-in are not keywords but idioms
1293 ; "|" is not in the regexps
1294 ; all these 3 values correspond to hard-coded names
1295
1296 "Association list of indentation values based on governing keywords.
1297
1298 Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
1299 non-nil for operator-type nodes, which affect indentation in a
1300 different way from keywords: subsequent lines are indented to the
1301 actual occurrence of an operator, but relative to the indentation of
1302 the line where the governing keyword occurs.")
1303
1304 ;;Originally, we had caml-kwop-regexp create these at runtime, from an
1305 ;;additional field in caml-kwop-alist. That proved way too slow,
1306 ;;although I still can't understand why. itz
1307
1308 (aset caml-kwop-regexps 0
1309       (concat
1310        "\\<\\(begin\\|object\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\>"
1311        "\\|:begin\\>\\|[[({]\\|;;"))
1312 (aset caml-kwop-regexps 1
1313       (concat (aref caml-kwop-regexps 0) "\\|\\<\\(class\\|module\\)\\>"))
1314 (aset caml-kwop-regexps 2
1315       (concat
1316        (aref caml-kwop-regexps 1)
1317        "\\|\\<\\(fun\\(ction\\)?\\|initializer\\|let\\|m\\(atch\\|ethod\\)"
1318        "\\|parser\\|try\\|val\\)\\>\\|->"))
1319 (aset caml-kwop-regexps 3
1320       (concat (aref caml-kwop-regexps 2) "\\|\\<if\\|when\\>"))
1321 (aset caml-kwop-regexps 4
1322       (concat (aref caml-kwop-regexps 3) "\\|:=\\|<-"))
1323 (aset caml-kwop-regexps 5
1324       (concat (aref caml-kwop-regexps 4) "\\|@"))
1325 (aset caml-kwop-regexps 6
1326       (concat (aref caml-kwop-regexps 5) "\\|::\\|\\^"))
1327 (aset caml-kwop-regexps 7
1328       (concat
1329        (aref caml-kwop-regexps 0)
1330        "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
1331        "\\|o\\(f\\|pen\\)\\|type\\|val\\)\\>"))
1332 (aset caml-kwop-regexps 8
1333       (concat (aref caml-kwop-regexps 6)
1334        "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
1335        "\\|o\\(f\\|pen\\)\\|type\\)\\>"))
1336
1337 (defun caml-find-done-match ()
1338   (let ((unbalanced 1) (kwop t))
1339     (while (and (not (= 0 unbalanced)) kwop)
1340       (setq kwop (caml-find-kwop "\\<\\(done\\|for\\|while\\)\\>"))
1341       (cond
1342        ((not kwop))
1343        ((string= kwop "done") (setq unbalanced (1+ unbalanced)))
1344        (t (setq unbalanced (1- unbalanced)))))
1345     kwop))
1346
1347 (defun caml-find-end-match ()
1348   (let ((unbalanced 1) (kwop t))
1349     (while (and (not (= 0 unbalanced)) kwop)
1350       (setq kwop
1351             (caml-find-kwop
1352              "\\<\\(end\\|begin\\|object\\|s\\(ig\\|truct\\)\\)\\>\\|:begin\\>\\|;;"))
1353       (cond
1354        ((not kwop))
1355        ((string= kwop ";;") (setq kwop nil) (forward-line 1))
1356        ((string= kwop "end") (setq unbalanced (1+ unbalanced)))
1357        ( t (setq unbalanced (1- unbalanced)))))
1358     (if (string= kwop ":begin") "begin"
1359       kwop)))
1360
1361 (defun caml-find-in-match ()
1362   (let ((unbalanced 1) (kwop t))
1363     (while (and (not (= 0 unbalanced)) kwop)
1364       (setq kwop (caml-find-kwop "\\<\\(in\\|let\\|end\\)\\>"))
1365       (cond
1366        ((not kwop))
1367        ((string= kwop "end") (caml-find-end-match))
1368        ((string= kwop "in") (setq unbalanced (1+ unbalanced)))
1369        (t (setq unbalanced (1- unbalanced)))))
1370     kwop))
1371
1372 (defun caml-find-with-match ()
1373   (let ((unbalanced 1) (kwop t))
1374     (while (and (not (= 0 unbalanced)) kwop)
1375       (setq kwop
1376         (caml-find-kwop
1377          "\\<\\(with\\|try\\|m\\(atch\\|odule\\)\\|functor\\)\\>\\|[{}()]"))
1378       (cond
1379        ((not kwop))
1380        ((caml-at-sexp-close-p)
1381         (caml-find-paren-match (following-char)))
1382        ((string= kwop "with")
1383         (setq unbalanced (1+ unbalanced)))
1384        ((or (string= kwop "module")
1385             (string= kwop "functor")
1386             (string= kwop "{")
1387             (string= kwop "("))
1388         (setq unbalanced 0))
1389        (t (setq unbalanced (1- unbalanced)))))
1390     kwop))
1391
1392 (defun caml-find-paren-match (close)
1393   (let ((unbalanced 1)
1394         (regexp (cond ((= close ?\)) "[()]")
1395                       ((= close ?\]) "[][]")
1396                       ((= close ?\}) "[{}]"))))
1397     (while (and (> unbalanced 0)
1398                 (caml-find-kwop regexp))
1399       (if (= close (following-char))
1400           (setq unbalanced (1+ unbalanced))
1401         (setq unbalanced (1- unbalanced))))))
1402
1403 (defun caml-find-then-match (&optional from-else)
1404   (let ((bol (if from-else
1405                  (save-excursion
1406                    (progn (beginning-of-line) (point)))))
1407         kwop done matching-fun)
1408     (while (not done)
1409       (setq kwop
1410             (caml-find-kwop
1411              "\\<\\(e\\(nd\\|lse\\)\\|done\\|then\\|if\\|with\\)\\>\\|[])};]"))
1412       (cond
1413        ((not kwop) (setq done t))
1414        ((caml-at-sexp-close-p)
1415         (caml-find-paren-match (following-char)))
1416        ((string= kwop "if") (setq done t))
1417        ((string= kwop "then")
1418         (if (not from-else) (setq kwop (caml-find-then-match))))
1419        ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist)))
1420         (setq kwop (funcall matching-fun)))))
1421     (if (and bol (>= (point) bol))
1422         "if-else"
1423       kwop)))
1424
1425 (defun caml-find-pipe-match ()
1426   (let ((done nil) (kwop)
1427         (re (concat
1428              "\\<\\(try\\|match\\|with\\|function\\|parser\\|type"
1429              "\\|e\\(nd\\|lse\\)\\|done\\|then\\|in\\)\\>"
1430              "\\|[^[|]|\\|[])}]")))
1431     (while (not done)
1432       (setq kwop (caml-find-kwop re))
1433       (cond
1434        ((not kwop) (setq done t))
1435        ((looking-at "[^[|]\\(|\\)")
1436         (goto-char (match-beginning 1))
1437         (setq kwop "|")
1438         (setq done t))
1439        ((caml-at-sexp-close-p)
1440         (caml-find-paren-match (following-char)))
1441        ((string= kwop "with")
1442         (setq kwop (caml-find-with-match))
1443         (setq done t))
1444        ((string= kwop "parser")
1445         (if (re-search-backward "\\<with\\>" (- (point) 5) t)
1446             (setq kwop (caml-find-with-match)))
1447         (setq done t))
1448        ((string= kwop "done") (caml-find-done-match))
1449        ((string= kwop "end") (caml-find-end-match))
1450        ((string= kwop "then") (caml-find-then-match))
1451        ((string= kwop "else") (caml-find-else-match))
1452        ((string= kwop "in") (caml-find-in-match))
1453        (t (setq done t))))
1454     kwop))
1455
1456 (defun caml-find-and-match ()
1457   (let ((done nil) (kwop))
1458     (while (not done)
1459       (setq kwop (caml-find-kwop
1460                   "\\<\\(object\\|exception\\|let\\|type\\|end\\|in\\)\\>"))
1461       (cond
1462        ((not kwop) (setq done t))
1463        ((string= kwop "end") (caml-find-end-match))
1464        ((string= kwop "in") (caml-find-in-match))
1465        (t (setq done t))))
1466     kwop))
1467
1468 (defun caml-find-else-match ()
1469   (caml-find-then-match t))
1470
1471 (defun caml-find-semi-match ()
1472   (caml-find-kwop-skipping-blocks 2))
1473
1474 (defun caml-find-comma-match ()
1475   (caml-find-kwop-skipping-blocks 3))
1476
1477 (defun caml-find-kwop-skipping-blocks (prio)
1478   "Look back for a caml keyword matching caml-kwop-regexps [PRIO].
1479
1480  Skip nested blocks."
1481
1482   (let ((done nil) (kwop nil) (matching-fun)
1483         (kwop-list (aref caml-kwop-regexps prio)))
1484     (while (not done)
1485       (setq kwop (caml-find-kwop
1486                   (concat caml-matching-kw-regexp
1487                           (cond ((> prio 3) "\\|[])},;]\\|")
1488                                 ((> prio 2) "\\|[])};]\\|")
1489                                 (t "\\|[])}]\\|"))
1490                           kwop-list)))
1491       (cond
1492        ((not kwop) (setq done t))
1493        ((caml-at-sexp-close-p)
1494         (caml-find-paren-match (following-char)))
1495        ((or (string= kwop ";;")
1496             (and (string= kwop ";") (= (preceding-char) ?\;)))
1497         (forward-line 1)
1498         (setq kwop ";;")
1499         (setq done t))
1500        ((and (>= prio 2) (string= kwop "|")) (setq done t))
1501        ((string= kwop "end") (caml-find-end-match))
1502        ((string= kwop "done") (caml-find-done-match))
1503        ((string= kwop "in")
1504         (cond ((and (caml-find-in-match) (>= prio 2))
1505                (setq kwop "let-in")
1506                (setq done t))))
1507        ((and (string= kwop "parser") (>= prio 2)
1508              (re-search-backward "\\<with\\>" (- (point) 5) t))
1509         (setq kwop (caml-find-with-match))
1510         (setq done t))
1511        ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist)))
1512         (setq kwop (funcall matching-fun))
1513         (if (looking-at kwop-list) (setq done t)))
1514        (t (let* ((kwop-info (assoc kwop caml-kwop-alist))
1515                  (is-op (and (nth 1 kwop-info)
1516                              ; check that we are not at beginning of line
1517                              (let ((pos (point)) bti)
1518                                (back-to-indentation)
1519                                (setq bti (point))
1520                                (goto-char pos)
1521                                (< bti pos)))))
1522             (if (and is-op (looking-at
1523                             (concat (regexp-quote kwop)
1524                                     "|?[ \t]*\\(\n\\|(\\*\\)")))
1525                 (setq kwop-list
1526                       (aref caml-kwop-regexps (nth 2 kwop-info)))
1527               (setq done t))))))
1528     kwop))
1529
1530 (defun caml-compute-basic-indent (prio)
1531   "Compute indent of current caml line, ignoring leading keywords.
1532
1533 Find the `governing node' for current line. Compute desired
1534 indentation based on the node and the indentation alists.
1535 Assumes point is exactly at line indentation.
1536 Does not preserve point."
1537
1538   (let* (in-expr
1539          (kwop (cond
1540                 ((looking-at ";;")
1541                  (beginning-of-line 1))
1542                 ((looking-at "|\\([^]|]\\|\\'\\)")
1543                  (caml-find-pipe-match))
1544                 ((and (looking-at caml-phrase-start-keywords)
1545                       (caml-in-expr-p))
1546                  (caml-find-end-match))
1547                 ((and (looking-at caml-matching-kw-regexp)
1548                       (assoc (caml-match-string 0) caml-matching-kw-alist))
1549                  (funcall (cdr-safe (assoc (caml-match-string 0)
1550                                       caml-matching-kw-alist))))
1551                 ((looking-at
1552                   (aref caml-kwop-regexps caml-max-indent-priority))
1553                  (let* ((kwop (caml-match-string 0))
1554                         (kwop-info (assoc kwop caml-kwop-alist))
1555                         (prio (if kwop-info (nth 2 kwop-info)
1556                                 caml-max-indent-priority)))
1557                    (if (and (looking-at (aref caml-kwop-regexps 0))
1558                             (not (looking-at "object"))
1559                             (caml-in-expr-p))
1560                        (setq in-expr t))
1561                    (caml-find-kwop-skipping-blocks prio)))
1562                 (t
1563                  (if (and (= prio caml-max-indent-priority) (caml-in-expr-p))
1564                      (setq in-expr t))
1565                  (caml-find-kwop-skipping-blocks prio))))
1566          (kwop-info (assoc kwop caml-kwop-alist))
1567          (indent-diff
1568           (cond
1569            ((not kwop-info) (beginning-of-line 1) 0)
1570            ((looking-at "[[({][|<]?[ \t]*")
1571             (length (caml-match-string 0)))
1572            ((nth 1 kwop-info) (symbol-value (nth 3 kwop-info)))
1573            (t
1574             (let ((pos (point)))
1575               (back-to-indentation)
1576 ;             (if (looking-at "\\<let\\>") (goto-char pos))
1577               (- (symbol-value (nth 3 kwop-info))
1578                  (if (looking-at "|") caml-|-extra-indent 0))))))
1579          (extra (if in-expr caml-apply-extra-indent 0)))
1580          (+ indent-diff extra (current-column))))
1581
1582 (defconst caml-leading-kwops-regexp
1583   (concat
1584    "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in"
1585    "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|})]")
1586
1587   "Regexp matching caml keywords which need special indentation.")
1588
1589 (defconst caml-leading-kwops-alist
1590   '(("and" caml-and-extra-indent 2)
1591     ("do" caml-do-extra-indent 0)
1592     ("done" caml-done-extra-indent 0)
1593     ("else" caml-else-extra-indent 3)
1594     ("end" caml-end-extra-indent 0)
1595     ("in" caml-in-extra-indent 2)
1596     ("then" caml-then-extra-indent 3)
1597     ("to" caml-to-extra-indent 0)
1598     ("with" caml-with-extra-indent 2)
1599     ("|" caml-|-extra-indent 2)
1600     ("]" caml-rb-extra-indent 0)
1601     ("}" caml-rc-extra-indent 0)
1602     (")" caml-rp-extra-indent 0))
1603
1604   "Association list of special caml keyword indent values.
1605
1606 Each member is of the form (KEYWORD EXTRA-INDENT PRIO) where
1607 EXTRA-INDENT is the variable holding extra indentation amount for
1608 KEYWORD (usually negative) and PRIO is upper bound on priority of
1609 matching nodes to determine KEYWORD's final indentation.")
1610
1611 (defun caml-compute-final-indent ()
1612   (save-excursion
1613     (back-to-indentation)
1614     (cond
1615      ((and (bolp) (looking-at comment-start-skip)) (current-column))
1616      ((caml-in-comment-p)
1617       (let ((closing (looking-at "\\*)"))
1618             (comment-mark (looking-at "\\*")))
1619         (caml-backward-comment)
1620         (looking-at comment-start-skip)
1621         (+ (current-column)
1622            (cond
1623             (closing 1)
1624             (comment-mark 1)
1625             (t (- (match-end 0) (match-beginning 0)))))))
1626      (t (let* ((leading (looking-at caml-leading-kwops-regexp))
1627                (assoc-val (if leading (assoc (caml-match-string 0)
1628                                              caml-leading-kwops-alist)))
1629                (extra (if leading (symbol-value (nth 1 assoc-val)) 0))
1630                (prio (if leading (nth 2 assoc-val)
1631                        caml-max-indent-priority))
1632                (basic (caml-compute-basic-indent prio)))
1633           (max 0 (if extra (+ extra basic) (current-column))))))))
1634
1635
1636
1637 (defun caml-split-string ()
1638   "Called whenever a line is broken inside a caml string literal."
1639   (insert-before-markers "\"^\"")
1640   (backward-char 1))
1641
1642 (defadvice indent-new-comment-line (around
1643                                     caml-indent-new-comment-line
1644                                     activate)
1645
1646   "Handle multi-line strings in caml mode."
1647
1648 ;this advice doesn't make sense in other modes. I wish there were a
1649 ;cleaner way to do this: I haven't found one.
1650
1651   (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p)))
1652         (split-mark))
1653     (if (not hooked) nil
1654       (setq split-mark (set-marker (make-marker) (point)))
1655       (caml-split-string))
1656     ad-do-it
1657     (if (not hooked) nil
1658       (goto-char split-mark)
1659       (set-marker split-mark nil))))
1660
1661 (defadvice newline-and-indent (around
1662                                caml-newline-and-indent
1663                                activate)
1664
1665   "Handle multi-line strings in caml mode."
1666
1667     (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p)))
1668         (split-mark))
1669     (if (not hooked) nil
1670       (setq split-mark (set-marker (make-marker) (point)))
1671       (caml-split-string))
1672     ad-do-it
1673     (if (not hooked) nil
1674       (goto-char split-mark)
1675       (set-marker split-mark nil))))
1676
1677 (defun caml-electric-pipe ()
1678   "If inserting a | or } operator at beginning of line, reindent the line.
1679
1680 Unfortunately there is a situation where this mechanism gets
1681 confused. It's when | is the first character of a |] sequence. This is
1682 a misfeature of caml syntax and cannot be fixed, however, as a
1683 workaround, the electric ] inserts | itself if the matching [ is
1684 followed by |."
1685
1686   (interactive "*")
1687   (let ((electric (and caml-electric-indent
1688                        (caml-in-indentation)
1689                        (not (caml-in-comment-p)))))
1690     (self-insert-command 1)
1691     (if electric (save-excursion (caml-indent-command)))))
1692
1693 (defun caml-electric-rb ()
1694   "If inserting a ] operator at beginning of line, reindent the line.
1695
1696 Also, if the matching [ is followed by a | and this ] is not preceded
1697 by |, insert one."
1698
1699   (interactive "*")
1700   (let* ((prec (preceding-char))
1701          (use-pipe (and caml-electric-close-vector
1702                         (not (caml-in-comment-p))
1703                         (not (caml-in-literal-p))
1704                         (or (not (numberp prec))
1705                             (not (char-equal ?| prec)))))
1706          (electric (and caml-electric-indent
1707                         (caml-in-indentation)
1708                         (not (caml-in-comment-p)))))
1709     (self-insert-command 1)
1710     (if electric (save-excursion (caml-indent-command)))
1711     (if (and use-pipe
1712              (save-excursion
1713                (condition-case nil
1714                    (prog2
1715                        (backward-list 1)
1716                        (looking-at "\\[|"))
1717                  (error ""))))
1718         (save-excursion
1719           (backward-char 1)
1720           (insert "|")))))
1721
1722 (defun caml-abbrev-hook ()
1723   "If inserting a leading keyword at beginning of line, reindent the line."
1724   ;itz unfortunately we need a special case
1725   (if (and (not (caml-in-comment-p)) (not (= last-command-char ?_)))
1726       (let* ((bol (save-excursion (beginning-of-line) (point)))
1727              (kw (save-excursion
1728                    (and (re-search-backward "^[ \t]*\\(\\sw+\\)\\=" bol t)
1729                         (caml-match-string 1)))))
1730         (if kw
1731             (let ((indent (save-excursion
1732                             (goto-char (match-beginning 1))
1733                             (caml-indent-command)
1734                             (current-column)))
1735                   (abbrev-correct (if (= last-command-char ?\ ) 1 0)))
1736               (indent-to (- indent
1737                             (or
1738                              (symbol-value
1739                               (nth 1
1740                                    (assoc kw caml-leading-kwops-alist)))
1741                              0)
1742                             abbrev-correct)))))))
1743
1744 ; (defun caml-indent-phrase ()
1745 ;   (interactive "*")
1746 ;   (let ((bounds (caml-mark-phrase)))
1747 ;     (indent-region (car bounds) (cdr bounds) nil)))
1748
1749 ;;; Additional commands by Didier to report errors in toplevel mode
1750
1751 (defun caml-skip-blank-forward ()
1752   (if (looking-at "[ \t\n]*\\((\\*\\([^*]\\|[^(]\\*[^)]\\)*\\*)[ \t\n]*\\)*")
1753       (goto-char (match-end 0))))
1754
1755 ;; to mark phrases, so that repeated calls will take several of them
1756 ;; knows little about Ocaml appart literals and comments, so it should work
1757 ;; with other dialects as long as ;; marks the end of phrase.
1758
1759 (defun caml-indent-phrase (arg)
1760   "Indent current phrase
1761 with prefix arg, indent that many phrases starting with the current phrase."
1762   (interactive "p")
1763   (save-excursion
1764     (let ((beg (caml-find-phrase)))
1765     (while (progn (setq arg (- arg 1)) (> arg 0)) (caml-find-phrase))
1766     (indent-region beg (point) nil))))
1767
1768 (defun caml-indent-buffer ()
1769   (interactive)
1770   (indent-region (point-min) (point-max) nil))
1771
1772 (defun caml-backward-to-less-indent (&optional n)
1773   "Move cursor back  N lines with less or same indentation."
1774   (interactive "p")
1775   (beginning-of-line 1)
1776   (if (< n 0) (caml-forward-to-less-indent (- n))
1777     (while (> n 0)
1778       (let ((i (current-indentation)))
1779         (forward-line -1)
1780         (while (or (> (current-indentation) i)
1781                    (caml-in-comment-p)
1782                    (looking-at
1783                     (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
1784           (forward-line -1)))
1785       (setq n (1- n))))
1786   (back-to-indentation))
1787
1788 (defun caml-forward-to-less-indent (&optional n)
1789   "Move cursor back N lines with less or same indentation."
1790   (interactive "p")
1791   (beginning-of-line 1)
1792   (if (< n 0) (caml-backward-to-less-indent (- n))
1793     (while (> n 0)
1794       (let ((i (current-indentation)))
1795         (forward-line 1)
1796         (while (or (> (current-indentation) i)
1797                    (caml-in-comment-p)
1798                    (looking-at
1799                     (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
1800           (forward-line 1)))
1801       (setq n (1- n))))
1802   (back-to-indentation))
1803
1804 (defun caml-insert-begin-form ()
1805   "Inserts a nicely formatted begin-end form, leaving a mark after end."
1806   (interactive "*")
1807   (let ((prec (preceding-char)))
1808     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1809         (insert " ")))
1810   (let* ((c (current-indentation)) (i (+ caml-begin-indent c)))
1811     (insert "begin\n\nend")
1812     (push-mark)
1813     (indent-line-to c)
1814     (forward-line -1)
1815     (indent-line-to i)))
1816
1817 (defun caml-insert-for-form ()
1818   "Inserts a nicely formatted for-do-done form, leaving a mark after do(ne)."
1819   (interactive "*")
1820   (let ((prec (preceding-char)))
1821     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1822         (insert " ")))
1823   (let* ((c (current-indentation)) (i (+ caml-for-indent c)))
1824     (insert "for  do\n\ndone")
1825     (push-mark)
1826     (indent-line-to c)
1827     (forward-line -1)
1828     (indent-line-to i)
1829     (push-mark)
1830     (beginning-of-line 1)
1831     (backward-char 4)))
1832
1833 (defun caml-insert-if-form ()
1834   "Insert nicely formatted if-then-else form leaving mark after then, else."
1835   (interactive "*")
1836   (let ((prec (preceding-char)))
1837     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1838         (insert " ")))
1839   (let* ((c (current-indentation)) (i (+ caml-if-indent c)))
1840     (insert "if\n\nthen\n\nelse\n")
1841     (indent-line-to i)
1842     (push-mark)
1843     (forward-line -1)
1844     (indent-line-to c)
1845     (forward-line -1)
1846     (indent-line-to i)
1847     (push-mark)
1848     (forward-line -1)
1849     (indent-line-to c)
1850     (forward-line -1)
1851     (indent-line-to i)))
1852
1853 (defun caml-insert-match-form ()
1854   "Insert nicely formatted match-with form leaving mark after with."
1855   (interactive "*")
1856   (let ((prec (preceding-char)))
1857     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1858         (insert " ")))
1859   (let* ((c (current-indentation)) (i (+ caml-match-indent c)))
1860     (insert "match\n\nwith\n")
1861     (indent-line-to i)
1862     (push-mark)
1863     (forward-line -1)
1864     (indent-line-to c)
1865     (forward-line -1)
1866     (indent-line-to i)))
1867
1868 (defun caml-insert-let-form ()
1869   "Insert nicely formatted let-in form leaving mark after in."
1870   (interactive "*")
1871   (let ((prec (preceding-char)))
1872     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1873         (insert " ")))
1874   (let* ((c (current-indentation)))
1875     (insert "let  in\n")
1876     (indent-line-to c)
1877     (push-mark)
1878     (forward-line -1)
1879     (forward-char (+ c 4))))
1880
1881 (defun caml-insert-try-form ()
1882   "Insert nicely formatted try-with form leaving mark after with."
1883   (interactive "*")
1884   (let ((prec (preceding-char)))
1885     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1886         (insert " ")))
1887   (let* ((c (current-indentation)) (i (+ caml-try-indent c)))
1888     (insert "try\n\nwith\n")
1889     (indent-line-to i)
1890     (push-mark)
1891     (forward-line -1)
1892     (indent-line-to c)
1893     (forward-line -1)
1894     (indent-line-to i)))
1895
1896 (defun caml-insert-while-form ()
1897   "Insert nicely formatted while-do-done form leaving mark after do, done."
1898   (interactive "*")
1899   (let ((prec (preceding-char)))
1900     (if (and (numberp prec) (not (char-equal ?\  (char-syntax prec))))
1901         (insert " ")))
1902   (let* ((c (current-indentation)) (i (+ caml-if-indent c)))
1903     (insert "while  do\n\ndone")
1904     (push-mark)
1905     (indent-line-to c)
1906     (forward-line -1)
1907     (indent-line-to i)
1908     (push-mark)
1909     (beginning-of-line 1)
1910     (backward-char 4)))
1911
1912 (autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
1913
1914 (autoload 'caml-types-show-type "caml-types"
1915   "Show the type of expression or pattern at point." t)
1916 (autoload 'caml-types-explore "caml-types"
1917   "Explore type annotations by mouse dragging." t)
1918
1919 (autoload 'caml-help "caml-help"
1920   "Show documentation for qualilifed OCaml identifier." t)
1921 (autoload 'caml-complete "caml-help"
1922   "Does completion for documented qualified OCaml identifier." t)
1923 (autoload 'ocaml-open-module "caml-help"
1924   "Add module in documentation search path." t)
1925 (autoload 'ocaml-close-module "caml-help"
1926   "Remove module from documentation search path." t)
1927 (autoload 'ocaml-add-path "caml-help"
1928   "Add search path for documentation." t)
1929
1930 ;;; caml.el ends here
1931
1932 (provide 'caml)