[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] externals/caml bf4ed0f 001/197: Mode OCaml Garrigue/Zimmerman
|
From: |
Stefan Monnier |
|
Subject: |
[nongnu] externals/caml bf4ed0f 001/197: Mode OCaml Garrigue/Zimmerman |
|
Date: |
Sat, 21 Nov 2020 01:19:26 -0500 (EST) |
branch: externals/caml
commit bf4ed0f926f3181a06b93396b2c59662da1e2711
Author: Xavier Leroy <xavier.leroy@inria.fr>
Commit: Xavier Leroy <xavier.leroy@inria.fr>
Mode OCaml Garrigue/Zimmerman
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1286
f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
README.itz | 178 +++++++
caml-font.el | 100 ++++
caml-hilit.el | 57 +++
caml.el | 1438 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
camldebug.el | 753 ++++++++++++++++++++++++++++++
inf-caml.el | 100 ++++
6 files changed, 2626 insertions(+)
diff --git a/README.itz b/README.itz
new file mode 100644
index 0000000..60678cf
--- /dev/null
+++ b/README.itz
@@ -0,0 +1,178 @@
+DESCRIPTION:
+
+This directory contains files to help editing Caml code, running a
+Caml toplevel, and running the Caml debugger under the Gnu Emacs editor.
+
+AUTHORS:
+
+Ian T Zimmerman <itz@rahul.net> added indentation to caml mode, beefed
+up camldebug to work much like gud/gdb.
+
+Xavier Leroy (Xavier.Leroy@inria.fr), Jerome Vouillon (Jerome.Vouillon@ens.fr).
+camldebug.el is derived from FSF code.
+
+CONTENTS:
+
+ caml.el A major mode for editing Caml code in Gnu Emacs
+ inf-caml.el To run a Caml toplevel under Emacs, with input and
+ output in an Emacs buffer.
+ camldebug.el To run the Caml debugger under Emacs.
+
+
+NOTE FOR EMACS 18 USERS:
+
+This package will no longer work with Emacs 18.x. Sorry. You really
+should consider upgrading to Emacs 19.
+
+USAGE:
+
+Add the following lines to your .emacs file:
+
+(setq auto-mode-alist (cons '("\\.ml[iylp]?" . caml-mode) auto-mode-alist))
+(autoload 'caml-mode "caml" "Major mode for editing Caml code." t)
+(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
+(autoload 'camldebug "camldebug" "Run the Caml debugger." t)
+
+The Caml major mode is triggered by visiting a file with extension .ml,
+.mli, .mly. .mll or .mlp, or manually by M-x caml-mode. It gives you the
+correct syntax table for the Caml language. For a brief description of
+the indentation capabilities, see below under NEWS.
+
+The Caml mode also allows you to run batch Caml compilations from
+Emacs (using M-x compile) and browse the errors (C-x `). Typing C-x `
+sets the point at the beginning of the erroneous program fragment, and
+the mark at the end. Under Emacs 19, the program fragment is
+temporarily highlighted.
+
+M-x run-caml starts a Caml toplevel with input and output in an Emacs
+buffer named *inferior-caml*. This gives you the full power of Emacs
+to edit the input to the Caml toplevel. This mode is based on comint
+so you get all the usual comint features, including command history.
+
+After M-x run-caml, typing C-c C-e or M-C-x in a buffer in Caml mode
+sends the current phrase (containing the point) to the Caml toplevel,
+and evaluates it.
+
+M-x camldebug FILE starts the Caml debugger camldebug on the executable
+FILE, with input and output in an Emacs buffer named *camldebug-FILE*.
+For a brief description of the commands available in this buffer, see
+NEWS below.
+
+NEWS:
+
+Ok, so this is the really important part of this file :-) I took the
+original package from the contrib subdirectory of the caml-light
+distribution, and hacked on it. First, I added real syntax dependent
+indentation to caml mode. Like Xavier has said, it was hard (and I
+knew it would be), but I refused to believe it was impossible, partly
+because I knew of a Standard ML mode with indentation (written by
+Matthew Morley).
+
+Indentation works pretty much like in other programming modes. C-j at
+the end of a line starts a new line properly indented. M-C-\ indents
+the current region (this may take a while :-)). I incorporated a
+slightly different TAB function, one that I use in other modes: if TAB
+is pressed while the point is not in line indentation, the line is
+indented to the column where point is (instead of just inserting a TAB
+character - you can always to that with C-q C-i). This way, you can
+indent a line any time, regardless of where the point lies, by hitting
+TAB twice in succession. If you don't like this behaviour (but you
+should), it's quite easy to add to your startup code like this:
+
+(defun caml-old-style-indent ()
+ (if (caml-in-indentation)
+ (caml-indent-command)
+ (insert "\t")))
+
+(add-hook 'caml-mode-hook
+ (function (lambda ()
+ (define-key 'caml-mode-map "\t"
+ caml-old-style-indent))))
+
+You can customize the appearance of your caml code by twiddling the
+variables listed at the start of caml.el. Good luck. :-)
+
+Other news in caml mode are the various caml-insert-*-form commands. I
+believe they are self-explanatory - just do a C-h m in a caml buffer
+to see what you've got.
+
+The ohter major news is that I changed camldebug mode considerably. I
+took many clues from the gud "Grand Unified Debugger" mode distributed
+with modern versions of Emacs. The main benefit here is that you can
+do debugger commands _from your caml source buffer_. Commands with the
+C-c prefix in the debugger buffer have counterparts which do the same
+thing (well, a similar thing) in the source buffer, with the C-x C-a
+prefix.
+
+I made the existing debugger commands smarter in that they now attempt
+to guess the correct parameter to the underlying camldebug command. A
+numeric argument will always override that guess. For example, the
+guess for C-c C-b (camldebug-break) is to set a breakpoint at the
+current event (which was the only behaviour provided with the old
+camldebug.el). But C-u 1 C-c C-b will now send "break 1" to the
+camldebug process, setting a break at code address 1.
+
+This also allowed me to add many more commands for which the
+underlying camldebug commands require a parameter. The best way to
+learn about them is to do C-h m in the camldebug buffer, and then C-h
+f for the commands you'll see listed.
+
+Finally, I added command completion. To use it, you'll have to apply
+the provided patch to the debugger itself
+(contrib/debugger/command_line_interpreter.ml), and recompile it
+(you'll get one warning from the compiler; it is safe to ignore
+it). Then hitting TAB in the following situation, for example:
+
+(cdb) pri_
+
+will complete the "pri" to "print".
+
+CAVEATS:
+
+I don't use X and haven't tested this stuff under the X mode of
+emacs. It is entirely possible (though not very probable) that I
+introduced some undesirable interaction between X (fontification,
+highlighting,...) and caml mode. I will welcome reports of such
+problems (see REPORTING below), but I won't be able to do much about
+them unless you also provide a patch.
+
+I don't know if the informational messages produced by camldebug are
+internationalized. If they are, the debugger mode won't work unless
+you set the language to English. The mode uses the messages to
+synchronize with camldebug, and looks for fixed Emacs regular
+expressions that match them. This may be fixed (if necessary) in a
+future release.
+
+BUGS:
+
+In the debugger buffer, it's possible to overflow your mental stack by
+asking for help on help on help on help on help on help on help on
+help...
+
+THANKS:
+
+Xavier Leroy <Xavier.Leroy@inria.fr> for Caml-light. Used together with the
+Emacs interface, it is about the most pleasant programming environment
+I've known on any platform.
+
+Eric Raymond <esr@thyrsus.com> for gud, which camldebug mode apes.
+
+Barry Warsaw <bwarsaw@cen.com> for elp, without which I wouldn't have
+been able to get the indentation code to perform acceptably.
+
+Gareth Rees <Gareth.Rees@cl.cam.ac.uk> for suggestions how to speed up
+Emacs regular expression search, even if I didn't use them in the end.
+
+Bill Dubuque <wgd@martigny.ai.mit.edu> for alerting me to the
+necessity of guarding against C-g inside Emacs code which modifies
+syntax tables.
+
+REPORTING:
+
+Bug reports (preferably with patches), suggestions, donations etc. to:
+
+Ian T Zimmerman +-------------------------------------------+
+Box 13445 I With so many executioners available, I
+Berkeley CA 94712 USA I suicide is a really foolish thing to do. I
+mailto:itz@rahul.net +-------------------------------------------+
+
diff --git a/caml-font.el b/caml-font.el
new file mode 100644
index 0000000..a1b959d
--- /dev/null
+++ b/caml-font.el
@@ -0,0 +1,100 @@
+;; useful colors
+
+; I don't know exactly when font-lock turned color...
+
+(cond
+ ((and (x-display-color-p)
+ (not (string< "19.30" emacs-version)))
+ (make-face 'Firebrick)
+ (set-face-foreground 'Firebrick "Firebrick")
+ (make-face 'RosyBrown)
+ (set-face-foreground 'RosyBrown "RosyBrown")
+ (make-face 'Purple)
+ (set-face-foreground 'Purple "Purple")
+ (make-face 'MidnightBlue)
+ (set-face-foreground 'MidnightBlue "MidnightBlue")
+ (make-face 'DarkGoldenRod)
+ (set-face-foreground 'DarkGoldenRod "DarkGoldenRod")
+ (make-face 'DarkOliveGreen)
+ (set-face-foreground 'DarkOliveGreen "DarkOliveGreen3")
+ (make-face 'CadetBlue)
+ (set-face-foreground 'CadetBlue "CadetBlue")))
+
+(cond
+ ((and (x-display-color-p)
+ (not (string< "19.30" emacs-version)))
+ (setq font-lock-comment-face 'Firebrick)
+ (setq font-lock-string-face 'RosyBrown)
+ (setq font-lock-keyword-face 'Purple)
+ (setq font-lock-function-name-face 'MidnightBlue)
+ (setq font-lock-variable-name-face 'DarkGoldenRod)
+ (setq font-lock-type-face 'DarkOliveGreen)
+ (setq font-lock-reference-face 'CadetBlue)))
+
+; The same definition is in caml.el:
+; we don't know in which order they will be loaded.
+(defvar caml-quote-char "'"
+ "*Quote for character constants. \"'\" for Objective Caml, \"`\" for
Caml-Light.")
+
+(defconst caml-font-lock-keywords
+ (list
+;comments
+ '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)"
+ 2 font-lock-comment-face)
+;character literals
+ (cons (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|"
+ "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char
+ "\\|\"[^\"\\]*\\(\\\\\\(.\\|\n\\)[^\"\\]*\\)*\"")
+ 'font-lock-string-face)
+;labels (and open)
+ '("\\([?]?\\<[A-Za-z][A-Za-z0-9_']*:\\)\\([^:=]\\|\\'\\|$\\)" 1
+ font-lock-variable-name-face)
+ '("\\<\\(open\\|include\\)\\>\\|[?]?\\<:[A-Za-z][A-Za-z0-9_']*\\>"
+ . font-lock-variable-name-face)
+;modules and constructors
+ '("\\(\\<\\|:\\)\\([A-Z][A-Za-z0-9_']*\\)\\>"
+ 2 font-lock-function-name-face)
+ '("`[A-Za-z][A-Za-z0-9_']*\\>" . font-lock-function-name-face)
+;definition
+ (cons (concat
+ "\\<\\(and\\|as\\|c\\(onstraint\\|losed\\)"
+ "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?"
+ "\\|in\\(herit\\)?\\|let\\|m\\(ethod\\|utable\\|odule\\)"
+ "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type"
+ "\\|v\\(al\\(ue\\)?\\|irtual\\)\\)\\>")
+ 'font-lock-type-face)
+;blocking
+ '("\\(\\<\\|:\\)\\(begin\\|class\\|end\\|s\\(ig\\|truct\\)\\)\\>"
+ 2 font-lock-keyword-face)
+;control
+ (cons (concat
+ "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|if"
+ "\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)"
+ "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>"
+ "\\|\|\\|->\\|&\\|#")
+ 'font-lock-reference-face)
+ '("\\<raise\\>" . font-lock-comment-face)))
+
+(defconst inferior-caml-font-lock-keywords
+ (append
+ (list
+;inferior
+ '("^[#-]" . font-lock-comment-face)
+;labels
+ '("[? \t]:[A-Za-z][A-Za-z0-9_']*\\>" . font-lock-variable-name-face))
+ caml-font-lock-keywords))
+
+;; font-lock commands are similar for caml-mode and inferior-caml-mode
+(setq caml-mode-hook
+ '(lambda ()
+ (setq font-lock-keywords caml-font-lock-keywords)
+ (setq font-lock-no-comments t)
+ (font-lock-mode 1)))
+
+(setq inferior-caml-mode-hooks
+ '(lambda ()
+ (setq font-lock-keywords inferior-caml-font-lock-keywords)
+ (setq font-lock-no-comments t)
+ (font-lock-mode 1)))
+
+(provide 'caml-font)
diff --git a/caml-hilit.el b/caml-hilit.el
new file mode 100644
index 0000000..712c299
--- /dev/null
+++ b/caml-hilit.el
@@ -0,0 +1,57 @@
+; Highlighting patterns for hilit19 under caml-mode
+
+; defined also in caml.el
+(defvar caml-quote-char "'"
+ "*Quote for character constants. \"'\" for Objective Caml, \"`\" for
Caml-Light.")
+
+(defconst caml-mode-patterns
+ (list
+;comments
+ '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)"
+ 2 comment)
+;string
+ (list 'hilit-string-find (string-to-char caml-quote-char) 'string)
+ (list (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|"
+ "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char)
+ nil
+ 'string)
+;labels
+ '("[?]?\\<[A-Za-z][A-Za-z0-9_\']*:" nil brown)
+ '("[?]?\\<:[A-Za-z][A-Za-z0-9_\']*\\>" nil brown)
+;modules
+ '("\\<open\\>" nil brown)
+ '("\\<[A-Z][A-Za-z0-9_\']*\\>" nil MidnightBlue)
+ '("`[A-Za-z][A-Za-z0-9_\']*\\>" nil MidnightBlue)
+;definition
+ (list (concat
+ "\\<\\(let\\|rec\\|in\\|type\\|of\\|and"
+ "\\|exception\\|val\\|and\\|function\\|fun"
+ "\\|parser\\|mutable\\|module\\|inherit"
+ "\\|external\\|method\\|virtual\\|private"
+ "\\|constraint\\|as\\|closed\\)\\>")
+ nil 'ForestGreen)
+;blocking
+ '("\\(\\<\\|:\\)\\(class\\|struct\\|sig\\|begin\\|end\\)\\>"
+ 2 include)
+;control
+ (list (concat
+ "\\<\\(if\\|then\\|else\\|match\\|when"
+ "\\|with\\|try\\|for\\|do\\|while\\|done"
+ "\\|downto\\|to\\|or\\|new\\)\\>"
+ "\\|\|\\|->\\|&\\|#")
+ nil 'keyword)
+ '(";" nil struct))
+ "Hilit19 patterns used for Caml mode")
+
+(hilit-set-mode-patterns 'caml-mode caml-mode-patterns)
+(hilit-set-mode-patterns
+ 'inferior-caml-mode
+ (append
+ (list
+;inferior
+ '("^[#-]" nil firebrick)
+ '("`[A-Za-z][A-Za-z0-9_\']*\\>" nil MidnightBlue)
+ '("[? \t]:[A-Za-z][A-Za-z0-9_\']*\\>" nil brown))
+ caml-mode-patterns))
+
+(provide 'caml-hilit)
diff --git a/caml.el b/caml.el
new file mode 100644
index 0000000..45acff3
--- /dev/null
+++ b/caml.el
@@ -0,0 +1,1438 @@
+;;; caml.el --- Caml code editing commands for Emacs
+
+;; Initial code written by Xavier Leroy, july 1993.
+
+;; Indentation code is Copyright (C) 1996 by Ian T Zimmerman <itz@rahul.net>
+;; copying: covered by the current FSF General Public License.
+
+;; Indentation code adapted for Objective Caml by Jacques Garrigue,
+;; october 1996. <garrigue@kurims.kyoto-u.ac.jp>
+
+;;user customizable variables
+(defvar caml-quote-char "'"
+ "*Quote for character constants. \"'\" for Objective Caml, \"`\" for
Caml-Light.")
+
+(defvar caml-mode-indentation 2
+ "*Used for \\[caml-unindent-command].")
+
+(defvar caml-lookback-limit 2000
+ "*How far to look back for syntax things in caml mode.")
+
+(defvar caml-max-indent-priority 8
+ "*Bounds priority of operators permitted to affect caml indentation.
+
+Priorities are assigned to `interesting' caml operators as follows:
+
+ all keywords 0 to 7 8
+ type, val, ... + 0 7
+ :: ^ 6
+ @ 5
+ := <- 4
+ if 3
+ fun, let, match ... 2
+ module 1
+ opening keywords 0.")
+
+(defvar caml-apply-extra-indent 2
+ "*How many spaces to add to indentation for an application in caml mode.")
+(make-variable-buffer-local 'caml-apply-extra-indent)
+
+(defvar caml-begin-indent 2
+ "*How many spaces to indent from a begin keyword in caml mode.")
+(make-variable-buffer-local 'caml-begin-indent)
+
+(defvar caml-class-indent 2
+ "*How many spaces to indent from a class keyword in caml mode.")
+(make-variable-buffer-local 'caml-class-indent)
+
+(defvar caml-exception-indent 2
+ "*How many spaces to indent from a exception keyword in caml mode.")
+(make-variable-buffer-local 'caml-exception-indent)
+
+(defvar caml-for-indent 2
+ "*How many spaces to indent from a for keyword in caml mode.")
+(make-variable-buffer-local 'caml-for-indent)
+
+(defvar caml-fun-indent 2
+ "*How many spaces to indent from a fun keyword in caml mode.")
+(make-variable-buffer-local 'caml-fun-indent)
+
+(defvar caml-function-indent 4
+ "*How many spaces to indent from a function keyword in caml mode.")
+(make-variable-buffer-local 'caml-function-indent)
+
+(defvar caml-if-indent 2
+ "*How many spaces to indent from a if keyword in caml mode.")
+(make-variable-buffer-local 'caml-if-indent)
+
+(defvar caml-if-else-indent 0
+ "*How many spaces to indent from an if .. else line in caml mode.")
+(make-variable-buffer-local 'caml-if-else-indent)
+
+(defvar caml-inherit-indent 2
+ "*How many spaces to indent from a inherit keyword in caml mode.")
+(make-variable-buffer-local 'caml-inherit-indent)
+
+(defvar caml-include-indent 2
+ "*How many spaces to indent from a include keyword in caml mode.")
+(make-variable-buffer-local 'caml-include-indent)
+
+(defvar caml-let-indent 2
+ "*How many spaces to indent from a let keyword in caml mode.")
+(make-variable-buffer-local 'caml-let-indent)
+
+(defvar caml-let-in-indent 0
+ "*How many spaces to indent from a let .. in keyword in caml mode.")
+(make-variable-buffer-local 'caml-let-in-indent)
+
+(defvar caml-match-indent 2
+ "*How many spaces to indent from a match keyword in caml mode.")
+(make-variable-buffer-local 'caml-match-indent)
+
+(defvar caml-method-indent 2
+ "*How many spaces to indent from a method keyword in caml mode.")
+(make-variable-buffer-local 'caml-method-indent)
+
+(defvar caml-module-indent 2
+ "*How many spaces to indent from a module keyword in caml mode.")
+(make-variable-buffer-local 'caml-module-indent)
+
+(defvar caml-of-indent 2
+ "*How many spaces to indent from a of keyword in caml mode.")
+(make-variable-buffer-local 'caml-of-indent)
+
+(defvar caml-parser-indent 4
+ "*How many spaces to indent from a parser keyword in caml mode.")
+(make-variable-buffer-local 'caml-parser-indent)
+
+(defvar caml-sig-indent 2
+ "*How many spaces to indent from a sig keyword in caml mode.")
+(make-variable-buffer-local 'caml-sig-indent)
+
+(defvar caml-struct-indent 2
+ "*How many spaces to indent from a struct keyword in caml mode.")
+(make-variable-buffer-local 'caml-struct-indent)
+
+(defvar caml-try-indent 2
+ "*How many spaces to indent from a try keyword in caml mode.")
+(make-variable-buffer-local 'caml-try-indent)
+
+(defvar caml-type-indent 4
+ "*How many spaces to indent from a type keyword in caml mode.")
+(make-variable-buffer-local 'caml-type-indent)
+
+(defvar caml-val-indent 2
+ "*How many spaces to indent from a val keyword in caml mode.")
+(make-variable-buffer-local 'caml-val-indent)
+
+(defvar caml-while-indent 2
+ "*How many spaces to indent from a while keyword in caml mode.")
+(make-variable-buffer-local 'caml-while-indent)
+
+(defvar caml-::-indent 3
+ "*How many spaces to indent from a :: operator in caml mode.")
+(make-variable-buffer-local 'caml-::-indent)
+
+(defvar caml-@-indent 2
+ "*How many spaces to indent from a @ operator in caml mode.")
+(make-variable-buffer-local 'caml-@-indent)
+
+(defvar caml-:=-indent 3
+ "*How many spaces to indent from a := operator in caml mode.")
+(make-variable-buffer-local 'caml-:=-indent)
+
+(defvar caml-<--indent 3
+ "*How many spaces to indent from a <- operator in caml mode.")
+(make-variable-buffer-local 'caml-<--indent)
+
+(defvar caml-->-indent 2
+ "*How many spaces to indent from a -> operator in caml mode.")
+(make-variable-buffer-local 'caml-->-indent)
+
+(defvar caml-lb-indent 2
+ "*How many spaces to indent from a \[ operator in caml mode.")
+(make-variable-buffer-local 'caml-lb-indent)
+
+(defvar caml-lc-indent 2
+ "*How many spaces to indent from a \{ operator in caml mode.")
+(make-variable-buffer-local 'caml-lc-indent)
+
+(defvar caml-lp-indent 1
+ "*How many spaces to indent from a \( operator in caml mode.")
+(make-variable-buffer-local 'caml-lp-indent)
+
+(defvar caml-and-extra-indent nil
+ "*Extra indent for caml lines starting with the and keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-and-extra-indent)
+
+(defvar caml-do-extra-indent nil
+ "*Extra indent for caml lines starting with the do keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-do-extra-indent)
+
+(defvar caml-done-extra-indent nil
+ "*Extra indent for caml lines starting with the done keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-done-extra-indent)
+
+(defvar caml-else-extra-indent nil
+ "*Extra indent for caml lines starting with the else keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-else-extra-indent)
+
+(defvar caml-end-extra-indent nil
+ "*Extra indent for caml lines starting with the end keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-end-extra-indent)
+
+(defvar caml-in-extra-indent nil
+ "*Extra indent for caml lines starting with the in keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-in-extra-indent)
+
+(defvar caml-then-extra-indent nil
+ "*Extra indent for caml lines starting with the then keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-then-extra-indent)
+
+(defvar caml-to-extra-indent -1
+ "*Extra indent for caml lines starting with the to keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-to-extra-indent)
+
+(defvar caml-with-extra-indent nil
+ "*Extra indent for caml lines starting with the with keyword.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-with-extra-indent)
+
+(defvar caml-|-extra-indent -2
+ "*Extra indent for caml lines starting with the | operator.
+Usually negative. nil is align on master.")
+(make-variable-buffer-local 'caml-|-extra-indent)
+
+(defvar caml-rb-extra-indent -2
+ "*Extra indent for caml lines statring with ].
+Usually negative. nil is align on master.")
+
+(defvar caml-rc-extra-indent -2
+ "*Extra indent for caml lines starting with }.
+Usually negative. nil is align on master.")
+
+(defvar caml-electric-indent t
+ "*Non-nil means electrically indent lines starting with |, ] or }.
+
+Many people find eletric keys irritating, so you can disable them if
+you are one.")
+
+(defvar caml-electric-close-vector t
+ "*Non-nil means electrically insert a | before a vector-closing ].
+
+Many people find eletric keys irritating, so you can disable them if
+you are one. You should probably have this on, though, if you also
+have caml-electric-indent on, which see.")
+
+;;compatibility function for old emacs.
+
+(if (not (fboundp 'indent-line-to))
+ (defun indent-line-to (column)
+ "Indent current line to COLUMN.
+
+This function removes or adds spaces and tabs at beginning of line
+only if necessary. It leaves point at end of indentation."
+ (if (= (current-indentation) column)
+ (back-to-indentation)
+ (beginning-of-line 1)
+ (delete-horizontal-space)
+ (indent-to column))))
+
+;;code
+(defvar caml-mode-map nil
+ "Keymap used in Caml mode.")
+(if caml-mode-map
+ ()
+ (setq caml-mode-map (make-sparse-keymap))
+ (define-key caml-mode-map "|" 'caml-electric-pipe)
+ (define-key caml-mode-map "}" 'caml-electric-pipe)
+ (define-key caml-mode-map "]" 'caml-electric-rb)
+ (define-key caml-mode-map "\t" 'caml-indent-command)
+ (define-key caml-mode-map [backtab] 'caml-unindent-command)
+ (define-key caml-mode-map "\M-\C-h" 'caml-mark-phrase)
+
+;itz 04-21-96 instead of defining a new function, use defadvice
+;that way we get out effect even when we do \C-x` in compilation buffer
+; (define-key caml-mode-map "\C-x`" 'caml-next-error)
+
+ (define-key caml-mode-map "\177" 'backward-delete-char-untabify)
+ (define-key caml-mode-map "\C-cb" 'caml-insert-begin-form)
+ (define-key caml-mode-map "\C-cf" 'caml-insert-for-form)
+ (define-key caml-mode-map "\C-ci" 'caml-insert-if-form)
+ (define-key caml-mode-map "\C-cl" 'caml-insert-let-form)
+ (define-key caml-mode-map "\C-cm" 'caml-insert-match-form)
+ (define-key caml-mode-map "\C-ct" 'caml-insert-try-form)
+ (define-key caml-mode-map "\C-cw" 'caml-insert-while-form)
+ (define-key caml-mode-map "\C-c\C-a" 'caml-find-alternate-file)
+ (define-key caml-mode-map "\C-c\C-c" 'compile)
+ (define-key caml-mode-map "\C-c\C-\[" 'caml-backward-to-less-indent)
+ (define-key caml-mode-map "\C-c\C-\]" 'caml-forward-to-less-indent)
+ (define-key caml-mode-map "\C-c\C-q" 'caml-indent-phrase))
+
+(defvar caml-mode-syntax-table nil
+ "Syntax table in use in Caml mode buffers.")
+(if caml-mode-syntax-table
+ ()
+ (setq caml-mode-syntax-table (make-syntax-table))
+ ; backslash is an escape sequence
+ (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table)
+ ; ( is first character of comment start
+ (modify-syntax-entry ?\( "()1" caml-mode-syntax-table)
+ ; * is second character of comment start,
+ ; and first character of comment end
+ (modify-syntax-entry ?* ". 23" caml-mode-syntax-table)
+ ; ) is last character of comment end
+ (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table)
+ ; backquote was a string-like delimiter (for character literals)
+ ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table)
+ ; quote and underscore are part of words
+ (modify-syntax-entry ?' "w" caml-mode-syntax-table)
+ (modify-syntax-entry ?_ "w" caml-mode-syntax-table)
+ ; : is part of words (labels)
+ (modify-syntax-entry ?: "w" caml-mode-syntax-table)
+ ; ISO-latin accented letters and EUC kanjis are part of words
+ (let ((i 160))
+ (while (< i 256)
+ (modify-syntax-entry i "w" caml-mode-syntax-table)
+ (setq i (1+ i)))))
+
+(defvar caml-mode-abbrev-table nil
+ "Abbrev table used for Caml mode buffers.")
+(if caml-mode-abbrev-table nil
+ (setq caml-mode-abbrev-table (make-abbrev-table))
+ (define-abbrev caml-mode-abbrev-table "and" "and" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "do" "do" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "done" "done" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "else" "else" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "end" "end" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "in" "in" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "then" "then" 'caml-abbrev-hook)
+ (define-abbrev caml-mode-abbrev-table "with" "with" 'caml-abbrev-hook))
+
+;;; The major mode
+
+(defun caml-mode ()
+ "Major mode for editing Caml code.
+
+\\{caml-mode-map}"
+
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'caml-mode)
+ (setq mode-name "caml")
+ (use-local-map caml-mode-map)
+ (set-syntax-table caml-mode-syntax-table)
+ (setq local-abbrev-table caml-mode-abbrev-table)
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^$\\|" page-delimiter))
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate paragraph-start)
+ (make-local-variable 'paragraph-ignore-fill-prefix)
+ (setq paragraph-ignore-fill-prefix t)
+ (make-local-variable 'require-final-newline)
+ (setq require-final-newline t)
+ (make-local-variable 'comment-start)
+ (setq comment-start "(*")
+ (make-local-variable 'comment-end)
+ (setq comment-end "*)")
+ (make-local-variable 'comment-column)
+ (setq comment-column 40)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "(\\*+ *")
+ (make-local-variable 'parse-sexp-ignore-comments)
+ (setq parse-sexp-ignore-comments nil)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'caml-indent-command)
+ ;itz 03-25-96
+ (setq before-change-function 'caml-before-change-function)
+ (setq caml-last-noncomment-pos nil)
+ (setq caml-last-comment-start (make-marker))
+ (setq caml-last-comment-end (make-marker))
+ ;garrigue 27-11-96
+ (setq case-fold-search nil)
+ (run-hooks 'caml-mode-hook))
+
+;;; Auxiliary function. Garrigue 96-11-01.
+
+(defun caml-find-alternate-file ()
+ (interactive)
+ (let ((name (buffer-file-name)))
+ (if (string-match "^\\(.*\\)\\.\\(ml\\|mli\\)$" name)
+ (find-file
+ (concat
+ (caml-match-string 1 name)
+ (if (string= "ml" (caml-match-string 2 name)) ".mli" ".ml"))))))
+
+;;; Indentation stuff
+
+(defun caml-in-indentation ()
+ "Tests whether all characters between beginning of line and point
+are blanks."
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+
+;;; The command
+;;; Sorry, I didn't like the previous behaviour... Garrigue 96/11/01
+
+(defun caml-indent-command (&optional p)
+ "Indent the current line in Caml mode.
+
+Compute new indentation based on caml syntax. If prefixed, indent
+the line all the way to where point is."
+
+ (interactive "*p")
+ (cond
+ ((and p (> p 1)) (indent-line-to (current-column)))
+ ((caml-in-indentation) (indent-line-to (caml-compute-final-indent)))
+ (t (save-excursion
+ (indent-line-to
+ (caml-compute-final-indent))))))
+
+(defun caml-unindent-command ()
+
+ "Decrease indentation by one level in Caml mode.
+
+Works only if the point is at the beginning of an indented line
+\(i.e. all characters between beginning of line and point are
+blanks\). Does nothing otherwise. The unindent size is given by the
+variable caml-mode-indentation."
+
+ (interactive "*")
+ (let* ((begline
+ (save-excursion
+ (beginning-of-line)
+ (point)))
+ (current-offset
+ (- (point) begline)))
+ (if (and (>= current-offset caml-mode-indentation)
+ (caml-in-indentation))
+ (backward-delete-char-untabify caml-mode-indentation))))
+
+;;; Error processing
+
+(require 'compile)
+
+;; In Emacs 19, the regexps in compilation-error-regexp-alist do not
+;; match the error messages when the language is not English.
+;; Hence we add a regexp.
+
+(defconst caml-error-regexp
+ "^[A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]"
+ "Regular expression matching the error messages produced by camlc.")
+
+(if (boundp 'compilation-error-regexp-alist)
+ (or (assoc caml-error-regexp
+ compilation-error-regexp-alist)
+ (setq compilation-error-regexp-alist
+ (cons (list caml-error-regexp 1 2)
+ compilation-error-regexp-alist))))
+
+;; A regexp to extract the range info
+
+(defconst caml-error-chars-regexp
+ ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):"
+ "Regular expression extracting the character numbers
+from an error message produced by camlc.")
+
+;; Wrapper around next-error.
+
+(defvar caml-error-overlay nil)
+
+;;itz 04-21-96 somebody didn't get the documetation for next-error
+;;right. When the optional argument is a number n, it should move
+;;forward n errors, not reparse.
+
+;itz 04-21-96 instead of defining a new function, use defadvice
+;that way we get our effect even when we do \C-x` in compilation buffer
+
+(defadvice next-error (after caml-next-error activate)
+ "Reads the extra positional information provided by the Caml compiler.
+
+Puts the point and the mark exactly around the erroneous program
+fragment. The erroneous fragment is also temporarily highlighted if
+possible."
+
+ (if (eq major-mode 'caml-mode)
+ (let ((beg nil) (end nil))
+ (save-excursion
+ (set-buffer
+ (if (boundp 'compilation-last-buffer)
+ compilation-last-buffer ;Emacs 19
+ "*compilation*")) ;Emacs 18
+ (save-excursion
+ (goto-char (window-point (get-buffer-window (current-buffer))))
+ (if (looking-at caml-error-chars-regexp)
+ (setq beg
+ (string-to-int
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ end
+ (string-to-int
+ (buffer-substring (match-beginning 2) (match-end 2)))))))
+ (cond (beg
+ (setq beg (+ (point) beg)
+ end (+ (point) end))
+ (goto-char beg)
+ (push-mark end t)
+ (cond ((fboundp 'make-overlay)
+ (if caml-error-overlay ()
+ (setq caml-error-overlay (make-overlay 1 1))
+ (overlay-put caml-error-overlay 'face 'region))
+ (unwind-protect
+ (progn
+ (move-overlay caml-error-overlay
+ beg end (current-buffer))
+ (sit-for 60))
+ (delete-overlay caml-error-overlay)))))))))
+
+;; Usual match-string doesn't work properly with font-lock-mode
+;; on some emacs.
+
+(cond
+ ((fboundp 'buffer-substring-no-properties)
+ (defun caml-buffer-substring (b e)
+ (buffer-substring-no-properties b e)))
+ ((fboundp 'buffer-substring-without-properties)
+ (defun caml-buffer-substring (b e)
+ (buffer-substring-without-properties b e)))
+ (t (defun caml-buffer-substring (b e) (buffer-substring b e))))
+
+(defun caml-match-string (num &optional string)
+
+ "Return string of text matched by last search, without properties.
+
+NUM specifies which parenthesized expression in the last regexp.
+Value is nil if NUMth pair didn't match, or there were less than NUM
+pairs. Zero means the entire text matched by the whole regexp or
+whole string."
+
+ (let* ((data (match-data))
+ (begin (nth (* 2 num) data))
+ (end (nth (1+ (* 2 num)) data)))
+ (if string (substring string begin end)
+ (caml-buffer-substring begin end))))
+
+;;; Phrases
+
+;itz the heuristics used to see if we're `between two phrases'
+;didn't seem right to me.
+
+(defconst caml-phrase-start-keywords
+ (concat "#\\|\\<\\(class\\|ex\\(ternal\\|ception\\)"
+ "\\|let\\|module\\|open\\|type\\|val\\)\\>")
+ "Keywords starting phrases in files")
+
+;; a phrase starts when a toplevel keyword is at the beginning of a line
+(defun caml-at-phrase-start-p ()
+ (and (bolp) (looking-at caml-phrase-start-keywords)))
+
+(defun caml-mark-phrase ()
+ "Put mark at end of this Caml phrase, point at beginning.
+
+The Caml phrase is the phrase just before the point.
+Completely rewritten by J. Garrigue, to handle both Objective Caml
+and Caml-Light syntax. \";;\" is left out of the region, and
+eventually added when sending to the subprocess."
+
+ (interactive)
+ (let (use-semi end)
+ (if (and (looking-at ";;") (not (caml-in-comment-p))) nil
+ (if (caml-at-phrase-start-p) (forward-char))
+ (while (and (cond
+ ((re-search-forward
+ (concat ";;\\|" caml-phrase-start-keywords) nil 'move)
+ (goto-char (match-beginning 0)) t))
+ (or (not (or (bolp) (looking-at ";;")))
+ (caml-in-comment-p)
+ (caml-in-literal-p)))
+ (forward-char)))
+ (setq use-semi (looking-at ";;"))
+ (skip-chars-backward " \n\t")
+ (while (and (eq (preceding-char) ?\)) (eq (char-after (- (point) 2)) ?*))
+ (backward-char 2)
+ (while (caml-in-comment-p) (up-list -1))
+ (skip-chars-backward " \n\t"))
+ (push-mark)
+ (setq end (point))
+ (cond
+ (use-semi
+ (if (caml-find-kwop ";;") (forward-char 2)
+ (goto-char (point-min)))
+ (skip-chars-forward " \n\t")
+ (while (or (looking-at comment-start-skip) (caml-in-comment-p))
+ (forward-list 1)
+ (skip-chars-forward " \n\t")))
+ (t
+ (if (not (caml-find-kwop caml-phrase-start-keywords))
+ (error "No phrase preceding point"))
+ (while (and (or (not (bolp))
+ (caml-in-comment-p)
+ (caml-in-literal-p))
+ (caml-find-kwop caml-phrase-start-keywords)))))
+ (cons (point) end)))
+
+(defvar caml-last-noncomment-pos nil
+ "Caches last buffer position determined not inside a caml comment.")
+(make-variable-buffer-local 'caml-last-noncomment-pos)
+
+;;last-noncomment-pos can be a simple position, because we nil it
+;;anyway whenever buffer changes upstream. last-comment-start and -end
+;;have to be markers, because we preserve them when the changes' end
+;;doesn't overlap with the comment's start.
+
+(defvar caml-last-comment-start nil
+ "A marker caching last determined caml comment start.")
+(make-variable-buffer-local 'caml-last-comment-start)
+
+(defvar caml-last-comment-end nil
+ "A marker caching last determined caml comment end.")
+(make-variable-buffer-local 'caml-last-comment-end)
+
+(make-variable-buffer-local 'before-change-function)
+
+(defun caml-overlap (b1 e1 b2 e2)
+ (<= (max b1 b2) (min e1 e2)))
+
+;this clears the last comment cache if necessary
+(defun caml-before-change-function (begin end)
+ (if (and caml-last-noncomment-pos
+ (> caml-last-noncomment-pos begin))
+ (setq caml-last-noncomment-pos nil))
+ (if (and (marker-position caml-last-comment-start)
+ (marker-position caml-last-comment-end)
+ (caml-overlap begin end
+ caml-last-comment-start
+ caml-last-comment-end))
+ (prog2
+ (set-marker caml-last-comment-start nil)
+ (set-marker caml-last-comment-end nil)))
+ (let ((orig-function (default-value 'before-change-function)))
+ (if orig-function (funcall orig-function begin end))))
+
+(defun caml-in-literal-p ()
+ "Returns non-nil if point is inside a caml literal."
+ (let* ((start-literal (concat "[\"" caml-quote-char "]"))
+ (char-literal
+ (concat "\\([^\\]\\|\\\\\\.\\|\\\\[0-9][0-9][0-9]\\)"
+ caml-quote-char))
+ (pos (point))
+ (eol (progn (end-of-line 1) (point)))
+ state in-str)
+ (beginning-of-line 1)
+ (while (and (not state)
+ (re-search-forward start-literal eol t)
+ (<= (point) pos))
+ (cond
+ ((string= (caml-match-string 0) "\"")
+ (setq in-str t)
+ (while (and in-str (not state)
+ (re-search-forward "\"\\|\\\\\"" eol t))
+ (if (> (point) pos) (setq state t))
+ (if (string= (caml-match-string 0) "\"") (setq in-str nil)))
+ (if in-str (setq state t)))
+ ((looking-at char-literal)
+ (if (and (>= pos (match-beginning 0)) (< pos (match-end 0)))
+ (setq state t)
+ (goto-char (match-end 0))))))
+ (goto-char pos)
+ state))
+
+(defun caml-forward-list-safe ()
+ (condition-case nil
+ (forward-list 1)
+ (error (goto-char (point-max)))))
+
+
+
+(defun caml-in-comment-p ()
+ "Returns non-nil if point is inside a caml comment."
+ ;;we look for comments differently than literals. there are two
+ ;;reasons for this. first, caml has nested comments and it is not so
+ ;;clear that parse-partial-sexp supports them; second, if proper
+ ;;style is used, literals are never split across lines, so we don't
+ ;;have to worry about bogus phrase breaks inside literals, while we
+ ;;have to account for that possibility in comments.
+ (save-excursion
+ (let* ((cached-pos caml-last-noncomment-pos)
+ (cached-begin (marker-position caml-last-comment-start))
+ (cached-end (marker-position caml-last-comment-end)))
+ (cond
+ ((and cached-begin cached-end
+ (< cached-begin (point)) (< (point) cached-end)) t)
+ ((and cached-pos (= cached-pos (point))) nil)
+ ((and cached-pos (< cached-pos (point)))
+ (let ((inside) (done nil) (here (point)))
+ (goto-char cached-pos)
+ (while (not done)
+ (setq inside nil)
+ (if (not (search-forward "(*" (1+ here) 'move))
+ (setq here 0)
+ (goto-char (match-beginning 0))
+ (setq inside (point))
+ (caml-forward-list-safe))
+ (setq done (< here (point))))
+ (if (not inside)
+ (setq caml-last-noncomment-pos here)
+ (set-marker caml-last-comment-start inside)
+ (set-marker caml-last-comment-end (point)))
+ inside))
+ (cached-pos
+ (let ((inside) (done nil) (here (point)))
+ (goto-char cached-pos)
+ (while (not done)
+ (setq inside nil)
+ (if (not (search-backward "*)" (1- here) 'move))
+ (setq here (point-max))
+ (goto-char (match-end 0))
+ (setq inside (point))
+ (backward-list 1))
+ (setq done (> here (point))))
+ (if (not inside)
+ (setq caml-last-noncomment-pos here)
+ (set-marker caml-last-comment-start (point))
+ (set-marker caml-last-comment-end inside))
+ inside))
+ (t
+ (let* ((here (point)) (done nil)
+ (limit (- (point) caml-lookback-limit))
+ (begin (condition-case nil
+ (prog2
+ (while (and (not done) (< limit (point)))
+ (up-list -1)
+ (setq done (looking-at comment-start-skip)))
+ (if done (point)))
+ (error nil))))
+ (if (not begin) (setq caml-last-noncomment-pos here)
+ (goto-char begin)
+ (caml-forward-list-safe)
+ (set-marker caml-last-comment-start begin)
+ (set-marker caml-last-comment-end (point)))
+ begin))))))
+
+(defconst caml-before-expr-prefix
+ (concat "\\<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else"
+ "\\|i\\(f\\|n\\(herit\\)?\\)"
+ "\\|f\\(or\\|un\\(ct\\(ion\\|or\\)\\)?\\)"
+ "\\|l\\(and\\|or\\|s[lr]\\|xor\\)\\|m\\(atch\\|od\\)"
+ "\\|o[fr]\\|parser\\|s\\(ig\\|truct\\)\\|t\\(hen\\|o\\|ry\\)"
+ "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>\\|:begin\\>"
+ "\\|[=<>@^|&+-*/$%][!$%*+-./:<=>?@^|~]*\\|:[:=]\\|[[({,;]")
+
+ "Keywords that may appear immediately before an expression.
+Used to distinguish it from toplevel let construct.")
+
+(defun caml-in-expr-p ()
+ (let ((pos (point)) (in-expr t))
+ (caml-find-kwop
+ (concat caml-before-expr-prefix "\\|"
+ caml-matching-kw-regexp "\\|"
+ (aref caml-kwop-regexps caml-max-indent-priority)))
+ (cond ((looking-at caml-before-expr-prefix)
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t\n")
+ (while (looking-at "(\\*")
+ (forward-sexp 1)
+ (skip-chars-forward " \t\n"))
+ (if (<= pos (point)) (setq in-expr nil))))
+ (goto-char pos)
+ in-expr))
+
+(defun caml-at-top-let-p ()
+ (and (looking-at "\\<let\\>")
+ (or (bolp)
+ (caml-in-expr-p))))
+
+
+(defun caml-at-sexp-close-p ()
+ (or (char-equal ?\) (following-char))
+ (char-equal ?\] (following-char))
+ (char-equal ?} (following-char))))
+
+(defun caml-find-kwop (kwop-regexp)
+ "Look back for a caml keyword or operator matching KWOP-REGEXP.
+
+Ignore occurences inside literals. If found, return a list of two
+values: the actual text of the keyword or operator, and a boolean
+indicating whether the keyword was one we looked for explicitly
+{non-nil}, or on the other hand one of the block-terminating
+keywords."
+
+ (let ((start-literal (concat "[\"" caml-quote-char "]"))
+ found kwop)
+ (progn
+ (while (and (not found)
+ (re-search-backward kwop-regexp nil t))
+ (setq kwop (caml-match-string 0))
+ (cond
+ ((caml-in-comment-p)
+ (up-list -1))
+ ((looking-at "(\\*")
+ (backward-char))
+ ((looking-at start-literal))
+ ((caml-in-literal-p)
+ (re-search-backward start-literal)) ;ugly hack
+ ((setq found t)))))
+ (if found
+ (if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!!
+ kwop
+ (forward-char 1) "|") nil)))
+
+; Association list of indentation values based on governing keywords.
+;
+;Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
+;non-nil for operator-type nodes, which affect indentation in a
+;different way from keywords: subsequent lines are indented to the
+;actual occurrence of an operator, but relative to the indentation of
+;the line where the governing keyword occurs.
+
+(defconst caml-no-indent 0)
+
+(defconst caml-kwop-alist
+ '(("begin" nil 6 caml-begin-indent)
+ (":begin" nil 6 caml-begin-indent) ; hack
+ ("class" nil 0 caml-class-indent)
+ ("constraint" nil 0 caml-val-indent)
+ ("sig" nil 1 caml-sig-indent)
+ ("struct" nil 1 caml-struct-indent)
+ ("exception" nil 0 caml-exception-indent)
+ ("for" nil 6 caml-for-indent)
+ ("fun" nil 3 caml-fun-indent)
+ ("function" nil 3 caml-function-indent)
+ ("if" nil 6 caml-if-indent)
+ ("if-else" nil 6 caml-if-else-indent)
+ ("include" nil 0 caml-include-indent)
+ ("inherit" nil 0 caml-inherit-indent)
+ ("let" nil 6 caml-let-indent)
+ ("let-in" nil 6 caml-let-in-indent)
+ ("match" nil 6 caml-match-indent)
+ ("method" nil 0 caml-method-indent)
+ ("module" nil 0 caml-module-indent)
+ ("of" nil 7 caml-of-indent)
+ ("open" nil 0 caml-no-indent)
+ ("parser" nil 3 caml-parser-indent)
+ ("try" nil 6 caml-try-indent)
+ ("type" nil 0 caml-type-indent)
+ ("val" nil 0 caml-val-indent)
+ ("virtual" nil 0 caml-val-indent)
+ ("while" nil 6 caml-while-indent)
+ ("::" t 5 caml-::-indent)
+ ("@" t 4 caml-@-indent)
+ ("^" t 4 caml-@-indent)
+ (":=" nil 3 caml-:=-indent)
+ ("<-" nil 3 caml-<--indent)
+ ("->" nil 2 caml-->-indent)
+ ("\[" t 8 caml-lb-indent)
+ ("{" t 8 caml-lc-indent)
+ ("\(" t 8 caml-lp-indent)
+ ("|" nil 2 caml-no-indent))
+; if-else and let-in are not keywords but idioms
+; "|" is not in the regexps
+; all these 3 values correspond to hard-coded names
+
+"Association list of indentation values based on governing keywords.
+
+Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is
+non-nil for operator-type nodes, which affect indentation in a
+different way from keywords: subsequent lines are indented to the
+actual occurrence of an operator, but relative to the indentation of
+the line where the governing keyword occurs.")
+
+;;Originally, we had caml-kwop-regexp create these at runtime, from an
+;;additional field in caml-kwop-alist. That proved way too slow,
+;;although I still can't understand why. itz
+
+(defconst caml-kwop-regexps (make-vector 9 nil)
+ "Array of regexps representing caml keywords of different priorities.")
+
+(aset caml-kwop-regexps 0
+ (concat
+ "\\<\\(begin\\|class\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\>"
+ "\\|:begin\\>\\|[[({]"))
+(aset caml-kwop-regexps 1
+ (concat (aref caml-kwop-regexps 0) "\\|\\<module\\>"))
+(aset caml-kwop-regexps 2
+ (concat
+ (aref caml-kwop-regexps 1)
+ "\\|\\<\\(fun\\(ction\\)?\\|let\\|m\\(atch\\|ethod\\)"
+ "\\|parser\\|try\\|val\\)\\>\\|->"))
+(aset caml-kwop-regexps 3
+ (concat (aref caml-kwop-regexps 2) "\\|\\<if\\>"))
+(aset caml-kwop-regexps 4
+ (concat (aref caml-kwop-regexps 3) "\\|:=\\|<-"))
+(aset caml-kwop-regexps 5
+ (concat (aref caml-kwop-regexps 4) "\\|@"))
+(aset caml-kwop-regexps 6
+ (concat (aref caml-kwop-regexps 5) "\\|::\\|\\^"))
+(aset caml-kwop-regexps 7
+ (concat
+ (aref caml-kwop-regexps 0)
+ "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
+ "\\|o\\(f\\|pen\\)\\|type\\|v\\(al\\|irtual\\)\\)\\>"))
+(aset caml-kwop-regexps 8
+ (concat (aref caml-kwop-regexps 6)
+ "\\|\\<\\(constraint\\|exception\\|in\\(herit\\|clude\\)"
+ "\\|o\\(f\\|pen\\)\\|type\\|virtual\\)\\>"))
+
+(defun caml-find-done-match ()
+ (let ((unbalanced 1) (kwop t))
+ (while (and (not (= 0 unbalanced)) kwop)
+ (setq kwop (caml-find-kwop "\\<\\(done\\|for\\|while\\)\\>"))
+ (cond
+ ((not kwop))
+ ((string= kwop "done") (setq unbalanced (1+ unbalanced)))
+ (t (setq unbalanced (1- unbalanced)))))
+ kwop))
+
+(defun caml-find-end-match ()
+ (let ((unbalanced 1) (kwop t))
+ (while (and (not (= 0 unbalanced)) kwop)
+ (setq kwop
+ (caml-find-kwop
+ "\\<\\(end\\|begin\\|class\\|s\\(ig\\|truct\\)\\)\\>\\|:begin\\>"))
+ (cond
+ ((not kwop))
+ ((string= kwop "end") (setq unbalanced (1+ unbalanced)))
+ ( t (setq unbalanced (1- unbalanced)))))
+ (if (string= kwop ":begin") "begin"
+ kwop)))
+
+(defun caml-find-in-match ()
+ (let ((unbalanced 1) (kwop t))
+ (while (and (not (= 0 unbalanced)) kwop)
+ (setq kwop (caml-find-kwop "\\<\\(in\\|let\\)\\>"))
+ (cond
+ ((not kwop))
+ ((string= kwop "in") (setq unbalanced (1+ unbalanced)))
+ ( t (setq unbalanced (1- unbalanced)))))
+ kwop))
+
+(defun caml-find-with-match ()
+ (let ((unbalanced 1) (kwop t))
+ (while (and (not (= 0 unbalanced)) kwop)
+ (setq kwop (caml-find-kwop "\\<\\(with\\|try\\|match\\)\\>"))
+ (cond
+ ((not kwop))
+ ((string= kwop "with") (setq unbalanced (1+ unbalanced)))
+ ( t (setq unbalanced (1- unbalanced)))))
+ kwop))
+
+(defun caml-find-then-match (&optional from-else)
+ (let ((bol (if from-else
+ (save-excursion
+ (progn (beginning-of-line) (point)))))
+ kwop done matching-fun)
+ (while (not done)
+ (setq kwop (caml-find-kwop
+ "\\<\\(e\\(nd\\|lse\\)\\|done\\|then\\|if\\)\\>\\|[])};]"))
+ (cond
+ ((not kwop) (setq done t))
+ ((caml-at-sexp-close-p)
+ (forward-char 1)
+ (backward-list 1))
+ ((string= kwop "if") (setq done t))
+ ((string= kwop "then")
+ (if (not from-else) (setq kwop (caml-find-then-match))))
+ ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist)))
+ (setq kwop (funcall matching-fun)))
+ ((string= kwop "then")
+ (if (not from-else) (setq kwop (caml-find-then-match))))))
+ (if (and bol (>= (point) bol))
+ "if-else"
+ kwop)))
+
+(defun caml-find-pipe-match ()
+ (let ((done nil) (kwop)
+ (re (concat
+ "\\<\\(try\\|match\\|with\\|function\\|type"
+ "\\|e\\(nd\\|lse\\)\\|done\\|then\\|in\\)\\>"
+ "\\|[^[|]|\\|[])}]")))
+ (while (not done)
+ (setq kwop (caml-find-kwop re))
+ (cond
+ ((not kwop) (setq done t))
+ ((looking-at "[^[|]\\(|\\)")
+ (goto-char (match-beginning 1))
+ (setq kwop "|")
+ (setq done t))
+ ((caml-at-sexp-close-p)
+ (forward-char 1)
+ (backward-list 1))
+ ((string= kwop "with")
+ (setq kwop (caml-find-with-match))
+ (setq done t))
+ ((string= kwop "done") (caml-find-done-match))
+ ((string= kwop "end") (caml-find-end-match))
+ ((string= kwop "then") (caml-find-then-match))
+ ((string= kwop "else") (caml-find-else-match))
+ ((string= kwop "in") (caml-find-in-match))
+ (t (setq done t))))
+ kwop))
+
+(defun caml-find-and-match ()
+ (let ((done nil) (kwop))
+ (while (not done)
+ (setq kwop (caml-find-kwop
+ "\\<\\(class\\|exception\\|let\\|type\\|end\\|in\\)\\>"))
+ (cond
+ ((not kwop) (setq done t))
+ ((string= kwop "end") (caml-find-end-match))
+ ((string= kwop "in") (caml-find-in-match))
+ (t (setq done t))))
+ kwop))
+
+(defun caml-find-else-match ()
+ (caml-find-then-match t))
+
+(defun caml-find-semi-match ()
+ (caml-find-kwop-skipping-blocks 2))
+
+(defun caml-find-comma-match ()
+ (caml-find-kwop-skipping-blocks 3))
+
+(defconst caml-matching-kw-regexp
+ (concat
+ "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)"
+ "\\|with\\)\\>\\|[^[|]|")
+ "Regexp used in caml mode for skipping back over nested blocks.")
+
+(defconst caml-matching-kw-alist
+ '(("|" . caml-find-pipe-match)
+ (";" . caml-find-semi-match)
+ ("," . caml-find-comma-match)
+ ("end" . caml-find-end-match)
+ ("done" . caml-find-done-match)
+ ("in" . caml-find-in-match)
+ ("with" . caml-find-with-match)
+ ("else" . caml-find-else-match)
+ ("then" . caml-find-then-match)
+ ("to" . caml-find-done-match)
+ ("do" . caml-find-done-match)
+ ("and" . caml-find-and-match))
+
+ "Association list used in caml mode for skipping back over nested blocks.")
+
+(defun caml-find-kwop-skipping-blocks (prio)
+ "Look back for a caml keyword matching caml-kwop-regexps [PRIO].
+
+ Skip nested blocks."
+
+ (let ((done nil) (kwop nil) (matching-fun)
+ (kwop-list (aref caml-kwop-regexps prio)))
+ (while (not done)
+ (setq kwop (caml-find-kwop
+ (concat caml-matching-kw-regexp
+ (cond ((> prio 3) "\\|[])},;]\\|")
+ ((> prio 2) "\\|[])};]\\|")
+ (t "\\|[])}]\\|"))
+ kwop-list)))
+ (cond
+ ((not kwop) (setq done t))
+ ((caml-at-sexp-close-p)
+ (forward-char 1)
+ (backward-list 1))
+ ((and (>= prio 2) (string= kwop "|")) (setq done t))
+ ((string= kwop "end") (caml-find-end-match))
+ ((string= kwop "done") (caml-find-done-match))
+ ((string= kwop "in")
+ (cond ((and (caml-find-in-match) (>= prio 2))
+ (setq kwop "let-in")
+ (setq done t))))
+ ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist)))
+ (setq kwop (funcall matching-fun))
+ (if (looking-at kwop-list) (setq done t)))
+ (t (let* ((kwop-info (assoc kwop caml-kwop-alist))
+ (is-op (nth 1 kwop-info)))
+ (if (and is-op (looking-at
+ (concat (regexp-quote kwop)
+ "|?[ \t]*\\(\n\\|(\\*\\)")))
+ (setq kwop-list
+ (aref caml-kwop-regexps (nth 2 kwop-info)))
+ (setq done t))))))
+ kwop))
+
+(defun caml-compute-basic-indent (prio)
+ "Compute indent of current caml line, ignoring leading keywords.
+
+Find the `governing node' for current line. Compute desired
+indentation based on the node and the indentation alists.
+Assumes point is exactly at line indentation.
+Does not preserve point."
+
+ (let* (in-expr
+ (kwop (cond
+ ((looking-at "|\\([^]|]\\|\\'\\)")
+ (caml-find-pipe-match))
+ ((caml-at-top-let-p)
+ (caml-find-kwop-skipping-blocks 0))
+ ((and (looking-at caml-matching-kw-regexp)
+ (assoc (caml-match-string 0) caml-matching-kw-alist))
+ (funcall (cdr-safe (assoc (caml-match-string 0)
+ caml-matching-kw-alist))))
+ ((looking-at
+ (aref caml-kwop-regexps caml-max-indent-priority))
+ (let* ((kwop (caml-match-string 0))
+ (kwop-info (assoc kwop caml-kwop-alist))
+ (is-op (if kwop-info (nth 1 kwop-info)))
+ (prio (if kwop-info (nth 2 kwop-info)
+ caml-max-indent-priority)))
+ (if (and (looking-at (aref caml-kwop-regexps 0))
+ (caml-in-expr-p))
+ (setq in-expr t))
+ (caml-find-kwop-skipping-blocks prio)))
+ (t
+ (if (and (= prio caml-max-indent-priority) (caml-in-expr-p))
+ (setq in-expr t))
+ (caml-find-kwop-skipping-blocks prio))))
+ (kwop-info (assoc kwop caml-kwop-alist))
+ (indent-diff
+ (cond
+ ((not kwop-info) (beginning-of-line 1) 0)
+ ((nth 1 kwop-info) (symbol-value (nth 3 kwop-info)))
+ (t (back-to-indentation)
+ (let* ((indent (symbol-value (nth 3 kwop-info)))
+ (kwop-extra
+ (if (looking-at "|")
+ (assoc (caml-match-string 0)
+ caml-leading-kwops-alist))))
+ (if kwop-extra
+ (- indent (symbol-value (nth 1 kwop-extra)))
+ indent)))))
+ (extra (if in-expr caml-apply-extra-indent 0)))
+ (+ indent-diff extra (current-column))))
+
+(defconst caml-leading-kwops-regexp
+ (concat
+ "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in"
+ "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|}]")
+
+ "Regexp matching caml keywords which need special indentation.")
+
+(defconst caml-leading-kwops-alist
+ '(("and" caml-and-extra-indent 2)
+ ("do" caml-do-extra-indent 0)
+ ("done" caml-done-extra-indent 0)
+ ("else" caml-else-extra-indent 3)
+ ("end" caml-end-extra-indent 0)
+ ("in" caml-in-extra-indent 2)
+ ("then" caml-then-extra-indent 3)
+ ("to" caml-to-extra-indent 0)
+ ("with" caml-with-extra-indent 2)
+ ("|" caml-|-extra-indent 2)
+ ("]" caml-rb-extra-indent 0)
+ ("}" caml-rc-extra-indent 0))
+
+ "Association list of special caml keyword indent values.
+
+Each member is of the form (KEYWORD EXTRA-INDENT PRIO) where
+EXTRA-INDENT is the variable holding extra indentation amount for
+KEYWORD (usually negative) and PRIO is upper bound on priority of
+matching nodes to determine KEYWORD's final indentation.")
+
+(defun caml-compute-final-indent ()
+ (save-excursion
+ (back-to-indentation)
+ (cond
+ ((looking-at comment-start-skip)
+ (current-column))
+ ((caml-in-comment-p)
+ (let ((done nil))
+ (while (not done)
+ (up-list -1)
+ (setq done (not (caml-in-comment-p))))
+ (looking-at comment-start-skip)
+ (goto-char (match-end 0))
+ (current-column)))
+ ((caml-at-phrase-start-p) 0)
+ (t (let* ((leading (looking-at caml-leading-kwops-regexp))
+ (assoc-val (if leading (assoc (caml-match-string 0)
+ caml-leading-kwops-alist)))
+ (extra (if leading (symbol-value (nth 1 assoc-val)) 0))
+ (prio (if leading (nth 2 assoc-val)
+ caml-max-indent-priority))
+ (basic (caml-compute-basic-indent prio)))
+ (max 0 (if extra (+ extra basic) (current-column))))))))
+
+
+
+(defun caml-split-string ()
+ "Called whenever a line is broken inside a caml string literal."
+ (insert-before-markers "\"^\"")
+ (backward-char 1))
+
+(defadvice indent-new-comment-line (around
+ caml-indent-new-comment-line
+ activate)
+
+ "Handle multi-line strings in caml mode."
+
+;this advice doesn't make sense in other modes. I wish there were a
+;cleaner way to do this: I haven't found one.
+
+ (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p)))
+ (split-mark))
+ (if (not hooked) nil
+ (setq split-mark (set-marker (make-marker) (point)))
+ (caml-split-string))
+ ad-do-it
+ (if (not hooked) nil
+ (goto-char split-mark)
+ (set-marker split-mark nil))))
+
+(defadvice newline-and-indent (around
+ caml-newline-and-indent
+ activate)
+
+ "Handle multi-line strings in caml mode."
+
+ (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p)))
+ (split-mark))
+ (if (not hooked) nil
+ (setq split-mark (set-marker (make-marker) (point)))
+ (caml-split-string))
+ ad-do-it
+ (if (not hooked) nil
+ (goto-char split-mark)
+ (set-marker split-mark nil))))
+
+(defun caml-electric-pipe ()
+ "If inserting a | or } operator at beginning of line, reindent the line.
+
+Unfortunately there is a situation where this mechanism gets
+confused. It's when | is the first character of a |] sequence. This is
+a misfeature of caml syntax and cannot be fixed, however, as a
+workaround, the electric ] inserts | itself if the matching [ is
+followed by |."
+
+ (interactive "*")
+ (let ((electric (and caml-electric-indent
+ (caml-in-indentation)
+ (not (caml-in-comment-p)))))
+ (self-insert-command 1)
+ (if electric
+ (let ((indent
+ (save-excursion
+ (backward-char 1)
+ (caml-indent-command)
+ (current-column))))
+ (indent-to (- indent
+ (symbol-value
+ (nth 1 (assoc
+ (char-to-string last-command-char)
+ caml-leading-kwops-alist)))))))))
+
+(defun caml-electric-rb ()
+ "If inserting a ] operator at beginning of line, reindent the line.
+
+Also, if the matching [ is followed by a | and this ] is not preceded
+by |, insert one."
+
+ (interactive "*")
+ (let* ((prec (preceding-char))
+ (look-pipe (and caml-electric-close-vector
+ (not (caml-in-comment-p))
+ (not (caml-in-literal-p))
+ (or (not (numberp prec))
+ (not (char-equal ?| prec)))
+ (set-marker (make-marker) (point))))
+ (electric (and caml-electric-indent
+ (caml-in-indentation)
+ (not (caml-in-comment-p)))))
+ (self-insert-command 1)
+ (if electric
+ (let ((indent
+ (save-excursion
+ (backward-char 1)
+ (caml-indent-command)
+ (current-column))))
+ (indent-to (- indent
+ (symbol-value
+ (nth 1 (assoc
+ (char-to-string last-command-char)
+ caml-leading-kwops-alist)))))))
+ (if look-pipe
+ (save-excursion
+ (let ((insert-pipe
+ (condition-case nil
+ (prog2
+ (backward-list 1)
+ (if (looking-at "\\[|") "|" ""))
+ (error ""))))
+ (goto-char look-pipe)
+ (insert insert-pipe))
+ (set-marker look-pipe nil)))))
+
+(defun caml-abbrev-hook ()
+ "If inserting a leading keyword at beginning of line, reindent the line."
+ ;itz unfortunately we need a special case
+ (if (and (not (caml-in-comment-p)) (not (= last-command-char ?_)))
+ (let* ((bol (save-excursion (beginning-of-line) (point)))
+ (kw (save-excursion
+ (and (re-search-backward "^[ \t]*\\(\\sw+\\)\\=" bol t)
+ (caml-match-string 1)))))
+ (if kw
+ (let ((indent (save-excursion
+ (goto-char (match-beginning 1))
+ (caml-indent-command)
+ (current-column)))
+ (abbrev-correct (if (= last-command-char ?\ ) 1 0)))
+ (indent-to (- indent
+ (symbol-value
+ (nth 1 (assoc kw caml-leading-kwops-alist)))
+ abbrev-correct)))))))
+
+(defun caml-indent-phrase ()
+ (interactive "*")
+ (let ((bounds (caml-mark-phrase)))
+ (indent-region (car bounds) (cdr bounds) nil)))
+
+(defun caml-backward-to-less-indent (&optional n)
+ "Move cursor back N lines with less or same indentation."
+ (interactive "p")
+ (beginning-of-line 1)
+ (if (< n 0) (caml-forward-to-less-indent (- n))
+ (while (> n 0)
+ (let ((i (current-indentation)))
+ (forward-line -1)
+ (while (or (> (current-indentation) i)
+ (caml-in-comment-p)
+ (looking-at
+ (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
+ (forward-line -1)))
+ (setq n (1- n))))
+ (back-to-indentation))
+
+(defun caml-forward-to-less-indent (&optional n)
+ "Move cursor back N lines with less or same indentation."
+ (interactive "p")
+ (beginning-of-line 1)
+ (if (< n 0) (caml-backward-to-less-indent (- n))
+ (while (> n 0)
+ (let ((i (current-indentation)))
+ (forward-line 1)
+ (while (or (> (current-indentation) i)
+ (caml-in-comment-p)
+ (looking-at
+ (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)")))
+ (forward-line 1)))
+ (setq n (1- n))))
+ (back-to-indentation))
+
+(defun caml-insert-begin-form ()
+ "Inserts a nicely formatted begin-end form, leaving a mark after end."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-begin-indent c)))
+ (insert "begin\n\nend")
+ (push-mark)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)))
+
+(defun caml-insert-for-form ()
+ "Inserts a nicely formatted for-do-done form, leaving a mark after do(ne)."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-for-indent c)))
+ (insert "for do\n\ndone")
+ (push-mark)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)
+ (push-mark)
+ (beginning-of-line 1)
+ (backward-char 4)))
+
+(defun caml-insert-if-form ()
+ "Insert nicely formatted if-then-else form leaving mark after then, else."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-if-indent c)))
+ (insert "if\n\nthen\n\nelse\n")
+ (indent-line-to i)
+ (push-mark)
+ (forward-line -1)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)
+ (push-mark)
+ (forward-line -1)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)))
+
+(defun caml-insert-match-form ()
+ "Insert nicely formatted match-with form leaving mark after with."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-match-indent c)))
+ (insert "match\n\nwith\n")
+ (indent-line-to i)
+ (push-mark)
+ (forward-line -1)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)))
+
+(defun caml-insert-let-form ()
+ "Insert nicely formatted let-in form leaving mark after in."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)))
+ (insert "let in\n")
+ (indent-line-to c)
+ (push-mark)
+ (forward-line -1)
+ (forward-char (+ c 4))))
+
+(defun caml-insert-try-form ()
+ "Insert nicely formatted try-with form leaving mark after with."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-try-indent c)))
+ (insert "try\n\nwith\n")
+ (indent-line-to i)
+ (push-mark)
+ (forward-line -1)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)))
+
+(defun caml-insert-while-form ()
+ "Insert nicely formatted while-do-done form leaving mark after do, done."
+ (interactive "*")
+ (let ((prec (preceding-char)))
+ (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec))))
+ (insert " ")))
+ (let* ((c (current-indentation)) (i (+ caml-if-indent c)))
+ (insert "while do\n\ndone")
+ (push-mark)
+ (indent-line-to c)
+ (forward-line -1)
+ (indent-line-to i)
+ (push-mark)
+ (beginning-of-line 1)
+ (backward-char 4)))
+
+;;; caml.el ends here
+
+(provide 'caml)
diff --git a/camldebug.el b/camldebug.el
new file mode 100644
index 0000000..b74c9a7
--- /dev/null
+++ b/camldebug.el
@@ -0,0 +1,753 @@
+;;; Run camldebug under Emacs
+;;; Derived from gdb.el.
+;;; gdb.el is Copyright (C) 1988 Free Software Foundation, Inc, and is part
+;;; of GNU Emacs
+;;; Modified by Jerome Vouillon, 1994.
+;;; Modified by Ian T. Zimmerman, 1996.
+;;; Modified by Xavier Leroy, 1997.
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;;itz 04-06-96 I pondered basing this on gud. The potential advantages
+;;were: automatic bugfix , keymaps and menus propagation.
+;;Disadvantages: gud is not so clean itself, there is little common
+;;functionality it abstracts (most of the stuff is done in the
+;;debugger specific parts anyway), and, most seriously, gud sees it
+;;fit to add C-x C-a bindings to the _global_ map, so there would be a
+;;conflict between camldebug and gdb, for instance. While it's OK to
+;;assume that a sane person doesn't use gdb and dbx at the same time,
+;;it's not so OK (IMHO) for gdb and camldebug.
+
+;; Xavier Leroy, 21/02/97: adaptation to ocamldebug.
+
+(require 'comint)
+(require 'shell)
+(require 'caml)
+(require 'derived)
+(require 'thingatpt)
+
+;;; Variables.
+
+(defvar camldebug-last-frame)
+(defvar camldebug-delete-prompt-marker)
+(defvar camldebug-filter-accumulator nil)
+(defvar camldebug-last-frame-displayed-p)
+(defvar camldebug-filter-function)
+
+(defvar camldebug-prompt-pattern "^(cdb) *"
+ "A regexp to recognize the prompt for camldebug.")
+
+(defvar camldebug-overlay-event nil
+ "Overlay for displaying the current event.")
+(defvar camldebug-overlay-under nil
+ "Overlay for displaying the current event.")
+(defvar camldebug-event-marker nil
+ "Marker for displaying the current event.")
+
+(defvar camldebug-track-frame t
+ "*If non-nil, always display current frame position in another window.")
+
+(cond
+ (window-system
+ (make-face 'camldebug-event)
+ (make-face 'camldebug-underline)
+ (if (not (face-differs-from-default-p 'camldebug-event))
+ (invert-face 'camldebug-event))
+ (if (not (face-differs-from-default-p 'camldebug-underline))
+ (set-face-underline-p 'camldebug-underline t))
+ (setq camldebug-overlay-event (make-overlay 1 1))
+ (overlay-put camldebug-overlay-event 'face 'camldebug-event)
+ (setq camldebug-overlay-under (make-overlay 1 1))
+ (overlay-put camldebug-overlay-under 'face 'camldebug-underline))
+ (t
+ (setq camldebug-event-marker (make-marker))
+ (setq overlay-arrow-string "=>")))
+
+;;; Camldebug mode.
+
+(define-derived-mode camldebug-mode comint-mode "Inferior CDB"
+
+ "Major mode for interacting with an inferior Camldebug process.
+
+The following commands are available:
+
+\\{camldebug-mode-map}
+
+\\[camldebug-display-frame] displays in the other window
+the last line referred to in the camldebug buffer.
+
+\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the
camldebug window,
+call camldebug to step, backstep or next and then update the other window
+with the current file and position.
+
+If you are in a source file, you may select a point to break
+at, by doing \\[camldebug-break].
+
+Commands:
+Many commands are inherited from comint mode.
+Additionally we have:
+
+\\[camldebug-display-frame] display frames file in other window
+\\[camldebug-step] advance one line in program
+C-x SPACE sets break point at current line."
+
+ (mapcar 'make-local-variable
+ '(camldebug-last-frame-displayed-p camldebug-last-frame
+ camldebug-delete-prompt-marker camldebug-filter-function
+ camldebug-filter-accumulator))
+ (setq
+ camldebug-last-frame nil
+ camldebug-delete-prompt-marker (make-marker)
+ camldebug-filter-accumulator ""
+ camldebug-filter-function 'camldebug-marker-filter
+ comint-prompt-regexp camldebug-prompt-pattern
+ comint-dynamic-complete-functions (cons 'camldebug-complete
+ comint-dynamic-complete-functions)
+ paragraph-start comint-prompt-regexp
+ camldebug-last-frame-displayed-p t)
+ (make-local-variable 'shell-dirtrackp)
+ (setq shell-dirtrackp t)
+ (setq comint-input-sentinel 'shell-directory-tracker))
+
+;;; Keymaps.
+
+(defun camldebug-numeric-arg (arg)
+ (and arg (prefix-numeric-value arg)))
+
+(defmacro def-camldebug (name key &optional doc args)
+
+ "Define camldebug-NAME to be a command sending NAME ARGS and bound
+to KEY, with optional doc string DOC. Certain %-escapes in ARGS are
+interpreted specially if present. These are:
+
+ %m module name of current module.
+ %d directory of current source file.
+ %c number of current character position
+ %e text of the caml variable surrounding point.
+
+ The `current' source file is the file of the current buffer (if
+we're in a caml buffer) or the source file current at the last break
+or step (if we're in the camldebug buffer), and the `current' module
+name is the filename stripped of any *.ml* suffixes (this assumes the
+usual correspondence between module and file naming is observed). The
+`current' position is that of the current buffer (if we're in a source
+file) or the position of the last break or step (if we're in the
+camldebug buffer).
+
+If a numeric is present, it overrides any ARGS flags and its string
+representation is simply concatenated with the COMMAND."
+
+ (let* ((fun (intern (format "camldebug-%s" name))))
+ (list 'progn
+ (if doc
+ (list 'defun fun '(arg)
+ doc
+ '(interactive "P")
+ (list 'camldebug-call name args
+ '(camldebug-numeric-arg arg))))
+ (list 'define-key 'camldebug-mode-map
+ (concat "\C-c" key)
+ (list 'quote fun))
+ (list 'define-key 'caml-mode-map
+ (concat "\C-x\C-a" key)
+ (list 'quote fun)))))
+
+(def-camldebug "step" "\C-s" "Step one source line with display.")
+(def-camldebug "run" "\C-r" "Run the program.")
+(def-camldebug "reverse" "\C-v" "Run the program in reverse.")
+(def-camldebug "last" "\C-l" "Go to latest time in execution history.")
+(def-camldebug "backtrace" "\C-t" "Print the call stack.")
+(def-camldebug "finish" "\C-f" "Finish executing current function.")
+(def-camldebug "print" "\C-p" "Print value of symbol at point." "%e")
+(def-camldebug "display" "\C-d" "Display value of symbol at point."
"%e")
+(def-camldebug "next" "\C-n" "Step one source line (skip functions)")
+(def-camldebug "up" "<" "Go up N stack frames (numeric arg) with display")
+(def-camldebug "down" ">" "Go down N stack frames (numeric arg) with display")
+(def-camldebug "break" "\C-b" "Set breakpoint at current line."
+ "@ \"%m\" # %c")
+
+(defun camldebug-mouse-display (click)
+ "Display value of symbol clicked on."
+ (interactive "e")
+ (let* ((start (event-start click))
+ (window (car start))
+ (pos (car (cdr start))))
+ (save-excursion
+ (select-window window)
+ (goto-char pos)
+ (camldebug-call "display" "%e"))))
+
+(define-key camldebug-mode-map [mouse-2] 'camldebug-mouse-display)
+
+(defun camldebug-kill-filter (string)
+ ;gob up stupid questions :-)
+ (setq camldebug-filter-accumulator
+ (concat camldebug-filter-accumulator string))
+ (if (not (string-match "\\(.* \\)(y or n) "
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-kill-output
+ (cons t (match-string 1 camldebug-filter-accumulator)))
+ (setq camldebug-filter-accumulator ""))
+ (if (string-match comint-prompt-regexp camldebug-filter-accumulator)
+ (let ((output (substring camldebug-filter-accumulator
+ (match-beginning 0))))
+ (setq camldebug-kill-output
+ (cons nil (substring camldebug-filter-accumulator 0
+ (1- (match-beginning 0)))))
+ (setq camldebug-filter-accumulator "")
+ output)
+ ""))
+
+(def-camldebug "kill" "\C-k")
+
+(defun camldebug-kill ()
+ "Kill the program."
+ (interactive)
+ (let ((camldebug-kill-output))
+ (save-excursion
+ (set-buffer current-camldebug-buffer)
+ (let ((proc (get-buffer-process (current-buffer)))
+ (camldebug-filter-function 'camldebug-kill-filter))
+ (camldebug-call "kill")
+ (while (not (and camldebug-kill-output
+ (zerop (length camldebug-filter-accumulator))))
+ (accept-process-output proc))))
+ (if (not (car camldebug-kill-output))
+ (error (cdr camldebug-kill-output))
+ (sit-for 0 300)
+ (camldebug-call-1 (if (y-or-n-p (cdr camldebug-kill-output)) "y" "n")))))
+;;FIXME: camldebug doesn't output the Hide marker on kill
+
+(defun camldebug-goto-filter (string)
+ ;accumulate onto previous output
+ (setq camldebug-filter-accumulator
+ (concat camldebug-filter-accumulator string))
+ (if (not (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+"
+ camldebug-goto-position
+ "[ \t]*\\(before\\|after\\)\n")
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-goto-output
+ (match-string 2 camldebug-filter-accumulator))
+ (setq camldebug-filter-accumulator
+ (substring camldebug-filter-accumulator (1- (match-end 0)))))
+ (if (not (string-match comint-prompt-regexp
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-goto-output (or camldebug-goto-output 'fail))
+ (setq camldebug-filter-accumulator ""))
+ (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
+ (setq camldebug-filter-accumulator
+ (match-string 1 camldebug-filter-accumulator)))
+ "")
+
+(def-camldebug "goto" "\C-g")
+(defun camldebug-goto (&optional time)
+
+ "Go to the execution time TIME.
+
+Without TIME, the command behaves as follows: In the camldebug buffer,
+if the point at buffer end, goto time 0\; otherwise, try to obtain the
+time from context around point. In a caml mode buffer, try to find the
+time associated in execution history with the current point location.
+
+With a negative TIME, move that many lines backward in the camldebug
+buffer, then try to obtain the time from context around point."
+
+ (interactive "P")
+ (cond
+ (time
+ (let ((ntime (camldebug-numeric-arg time)))
+ (if (>= ntime 0) (camldebug-call "goto" nil ntime)
+ (save-selected-window
+ (select-window (get-buffer-window current-camldebug-buffer))
+ (save-excursion
+ (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ "
+ nil t (- 1 ntime))
+ (camldebug-goto nil)
+ (error "I don't have %d times in my history"
+ (- 1 ntime))))))))
+ ((eq (current-buffer) current-camldebug-buffer)
+ (let ((time (cond
+ ((eobp) 0)
+ ((save-excursion
+ (beginning-of-line 1)
+ (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ "))
+ (string-to-int (match-string 1)))
+ ((string-to-int (camldebug-format-command "%e"))))))
+ (camldebug-call "goto" nil time)))
+ (t
+ (let ((module (camldebug-module-name (buffer-file-name)))
+ (camldebug-goto-position (int-to-string (1- (point))))
+ (camldebug-goto-output) (address))
+ ;get a list of all events in the current module
+ (save-excursion
+ (set-buffer current-camldebug-buffer)
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (camldebug-filter-function 'camldebug-goto-filter))
+ (camldebug-call-1 (concat "info events " module))
+ (while (not (and camldebug-goto-output
+ (zerop (length camldebug-filter-accumulator))))
+ (accept-process-output proc))
+ (setq address (if (eq camldebug-goto-output 'fail) nil
+ (re-search-backward
+ (concat "^Time : \\([0-9]+\\) - pc : "
+ camldebug-goto-output
+ " - module "
+ module "$") nil t)
+ (match-string 1)))))
+ (if address (camldebug-call "goto" nil (string-to-int address))
+ (error "No time at %s at %s" module camldebug-goto-position))))))
+
+
+(defun camldebug-delete-filter (string)
+ (setq camldebug-filter-accumulator
+ (concat camldebug-filter-accumulator string))
+ (if (not (string-match
+ (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in "
+ (regexp-quote camldebug-delete-file)
+ ", character "
+ camldebug-delete-position "\n")
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-delete-output
+ (match-string 2 camldebug-filter-accumulator))
+ (setq camldebug-filter-accumulator
+ (substring camldebug-filter-accumulator (1- (match-end 0)))))
+ (if (not (string-match comint-prompt-regexp
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-delete-output (or camldebug-delete-output 'fail))
+ (setq camldebug-filter-accumulator ""))
+ (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
+ (setq camldebug-filter-accumulator
+ (match-string 1 camldebug-filter-accumulator)))
+ "")
+
+
+(def-camldebug "delete" "\C-d")
+
+(defun camldebug-delete (&optional arg)
+ "Delete the breakpoint numbered ARG.
+
+Without ARG, the command behaves as follows: In the camldebug buffer,
+try to obtain the time from context around point. In a caml mode
+buffer, try to find the breakpoint associated with the current point
+location.
+
+With a negative ARG, look for the -ARGth breakpoint pattern in the
+camldebug buffer, then try to obtain the breakpoint info from context
+around point."
+
+ (interactive "P")
+ (cond
+ (arg
+ (let ((narg (camldebug-numeric-arg arg)))
+ (if (> narg 0) (camldebug-call "delete" nil narg)
+ (save-excursion
+ (set-buffer current-camldebug-buffer)
+ (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file "
+ nil t (- 1 narg))
+ (camldebug-delete nil)
+ (error "I don't have %d breakpoints in my history"
+ (- 1 narg)))))))
+ ((eq (current-buffer) current-camldebug-buffer)
+ (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ")
+ (arg (cond
+ ((eobp)
+ (save-excursion (re-search-backward bpline nil t))
+ (string-to-int (match-string 1)))
+ ((save-excursion
+ (beginning-of-line 1)
+ (looking-at bpline))
+ (string-to-int (match-string 1)))
+ ((string-to-int (camldebug-format-command "%e"))))))
+ (camldebug-call "delete" nil arg)))
+ (t
+ (let ((camldebug-delete-file
+ (concat (camldebug-format-command "%m") ".ml"))
+ (camldebug-delete-position (camldebug-format-command "%c")))
+ (save-excursion
+ (set-buffer current-camldebug-buffer)
+ (let ((proc (get-buffer-process (current-buffer)))
+ (camldebug-filter-function 'camldebug-delete-filter)
+ (camldebug-delete-output))
+ (camldebug-call-1 "info break")
+ (while (not (and camldebug-delete-output
+ (zerop (length
+ camldebug-filter-accumulator))))
+ (accept-process-output proc))
+ (if (eq camldebug-delete-output 'fail)
+ (error "No breakpoint in %s at %s"
+ camldebug-delete-file
+ camldebug-delete-position)
+ (camldebug-call "delete" nil
+ (string-to-int camldebug-delete-output)))))))))
+
+(defun camldebug-complete-filter (string)
+ (setq camldebug-filter-accumulator
+ (concat camldebug-filter-accumulator string))
+ (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n"
+ camldebug-filter-accumulator)
+ (setq camldebug-complete-list
+ (cons (match-string 2 camldebug-filter-accumulator)
+ camldebug-complete-list))
+ (setq camldebug-filter-accumulator
+ (substring camldebug-filter-accumulator
+ (1- (match-end 0)))))
+ (if (not (string-match comint-prompt-regexp
+ camldebug-filter-accumulator)) nil
+ (setq camldebug-complete-list
+ (or camldebug-complete-list 'fail))
+ (setq camldebug-filter-accumulator ""))
+ (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
+ (setq camldebug-filter-accumulator
+ (match-string 1 camldebug-filter-accumulator)))
+ "")
+
+(defun camldebug-complete ()
+
+ "Perform completion on the camldebug command preceding point."
+
+ (interactive)
+ (let* ((end (point))
+ (command (save-excursion
+ (beginning-of-line)
+ (and (looking-at comint-prompt-regexp)
+ (goto-char (match-end 0)))
+ (buffer-substring (point) end)))
+ (camldebug-complete-list nil) (command-word))
+
+ ;; Find the word break. This match will always succeed.
+ (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
+ (setq command-word (match-string 2 command))
+
+ ;itz 04-21-96 if we are trying to complete a word of nonzero
+ ;length, chop off the last character. This is a nasty hack, but it
+ ;works - in general, not just for this set of words: the comint
+ ;call below will weed out false matches - and it avoids further
+ ;mucking with camldebug's lexer.
+ (if (> (length command-word) 0)
+ (setq command (substring command 0 (1- (length command)))))
+
+ (let ((camldebug-filter-function 'camldebug-complete-filter))
+ (camldebug-call-1 (concat "complete " command))
+ (set-marker camldebug-delete-prompt-marker nil)
+ (while (not (and camldebug-complete-list
+ (zerop (length camldebug-filter-accumulator))))
+ (accept-process-output (get-buffer-process
+ (current-buffer)))))
+ (if (eq camldebug-complete-list 'fail)
+ (setq camldebug-complete-list nil))
+ (setq camldebug-complete-list
+ (sort camldebug-complete-list 'string-lessp))
+ (comint-dynamic-simple-complete command-word camldebug-complete-list)))
+
+(define-key camldebug-mode-map "\C-l" 'camldebug-refresh)
+(define-key camldebug-mode-map "\t" 'comint-dynamic-complete)
+(define-key camldebug-mode-map "\M-?" 'comint-dynamic-list-completions)
+
+(define-key caml-mode-map "\C-x " 'camldebug-break)
+
+
+(defvar current-camldebug-buffer nil)
+
+
+;;;###autoload
+(defvar camldebug-command-name "ocamldebug"
+ "Pathname for executing camldebug.")
+
+;;;###autoload
+(defun camldebug (path)
+ "Run camldebug on program FILE in buffer *camldebug-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for camldebug. If you wish to change this, use
+the camldebug commands `cd DIR' and `directory'."
+ (interactive "fRun camldebug on file: ")
+ (setq path (expand-file-name path))
+ (let ((file (file-name-nondirectory path)))
+ (pop-to-buffer (concat "*camldebug-" file "*"))
+ (setq default-directory (file-name-directory path))
+ (message "Current directory is %s" default-directory)
+ (make-comint (concat "camldebug-" file)
+ (substitute-in-file-name camldebug-command-name)
+ nil
+ "-emacs" "-cd" default-directory file)
+ (set-process-filter (get-buffer-process (current-buffer))
+ 'camldebug-filter)
+ (set-process-sentinel (get-buffer-process (current-buffer))
+ 'camldebug-sentinel)
+ (camldebug-mode)
+ (camldebug-set-buffer)))
+
+(defun camldebug-set-buffer ()
+ (if (eq major-mode 'camldebug-mode)
+ (setq current-camldebug-buffer (current-buffer))
+ (save-selected-window (pop-to-buffer current-camldebug-buffer))))
+
+;;; Filter and sentinel.
+
+(defun camldebug-marker-filter (string)
+ (setq camldebug-filter-accumulator
+ (concat camldebug-filter-accumulator string))
+ (let ((output "") (begin))
+ ;; Process all the complete markers in this chunk.
+ (while (setq begin
+ (string-match
+ "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n"
+ camldebug-filter-accumulator))
+ (setq camldebug-last-frame
+ (if (char-equal ?H (aref camldebug-filter-accumulator
+ (1+ (1+ begin)))) nil
+ (list (match-string 2 camldebug-filter-accumulator)
+ (string-to-int
+ (match-string 3 camldebug-filter-accumulator))
+ (string= "before"
+ (match-string 4
+ camldebug-filter-accumulator))))
+ output (concat output
+ (substring camldebug-filter-accumulator
+ 0 begin))
+ ;; Set the accumulator to the remaining text.
+ camldebug-filter-accumulator (substring
+ camldebug-filter-accumulator
+ (match-end 0))
+ camldebug-last-frame-displayed-p nil))
+
+ ;; Does the remaining text look like it might end with the
+ ;; beginning of another marker? If it does, then keep it in
+ ;; camldebug-filter-accumulator until we receive the rest of it. Since we
+ ;; know the full marker regexp above failed, it's pretty simple to
+ ;; test for marker starts.
+ (if (string-match "\032.*\\'" camldebug-filter-accumulator)
+ (progn
+ ;; Everything before the potential marker start can be output.
+ (setq output (concat output (substring camldebug-filter-accumulator
+ 0 (match-beginning 0))))
+
+ ;; Everything after, we save, to combine with later input.
+ (setq camldebug-filter-accumulator
+ (substring camldebug-filter-accumulator (match-beginning 0))))
+
+ (setq output (concat output camldebug-filter-accumulator)
+ camldebug-filter-accumulator ""))
+
+ output))
+
+(defun camldebug-filter (proc string)
+ (let ((output))
+ (if (buffer-name (process-buffer proc))
+ (let ((process-window))
+ (save-excursion
+ (set-buffer (process-buffer proc))
+ ;; If we have been so requested, delete the debugger prompt.
+ (if (marker-buffer camldebug-delete-prompt-marker)
+ (progn
+ (delete-region (process-mark proc)
+ camldebug-delete-prompt-marker)
+ (set-marker camldebug-delete-prompt-marker nil)))
+ (setq output (funcall camldebug-filter-function string))
+ ;; Don't display the specified file unless
+ ;; (1) point is at or after the position where output appears
+ ;; and (2) this buffer is on the screen.
+ (setq process-window (and camldebug-track-frame
+ (not camldebug-last-frame-displayed-p)
+ (>= (point) (process-mark proc))
+ (get-buffer-window (current-buffer))))
+ ;; Insert the text, moving the process-marker.
+ (comint-output-filter proc output))
+ (if process-window
+ (save-selected-window
+ (select-window process-window)
+ (camldebug-display-frame)))))))
+
+(defun camldebug-sentinel (proc msg)
+ (cond ((null (buffer-name (process-buffer proc)))
+ ;; buffer killed
+ ;; Stop displaying an arrow in a source file.
+ (camldebug-remove-current-event)
+ (set-process-buffer proc nil))
+ ((memq (process-status proc) '(signal exit))
+ ;; Stop displaying an arrow in a source file.
+ (camldebug-remove-current-event)
+ ;; Fix the mode line.
+ (setq mode-line-process
+ (concat ": "
+ (symbol-name (process-status proc))))
+ (let* ((obuf (current-buffer)))
+ ;; save-excursion isn't the right thing if
+ ;; process-buffer is current-buffer
+ (unwind-protect
+ (progn
+ ;; Write something in *compilation* and hack its mode line,
+ (set-buffer (process-buffer proc))
+ ;; Force mode line redisplay soon
+ (set-buffer-modified-p (buffer-modified-p))
+ (if (eobp)
+ (insert ?\n mode-name " " msg)
+ (save-excursion
+ (goto-char (point-max))
+ (insert ?\n mode-name " " msg)))
+ ;; If buffer and mode line will show that the process
+ ;; is dead, we can delete it now. Otherwise it
+ ;; will stay around until M-x list-processes.
+ (delete-process proc))
+ ;; Restore old buffer, but don't restore old point
+ ;; if obuf is the cdb buffer.
+ (set-buffer obuf))))))
+
+
+(defun camldebug-refresh (&optional arg)
+ "Fix up a possibly garbled display, and redraw the mark."
+ (interactive "P")
+ (camldebug-display-frame)
+ (recenter arg))
+
+(defun camldebug-display-frame ()
+ "Find, obey and delete the last filename-and-line marker from CDB.
+The marker looks like \\032\\032FILENAME:CHARACTER\\n.
+Obeying it means displaying in another window the specified file and line."
+ (interactive)
+ (camldebug-set-buffer)
+ (if (not camldebug-last-frame)
+ (camldebug-remove-current-event)
+ (camldebug-display-line (car camldebug-last-frame)
+ (car (cdr camldebug-last-frame))
+ (cdr (cdr camldebug-last-frame))))
+ (setq camldebug-last-frame-displayed-p t))
+
+;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
+;; and that its character CHARACTER is visible.
+;; Put the mark on this character in that buffer.
+
+(defun camldebug-display-line (true-file character kind)
+ (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
+ (pop-up-windows t)
+ (buffer (find-file-noselect true-file))
+ (window (display-buffer buffer t))
+ (pos))
+ (save-excursion
+ (set-buffer buffer)
+ (save-restriction
+ (widen)
+ (setq pos (+ (point-min) character))
+ (camldebug-set-current-event pos (current-buffer) kind))
+ (cond ((or (< pos (point-min)) (> pos (point-max)))
+ (widen)
+ (goto-char pos))))
+ (set-window-point window pos)))
+
+;;; Events.
+
+(defun camldebug-remove-current-event ()
+ (if window-system
+ (progn
+ (delete-overlay camldebug-overlay-event)
+ (delete-overlay camldebug-overlay-under))
+ (setq overlay-arrow-position nil)))
+
+(defun camldebug-set-current-event (pos buffer before)
+ (if window-system
+ (progn
+ (if (save-excursion
+ (set-buffer buffer)
+ (goto-char (1+ pos))
+ (looking-at "\n"))
+ (setq pos (1- pos)))
+ (move-overlay camldebug-overlay-event pos (1+ pos) buffer)
+ (if before
+ (move-overlay camldebug-overlay-under (+ pos 1) (+ pos 3) buffer)
+ (move-overlay camldebug-overlay-under (- pos 2) pos buffer)))
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char pos)
+ (beginning-of-line)
+ (move-marker camldebug-event-marker (point))
+ (setq overlay-arrow-position camldebug-event-marker))))
+
+;;; Miscellaneous.
+
+(defun camldebug-module-name (filename)
+ (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end
1)))
+
+;;; The camldebug-call function must do the right thing whether its
+;;; invoking keystroke is from the camldebug buffer itself (via
+;;; major-mode binding) or a caml buffer. In the former case, we want
+;;; to supply data from camldebug-last-frame. Here's how we do it:
+
+(defun camldebug-format-command (str)
+ (let* ((insource (not (eq (current-buffer) current-camldebug-buffer)))
+ (frame (if insource nil camldebug-last-frame)) (result))
+ (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str))
+ (let ((key (string-to-char (substring str (match-beginning 2))))
+ (cmd (substring str (match-beginning 1) (match-end 1)))
+ (subst))
+ (setq str (substring str (match-end 2)))
+ (cond
+ ((eq key ?m)
+ (setq subst (camldebug-module-name
+ (if insource (buffer-file-name) (nth 0 frame)))))
+ ((eq key ?d)
+ (setq subst (file-name-directory
+ (if insource (buffer-file-name) (nth 0 frame)))))
+ ((eq key ?c)
+ (setq subst (int-to-string
+ (if insource (1- (point)) (nth 1 frame)))))
+ ((eq key ?e)
+ (setq subst (thing-at-point 'symbol))))
+ (setq result (concat result cmd subst))))
+ ;; There might be text left in STR when the loop ends.
+ (concat result str)))
+
+(defun camldebug-call (command &optional fmt arg)
+ "Invoke camldebug COMMAND displaying source in other window.
+
+Certain %-escapes in FMT are interpreted specially if present.
+These are:
+
+ %m module name of current module.
+ %d directory of current source file.
+ %c number of current character position
+ %e text of the caml variable surrounding point.
+
+ The `current' source file is the file of the current buffer (if
+we're in a caml buffer) or the source file current at the last break
+or step (if we're in the camldebug buffer), and the `current' module
+name is the filename stripped of any *.ml* suffixes (this assumes the
+usual correspondence between module and file naming is observed). The
+`current' position is that of the current buffer (if we're in a source
+file) or the position of the last break or step (if we're in the
+camldebug buffer).
+
+If ARG is present, it overrides any FMT flags and its string
+representation is simply concatenated with the COMMAND."
+
+ ;; Make sure debugger buffer is displayed in a window.
+ (camldebug-set-buffer)
+ (message "Command: %s" (camldebug-call-1 command fmt arg)))
+
+(defun camldebug-call-1 (command &optional fmt arg)
+
+ ;; Record info on the last prompt in the buffer and its position.
+ (save-excursion
+ (set-buffer current-camldebug-buffer)
+ (goto-char (process-mark (get-buffer-process current-camldebug-buffer)))
+ (let ((pt (point)))
+ (beginning-of-line)
+ (if (looking-at comint-prompt-regexp)
+ (set-marker camldebug-delete-prompt-marker (point)))))
+ (let ((cmd (cond
+ (arg (concat command " " (int-to-string arg)))
+ (fmt (camldebug-format-command
+ (concat command " " fmt)))
+ (command))))
+ (process-send-string (get-buffer-process current-camldebug-buffer)
+ (concat cmd "\n"))
+ cmd))
+
+
+(provide 'camldebug)
diff --git a/inf-caml.el b/inf-caml.el
new file mode 100644
index 0000000..e573b4c
--- /dev/null
+++ b/inf-caml.el
@@ -0,0 +1,100 @@
+;;; inf-caml.el --- run the Caml toplevel in an Emacs buffer
+
+;; Xavier Leroy, july 1993.
+
+(require 'comint)
+(require 'caml)
+
+(defvar inferior-caml-mode-map nil)
+(if inferior-caml-mode-map nil
+ (setq inferior-caml-mode-map
+ (copy-keymap comint-mode-map)))
+
+;; Augment Caml mode, so you can process Caml code in the source files.
+
+(define-key caml-mode-map "\M-\C-x" 'caml-eval-phrase)
+(define-key caml-mode-map "\C-x\C-e" 'caml-eval-phrase)
+(define-key caml-mode-map "\C-c\C-e" 'caml-eval-phrase)
+(define-key caml-mode-map "\C-c\C-r" 'caml-eval-region)
+
+(defvar inferior-caml-program "ocaml"
+ "*Program name for invoking an inferior Caml from Emacs.")
+
+(defun inferior-caml-mode ()
+ "Major mode for interacting with an inferior Caml process.
+Runs a Caml toplevel as a subprocess of Emacs, with I/O through an
+Emacs buffer. A history of input phrases is maintained. Phrases can
+be sent from another buffer in Caml mode.
+
+\\{inferior-caml-mode-map}"
+ (interactive)
+ (comint-mode)
+ (setq comint-prompt-regexp "^# ?")
+ (setq major-mode 'inferior-caml-mode)
+ (setq mode-name "Inferior Caml")
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^$\\|" page-delimiter))
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate paragraph-start)
+ (make-local-variable 'paragraph-ignore-fill-prefix)
+ (setq paragraph-ignore-fill-prefix t)
+ (make-local-variable 'require-final-newline)
+ (setq require-final-newline t)
+ (make-local-variable 'comment-start)
+ (setq comment-start "(*")
+ (make-local-variable 'comment-end)
+ (setq comment-end "*)")
+ (make-local-variable 'comment-column)
+ (setq comment-column 40)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "(\\*+ *")
+ (make-local-variable 'parse-sexp-ignore-comments)
+ (setq parse-sexp-ignore-comments nil)
+ (use-local-map inferior-caml-mode-map)
+ (run-hooks 'inferior-caml-mode-hooks))
+
+(defun run-caml (cmd)
+ "Run an inferior Caml process.
+Input and output via buffer `*inferior-caml*'."
+ (interactive (list (read-from-minibuffer "Caml command to run: "
+ inferior-caml-program)))
+ (setq inferior-caml-program cmd)
+ (if (not (comint-check-proc "*inferior-caml*"))
+ (let ((cmdlist (inferior-caml-args-to-list cmd))
+ (process-connection-type nil))
+ (set-buffer (apply (function make-comint)
+ "inferior-caml" (car cmdlist) nil (cdr cmdlist)))
+ (inferior-caml-mode)))
+ (switch-to-buffer "*inferior-caml*"))
+
+(defun inferior-caml-args-to-list (string)
+ (let ((where (string-match "[ \t]" string)))
+ (cond ((null where) (list string))
+ ((not (= where 0))
+ (cons (substring string 0 where)
+ (inferior-caml-args-to-list (substring string (+ 1 where)
+ (length string)))))
+ (t (let ((pos (string-match "[^ \t]" string)))
+ (if (null pos)
+ nil
+ (inferior-caml-args-to-list (substring string pos
+ (length string)))))))))
+
+(defun caml-eval-region (start end)
+ "Send the current region to the inferior Caml process."
+ (interactive"r")
+ (comint-send-region "*inferior-caml*" start end)
+ (comint-send-string "*inferior-caml*" ";;\n")
+ (if (not (get-buffer-window "*inferior-caml*" t))
+ (display-buffer "*inferior-caml*")))
+
+(defun caml-eval-phrase ()
+ "Send the current Caml phrase to the inferior Caml process."
+ (interactive)
+ (save-excursion
+ (let ((bounds (caml-mark-phrase)))
+ (caml-eval-region (car bounds) (cdr bounds)))))
+
+;;; inf-caml.el ends here
+
+(provide 'inf-caml)
- [nongnu] branch externals/caml created (now 38ebde1), Stefan Monnier, 2020/11/21
- [nongnu] externals/caml bf4ed0f 001/197: Mode OCaml Garrigue/Zimmerman,
Stefan Monnier <=
- [nongnu] externals/caml 087fca8 003/197: Fichier oublie., Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 8ef19e2 002/197: Makefile d'installation, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml ad4f8bf 007/197: Nouveau module Marshal dans stdlib, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 9d045e4 009/197: Corrections de Jacques sur sa version 1.05, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 78f81bc 004/197: Corrections diverses, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 6ce04bf 006/197: Donne a ocamldebug le chemin complet du programme a lancer, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml fc4b394 017/197: some changes due to ITZ, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml a0f8f81 008/197: Mise a jour avec la version 1.05 de Jacques Garrigue, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 6186a9f 013/197: Patch d'Erwan David, Stefan Monnier, 2020/11/21
- [nongnu] externals/caml 98bd08b 011/197: Bug de l'affichage des evenements after., Stefan Monnier, 2020/11/21