cgit.sxemacs.org Git - packages/blob - xemacs-packages/ocaml/caml.el.upstream

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