From fe590b1def1df5e905274a8b47750e1a259da37b Mon Sep 17 00:00:00 2001 From: twittner Date: Sun, 10 Jun 2007 13:59:16 +0000 Subject: [PATCH] - added files from DEVEL Changed files: emacs-athena.desktop -> 1.2 emacs-motif.desktop -> 1.2 emacs-nemerle.el -> 1.3 emacs-nox.desktop -> 1.2 emacs-tuareg.el -> 1.3 --- emacs-athena.desktop | 13 + emacs-motif.desktop | 12 + emacs-nemerle.el | 373 +++++ emacs-nox.desktop | 13 + emacs-tuareg.el | 3199 ++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 3610 insertions(+) create mode 100644 emacs-athena.desktop create mode 100644 emacs-motif.desktop create mode 100644 emacs-nemerle.el create mode 100644 emacs-nox.desktop create mode 100644 emacs-tuareg.el diff --git a/emacs-athena.desktop b/emacs-athena.desktop new file mode 100644 index 0000000..995d560 --- /dev/null +++ b/emacs-athena.desktop @@ -0,0 +1,13 @@ +[Desktop Entry] +Name=Emacs Athena +Name[ko]=이맥스 +Comment=Emacs text editor - Athena version +Comment[pl]=Edytor tekstu Emacs - wersja Athena +TryExec=emacs-athena +Exec=emacs-athena +Icon=emacs.png +Terminal=false +Type=Application +Encoding=UTF-8 +Categories=TextEditor; +# vi: encoding=utf-8 diff --git a/emacs-motif.desktop b/emacs-motif.desktop new file mode 100644 index 0000000..ce20442 --- /dev/null +++ b/emacs-motif.desktop @@ -0,0 +1,12 @@ +[Desktop Entry] +Name=Emacs Motif +Comment=Emacs text editor - Motif version +Comment[pl]=Edytor tekstu Emacs - wersja Motif +TryExec=emacs-motif +Exec=emacs-motif +Icon=emacs.png +Terminal=false +Type=Application +Encoding=UTF-8 +Categories=Motif;TextEditor; +# vi: encoding=utf-8 diff --git a/emacs-nemerle.el b/emacs-nemerle.el new file mode 100644 index 0000000..fa1e930 --- /dev/null +++ b/emacs-nemerle.el @@ -0,0 +1,373 @@ +;;; nemerle.el -- major mode for editing nemerle programs + +;; Copyright (C) 2003, 2004 The University of Wroclaw +;; All rights reserved. + +;; Author: Jacek Sliwerski (rzyjontko) +;; Maintainer: Jacek Sliwerski (rzyjontko) +;; Created: 5 Oct 2003 +;; Version: 0.1 +;; Keywords: nemerle, mode, languages +;; Website: http://nemerle.org + + +;; This file is not part of GNU Emacs. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions +;; are met: +;; 1. Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; 2. Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in the +;; documentation and/or other materials provided with the distribution. +;; 3. The name of the University may not be used to endorse or promote +;; products derived from this software without specific prior +;; written permission. +;; +;; THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR +;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +;; NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + + +;;; Commentary: + +;; A major mode for editing nemerle source files. It provides syntax +;; hilighting, proper indentation, and many other features. +;; To install the nemerle mode, put the following lines into your +;; ~/.emacs file: + +;; (setq load-path (cons "/path/to/dir/where/this/file/resides" load-path)) +;; (autoload 'nemerle-mode "nemerle.el" +;; "Major mode for editing nemerle programs." t) +;; (setq auto-mode-alist (cons '("\\.n$" . nemerle-mode) auto-mode-alist)) + +;; If you'd like to have every line indented right after new line put +;; these lines into your ~/.emacs files. + +;; (defun my-nemerle-mode-hook () +;; (setq nemerle-basic-offset 2) +;; (define-key nemerle-mode-map "\C-m" 'newline-and-indent)) +;; (add-hook 'nemerle-mode-hook 'my-nemerle-mode-hook) + + + +;;; Change Log: + +;; 2004-04-27 rzyjontko +;; * further coloring improvements +;; * fixed syntax table + +;; 2004-01-24 rzyjontko +;; * fixed coloring + +;; 2004-01-23 rzyjontko +;; * indent to open parenthesis + +;; 2004-01-21 rzyjontko +;; * improved indentation +;; * changed syntax table +;; * disabled tab-indent +;; * switched to new grammar +;; * electric-bar and electric-brace + +;; 2003-11-17 rzyjontko +;; * updated copyright disclaimer +;; * basic indentation engine + +;; 2003-10-09 rzyjontko +;; * nemerle mode automatically sets file coding system to utf-8 +;; * syntax table changes +;; * more colours +;; * indentation framework + +;; 2003-10-05 rzyjontko +;; * initial version + + + +;;; Todo: + +;; - further indentation improvements +;; - imenu (with ncc execution) +;; - make _ be a special symbol (write matcher functions) + + + +;;; Code: + +(provide 'nemerle-mode) + + +(defvar nemerle-mode-map nil + "The keymap used in nemerle-mode.") + +(defvar nemerle-font-lock-keywords nil + "Font lock definitions for nemerle-mode.") + +(defvar nemerle-mode-syntax-table nil + "The syntax table used in nemerle-mode.") + +(defvar nemerle-mode-hook nil + "This hook is run when nemerle-mode is loaded, or a new nemerle-mode +buffer created. This is a good place to put your customizations.") + +(defvar nemerle-basic-offset 4 + "Indentation of blocks in nemerle.") + +(unless nemerle-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "|" 'nemerle-electric-bar) + (define-key map "}" 'nemerle-electric-brace) + (setq nemerle-mode-map map))) + +(unless nemerle-font-lock-keywords + (setq nemerle-font-lock-keywords + (list + ;; strings + '("[^']\\(\"[^\"]*\"\\)" 1 font-lock-string-face) + '("'[^\\']'\\|'\\\\.'" 0 font-lock-string-face) + + ;; one-line comments + '("//.*" 0 font-lock-comment-face) + + ;; keywords + '("\\<\\(_\\|abstract\\|and\\|as\\|base\\|catch\\|const\\|def\\|delegate\\|enum\\|extends\\|extern\\|finally\\|fun\\|implements\\|interface\\|internal\\|is\\|macro\\|match\\|matches\\|mutable\\|new\\|out\\|override\\|params\\|private\\|protected\\|public\\|ref\\|sealed\\|static\\|struct\\|syntax\\|this\\|throw\\|try\\|tymatch\\|type\\|typeof\\|virtual\\|where\\|partial\\)\\>" + 0 font-lock-keyword-face) + ;; these aren't really keywords but we set them so + '("\\<\\(do\\|else\\|for\\|if\\|regexp\\|unless\\|while\\|when\\|in\\|foreach\\)\\>" + 0 font-lock-keyword-face) + '("=>\\||" 0 font-lock-keyword-face) + + '("\\<\\(foreach\\)\\s *(.*:\\s *\\(\\w*\\)\\s *\\(\\\\)" + (1 font-lock-keyword-face) (2 font-lock-type-face) (3 font-lock-keyword-face)) + + '("\\<\\(variant\\|class\\|interface\\|module\\|namespace\\|using\\)\\s +\\(\\(\\w\\|\\.\\)*\\)" + (1 font-lock-keyword-face) (2 font-lock-function-name-face)) + + ;; types + '("\\]*[^\\-]>+" 0 font-lock-type-face t) + '("\\]*>+" 0 font-lock-type-face t) + '("\\]*>+" 0 font-lock-type-face t) + '("->" 0 font-lock-type-face) + '("\\<\\(void\\|int\\|uint\\|char\\|float\\|double\\|decimal\\|byte\\|sbyte\\|short\\|ushort\\|long\\|ulong\\|bool\\|string\\|object\\)\\>" + 0 font-lock-type-face) + + ;; constants + '("\\<[0-9]+\\>" 0 font-lock-constant-face) + '("\\" 0 font-lock-constant-face) + '("\\<\\(false\\|true\\|null\\)\\>" 0 font-lock-constant-face)))) + + +(unless nemerle-mode-syntax-table + (setq nemerle-mode-syntax-table (copy-syntax-table c-mode-syntax-table)) + (modify-syntax-entry ?< "(>" nemerle-mode-syntax-table) + (modify-syntax-entry ?> ")<" nemerle-mode-syntax-table)) + + +(defun nemerle-syntax () + (save-excursion + (beginning-of-line) + (cond ((looking-at "[ \t]*\\") + 'try) + ((looking-at "[ \t]*\\") + 'catch) + ((looking-at "[ \t]*|") + 'match-case) + ((looking-at "[ \t]*$") + 'empty) + ((looking-at "[ \t]*\\") + 'if) + ((looking-at "[ \t]*\\") + 'else) + ((looking-at "[^\n{]*}") + 'block-end) + ((looking-at "[^\n]*{[^\n}]*$") + 'block-beg) + ((looking-at "[ \t]*\\") + 'if) + ((looking-at "[ \t]*\\") + 'if) + (t + 'other)))) + + +(defun nemerle-prev-line () + (save-excursion + (beginning-of-line) + (if (bobp) + 0 + (let ((there (point))) + (skip-chars-backward " \t\n") + (beginning-of-line) + (let* ((here (point)) + (syntax (nemerle-syntax)) + (indent (current-indentation)) + (state (parse-partial-sexp here there))) + (cond ((and (< (nth 0 state) 0) (eq ?\) (nth 2 state))) + (goto-char (scan-lists (nth 2 state) -1 1)) + (cons (current-indentation) (nemerle-syntax))) + ((null (nth 1 state)) + (cons indent syntax)) + ((eq (char-after (nth 1 state)) ?\() + (cons (- (nth 1 state) here) 'open-paren)) + (t + (cons indent syntax)))))))) + + +(defun nemerle-calculate-indentation () + (let* ((prev-info (nemerle-prev-line)) + (prev-indent (car prev-info)) + (prev-syntax (cdr prev-info)) + (cur-syntax (nemerle-syntax))) + (cond ((eq prev-syntax 'open-paren) + (1+ prev-indent)) + ((eq prev-syntax 'match-case) ; match-case + (cond ((eq cur-syntax 'match-case) + prev-indent) + ((eq cur-syntax 'block-end) + (- prev-indent nemerle-basic-offset)) + (t + (+ prev-indent 2)))) + ((eq prev-syntax 'try) ; try + (cond ((eq cur-syntax 'block-beg) + prev-indent) + ((eq cur-syntax 'catch) + prev-indent) + (t (+ prev-indent nemerle-basic-offset)))) + ((eq prev-syntax 'catch) + (+ prev-indent nemerle-basic-offset)) + ((eq prev-syntax 'block-beg) ; beginning of block + (+ prev-indent nemerle-basic-offset)) + ((eq prev-syntax 'block-end) ; end of block + (cond ((eq cur-syntax 'block-end) + (- prev-indent nemerle-basic-offset)) + (t + prev-indent))) + ((eq prev-syntax 'if) ; if + (+ prev-indent nemerle-basic-offset)) + ((eq prev-syntax 'else) ; else + (+ prev-indent nemerle-basic-offset)) + (t + (cond ((eq cur-syntax 'block-end) + (- prev-indent nemerle-basic-offset)) + ((eq cur-syntax 'else) + (- prev-indent nemerle-basic-offset)) + ((eq cur-syntax 'catch) + (- prev-indent nemerle-basic-offset)) + (t + prev-indent)))))) + + +(defun nemerle-indent-to (level) + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (if (< level (current-indentation)) + (delete-horizontal-space)) + (indent-to level)) + (if (< (current-column) (current-indentation)) + (skip-chars-forward " \t"))) + + + +(defun nemerle-indent-line () + "Indent current line of nemerle code." + (interactive) + (let ((level (nemerle-calculate-indentation))) + (nemerle-indent-to level))) + + + +(defun nemerle-electric-bar (arg) + "Insert a bar. + +Also, the line is re-indented unless a numeric ARG is supplied +or there are some non-blank symbols on the line." + (interactive "p") + (if (or (not (eq (nemerle-syntax) 'empty)) (and arg (> arg 1))) + (self-insert-command (or arg 1)) + (message "ok") + (let* ((prev-info (nemerle-prev-line)) + (prev-indent (car prev-info)) + (prev-syntax (cdr prev-info)) + (level prev-indent)) + (if (eq prev-syntax 'block-beg) + (setq level (+ prev-indent nemerle-basic-offset))) + (nemerle-indent-to level) + (insert-char ?| 1)))) + + +(defun nemerle-electric-brace (arg) + "Insert a brace. + +Also, the line is re-indented unless a numeric ARG is supplied +or there are some non-blank symbols on the line." + (interactive "p") + (if (or (not (eq (nemerle-syntax) 'empty)) (and arg (> arg 1))) + (self-insert-command (or arg 1)) + (let* ((prev-info (nemerle-prev-line)) + (prev-indent (car prev-info)) + (prev-syntax (cdr prev-info)) + (level prev-indent)) + (nemerle-indent-to (- prev-indent nemerle-basic-offset)) + (insert-char ?} 1)))) + + +(defun nemerle-comment-indent () + "Indent current line of nemerle comment." + (interactive) + 0) + + +(defun nemerle-mode () + "Major mode for editing nemerle source files. + +Mode map +======== +\\{nemerle-mode-map}" + + (interactive) + (kill-all-local-variables) + + (setq mode-name "Nemerle") + (setq major-mode 'nemerle-mode) + + (use-local-map nemerle-mode-map) + (set-syntax-table nemerle-mode-syntax-table) + + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(nemerle-font-lock-keywords nil nil + ((?_ . "w") (?. . "w") (?\/ . ". 14b") + (?* . ". 23") (?\" . ".") (?\' . ".")))) + + (make-local-variable 'indent-line-function) + (setq indent-line-function 'nemerle-indent-line) + + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'c-comment-indent) + + (make-local-variable 'comment-start) + (setq comment-start "/* ") + + (make-local-variable 'comment-end) + (setq comment-end " */") + + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "/\\*+[ \t]*\\|//+ *") + + (setq buffer-file-coding-system 'utf-8) + (setq indent-tabs-mode nil) + + (run-hooks 'nemerle-mode-hook)) + +;;; nemerle.el ends here diff --git a/emacs-nox.desktop b/emacs-nox.desktop new file mode 100644 index 0000000..aadedc0 --- /dev/null +++ b/emacs-nox.desktop @@ -0,0 +1,13 @@ +[Desktop Entry] +Name=Emacs console +Name[ko]=이맥스 +Comment=Emacs text editor - console version +Comment[pl]=Edytor tekstu Emacs - wersja konsolowa +TryExec=emacs-nox +Exec=emacs-nox +Icon=emacs.png +Terminal=true +Type=Application +Encoding=UTF-8 +Categories=ConsoleOnly;TextEditor; +# vi: encoding=utf-8 diff --git a/emacs-tuareg.el b/emacs-tuareg.el new file mode 100644 index 0000000..c80ef41 --- /dev/null +++ b/emacs-tuareg.el @@ -0,0 +1,3199 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tuareg.el - Caml mode for Emacs and XEmacs (20 and more). + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Copyright © 1997-2004 Albert Cohen, all rights reserved. +;; Licensed under the GNU General Public License. + +;; This program 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 2 of the License, or +;; (at your option) any later version. + +;; This program 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. + +(defconst tuareg-mode-version "Tuareg Version 1.42.1" + " Copyright © 1997-2004 Albert Cohen, all rights reserved. + Copying is covered by the GNU General Public License. + + This program 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 2 of the License, or + (at your option) any later version. + + This program 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.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Emacs versions support + +(defconst tuareg-with-xemacs (string-match "XEmacs" emacs-version)) + +(defconst tuareg-with-modern-emacs (string-match "21" emacs-version)) + +(defconst tuareg-window-system + (or tuareg-with-modern-emacs + tuareg-with-xemacs + (and (boundp 'window-system) window-system) + (and (fboundp 'console-type) (or (eq (console-type) 'x) + (eq (console-type) 'gtk) + (eq (console-type) 'win32)))) + "Are we running under a window system or something alike?") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Compatibility functions + +(if (fboundp 'match-string-no-properties) + (defalias 'tuareg-match-string 'match-string-no-properties) + (defalias 'tuareg-match-string 'match-string)) + +(if (not (fboundp 'read-shell-command)) + (defun read-shell-command (prompt &optional initial-input history) + "Read a string from the minibuffer, using `shell-command-history'." + (read-from-minibuffer prompt initial-input nil nil + (or history 'shell-command-history)))) + +(if (not (fboundp 'string-as-multibyte)) + (defun string-as-multibyte (str) + "Return same string for not multibyte emacs'en" + str)) + +(require 'cl) +(require 'easymenu) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Import types and help features + +(defvar tuareg-with-caml-mode-p + (condition-case nil + (and (require 'caml-types) (require 'caml-help)) + (error nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User customizable variables + +;; use the standard `customize' interface or `tuareg-mode-hook' to +;; configure these variables + +(require 'custom) + +(defgroup tuareg nil + "Support for the Objective Caml language." + :group 'languages) + +;; comments + +(defcustom tuareg-indent-leading-comments t + "*If true, indent leading comment lines (starting with `(*') like others." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-indent-comments t + "*If true, automatically align multi-line comments." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-comment-end-extra-indent 0 + "*How many spaces to indent a leading comment end `*)'. +If you expect comments to be indented like + (* + ... + *) +even without leading `*', use `tuareg-comment-end-extra-indent' = 1." + :group 'tuareg + :type '(radio :extra-offset 8 + :format "%{Comment End Extra Indent%}: + Comment alignment:\n%v" + (const :tag "align with `(' in comment opening" 0) + (const :tag "align with `*' in comment opening" 1) + (integer :tag "custom alignment" 0))) + +(defcustom tuareg-support-leading-star-comments t + "*Enables automatic intentation of comments of the form + (* + * ... + *) +If you still expect comments to be indented like + (* + ... + *) +without leading `*', set `tuareg-comment-end-extra-indent' to 1." + :group 'tuareg :type 'boolean) + +;; indentation defaults + +(defcustom tuareg-default-indent 2 + "*Default indentation. + +Global indentation variable (large values may lead to indentation overflows). +When no governing keyword is found, this value is used to indent the line +if it has to." + :group 'tuareg :type 'integer) + +(defcustom tuareg-lazy-= nil + "*If true, indent `=' like a standard keyword (not `:=', `<='...)." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-lazy-paren nil + "*If true, indent parentheses like a standard keyword." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-support-camllight nil + "*If true, handle Caml Light character syntax (incompatible with labels)." + :group 'tuareg :type 'boolean + :set '(lambda (var val) + (setq tuareg-support-camllight val) + (if (boundp 'tuareg-mode-syntax-table) + (if val + (modify-syntax-entry ?` "\"" tuareg-mode-syntax-table) + (modify-syntax-entry ?` "." tuareg-mode-syntax-table))))) + +(defcustom tuareg-let-always-indent t + "*If true, enforce indentation is at least `tuareg-let-indent' after a `let'. + +As an example, set it to false when you have `tuareg-with-indent' set to 0, +and you want `let x = match ... with' and `match ... with' indent the +same way." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-|-extra-unindent tuareg-default-indent + "*Extra backward indent for Caml lines starting with the `|' operator. + +It is NOT the variable controlling the indentation of the `|' itself: +this value is automatically added to `function', `with', `parse' and +some cases of `type' keywords to leave enough space for `|' backward +indentation. + +For exemple, setting this variable to 0 leads to the following indentation: + match ... with + X -> ... + | Y -> ... + | Z -> ... + +To modify the indentation of lines lead by `|' you need to modify the +indentation variables for `with', `function' and `parse', and possibly +for `type' as well. For example, setting them to 0 (and leaving +`tuareg-|-extra-unindent' to its default value) yields: + match ... with + X -> ... + | Y -> ... + | Z -> ..." + :group 'tuareg :type 'integer) + +(defcustom tuareg-class-indent tuareg-default-indent + "*How many spaces to indent from a `class' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-sig-struct-align t + "*Align `sig' and `struct' keywords with `module'." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-sig-struct-indent tuareg-default-indent + "*How many spaces to indent from a `sig' or `struct' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-method-indent tuareg-default-indent + "*How many spaces to indent from a `method' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-begin-indent tuareg-default-indent + "*How many spaces to indent from a `begin' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-for-while-indent tuareg-default-indent + "*How many spaces to indent from a `for' or `while' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-do-indent tuareg-default-indent + "*How many spaces to indent from a `do' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-fun-indent tuareg-default-indent + "*How many spaces to indent from a `fun' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-function-indent tuareg-default-indent + "*How many spaces to indent from a `function' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-if-then-else-indent tuareg-default-indent + "*How many spaces to indent from an `if', `then' or `else' keyword +in Tuareg mode." + :group 'tuareg :type 'integer) + +(defcustom tuareg-let-indent tuareg-default-indent + "*How many spaces to indent from a `let' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-in-indent tuareg-default-indent + "*How many spaces to indent from a `in' keyword. +A lot of people like formatting `let' ... `in' expressions whithout +indentation: + let x = 0 in + blah x +Set this variable to 0 to get this behaviour. +However, nested declarations are always correctly handled: + let x = 0 in let x = 0 + let y = 0 in or in let y = 0 + let z = 0 ... in let z = 0 ..." + :group 'tuareg :type 'integer) + +(defcustom tuareg-match-indent tuareg-default-indent + "*How many spaces to indent from a `match' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-try-indent tuareg-default-indent + "*How many spaces to indent from a `try' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-with-indent tuareg-default-indent + "*How many spaces to indent from a `with' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-rule-indent tuareg-default-indent + "*How many spaces to indent from a `rule' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-parse-indent tuareg-default-indent + "*How many spaces to indent from a `parse' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-parser-indent tuareg-default-indent + "*How many spaces to indent from a `parser' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-type-indent tuareg-default-indent + "*How many spaces to indent from a `type' keyword." + :group 'tuareg :type 'integer) + +(defcustom tuareg-val-indent tuareg-default-indent + "*How many spaces to indent from a `val' keyword." + :group 'tuareg :type 'integer) + +;; automatic indentation +;; using abbrev-mode and electric keys + +(defcustom tuareg-use-abbrev-mode t + "*Non-nil means electrically indent lines starting with leading keyword +such as `end', `done', `else' etc. It makes use of abbrev-mode. + +Many people find eletric keywords irritating, so you can disable them in +setting this variable to nil." + :group 'tuareg :type 'boolean + :set '(lambda (var val) + (setq tuareg-use-abbrev-mode val) + (abbrev-mode val))) + +(defcustom tuareg-electric-indent t + "*Non-nil means electrically indent lines starting with `|', `)', `]' or `}'. + +Many people find eletric keys irritating, so you can disable them in +setting this variable to nil." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-electric-close-vector t + "*Non-nil means electrically insert `|' before a vector-closing `]' or +`>' before an object-closing `}'. + +Many people find eletric keys irritating, so you can disable them in +setting this variable to nil. You should probably have this on, +though, if you also have tuareg-electric-indent on." + :group 'tuareg :type 'boolean) + +;; Tuareg-Interactive +;; configure via `tuareg-mode-hook' + +(defcustom tuareg-skip-after-eval-phrase t + "*Non-nil means skip to the end of the phrase after evaluation in the +Caml toplevel." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-interactive-read-only-input nil + "*Non-nil means input send to the Caml toplevel is read-only." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-interactive-echo-phrase t + "*Non-nil means echo phrases in the toplevel buffer when sending +them to the Caml toplevel." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-interactive-input-font-lock t + "*Non nil means Font-Lock for toplevel input phrases." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-interactive-output-font-lock t + "*Non nil means Font-Lock for toplevel output messages." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-interactive-error-font-lock t + "*Non nil means Font-Lock for toplevel error messages." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-display-buffer-on-eval t + "*Non nil means pop up the Caml toplevel when evaluating code." + :group 'tuareg :type 'boolean) + +(defcustom tuareg-manual-url "http://pauillac.inria.fr/ocaml/htmlman/index.html" + "*URL to the Caml reference manual." + :group 'tuareg :type 'string) + +(defcustom tuareg-browser 'tuareg-netscape-manual + "*Name of function that displays the Caml reference manual. +Valid names are `tuareg-netscape-manual', `tuareg-mmm-manual' +and `tuareg-xemacs-w3-manual' (XEmacs only)." + :group 'tuareg) + +(defcustom tuareg-library-path "/usr/local/lib/ocaml/" + "*Path to the Caml library." + :group 'tuareg :type 'string) + +(defcustom tuareg-definitions-max-items 30 + "*Maximum number of items a definitions menu can contain." + :group 'tuareg :type 'integer) + +(defvar tuareg-options-list + '(("Lazy parentheses indentation" . 'tuareg-lazy-paren) + ("Lazy `=' indentation" . 'tuareg-lazy-=) + ("Force indentation after `let'" . 'tuareg-let-always-indent) + "---" + ("Automatic indentation of leading keywords" . 'tuareg-use-abbrev-mode) + ("Electric indentation of ), ] and }" . 'tuareg-electric-indent) + ("Electric matching of [| and {<" . 'tuareg-electric-close-vector) + "---" + ("Indent body of comments" . 'tuareg-indent-comments) + ("Indent first line of comments" . 'tuareg-indent-leading-comments) + ("Leading-`*' comment style" . 'tuareg-support-leading-star-comments)) + "*List of menu-configurable Tuareg options") + +(defvar tuareg-interactive-options-list + '(("Skip phrase after evaluation" . 'tuareg-skip-after-eval-phrase) + ("Echo phrase in interactive buffer" . 'tuareg-interactive-echo-phrase) + "---" + ("Font-lock interactive input" . 'tuareg-interactive-input-font-lock) + ("Font-lock interactive output" . 'tuareg-interactive-output-font-lock) + ("Font-lock interactive error" . 'tuareg-interactive-error-font-lock) + "---" + ("Read only input (XEmacs)" . 'tuareg-interactive-read-only-input)) + "*List of menu-configurable Tuareg options") + +(defvar tuareg-interactive-program "ocaml" + "*Default program name for invoking a Caml toplevel from Emacs.") +;; Could be interesting to have this variable buffer-local +;; (e.g., ocaml vs. metaocaml buffers) +;; (make-variable-buffer-local 'tuareg-interactive-program) + +(defgroup tuareg-faces nil + "Special faces for the Tuareg mode." + :group 'tuareg) + +(defface tuareg-font-lock-governing-face + '((((background light)) + (:foreground "darkorange3" :bold t)) + (t (:foreground "orange" :bold t))) + "Face description for governing/leading keywords." + :group 'tuareg-faces) +(defvar tuareg-font-lock-governing-face + 'tuareg-font-lock-governing-face) + +(defface tuareg-font-lock-multistage-face + '((((background light)) + (:foreground "darkblue" :background "lightgray" :bold t)) + (t (:foreground "steelblue" :background "darkgray" :bold t))) + "Face description for MetaOCaml staging operators." + :group 'tuareg-faces) +(defvar tuareg-font-lock-multistage-face + 'tuareg-font-lock-multistage-face) + +(defface tuareg-font-lock-operator-face + '((((background light)) + (:foreground "brown4")) + (t (:foreground "salmon"))) + "Face description for all operators." + :group 'tuareg-faces) +(defvar tuareg-font-lock-operator-face + 'tuareg-font-lock-operator-face) + +(defface tuareg-font-lock-error-face + '((t (:foreground "yellow" :background "red"))) + "Face description for all errors reported to the source." + :group 'tuareg-faces) +(defvar tuareg-font-lock-error-face + 'tuareg-font-lock-error-face) + +(defface tuareg-font-lock-interactive-output-face + '((((background light)) + (:foreground "blue4")) + (t (:foreground "cyan"))) + "Face description for all toplevel outputs." + :group 'tuareg-faces) +(defvar tuareg-font-lock-interactive-output-face + 'tuareg-font-lock-interactive-output-face) + +(defface tuareg-font-lock-interactive-error-face + '((((background light)) + (:foreground "red3")) + (t (:foreground "red2"))) + "Face description for all toplevel errors." + :group 'tuareg-faces) +(defvar tuareg-font-lock-interactive-error-face + 'tuareg-font-lock-interactive-error-face) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Support definitions + +(defvar tuareg-cache-stop (point-min)) +(make-variable-buffer-local 'tuareg-cache-stop) +(defvar tuareg-cache nil) +(make-variable-buffer-local 'tuareg-cache) +(defvar tuareg-cache-local nil) +(make-variable-buffer-local 'tuareg-cache-local) +(defvar tuareg-cache-last-local nil) +(make-variable-buffer-local 'tuareg-cache-last-local) +(defvar tuareg-last-loc (cons nil nil)) + +(defun tuareg-leading-star-p () + (and tuareg-support-leading-star-comments + (save-excursion ; this function does not make sense outside of a comment + (tuareg-beginning-of-literal-or-comment) + (and (not (looking-at "(\\*[Tt][Ee][Xx]\\|(\\*\\*")) + (progn + (forward-line 1) + (back-to-indentation) + (looking-at "\\*[^)]")))))) + +(defun tuareg-auto-fill-insert-leading-star (&optional leading-star) + (let ((point-leading-comment (looking-at "(\\*")) (return-leading nil)) + (save-excursion + (back-to-indentation) + (if tuareg-electric-indent + (prog2 + (if (and (tuareg-in-comment-p) + (or leading-star + (tuareg-leading-star-p))) + (prog2 + (if (not (looking-at "(?\\*")) + (insert-before-markers "* ")) + (setq return-leading t))) + (if (not point-leading-comment) + ;; use optional argument to break recursion + (tuareg-indent-command t))))) + return-leading)) + +(defun tuareg-auto-fill-function () + (if (tuareg-in-literal-p) () + (let ((leading-star + (if (not (char-equal ?\n last-command-char)) + (tuareg-auto-fill-insert-leading-star) + nil))) + (do-auto-fill) + (if (not (char-equal ?\n last-command-char)) + (tuareg-auto-fill-insert-leading-star leading-star))))) + +(defun tuareg-forward-char (&optional step) + (if step (goto-char (+ (point) step)) + (goto-char (1+ (point))))) + +(defun tuareg-backward-char (&optional step) + (if step (goto-char (- (point) step)) + (goto-char (1- (point))))) + +(defun tuareg-in-indentation-p () + "Tests whether all characters between beginning of line and point +are blanks." + (save-excursion + (skip-chars-backward " \t") + (bolp))) + +(defun tuareg-before-change-function (begin end) + (setq tuareg-cache-stop (min tuareg-cache-stop (1- begin)))) + +(defun tuareg-in-literal-p () + "Returns non-nil if point is inside a Caml literal." + (car (tuareg-in-literal-or-comment))) +(defun tuareg-in-comment-p () + "Returns non-nil if point is inside a Caml comment." + (cdr (tuareg-in-literal-or-comment))) +(defun tuareg-in-literal-or-comment-p () + "Returns non-nil if point is inside a Caml literal or comment." + (tuareg-in-literal-or-comment) + (or (car tuareg-last-loc) (cdr tuareg-last-loc))) +(defun tuareg-in-literal-or-comment () + "Returns the pair `((tuareg-in-literal-p) . (tuareg-in-comment-p))'." + (if (and (<= (point) tuareg-cache-stop) tuareg-cache) + (progn + (if (or (not tuareg-cache-local) (not tuareg-cache-last-local) + (and (>= (point) (caar tuareg-cache-last-local)))) + (setq tuareg-cache-local tuareg-cache)) + (while (and tuareg-cache-local (< (point) (caar tuareg-cache-local))) + (setq tuareg-cache-last-local tuareg-cache-local + tuareg-cache-local (cdr tuareg-cache-local))) + (setq tuareg-last-loc + (if tuareg-cache-local + (cons (eq (cadar tuareg-cache-local) 'b) + (> (cddar tuareg-cache-local) 0)) + (cons nil nil)))) + (let ((flag t) (op (point)) (mp (min (point) (1- (point-max)))) + (balance 0) (end-of-comment nil)) + (while (and tuareg-cache (<= tuareg-cache-stop (caar tuareg-cache))) + (setq tuareg-cache (cdr tuareg-cache))) + (if tuareg-cache + (if (eq (cadar tuareg-cache) 'b) + (progn + (setq tuareg-cache-stop (1- (caar tuareg-cache))) + (goto-char tuareg-cache-stop) + (setq balance (cddar tuareg-cache)) + (setq tuareg-cache (cdr tuareg-cache))) + (setq balance (cddar tuareg-cache)) + (setq tuareg-cache-stop (caar tuareg-cache)) + (goto-char tuareg-cache-stop) + (skip-chars-forward "(")) + (goto-char tuareg-cache-stop)) + (skip-chars-backward "\\\\*") + (while flag + (if end-of-comment (setq balance 0 end-of-comment nil)) + (skip-chars-forward "^\\\\'`\"(\\*") + (cond + ((looking-at "\\\\") + (tuareg-forward-char 2)) + ((looking-at "'\\([^\n']\\|\\\\..?.?\\)'") + (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'b balance)) + tuareg-cache)) + (skip-chars-forward "^'") (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'e balance)) + tuareg-cache))) + ((and tuareg-support-camllight + (looking-at "`\\([^\n']\\|\\\\..?.?\\)`")) + (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'b balance)) + tuareg-cache)) + (skip-chars-forward "^`") (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'e balance)) + tuareg-cache))) + ((looking-at "\"") + (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'b balance)) + tuareg-cache)) + (skip-chars-forward "^\\\\\"") + (while (looking-at "\\\\") + (tuareg-forward-char 2) (skip-chars-forward "^\\\\\"")) + (tuareg-forward-char) + (setq tuareg-cache (cons (cons (point) (cons 'e balance)) + tuareg-cache))) + ((looking-at "(\\*") + (setq balance (1+ balance)) + (setq tuareg-cache (cons (cons (point) (cons nil balance)) + tuareg-cache)) + (tuareg-forward-char 2)) + ((looking-at "\\*)") + (tuareg-forward-char 2) + (if (> balance 1) + (prog2 + (setq balance (1- balance)) + (setq tuareg-cache (cons (cons (point) (cons nil balance)) + tuareg-cache))) + (setq end-of-comment t) + (setq tuareg-cache (cons (cons (point) (cons nil 0)) + tuareg-cache)))) + (t (tuareg-forward-char))) + (setq flag (<= (point) mp))) + (setq tuareg-cache-local tuareg-cache + tuareg-cache-stop (point)) + (goto-char op) + (if tuareg-cache (tuareg-in-literal-or-comment) + (setq tuareg-last-loc (cons nil nil)) + tuareg-last-loc)))) + +(defun tuareg-beginning-of-literal-or-comment () + "Skips to the beginning of the current literal or comment (or buffer)." + (interactive) + (if (tuareg-in-literal-or-comment-p) + (tuareg-beginning-of-literal-or-comment-fast))) + +(defun tuareg-beginning-of-literal-or-comment-fast () + (while (and tuareg-cache-local + (or (eq 'b (cadar tuareg-cache-local)) + (> (cddar tuareg-cache-local) 0))) + (setq tuareg-cache-last-local tuareg-cache-local + tuareg-cache-local (cdr tuareg-cache-local))) + (if tuareg-cache-last-local + (goto-char (caar tuareg-cache-last-local)) + (goto-char (point-min))) + (if (eq 'b (cadar tuareg-cache-last-local)) (tuareg-backward-char))) + +(defun tuareg-false-=-p () + "Is the underlying `=' the first/second letter of an operator?" + (or (memq (preceding-char) '(?: ?> ?< ?=)) + (char-equal ?= (char-after (1+ (point)))))) + +(defun tuareg-at-phrase-break-p () + "Is the underlying `;' a phrase break?" + (and (char-equal ?\; (following-char)) + (or (and (not (eobp)) + (char-equal ?\; (char-after (1+ (point))))) + (char-equal ?\; (preceding-char))))) + +(defun tuareg-backward-up-list () + "Safe up-list regarding comments, literals and errors." + (let ((balance 1) (op (point)) (oc nil)) + (tuareg-in-literal-or-comment) + (while (and (> (point) (point-min)) (> balance 0)) + (setq oc (if tuareg-cache-local (caar tuareg-cache-local) (point-min))) + (condition-case nil (up-list -1) (error (goto-char (point-min)))) + (if (>= (point) oc) (setq balance (1- balance)) + (goto-char op) + (skip-chars-backward "^[]{}()") (tuareg-backward-char) + (if (not (tuareg-in-literal-or-comment-p)) + (cond + ((looking-at "[[{(]") + (setq balance (1- balance))) + ((looking-at "[]})]") + (setq balance (1+ balance)))) + (tuareg-beginning-of-literal-or-comment-fast))) + (setq op (point))))) + +(defun tuareg-assoc-indent (kwop &optional look-for-let-or-and) + "Returns relative indentation of the keyword given in argument." + (let ((ind (symbol-value (cdr (assoc kwop tuareg-keyword-alist)))) + (looking-let-or-and (and look-for-let-or-and + (looking-at "\\<\\(let\\|and\\)\\>")))) + (if (string-match "\\<\\(with\\|fun\\(ction\\)?\\|parser?\\)\\>" kwop) + (+ (if (and tuareg-let-always-indent + looking-let-or-and (< ind tuareg-let-indent)) + tuareg-let-indent ind) + tuareg-|-extra-unindent) + ind))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Font-Lock + +(if (and (featurep 'font-lock) + tuareg-window-system) + (progn + (defun tuareg-fontify-buffer () + (font-lock-default-fontify-buffer) + (tuareg-fontify (point-min) (point-max))) + + (defun tuareg-fontify-region (begin end &optional verbose) + (font-lock-default-fontify-region begin end verbose) + (tuareg-fontify begin end)) + + (defun tuareg-after-fontify-buffer () ; compatibility with XEmacs 20.x + (tuareg-fontify (point-min) (point-max))) + + (defun tuareg-fontify (begin end) + (if (eq major-mode 'tuareg-mode) + (save-excursion + (let ((modified (buffer-modified-p))) ; Emacs hack (see below) + (goto-char begin) + (beginning-of-line) + (setq begin (point)) + (goto-char (1- end)) + (end-of-line) + ;; dirty hack to trick `font-lock-default-unfontify-region' + (if (not tuareg-with-xemacs) (forward-line 2)) + (setq end (point)) + (while (> end begin) + (goto-char (1- end)) + (tuareg-in-literal-or-comment) + (cond + ((cdr tuareg-last-loc) + (tuareg-beginning-of-literal-or-comment) + (put-text-property (max begin (point)) end 'face + (if (looking-at + "(\\*[Tt][Ee][Xx]\\|(\\*\\*[^*]") + tuareg-doc-face + 'font-lock-comment-face)) + (setq end (1- (point)))) + ((car tuareg-last-loc) + (tuareg-beginning-of-literal-or-comment) + (put-text-property (max begin (point)) end 'face + 'font-lock-string-face) + (setq end (point))) + (t (while (and tuareg-cache-local + (or (> (caar tuareg-cache-local) end) + (eq 'b (cadar tuareg-cache-local)))) + (setq tuareg-cache-local (cdr tuareg-cache-local))) + (setq end (if tuareg-cache-local + (caar tuareg-cache-local) begin))))) + (if (not (or tuareg-with-xemacs modified)) ; properties taken + (set-buffer-modified-p nil)))))) ; too seriously... + + ; XEmacs and Emacs have different documentation faces... + (defvar tuareg-doc-face (if (facep 'font-lock-doc-face) + 'font-lock-doc-face + 'font-lock-doc-string-face)) + + (if (facep 'font-lock-constant-face) () + (defvar font-lock-constant-face font-lock-reference-face) + (copy-face font-lock-reference-face 'font-lock-constant-face)) + + (defvar tuareg-font-lock-keywords + (list + (list (string-as-multibyte "\\<\\(external\\|open\\|include\\|rule\\|s\\(ig\\|truct\\)\\|module\\([ \t\n]+type\\)?\\|functor\\|\\(with\\|and\\|let\\)[ \t\n]+\\(type\\|module\\)\\|val\\|type\\|method\\|virtual\\|constraint\\|class\\|in\\|inherit\\|initializer\\|let\\|rec\\|and\\|begin\\|object\\|end\\)\\>") + 0 'tuareg-font-lock-governing-face nil nil) + (list (string-as-multibyte "\\.<\\|>\\.\\|\\.~\\|\\.!") + 0 'tuareg-font-lock-multistage-face nil nil) + (list (string-as-multibyte "\\<\\(as\\|do\\(ne\\|wnto\\)?\\|else\\|for\\|if\\|m\\(atch\\|utable\\)\\|new\\|p\\(arser\\|rivate\\)\\|t\\(hen\\|o\\|ry\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|lazy\\|exception\\|raise\\|failwith\\|exit\\|assert\\|fun\\(ction\\)?\\)\\>") + 0 'font-lock-keyword-face nil nil) + (list (string-as-multibyte "\\<\\(\\(method\\([ \t\n]+\\(private\\|virtual\\)\\)?\\)\\([ \t\n]+virtual\\)?\\|val\\([ \t\n]+mutable\\)?\\|external\\|and\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t]*\\(\\(\\w\\|[->_ \t,?~.]\\|(\\(\\w\\|[->_ \t,?~.=]\\)*)\\)*\\)") + 8 'font-lock-variable-name-face nil nil) + (list (string-as-multibyte "\\<\\(\\(method\\([ \t\n]+\\(private\\|virtual\\)\\)?\\)\\([ \t\n]+virtual\\)?\\|val\\([ \t\n]+mutable\\)?\\|external\\|and\\|let\\([ \t\n]+rec\\)?\\)\\>[ \t]*\\(['_a-z\277-\377]\\(\\w\\|[._]\\)*\\)\\>[ \t]*\\(\\w\\|[()_?~.]\\|:?\\(\\w\\|[ \t ->_*]\\)*=[ \t]*fun\\(ction\\)?\\>\\)") + 8 'font-lock-function-name-face t nil) + (list (string-as-multibyte "\\<\\(open\\|\\(class\\([ \t\n]+type\\)?\\)\\([ \t\n]+virtual\\)?\\|inherit\\|include\\|module\\([ \t\n]+\\(type\\|rec\\)\\)?\\|type\\)\\>[ \t]*\\(\\(\\<['_A-Za-z\277-\377~?]\\w*\\>[ \t]*\\)*\\<['_A-Za-z\277-\377~?]\\w*\\>:?\\)\\>") + 7 'font-lock-type-face nil nil) + (list (string-as-multibyte "\\<\\([A-Z]\\w*\\>\\)[ \t]*\\.") + 1 'font-lock-type-face nil nil) + (list (string-as-multibyte "\\<\\([?~]?[_A-Za-z\277-\377]\\w*[ \t\n]*:\\)[^:>=]") + 1 'font-lock-variable-name-face nil nil) + (list (string-as-multibyte "\\[ \t]*\\(\\<[_A-Za-z\277-\377]\\w*\\>\\)") + 1 'font-lock-variable-name-face nil nil) + (list (string-as-multibyte "\\<\\(as[lr]\\|false\\|l\\(and\\|xor\\|or\\|s[lr]\\)mod\\|not\\|ref\\|o[fr]\\|true\\|unit\\)\\>") + 0 'font-lock-constant-face nil nil) + (list (string-as-multibyte "[][;,()|{}]\\|[@^!:*=<>&/%+~?---]\\.?\\|\\.\\.\\.*") + 0 'tuareg-font-lock-operator-face nil nil) + (list (string-as-multibyte "^#\\w\\w*\\>") + 0 'font-lock-preprocessor-face nil nil)) + "Font-Lock patterns for Tuareg mode.") + + (when (featurep 'sym-lock) + (make-face 'tuareg-font-lock-lambda-face + "Face description for fun keywords (lambda operator).") + (set-face-parent 'tuareg-font-lock-lambda-face + tuareg-font-lock-governing-face) + (set-face-font 'tuareg-font-lock-lambda-face + sym-lock-font-name) + + ;; to change this table, xfd -fn '-adobe-symbol-*--12-*' may be + ;; used to determine the symbol character codes. + (defvar tuareg-sym-lock-keywords + '(("<-" 0 1 172 nil) + ("->" 0 1 174 nil) + ("<=" 0 1 163 nil) + (">=" 0 1 179 nil) + ("<>" 0 1 185 nil) + ("==" 0 1 186 nil) + ("||" 0 1 218 nil) + ("&&" 0 1 217 nil) + ("[^*]\\(\\*\\)\\." 1 8 180 nil) + ("\\(/\\)\\." 1 3 184 nil) + (";;" 0 1 191 nil) + ("\\" 0 3 214 nil) + ("\\" 0 3 108 tuareg-font-lock-lambda-face) + ("\\" 0 3 218 nil) + ("\\" 0 3 216 nil)) + "If non nil: Overrides default Sym-Lock patterns for Tuareg.")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Keymap + +(defvar tuareg-mode-map nil + "Keymap used in Tuareg mode.") +(setq tuareg-mode-map (make-sparse-keymap)) +(define-key tuareg-mode-map "|" 'tuareg-electric) +(define-key tuareg-mode-map ")" 'tuareg-electric-rp) +(define-key tuareg-mode-map "}" 'tuareg-electric-rc) +(define-key tuareg-mode-map "]" 'tuareg-electric-rb) +(define-key tuareg-mode-map "\t" 'tuareg-indent-command) +(define-key tuareg-mode-map "\M-q" 'tuareg-indent-phrase) +(define-key tuareg-mode-map "\C-c\C-q" 'tuareg-indent-phrase) +(define-key tuareg-mode-map "\M-\C-\\" 'indent-region) +(define-key tuareg-mode-map "\C-c\C-a" 'tuareg-find-alternate-file) +(define-key tuareg-mode-map "\C-c\C-c" 'compile) +(define-key tuareg-mode-map "\C-xnd" 'tuareg-narrow-to-phrase) +(define-key tuareg-mode-map "\M-\C-x" 'tuareg-eval-phrase) +(define-key tuareg-mode-map "\C-x\C-e" 'tuareg-eval-phrase) +(define-key tuareg-mode-map "\C-c\C-e" 'tuareg-eval-phrase) +(define-key tuareg-mode-map "\C-c\C-r" 'tuareg-eval-region) +(define-key tuareg-mode-map "\C-c\C-b" 'tuareg-eval-buffer) +(define-key tuareg-mode-map "\C-c\C-s" 'tuareg-run-caml) +(define-key tuareg-mode-map "\C-c\C-i" 'tuareg-interrupt-caml) +(define-key tuareg-mode-map "\C-c\C-k" 'tuareg-kill-caml) +(define-key tuareg-mode-map "\C-c\C-n" 'tuareg-next-phrase) +(define-key tuareg-mode-map "\C-c\C-p" 'tuareg-previous-phrase) +(define-key tuareg-mode-map [(control c) (home)] 'tuareg-move-inside-block-opening) +(define-key tuareg-mode-map [(control c) (control down)] 'tuareg-next-phrase) +(define-key tuareg-mode-map [(control c) (control up)] 'tuareg-previous-phrase) +(define-key tuareg-mode-map [(meta control down)] 'tuareg-next-phrase) +(define-key tuareg-mode-map [(meta control up)] 'tuareg-previous-phrase) +(define-key tuareg-mode-map [(meta control h)] 'tuareg-mark-phrase) +(define-key tuareg-mode-map "\C-c`" 'tuareg-interactive-next-error-source) +(define-key tuareg-mode-map "\C-c?" 'tuareg-interactive-next-error-source) +(define-key tuareg-mode-map "\C-c.c" 'tuareg-insert-class-form) +(define-key tuareg-mode-map "\C-c.b" 'tuareg-insert-begin-form) +(define-key tuareg-mode-map "\C-c.f" 'tuareg-insert-for-form) +(define-key tuareg-mode-map "\C-c.w" 'tuareg-insert-while-form) +(define-key tuareg-mode-map "\C-c.i" 'tuareg-insert-if-form) +(define-key tuareg-mode-map "\C-c.l" 'tuareg-insert-let-form) +(define-key tuareg-mode-map "\C-c.m" 'tuareg-insert-match-form) +(define-key tuareg-mode-map "\C-c.t" 'tuareg-insert-try-form) + +(when tuareg-with-caml-mode-p + ;; caml-types + (define-key tuareg-mode-map [?\C-c?\C-t] 'caml-types-show-type) + ;; to prevent misbehavior in case of error during exploration. + (define-key tuareg-mode-map [(control mouse-2)] 'caml-types-mouse-ignore) + (define-key tuareg-mode-map [(control down-mouse-2)] 'caml-types-explore) + ;; caml-help + (define-key tuareg-mode-map [?\C-c?i] 'ocaml-add-path) + (define-key tuareg-mode-map [?\C-c?[] 'ocaml-open-module) + (define-key tuareg-mode-map [?\C-c?]] 'ocaml-close-module) + (define-key tuareg-mode-map [?\C-c?h] 'caml-help) + (define-key tuareg-mode-map [?\C-c?\t] 'caml-complete)) + +(defvar tuareg-mode-syntax-table (make-syntax-table) + "Syntax table in use in Tuareg mode buffers.") + +(modify-syntax-entry ?_ "_" tuareg-mode-syntax-table) +(modify-syntax-entry ?? "w" tuareg-mode-syntax-table) +(modify-syntax-entry ?~ "w" tuareg-mode-syntax-table) +(modify-syntax-entry ?: "." tuareg-mode-syntax-table) +(modify-syntax-entry ?' "w" tuareg-mode-syntax-table) +;; ' is part of words (for primes) +(if tuareg-support-camllight + (modify-syntax-entry ?` "\"" tuareg-mode-syntax-table) + (modify-syntax-entry ?` "." tuareg-mode-syntax-table)) +;; ` is punctuation or character delimiter (Caml Light compatibility) +(modify-syntax-entry ?\" "\"" tuareg-mode-syntax-table) +;; " is a string delimiter +(modify-syntax-entry ?\\ "\\" tuareg-mode-syntax-table) +(modify-syntax-entry ?\( "()1" tuareg-mode-syntax-table) +(modify-syntax-entry ?* ".23" tuareg-mode-syntax-table) +(modify-syntax-entry ?\) ")(4" tuareg-mode-syntax-table) +(let ((i 192)) + (while (< i 256) + (modify-syntax-entry i "w" tuareg-mode-syntax-table) + (setq i (1+ i)))) + +(defconst tuareg-font-lock-syntax + '((?_ . "w") (?` . ".") (?\" . ".") (?\( . ".") (?\) . ".") (?* . ".")) + "Syntax changes for Font-Lock.") + +(defvar tuareg-mode-abbrev-table () + "Abbrev table used for Tuareg mode buffers.") +(defun tuareg-define-abbrev (keyword) + (define-abbrev tuareg-mode-abbrev-table keyword keyword 'tuareg-abbrev-hook)) +(if tuareg-mode-abbrev-table () + (setq tuareg-mode-abbrev-table (make-abbrev-table)) + (mapcar 'tuareg-define-abbrev + '("module" "class" "object" "type" "val" "inherit" "virtual" + "constraint" "exception" "external" "open" "method" "and" + "initializer" "to" "downto" "do" "done" "else" "begin" "end" + "let" "in" "then" "with")) + (setq abbrevs-changed nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The major mode + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.ml[ily]?\\'" . tuareg-mode)) +(defun tuareg-mode () + "Major mode for editing Caml code. + +Dedicated to Emacs and XEmacs, version 20 and higher. Provides +automatic indentation and compilation interface. Performs font/color +highlighting using Font-Lock. It is designed for Objective Caml but +handles Objective Labl and Caml Light as well. + +Report bugs, remarks and questions to Albert.Cohen@prism.uvsq.fr. + +The Font-Lock minor-mode is used accordingly to your customization +options. Within XEmacs (non-MULE versions only) you may also want to +use Sym-Lock: + +\(if (and (boundp 'window-system) window-system) + (when (string-match \"XEmacs\" emacs-version) + (if (not (and (boundp 'mule-x-win-initted) mule-x-win-initted)) + (require 'sym-lock)) + (require 'font-lock))) + +You have better byte-compile tuareg.el (and sym-lock.el if you use it) +because symbol highlighting is very time consuming. + +For customization purposes, you should use `tuareg-mode-hook' +\(run for every file) or `tuareg-load-hook' (run once) and not patch +the mode itself. You should add to your configuration file something like: + \(add-hook 'tuareg-mode-hook + '(lambda () + ... ; your customization code + )) +For example you can change the indentation of some keywords, the +`electric' flags, Font-Lock colors... Every customizable variable is +documented, use `C-h-v' or look at the mode's source code. + +A special case is Sym-Lock customization: You may set +`tuareg-sym-lock-keywords' in your `.emacs' configuration file +to override default Sym-Lock patterns. + +`custom-tuareg.el' is a sample customization file for standard changes. +You can append it to your `.emacs' or use it as a tutorial. + +`M-x camldebug' FILE starts the Caml debugger camldebug on the executable +FILE, with input and output in an Emacs buffer named *camldebug-FILE*. + +A Tuareg Interactive Mode to evaluate expressions in a toplevel is included. +Type `M-x tuareg-run-caml' or see special-keys below. + +Some elementary rules have to be followed in order to get the best of +indentation facilities. + - Because the `function' keyword has a special indentation (to handle + case matchs) use the `fun' keyword when no case match is performed. + - Prefer the `or' keyword to `||' (they are semantically equivalent), + it avoids some unwanted electric indentations. + - In OCaml, `;;' is no longer necessary for correct indentation, + except before top level phrases not introduced by `type', `val', `let' + etc. (i.e., phrases used for their side-effects or to be executed + in a top level.) + - Long sequences of `and's may slow down indentation slightly, since + some computations (few) require to go back to the beginning of the + sequence. Some very long nested blocks may also lead to slow + processing of `end's, `else's, `done's... + - Multiline strings are handled properly, but the string concatenation `^' + is preferred to break long strings (the C-j keystroke can help). + +Known bugs: + - When writting a line with mixed code and comments, avoid putting + comments at the beginning or middle of the text. More precisely, + writing comments immediately after `=' or parentheses then writing + some more code on the line leads to indentation errors. You may write + `let x (* blah *) = blah' but should avoid `let x = (* blah *) blah'. + +Special keys for Tuareg mode:\\{tuareg-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'tuareg-mode) + (setq mode-name "Tuareg") + (use-local-map tuareg-mode-map) + (set-syntax-table tuareg-mode-syntax-table) + (setq local-abbrev-table tuareg-mode-abbrev-table) + + (if tuareg-window-system (tuareg-build-menu)) + + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (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 "(\\*+[ \t]*") + (make-local-variable 'comment-multi-line) + (setq comment-multi-line t) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments nil) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'tuareg-indent-command) + (make-local-hook 'before-change-functions) + (add-hook 'before-change-functions 'tuareg-before-change-function nil t) + (make-local-variable 'normal-auto-fill-function) + (setq normal-auto-fill-function 'tuareg-auto-fill-function) + + ;; hooks for tuareg-mode, use them for tuareg-mode configuration + (run-hooks 'tuareg-mode-hook) + (tuareg-install-font-lock) + (if tuareg-use-abbrev-mode (abbrev-mode 1)) + (message (concat "Major mode for Caml programs, " + tuareg-mode-version "."))) + +(defun tuareg-install-font-lock (&optional no-sym-lock) + (if (and (featurep 'font-lock) + tuareg-window-system) + (progn + (if (and (not no-sym-lock) + (featurep 'sym-lock)) + (progn + (setq sym-lock-color + (face-foreground 'tuareg-font-lock-operator-face)) + (if (not sym-lock-keywords) + (sym-lock tuareg-sym-lock-keywords)))) + (setq font-lock-defaults + (list 'tuareg-font-lock-keywords t nil + tuareg-font-lock-syntax nil + '(font-lock-fontify-buffer-function + . tuareg-fontify-buffer) + '(font-lock-fontify-region-function + . tuareg-fontify-region))) + (make-local-variable 'font-lock-fontify-buffer-function) + (if (boundp 'font-lock-fontify-buffer-function) + (setq font-lock-fontify-buffer-function 'tuareg-fontify-buffer) + (add-hook 'font-lock-after-fontify-buffer-hook + 'tuareg-after-fontify-buffer)) + (make-local-variable 'font-lock-fontify-region-function) + (if (boundp 'font-lock-fontify-region-function) + (setq font-lock-fontify-region-function 'tuareg-fontify-region)) + (font-lock-set-defaults) + (if (not (or tuareg-with-xemacs font-lock-mode)) + (font-lock-mode 1)) ; useful for beginners if not standard + 'font-lock))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Error processing + +(require 'compile) + +;; In some versions of Emacs, 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 tuareg-error-regexp + (string-as-multibyte "^[A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]") + "Regular expression matching the error messages produced by (o)camlc.") + +(if (boundp 'compilation-error-regexp-alist) + (or (assoc tuareg-error-regexp + compilation-error-regexp-alist) + (setq compilation-error-regexp-alist + (cons (list tuareg-error-regexp 1 2) + compilation-error-regexp-alist)))) + +;; A regexp to extract the range info. + +(defconst tuareg-error-chars-regexp + (string-as-multibyte ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):") + "Regular expression extracting the character numbers +from an error message produced by (o)camlc.") + +;; Wrapper around next-error. + +;; itz 04-21-96 somebody didn't get the documentation 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 tuareg-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 'tuareg-mode) + (let ((beg nil) (end nil)) + (save-excursion + (set-buffer compilation-last-buffer) + (save-excursion + (goto-char (window-point (get-buffer-window (current-buffer) t))) + (if (looking-at tuareg-error-chars-regexp) + (setq beg (string-to-int (tuareg-match-string 1)) + end (string-to-int (tuareg-match-string 2)))))) + (beginning-of-line) + (if beg + (progn + (setq beg (+ (point) beg) end (+ (point) end)) + (goto-char beg) (push-mark end t t)))))) + +(defvar tuareg-interactive-error-regexp + (concat "\\(\\(" + "Toplevel input:" + "\\|Entr.e interactive:" + "\\|Characters [0-9-]*:" + "\\|Toplevel input:" + "\\|The global value [^ ]* is referenced before being defined." + "\\|La valeur globale [^ ]* est utilis.e avant d'.tre d.finie." + "\\|Reference to undefined global" + "\\|The C primitive \"[^\"]*\" is not available." + "\\|La primitive C \"[^\"]*\" est inconnue." + "\\|Cannot find \\(the compiled interface \\)?file" + "\\|L'interface compil.e [^ ]* est introuvable." + "\\|Le fichier [^ ]* est introuvable." + "\\|Exception non rattrap.e:" + "\\|Uncaught exception:" + "\\)[^#]*\\)" ) + "Regular expression matching the error messages produced by Caml.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Indentation stuff + +(defconst tuareg-keyword-regexp "\\<\\(object\\|initializer\\|and\\|c\\(onstraint\\|lass\\)\\|m\\(atch\\|odule\\|ethod\\|utable\\)\\|s\\(ig\\|truct\\)\\|begin\\|e\\(lse\\|x\\(ception\\|ternal\\)\\)\\|t\\(o\\|hen\\|ry\\|ype\\)\\|v\\(irtual\\|al\\)\\|w\\(h\\(ile\\|en\\)\\|ith\\)\\|i\\(f\\|n\\(herit\\)?\\)\\|f\\(or\\|un\\(ct\\(or\\|ion\\)\\)?\\)\\|let\\|do\\(wnto\\)?\\|parser?\\|rule\\|of\\)\\>\\|->\\|[;,|]" + "Regexp for all recognized keywords.") + +(defconst tuareg-match-|-keyword-regexp + "\\<\\(and\\|fun\\(ction\\)?\\|type\\|with\\|parser?\\)\\>\\|[[({|=]" + "Regexp for keywords supporting case match.") + +(defconst tuareg-operator-regexp "[---+*/=<>@^&|]\\|:>\\|::\\|\\<\\(or\\|l\\(and\\|x?or\\|s[lr]\\)\\|as[lr]\\|mod\\)\\>" + "Regexp for all operators.") + +(defconst tuareg-kwop-regexp (concat tuareg-keyword-regexp "\\|=") + "Regexp for all keywords, and the = operator which is generally +considered as a special keyword.") + +(defconst tuareg-matching-keyword-regexp + "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|>\\." + "Regexp matching Caml keywords which act as end block delimiters.") + +(defconst tuareg-leading-kwop-regexp + (concat tuareg-matching-keyword-regexp "\\|\\\\|[|>]?\\]\\|>?}\\|[|)]\\|;;") + "Regexp matching Caml keywords which need special indentation.") + +(defconst tuareg-governing-phrase-regexp + "\\<\\(val\\|type\\|m\\(ethod\\|odule\\)\\|c\\(onstraint\\|lass\\)\\|in\\(herit\\|itializer\\)\\|ex\\(ternal\\|ception\\)\\|open\\|let\\|object\\|include\\)\\>" + "Regexp matching tuareg phrase delimitors.") + +(defconst tuareg-governing-phrase-regexp-with-break + (concat tuareg-governing-phrase-regexp "\\|;;")) + +(defconst tuareg-keyword-alist + '(("module" . tuareg-default-indent) + ("class" . tuareg-class-indent) + ("sig" . tuareg-sig-struct-indent) + ("struct" . tuareg-sig-struct-indent) + ("method" . tuareg-method-indent) + ("object" . tuareg-begin-indent) + ("begin" . tuareg-begin-indent) + (".<" . tuareg-begin-indent) + ("for" . tuareg-for-while-indent) + ("while" . tuareg-for-while-indent) + ("do" . tuareg-do-indent) + ("type" . tuareg-type-indent) ; in some cases, `type' acts like a match + ("val" . tuareg-val-indent) + ("fun" . tuareg-fun-indent) + ("if" . tuareg-if-then-else-indent) + ("then" . tuareg-if-then-else-indent) + ("else" . tuareg-if-then-else-indent) + ("let" . tuareg-let-indent) + ("match" . tuareg-match-indent) + ("try" . tuareg-try-indent) + ("rule" . tuareg-rule-indent) + + ;; case match keywords + ("function" . tuareg-function-indent) + ("with" . tuareg-with-indent) + ("parse" . tuareg-parse-indent) + ("parser" . tuareg-parser-indent) + + ;; default indentation keywords + ("when" . tuareg-default-indent) + ("functor" . tuareg-default-indent) + ("exception" . tuareg-default-indent) + ("inherit" . tuareg-default-indent) + ("initializer" . tuareg-default-indent) + ("constraint" . tuareg-default-indent) + ("virtual" . tuareg-default-indent) + ("mutable" . tuareg-default-indent) + ("external" . tuareg-default-indent) + ("in" . tuareg-in-indent) + ("of" . tuareg-default-indent) + ("to" . tuareg-default-indent) + ("downto" . tuareg-default-indent) + (".<" . tuareg-default-indent) + ("[" . tuareg-default-indent) + ("(" . tuareg-default-indent) + ("{" . tuareg-default-indent) + ("->" . tuareg-default-indent) + ("|" . tuareg-default-indent)) +"Association list of indentation values based on governing keywords.") + +(defconst tuareg-leading-kwop-alist + '(("|" . tuareg-find-|-match) + ("}" . tuareg-find-match) + (">}" . tuareg-find-match) + (">." . tuareg-find-match) + (")" . tuareg-find-match) + ("]" . tuareg-find-match) + ("|]" . tuareg-find-match) + (">]" . tuareg-find-match) + ("end" . tuareg-find-match) + ("done" . tuareg-find-done-match) + ("in" . tuareg-find-in-match) + ("with" . tuareg-find-with-match) + ("else" . tuareg-find-else-match) + ("then" . tuareg-find-match) + ("do" . tuareg-find-do-match) + ("to" . tuareg-find-match) + ("downto" . tuareg-find-match) + ("and" . tuareg-find-and-match)) + "Association list used in Tuareg mode for skipping back over nested blocks.") + +(defun tuareg-find-meaningful-word () + "Look back for a word, skipping comments and blanks. +Returns the actual text of the word, if found." + (let ((found nil) (kwop nil)) + (while (and (not found) + (re-search-backward + (string-as-multibyte + "[^ \t\n'_0-9A-Za-z\277-\377]\\|\\<\\(\\w\\|_\\)+\\>\\|\\*)") + (point-min) t)) + (setq kwop (tuareg-match-string 0)) + (if kwop + (if (tuareg-in-comment-p) + (tuareg-beginning-of-literal-or-comment-fast) + (setq found t)) + (setq found t))) + (if found kwop (goto-char (point-min)) nil))) + +(defconst tuareg-find-kwop-regexp + (concat tuareg-matching-keyword-regexp "\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|object\\)\\>\\|[][(){}]\\|\\.<\\|>\\.\\|\\*)")) +(defun tuareg-make-find-kwop-regexp (kwop-regexp) + (concat tuareg-find-kwop-regexp "\\|" kwop-regexp)) + +(defun tuareg-find-kwop (kwop-regexp &optional do-not-skip-regexp) + "Look back for a Caml keyword or operator matching KWOP-REGEXP. +Skips blocks etc... + +Ignore occurences inside literals and comments. +If found, return the actual text of the keyword or operator." + (let ((found nil) (kwop nil)) + (while (and (not found) + (re-search-backward kwop-regexp (point-min) t) + (setq kwop (tuareg-match-string 0))) + (cond + ((tuareg-in-literal-or-comment-p) + (tuareg-beginning-of-literal-or-comment-fast)) + ((looking-at "[]})]") + (tuareg-backward-up-list)) + ((tuareg-at-phrase-break-p) + (setq found t)) + ((and do-not-skip-regexp (looking-at do-not-skip-regexp)) + (if (and (string= kwop "|") (char-equal ?| (preceding-char))) + (backward-char) + (setq found t))) + ((looking-at tuareg-matching-keyword-regexp) + (funcall (cdr (assoc (tuareg-match-string 0) + tuareg-leading-kwop-alist)))) + (t (setq found t)))) + (if found kwop (goto-char (point-min)) nil))) + +(defun tuareg-find-match () + (tuareg-find-kwop tuareg-find-kwop-regexp)) + +(defconst tuareg-find-with-match-regexp + (tuareg-make-find-kwop-regexp + "\\<\\(match\\|try\\|module\\|begin\\|with\\)\\>\\|[[{(]")) +(defun tuareg-find-with-match () + (let ((kwop (tuareg-find-kwop tuareg-find-with-match-regexp + "\\"))) + (if (string= kwop "with") + (progn + (tuareg-find-with-match) + (tuareg-find-with-match))) + kwop)) + +(defconst tuareg-find-in-match-regexp + (tuareg-make-find-kwop-regexp "\\")) +(defun tuareg-find-in-match () + (let ((kwop (tuareg-find-kwop tuareg-find-in-match-regexp "\\"))) + (cond ((string= kwop "and") (tuareg-find-in-match)) + (t kwop)))) + +(defconst tuareg-find-else-match-regexp + (tuareg-make-find-kwop-regexp ";")) +(defun tuareg-find-else-match () + (let ((kwop (tuareg-find-kwop tuareg-find-else-match-regexp + "\\"))) + (cond ((string= kwop "then") + (tuareg-find-match) kwop) + ((string= kwop ";") + (tuareg-find-semi-colon-match) + (tuareg-find-else-match) kwop)))) + +(defun tuareg-find-do-match () + (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp + "\\<\\(down\\)?to\\>"))) + (if (or (string= kwop "to") (string= kwop "downto")) + (tuareg-find-match) kwop))) + +(defun tuareg-find-done-match () + (let ((kwop (tuareg-find-kwop tuareg-find-kwop-regexp "\\"))) + (if (string= kwop "do") + (tuareg-find-do-match) kwop))) + +(defconst tuareg-find-and-match-regexp + "\\<\\(do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|then\\|\\(down\\)?to\\)\\>\\|\\<\\(for\\|while\\|do\\|if\\|begin\\|s\\(ig\\|truct\\)\\|class\\)\\>\\|[][(){}]\\|\\*)\\|\\<\\(rule\\|exception\\|let\\|in\\|type\\|val\\|module\\)\\>") +(defconst tuareg-find-and-match-regexp-dnr + (concat tuareg-find-and-match-regexp "\\|\\")) +(defun tuareg-find-and-match (&optional do-not-recurse) + (let* ((kwop (tuareg-find-kwop (if do-not-recurse + tuareg-find-and-match-regexp-dnr + tuareg-find-and-match-regexp) + "\\")) + (old-point (point))) + (cond ((or (string= kwop "type") (string= kwop "module")) + (let ((kwop2 (tuareg-find-meaningful-word))) + (cond ((string= kwop2 "with") + kwop2) + ((string= kwop2 "and") + (tuareg-find-and-match)) + ((and (string= kwop "module") + (string= kwop2 "let")) + kwop2) + (t (goto-char old-point) kwop)))) + (t kwop)))) + +(defconst tuareg-find-=-match-regexp + (tuareg-make-find-kwop-regexp "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|type\\|class\\|when\\|i[fn]\\)\\>\\|=")) +(defun tuareg-find-=-match () + (let ((kwop (tuareg-find-kwop tuareg-find-=-match-regexp + "\\<\\(and\\|in\\)\\>\\|="))) + (if (string= kwop "and") + (tuareg-find-and-match) + (if (and (string= kwop "=") (not (tuareg-false-=-p))) + (tuareg-find-=-match)) + kwop))) + +(defun tuareg-if-when-= () + (save-excursion + (tuareg-find-=-match) + (looking-at "\\<\\(if\\|when\\)\\>"))) + +(defun tuareg-captive-= () + (save-excursion + (tuareg-find-=-match) + (looking-at "\\<\\(if\\|when\\|module\\|type\\|class\\)\\>"))) + +(defconst tuareg-find-|-match-regexp + (tuareg-make-find-kwop-regexp + "\\<\\(with\\|fun\\(ction\\)?\\|type\\|parser?\\)\\>\\|[=|]")) +(defun tuareg-find-|-match () + (let* ((kwop (tuareg-find-kwop tuareg-find-|-match-regexp + "\\<\\(and\\|with\\)\\>\\||")) + (old-point (point))) + (cond ((string= kwop "and") + (setq old-point (point)) + (setq kwop (tuareg-find-and-match)) + (goto-char old-point) + kwop) + ((and (string= kwop "|") + (looking-at "|[^|]") + (tuareg-in-indentation-p)) + kwop) + ((string= kwop "|") (tuareg-find-|-match)) + ((and (string= kwop "=") + (or (looking-at "=[ \t]*\\((\\*\\|$\\)") + (tuareg-false-=-p) + (not (string= (save-excursion (tuareg-find-=-match)) + "type")))) + (tuareg-find-|-match)) + ((string= kwop "parse") + (if (and (string-match "\\.mll" (buffer-name)) + (save-excursion + (string= (tuareg-find-meaningful-word) "="))) + kwop (tuareg-find-|-match))) + (t kwop)))) + +(defconst tuareg-find-->-match-regexp + (tuareg-make-find-kwop-regexp "\\<\\(external\\|val\\|method\\|let\\|with\\|fun\\(ction\\|ctor\\)?\\|parser\\)\\>\\|[|:;]")) +(defun tuareg-find-->-match () + (let ((kwop (tuareg-find-kwop tuareg-find-->-match-regexp "\\"))) + (cond + ((string= kwop "|") + (if (tuareg-in-indentation-p) + kwop + (prog2 (forward-char -1) (tuareg-find-->-match)))) + ((not (string= kwop ":")) kwop) + ;; if we get this far, we know we're looking at a colon. + ((or (char-equal (char-before) ?:) + (char-equal (char-after (1+ (point))) ?:) + (char-equal (char-after (1+ (point))) ?>)) + (tuareg-find-->-match)) + ;; patch by T. Freeman + (t (let ((oldpoint (point)) + (match (tuareg-find-->-match))) + (if (looking-at ":") + match + (progn + ;; go back to where we were before the recursive call. + (goto-char oldpoint) + kwop))))))) + +(defconst tuareg-find-semi-colon-match-regexp + (tuareg-make-find-kwop-regexp ";[ \t]*\\((\\*\\|$\\)\\|->\\|\\<\\(let\\|method\\|with\\|try\\|initializer\\)\\>")) +(defun tuareg-find-semi-colon-match (&optional leading-semi-colon) + (tuareg-find-kwop tuareg-find-semi-colon-match-regexp + "\\<\\(in\\|end\\|and\\|do\\|with\\)\\>") + ;; we don't need to find the keyword matching `and' since we know it's `let'! + (cond + ((looking-at ";[ \t]*\\((\\*\\|$\\)") + (forward-line 1) + (while (or (tuareg-in-comment-p) + (looking-at "^[ \t]*\\((\\*\\|$\\)")) + (forward-line 1)) + (back-to-indentation) + (current-column)) + ((and leading-semi-colon + (looking-at "\\((\\|\\[[<|]?\\|{[ \t]*\\((\\*\\|$\\)") + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-method-indent)) + ((looking-at "\\[ \t]*\\((\\*\\|$\\)") + (tuareg-back-to-paren-or-indentation t) + (+ (current-column) tuareg-begin-indent)) + ((looking-at "->") + (if (save-excursion + (tuareg-find-->-match) + (looking-at "\\<\\(with\\|fun\\(ction\\)?\\|parser\\)\\>\\||")) + (progn + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-default-indent)) + (tuareg-find-semi-colon-match))) + ((looking-at "\\") + (tuareg-find-match) + (tuareg-find-semi-colon-match)) + ((looking-at "\\") + (tuareg-find-in-match) + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-in-indent)) + ((looking-at "\\") + (+ (current-column) tuareg-let-indent)) + (t (tuareg-back-to-paren-or-indentation t) + (+ (current-column) tuareg-default-indent)))) + +(defconst tuareg-find-phrase-indentation-regexp + (tuareg-make-find-kwop-regexp (concat tuareg-governing-phrase-regexp + "\\|\\"))) +(defconst tuareg-find-phrase-indentation-regexp-pb + (concat tuareg-find-phrase-indentation-regexp "\\|;;")) +(defconst tuareg-find-phrase-indentation-class-regexp + (concat tuareg-matching-keyword-regexp "\\|\\")) +(defun tuareg-find-phrase-indentation (&optional phrase-break) + (if (and (looking-at "\\<\\(type\\|module\\)\\>") (> (point) (point-min)) + (save-excursion + (tuareg-find-meaningful-word) + (looking-at "\\<\\(module\\|with\\|and\\|let\\)\\>"))) + (progn + (tuareg-find-meaningful-word) + (+ (current-column) tuareg-default-indent)) + (let ((looking-at-and (looking-at "\\")) + (kwop (tuareg-find-kwop + (if phrase-break + tuareg-find-phrase-indentation-regexp-pb + tuareg-find-phrase-indentation-regexp) + "\\<\\(end\\|and\\|with\\|in\\)\\>")) + (tmpkwop nil) (curr nil)) + (if (and kwop (string= kwop "and")) + (setq kwop (tuareg-find-and-match))) + (if (not kwop) (current-column) + (cond + ((string= kwop "end") + (if (not (save-excursion + (setq tmpkwop (tuareg-find-match)) + (setq curr (point)) + (string= tmpkwop "object"))) + (prog2 + (tuareg-find-match) + (tuareg-find-phrase-indentation phrase-break)) + (tuareg-find-kwop tuareg-find-phrase-indentation-class-regexp) + (current-column))) + ((and (string= kwop "with") + (not (save-excursion + (setq tmpkwop (tuareg-find-with-match)) + (setq curr (point)) + (string= tmpkwop "module")))) + (goto-char curr) + (tuareg-find-phrase-indentation phrase-break)) + ((and (string= kwop "in") + (not (save-excursion + (setq tmpkwop (tuareg-find-in-match)) + (if (string= tmpkwop "and") + (setq tmpkwop (tuareg-find-and-match))) + (setq curr (point)) + (and (string= tmpkwop "let") + (not (tuareg-looking-at-expression-let)))))) + (goto-char curr) + (tuareg-find-phrase-indentation phrase-break)) + ((tuareg-at-phrase-break-p) + (end-of-line) + (tuareg-skip-blank-and-comments) + (current-column)) + ((string= kwop "let") + (if (tuareg-looking-at-expression-let) + (tuareg-find-phrase-indentation phrase-break) + (current-column))) + ((string= kwop "with") + (current-column)) + ((string= kwop "end") + (current-column)) + ((string= kwop "in") + (tuareg-find-in-match) + (current-column)) + ((string= kwop "class") + (tuareg-back-to-paren-or-indentation) + (current-column)) + ((looking-at "\\<\\(object\\|s\\(ig\\|truct\\)\\)\\>") + (tuareg-back-to-paren-or-indentation t) + (+ (tuareg-assoc-indent kwop) (current-column))) + ((or (string= kwop "type") (string= kwop "module")) + (if (or (tuareg-looking-at-false-type) + (tuareg-looking-at-false-module)) + (if looking-at-and (current-column) + (tuareg-find-meaningful-word) + (if (looking-at "\\") + (prog2 + (tuareg-find-and-match) + (tuareg-find-phrase-indentation phrase-break)) + (tuareg-find-phrase-indentation phrase-break))) + (current-column))) + ((looking-at + "\\(\\.<\\|(\\|\\[[<|]?\\|{\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") +(defconst tuareg-back-to-paren-or-indentation-in-regexp + (concat "\\\\|" tuareg-back-to-paren-or-indentation-regexp)) +(defconst tuareg-back-to-paren-or-indentation-lazy-regexp + "[])}]\\|\\.<\\|>\\.\\|\\*)\\|^[ \t]*\\(.\\|\n\\)") +(defconst tuareg-back-to-paren-or-indentation-lazy-in-regexp + (concat "\\\\|" tuareg-back-to-paren-or-indentation-regexp)) +(defun tuareg-back-to-paren-or-indentation (&optional forward-in) + "Searches backwards for the first open paren in line, or skip to indentation. +Returns t iff skipped to indentation." + (if (or (bolp) (tuareg-in-indentation-p)) (prog2 (back-to-indentation) t) + (let ((kwop (tuareg-find-kwop + (if tuareg-lazy-paren + (if forward-in + tuareg-back-to-paren-or-indentation-lazy-in-regexp + tuareg-back-to-paren-or-indentation-lazy-regexp) + (if forward-in + tuareg-back-to-paren-or-indentation-in-regexp + tuareg-back-to-paren-or-indentation-regexp)) + "\\")) + (retval)) + (if (string= kwop "with") + (let ((with-point (point))) + (setq kwop (tuareg-find-with-match)) + (if (or (string= kwop "match") (string= kwop "try")) + (tuareg-find-kwop + tuareg-back-to-paren-or-indentation-regexp + "\\") + (setq kwop "with") (goto-char with-point)))) + (setq retval + (cond + ((string= kwop "with") nil) + ((string= kwop "in") (tuareg-in-indentation-p)) + ((looking-at "[[{(]\\|\\.<") (tuareg-search-forward-paren) nil) + (t (back-to-indentation) t))) + (cond + ((looking-at "|[^|]") + (prog2 (re-search-forward "|[^|][ \t]*") nil)) + ((and forward-in (string= kwop "in")) + (tuareg-find-in-match) + (tuareg-back-to-paren-or-indentation forward-in) + (if (looking-at "\\<\\(let\\|and\\)\\>") + (forward-char tuareg-in-indent)) nil) + (t retval))))) + +(defun tuareg-search-forward-paren () + (if tuareg-lazy-paren (tuareg-back-to-paren-or-indentation) + (re-search-forward "\\(\\.<\\|(\\|\\[[<|]?\\|{") + (not (looking-at "->[ \t]*\\((\\*.*\\)?$"))) + (let* (matching-kwop matching-pos) + (save-excursion + (setq matching-kwop (tuareg-find-->-match)) + (setq matching-pos (point))) + (cond + ((string= matching-kwop ":") + (goto-char matching-pos) + (tuareg-find-->-match) ; matching `val' or `let' + (+ (current-column) tuareg-val-indent)) + ((string= matching-kwop "|") + (goto-char matching-pos) + (+ (tuareg-add-default-indent leading-operator) + (current-column) tuareg-|-extra-unindent tuareg-default-indent)) + (t + (tuareg-back-to-paren-or-indentation) + (+ (tuareg-add-default-indent leading-operator) (current-column)))))) + ((string= kwop "fun") + (tuareg-back-to-paren-or-indentation t) + (+ (current-column) + (tuareg-assoc-indent kwop))) + ((<= old-point (point)) + (+ (tuareg-add-default-indent leading-operator) (current-column))) + (t + (forward-line 1) + (beginning-of-line) + (while (or (tuareg-in-comment-p) (looking-at "^[ \t]*\\((\\*.*\\)?$")) + (forward-line 1)) + (tuareg-back-to-paren-or-indentation) + (if (save-excursion (goto-char match-end-point) + (looking-at "[ \t]*\\((\\*.*\\)?$")) + (+ (tuareg-add-default-indent leading-operator) + (current-column)) + (current-column)))))) + +(defconst tuareg-compute-normal-indent-regexp + (concat tuareg-compute-argument-indent-regexp "\\|^.[ \t]*")) +(defun tuareg-compute-normal-indent () + (let ((leading-operator (looking-at tuareg-operator-regexp))) + (beginning-of-line) + ;; operator ending previous line used to be considered leading + ;; (save-excursion + ;; (tuareg-find-meaningful-word) + ;; (if (looking-at tuareg-operator-regexp) + ;; (setq leading-operator t))) + (save-excursion + (let ((kwop (tuareg-find-kwop (if leading-operator + tuareg-compute-argument-indent-regexp + tuareg-compute-normal-indent-regexp) + tuareg-keyword-regexp))) + (if (string= kwop "and") (setq kwop (tuareg-find-and-match))) + (while (or (and (string= kwop "=") + (tuareg-false-=-p)) + (and (looking-at "^[ \t]*\\((\\*.*\\)?$") + (not (= (point) (point-min))))) + (setq kwop (tuareg-find-kwop tuareg-compute-normal-indent-regexp + tuareg-keyword-regexp)) + (if (string= kwop "and") (setq kwop (tuareg-find-and-match)))) + (if (not kwop) (current-column) + (cond + ((tuareg-at-phrase-break-p) + (tuareg-find-phrase-indentation t)) + ((and (string= kwop "|") (not (char-equal ?\[ (preceding-char)))) + (tuareg-backward-char) + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-default-indent + (tuareg-add-default-indent leading-operator))) + ((or (looking-at "[[{(]\\|\\.<") + (and (looking-at "[<|]") + (char-equal ?\[ (preceding-char)) + (prog2 (tuareg-backward-char) t)) + (and (looking-at "<") + (char-equal ?\{ (preceding-char)) + (prog2 (tuareg-backward-char) t))) + (if (looking-at + "\\(\\.<\\|(\\|\\[[<|]?\\|{") + (let ((keyword-->-match (save-excursion (tuareg-find-->-match)))) + (cond ((string= keyword-->-match "|") + (tuareg-find-->-match) + (re-search-forward "|[ \t]*") + (+ (current-column) tuareg-default-indent)) + ((string= keyword-->-match ":") + (tuareg-find-->-match) ; slow, better to save the column + (tuareg-find-->-match) ; matching `val' or `let' + (+ (current-column) tuareg-val-indent)) + (t (tuareg-back-to-paren-or-indentation) + (+ tuareg-default-indent (current-column)))))) + ((looking-at tuareg-keyword-regexp) + (cond ((or (string= kwop ",") (string= kwop ";")) + (if (looking-at ";[ \t]*\\((\\*\\|$\\)") + (tuareg-find-semi-colon-match) + (if (looking-at ",[ \t]*\\((\\*\\|$\\)") + (progn + (tuareg-back-to-paren-or-indentation t) + (current-column)) + (tuareg-back-to-paren-or-indentation t) + (+ (current-column) tuareg-default-indent)))) + ((and (looking-at "\\<\\(in\\|begin\\|do\\)\\>\\|->") + (not (looking-at + "\\([a-z]+\\|->\\)[ \t]*\\((\\*\\|$\\)"))) + (if (string= kwop "in") + (re-search-forward "\\[ \t]*") + (tuareg-back-to-paren-or-indentation t)) + (+ (current-column) + (tuareg-add-default-indent leading-operator) + (if (string= kwop "in") 0 ; aligned, do not indent + (tuareg-assoc-indent kwop)))) + ((string= kwop "with") + (if (save-excursion + (let ((tmpkwop (tuareg-find-with-match))) + (or (string= tmpkwop "module") + (string= tmpkwop "{")))) + (prog2 + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-default-indent)) + (tuareg-back-to-paren-or-indentation) + (+ (current-column) + (tuareg-assoc-indent kwop t)))) + ((string= kwop "in") + (tuareg-find-in-match) + (tuareg-back-to-paren-or-indentation) + (+ (current-column) tuareg-in-indent)) + ((or (string= kwop "let") (string= kwop "and")) + (tuareg-back-to-paren-or-indentation t) + (+ (current-column) + tuareg-default-indent + (tuareg-assoc-indent kwop t))) + (t (tuareg-back-to-paren-or-indentation t) + (+ (current-column) + (tuareg-assoc-indent kwop t))))) + ((and (looking-at "=") (not (tuareg-false-=-p))) + (if (or tuareg-lazy-= (tuareg-captive-=) + (looking-at "=[ \t]*\\((\\*\\|$\\)")) ; not perfect... + (let ((current-column-module-type nil)) + (+ + (progn + (tuareg-find-=-match) + (save-excursion + (if (looking-at "\\") (tuareg-find-and-match)) + (cond + ((looking-at "\\") + (tuareg-find-meaningful-word) + (if (looking-at "\\") + (progn + (setq current-column-module-type + (current-column)) + tuareg-default-indent) + (if (looking-at "\\<\\(with\\|and\\)\\>") + (progn + (setq current-column-module-type + (current-column)) + tuareg-default-indent) + (re-search-forward "\\") + (beginning-of-line) + (+ tuareg-type-indent + tuareg-|-extra-unindent)))) + ((looking-at + "\\<\\(val\\|let\\|m\\(ethod\\|odule\\)\\|class\\|when\\|\\|for\\|if\\)\\>") + (let ((matched-string (tuareg-match-string 0))) + (tuareg-back-to-paren-or-indentation t) + (setq current-column-module-type (current-column)) + (tuareg-assoc-indent matched-string))) + ((looking-at "\\") + (tuareg-back-to-paren-or-indentation t) + (setq current-column-module-type (current-column)) + (+ (tuareg-assoc-indent "object") + tuareg-default-indent)) + (t (tuareg-back-to-paren-or-indentation t) + (setq current-column-module-type + (+ (current-column) tuareg-default-indent)) + tuareg-default-indent)))) + (if current-column-module-type + current-column-module-type + (current-column)))) + (let ((kwop (save-excursion (tuareg-find-=-match)))) + (cond + ((string= kwop "sig") + (tuareg-back-to-paren-or-indentation t) + (tuareg-assoc-indent "sig")) + ((string= kwop "=") + (tuareg-back-to-paren-or-indentation t) + (tuareg-find-=-match) + (+ (current-column) tuareg-default-indent)) + (t + (re-search-forward "=[ \t]*") + (+ (tuareg-add-default-indent leading-operator) + (current-column))))))) + (nil 0) + (t (tuareg-compute-argument-indent leading-operator)))))))) + +(defun tuareg-looking-at-expression-let () + (save-excursion + (and (tuareg-find-meaningful-word) + (not (tuareg-at-phrase-break-p)) + (or (looking-at "[[({;=]\\|\\.<\\|\\<\\(begin\\|i[fn]\\|do\\|t\\(ry\\|hen\\)\\|else\\|match\\|wh\\(ile\\|en\\)\\)\\>") + (looking-at tuareg-operator-regexp))))) + +(defun tuareg-looking-at-false-module () + (save-excursion (tuareg-find-meaningful-word) + (looking-at "\\<\\(let\\|with\\|and\\)\\>"))) + +(defun tuareg-looking-at-false-sig-struct () + (save-excursion (tuareg-find-module) + (looking-at "\\"))) + +(defun tuareg-looking-at-false-type () + (save-excursion (tuareg-find-meaningful-word) + (looking-at "\\<\\(class\\|with\\|module\\|and\\)\\>"))) + +(defun tuareg-looking-at-in-let () + (save-excursion (string= (tuareg-find-meaningful-word) "in"))) + +(defconst tuareg-find-module-regexp + (tuareg-make-find-kwop-regexp "\\")) +(defun tuareg-find-module () + (tuareg-find-kwop tuareg-find-module-regexp)) + +(defun tuareg-modify-syntax () + "Switch to modified internal syntax." + (modify-syntax-entry ?. "w" tuareg-mode-syntax-table) + (modify-syntax-entry ?_ "w" tuareg-mode-syntax-table)) + +(defun tuareg-restore-syntax () + "Switch back to interactive syntax." + (modify-syntax-entry ?. "." tuareg-mode-syntax-table) + (modify-syntax-entry ?_ "_" tuareg-mode-syntax-table)) + +(defun tuareg-indent-command (&optional from-leading-star) + "Indent the current line in Tuareg mode. + +Compute new indentation based on Caml syntax." + (interactive "*") + (let ((old-cfs case-fold-search)) + (if (not from-leading-star) + (tuareg-auto-fill-insert-leading-star)) + (setq case-fold-search nil) + (tuareg-modify-syntax) + (save-excursion + (back-to-indentation) + (indent-line-to (tuareg-compute-indent))) + (if (tuareg-in-indentation-p) (back-to-indentation)) + (setq case-fold-search old-cfs) + (tuareg-restore-syntax))) + +(defun tuareg-compute-indent () + (save-excursion + (cond + ((tuareg-in-comment-p) + (cond + ((looking-at "(\\*") + (if tuareg-indent-leading-comments + (save-excursion + (while (and (progn (beginning-of-line) + (> (point) 1)) + (progn (forward-line -1) + (back-to-indentation) + (tuareg-in-comment-p)))) + (if (looking-at "[ \t]*$") + (progn + (tuareg-skip-blank-and-comments) + (if (or (looking-at "$") (tuareg-in-comment-p)) + 0 + (tuareg-compute-indent))) + (forward-line 1) + (tuareg-compute-normal-indent))) + (current-column))) + ((looking-at "\\*\\**)") + (tuareg-beginning-of-literal-or-comment-fast) + (if (tuareg-leading-star-p) + (+ (current-column) + (if (save-excursion + (forward-line 1) + (back-to-indentation) + (looking-at "*")) 1 + tuareg-comment-end-extra-indent)) + (+ (current-column) tuareg-comment-end-extra-indent))) + (tuareg-indent-comments + (let ((star (and (tuareg-leading-star-p) + (looking-at "\\*")))) + (tuareg-beginning-of-literal-or-comment-fast) + (if star (re-search-forward "(") (re-search-forward "(\\*+[ \t]*")) + (current-column))))) + ((tuareg-in-literal-p) + (current-column)) + ((looking-at "\\") + (if (tuareg-looking-at-expression-let) + (if (tuareg-looking-at-in-let) + (progn + (tuareg-find-meaningful-word) + (tuareg-find-in-match) + (tuareg-back-to-paren-or-indentation) + (current-column)) + (tuareg-compute-normal-indent)) + (tuareg-find-phrase-indentation))) + ((looking-at tuareg-governing-phrase-regexp-with-break) + (tuareg-find-phrase-indentation)) + ((and tuareg-sig-struct-align (looking-at "\\<\\(sig\\|struct\\)\\>")) + (if (string= (tuareg-find-module) "module") (current-column) + (tuareg-back-to-paren-or-indentation) + (+ tuareg-default-indent (current-column)))) + ((looking-at ";") (tuareg-find-semi-colon-match t)) + ((or (looking-at "%\\|;;") + (and tuareg-support-camllight (looking-at "#")) + (looking-at "#open")) 0) + ((looking-at tuareg-leading-kwop-regexp) + (let ((kwop (tuareg-match-string 0))) + (let* ((old-point (point)) + (paren-match-p (looking-at "[|>]?[]})]\\|>\\.")) + (need-not-back-kwop (string= kwop "and")) + (real-| (looking-at "|\\([^|]\\|$\\)")) + (matching-kwop + (if (string= kwop "and") + (tuareg-find-and-match t) + (funcall (cdr (assoc kwop tuareg-leading-kwop-alist))))) + (match-|-keyword-p + (and matching-kwop + (looking-at tuareg-match-|-keyword-regexp)))) + (cond + ((and (string= kwop "|") real-|) + (cond + ((string= matching-kwop "|") + (if (not need-not-back-kwop) + (tuareg-back-to-paren-or-indentation)) + (current-column)) + ((and (string= matching-kwop "=") + (not (tuareg-false-=-p))) + (re-search-forward "=[ \t]*") + (current-column)) + (match-|-keyword-p + (if (not need-not-back-kwop) + (tuareg-back-to-paren-or-indentation)) + (- (+ (tuareg-assoc-indent + matching-kwop t) + (current-column)) + (if (string= matching-kwop "type") 0 + tuareg-|-extra-unindent))) + (t (goto-char old-point) + (tuareg-compute-normal-indent)))) + ((and (string= kwop "|") (not real-|)) + (goto-char old-point) + (tuareg-compute-normal-indent)) + ((and + (looking-at "\\(\\[|?\\|{ operator at beginning of line. +Also, if the matching { is followed by a < and this } is not preceded +by >, insert one >." + (interactive "*") + (let* ((prec (preceding-char)) + (look-bra (and tuareg-electric-close-vector + (not (tuareg-in-literal-or-comment-p)) + (not (char-equal ?> prec)))) + (electric (and tuareg-electric-indent + (or (tuareg-in-indentation-p) + (and (char-equal ?> prec) + (save-excursion (tuareg-backward-char) + (tuareg-in-indentation-p)))) + (not (tuareg-in-literal-or-comment-p))))) + (self-insert-command 1) + (if look-bra + (save-excursion + (let ((inserted-char + (save-excursion + (tuareg-backward-char) + (tuareg-backward-up-list) + (cond ((looking-at "{<") ">") + (t ""))))) + (tuareg-backward-char) + (insert inserted-char)))) + (if electric (tuareg-indent-command)))) + +(defun tuareg-electric-rb () + "If inserting a ] operator at beginning of line, reindent the line. + +Reindent also if ] is inserted after a | operator at beginning of line. +Also, if the matching [ is followed by a | and this ] is not preceded +by |, insert one |." + (interactive "*") + (let* ((prec (preceding-char)) + (look-|-or-bra (and tuareg-electric-close-vector + (not (tuareg-in-literal-or-comment-p)) + (not (and (char-equal ?| prec) + (not (char-equal + (save-excursion + (tuareg-backward-char) + (preceding-char)) ?\[)))))) + (electric (and tuareg-electric-indent + (or (tuareg-in-indentation-p) + (and (char-equal ?| prec) + (save-excursion (tuareg-backward-char) + (tuareg-in-indentation-p)))) + (not (tuareg-in-literal-or-comment-p))))) + (self-insert-command 1) + (if look-|-or-bra + (save-excursion + (let ((inserted-char + (save-excursion + (tuareg-backward-char) + (tuareg-backward-up-list) + (cond ((looking-at "\\[|") "|") + (t ""))))) + (tuareg-backward-char) + (insert inserted-char)))) + (if electric (tuareg-indent-command)))) + +(defun tuareg-abbrev-hook () + "If inserting a leading keyword at beginning of line, reindent the line." + (if (not (tuareg-in-literal-or-comment-p)) + (let* ((bol (save-excursion (beginning-of-line) (point))) + (kw (save-excursion + (and (re-search-backward "^[ \t]*\\(\\w\\|_\\)+\\=" bol t) + (tuareg-match-string 1))))) + (if kw (progn + (insert " ") + (tuareg-indent-command) + (backward-delete-char-untabify 1)))))) + +(defun tuareg-skip-to-end-of-phrase () + (let ((old-point (point))) + (if (and (string= (tuareg-find-meaningful-word) ";") + (char-equal (preceding-char) ?\;)) + (setq old-point (1- (point)))) + (goto-char old-point) + (let ((kwop (tuareg-find-meaningful-word))) + (goto-char (+ (point) (length kwop)))))) + +(defun tuareg-skip-blank-and-comments () + (skip-chars-forward " \t\n") + (while (and (not (eobp)) (tuareg-in-comment-p) + (search-forward "*)" nil t)) + (skip-chars-forward " \t\n"))) + +(defun tuareg-skip-back-blank-and-comments () + (skip-chars-backward " \t\n") + (while (save-excursion (tuareg-backward-char) + (and (> (point) (point-min)) (tuareg-in-comment-p))) + (tuareg-backward-char) + (tuareg-beginning-of-literal-or-comment) (skip-chars-backward " \t\n"))) + +(defconst tuareg-beginning-phrase-regexp + "^#[ \t]*[a-z][_a-z]*\\>\\|\\<\\(end\\|type\\|module\\|sig\\|struct\\|class\\|exception\\|open\\|let\\)\\>\\|;;" + "Regexp matching tuareg phrase delimitors.") +(defun tuareg-find-phrase-beginning () + "Find `real' phrase beginning and returns point." + (beginning-of-line) + (tuareg-skip-blank-and-comments) + (end-of-line) + (tuareg-skip-to-end-of-phrase) + (let ((old-point (point))) + (tuareg-find-kwop tuareg-beginning-phrase-regexp) + (while (and (> (point) (point-min)) (< (point) old-point) + (or (not (looking-at tuareg-beginning-phrase-regexp)) + (and (looking-at "\\") + (tuareg-looking-at-expression-let)) + (and (looking-at "\\") + (tuareg-looking-at-false-module)) + (and (looking-at "\\<\\(sig\\|struct\\)\\>") + (tuareg-looking-at-false-sig-struct)) + (and (looking-at "\\") + (tuareg-looking-at-false-type)))) + (if (looking-at "\\") + (tuareg-find-match) + (if (not (bolp)) (tuareg-backward-char)) + (setq old-point (point)) + (tuareg-find-kwop tuareg-beginning-phrase-regexp))) + (if (tuareg-at-phrase-break-p) + (prog2 (end-of-line) (tuareg-skip-blank-and-comments))) + (back-to-indentation) + (point))) + +(defconst tuareg-inside-block-opening "\\<\\(struct\\|sig\\|object\\)\\>") +(defun tuareg-search-forward-end-iter (begin) + (if (re-search-forward "\\" (point-max) t) + (if (save-excursion + (tuareg-backward-char 3) + (tuareg-find-match) + (if (looking-at tuareg-inside-block-opening) + (tuareg-find-phrase-beginning)) + (> (point) begin)) + (tuareg-search-forward-end-iter begin) + t) + nil)) +(defun tuareg-search-forward-end () + (tuareg-search-forward-end-iter (point))) + +(defconst tuareg-inside-block-opening-full + (concat tuareg-inside-block-opening "\\|\\<\\(module\\|class\\)\\>")) +(defconst tuareg-inside-block-regexp + (concat tuareg-matching-keyword-regexp "\\|" tuareg-inside-block-opening)) +(defun tuareg-inside-block-find-kwop () + (let ((kwop (tuareg-find-kwop tuareg-inside-block-regexp + "\\<\\(and\\|end\\)\\>"))) + (if (string= kwop "and") (setq kwop (tuareg-find-and-match))) + (if (string= kwop "with") (setq kwop nil)) + (if (string= kwop "end") + (progn + (tuareg-find-match) + (tuareg-find-kwop tuareg-inside-block-regexp) + (tuareg-inside-block-find-kwop)) + kwop))) + +(defun tuareg-inside-block-p () + (let ((begin) (end) (and-end) (kwop t)) + (save-excursion + (if (looking-at "\\") + (tuareg-find-and-match)) + (setq begin (point)) + (if (or (and (looking-at "\\") + (save-excursion + (re-search-forward "\\" + (point-max) t) + (tuareg-find-phrase-beginning) + (> (point) begin))) + (and (looking-at "\\") + (save-excursion + (re-search-forward "\\<\\(sig\\|struct\\)\\>" + (point-max) t) + (tuareg-find-phrase-beginning) + (> (point) begin)))) () + (if (not (looking-at tuareg-inside-block-opening-full)) + (setq kwop (tuareg-inside-block-find-kwop))) + (if (not kwop) () + (setq begin (point)) + (if (not (tuareg-search-forward-end)) () + (tuareg-backward-char 3) + (if (not (looking-at "\\")) () + (tuareg-forward-char 3) + (setq end (point)) + (setq and-end (point)) + (tuareg-skip-blank-and-comments) + (while (looking-at "\\") + (setq and-end (point)) + (if (not (tuareg-search-forward-end)) () + (tuareg-backward-char 3) + (if (not (looking-at "\\")) () + (tuareg-forward-char 3) + (setq and-end (point)) + (tuareg-skip-blank-and-comments)))) + (list begin end and-end)))))))) + +(defun tuareg-move-inside-block-opening () + "Go to the beginning of the enclosing module or class. + +Notice that white-lines (or comments) located immediately before a +module/class are considered enclosed in this module/class." + (interactive) + (let* ((old-point (point)) + (kwop (tuareg-inside-block-find-kwop))) + (if (not kwop) + (goto-char old-point)) + (tuareg-find-phrase-beginning))) + +(defun tuareg-discover-phrase (&optional quiet) + (end-of-line) + (let ((end (point)) (old-cfs case-fold-search)) + (setq case-fold-search nil) + (tuareg-modify-syntax) + (tuareg-find-phrase-beginning) + (if (> (point) end) (setq end (point))) + (save-excursion + (let ((begin (point)) (cpt 0) (lines-left 0) (stop) + (inside-block (tuareg-inside-block-p)) + (looking-block (looking-at tuareg-inside-block-opening-full))) + (if (and looking-block inside-block) + (progn + (setq begin (nth 0 inside-block)) + (setq end (nth 2 inside-block)) + (goto-char end)) + (if inside-block + (progn + (setq stop (save-excursion (goto-char (nth 1 inside-block)) + (beginning-of-line) (point))) + (if (< stop end) (setq stop (point-max)))) + (setq stop (point-max))) + (save-restriction + (goto-char end) + (while (and (= lines-left 0) + (or (not inside-block) (< (point) stop)) + (<= (save-excursion + (tuareg-find-phrase-beginning)) end)) + (if (not quiet) + (prog2 + (setq cpt (1+ cpt)) + (if (= 8 cpt) + (message "Looking for enclosing phrase...")))) + (setq end (point)) + (tuareg-skip-to-end-of-phrase) + (beginning-of-line) + (narrow-to-region (point) (point-max)) + (goto-char end) + (setq lines-left (forward-line 1))))) + (if (>= cpt 8) (message "Looking for enclosing phrase... done.")) + (save-excursion (tuareg-skip-blank-and-comments) (setq end (point))) + (tuareg-skip-back-blank-and-comments) + (setq case-fold-search old-cfs) + (tuareg-restore-syntax) + (list begin (point) end))))) + +(defun tuareg-mark-phrase () + "Put mark at end of this Caml phrase, point at beginning. +The Caml phrase is the phrase just before the point." + (interactive) + (let ((pair (tuareg-discover-phrase))) + (goto-char (nth 1 pair)) (push-mark (nth 0 pair) t t))) + +(defun tuareg-next-phrase (&optional quiet) + "Skip to the beginning of the next phrase." + (interactive "i") + (goto-char (save-excursion (nth 2 (tuareg-discover-phrase quiet)))) + (if (looking-at "\\") (tuareg-next-phrase quiet)) + (if (looking-at ";;") + (progn + (forward-char 2) + (tuareg-skip-blank-and-comments)))) + +(defun tuareg-previous-phrase () + "Skip to the beginning of the previous phrase." + (interactive) + (beginning-of-line) + (tuareg-skip-to-end-of-phrase) + (tuareg-discover-phrase)) + +(defun tuareg-indent-phrase () + "Depending of the context: justify and indent a comment, +or indent all lines in the current phrase." + (interactive) + (save-excursion + (back-to-indentation) + (if (tuareg-in-comment-p) + (let* ((cobpoint (save-excursion + (tuareg-beginning-of-literal-or-comment) + (point))) + (begpoint (save-excursion + (while (and (> (point) cobpoint) + (tuareg-in-comment-p) + (not (looking-at "^[ \t]*$"))) + (forward-line -1)) + (max cobpoint (point)))) + (coepoint (save-excursion + (while (tuareg-in-comment-p) + (re-search-forward "\\*)")) + (point))) + (endpoint (save-excursion + (re-search-forward "^[ \t]*$" coepoint 'end) + (beginning-of-line) + (forward-line 1) + (point))) + (leading-star (tuareg-leading-star-p))) + (goto-char begpoint) + (while (and leading-star + (< (point) endpoint) + (not (looking-at "^[ \t]*$"))) + (forward-line 1) + (back-to-indentation) + (if (looking-at "\\*\\**\\([^)]\\|$\\)") + (progn + (delete-char 1) + (setq endpoint (1- endpoint))))) + (goto-char (min (point) endpoint)) + (fill-region begpoint endpoint) + (re-search-forward "\\*)") + (setq endpoint (point)) + (if leading-star + (progn + (goto-char begpoint) + (forward-line 1) + (if (< (point) endpoint) + (tuareg-auto-fill-insert-leading-star t)))) + (indent-region begpoint endpoint nil)) + (let ((pair (tuareg-discover-phrase))) + (indent-region (nth 0 pair) (nth 1 pair) nil))))) + +(defun tuareg-find-alternate-file () + "Switch Implementation/Interface." + (interactive) + (let ((name (buffer-file-name))) + (if (string-match "\\`\\(.*\\)\\.\\(mli?\\)\\'" name) + (find-file (concat (tuareg-match-string 1 name) + (if (match-beginning 2) ".ml" ".mli")))))) + +(defun tuareg-insert-class-form () + "Inserts a nicely formatted class-end form, leaving a mark after end." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "class = object (self)\ninherit as super\nend;;\n") + (end-of-line) + (indent-region old (point) nil) + (tuareg-indent-command) + (push-mark) + (forward-line -2) + (tuareg-indent-command))) + +(defun tuareg-insert-begin-form () + "Inserts a nicely formatted begin-end form, leaving a mark after end." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "begin\n\nend\n") + (end-of-line) + (indent-region old (point) nil) + (push-mark) + (forward-line -2) + (tuareg-indent-command))) + +(defun tuareg-insert-for-form () + "Inserts a nicely formatted for-to-done form, leaving a mark after done." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "for do\n\ndone\n") + (end-of-line) + (indent-region old (point) nil) + (push-mark) + (forward-line -2) + (tuareg-indent-command) + (beginning-of-line 1) + (backward-char 4))) + +(defun tuareg-insert-while-form () + "Inserts a nicely formatted for-to-done form, leaving a mark after done." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "while do\n\ndone\n") + (end-of-line) + (indent-region old (point) nil) + (push-mark) + (forward-line -2) + (tuareg-indent-command) + (beginning-of-line 1) + (backward-char 4))) + +(defun tuareg-insert-if-form () + "Inserts a nicely formatted if-then-else form, leaving a mark after else." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "if\n\nthen\n\nelse\n") + (end-of-line) + (indent-region old (point) nil) + (tuareg-indent-command) + (push-mark) + (forward-line -2) + (tuareg-indent-command) + (forward-line -2) + (tuareg-indent-command))) + +(defun tuareg-insert-match-form () + "Inserts a nicely formatted math-with form, leaving a mark after with." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "match\n\nwith\n") + (end-of-line) + (indent-region old (point) nil) + (tuareg-indent-command) + (push-mark) + (forward-line -2) + (tuareg-indent-command))) + +(defun tuareg-insert-let-form () + "Inserts a nicely formatted let-in form, leaving a mark after in." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "let in\n") + (end-of-line) + (indent-region old (point) nil) + (tuareg-indent-command) + (push-mark) + (beginning-of-line) + (backward-char 4) + (tuareg-indent-command))) + +(defun tuareg-insert-try-form () + "Inserts a nicely formatted try-with form, leaving a mark after with." + (interactive "*") + (let ((prec (preceding-char))) + (if (and prec (not (char-equal ?\ (char-syntax prec)))) + (insert " "))) + (let ((old (point))) + (insert "try\n\nwith\n") + (end-of-line) + (indent-region old (point) nil) + (tuareg-indent-command) + (push-mark) + (forward-line -2) + (tuareg-indent-command))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tuareg interactive mode + +;; Augment Tuareg mode with a Caml toplevel. + +(require 'comint) + +(defvar tuareg-interactive-mode-map nil) +(if tuareg-interactive-mode-map nil + (setq tuareg-interactive-mode-map + (copy-keymap comint-mode-map))) +(define-key tuareg-interactive-mode-map "|" 'tuareg-electric) +(define-key tuareg-interactive-mode-map ")" 'tuareg-electric-rp) +(define-key tuareg-interactive-mode-map "}" 'tuareg-electric-rc) +(define-key tuareg-interactive-mode-map "]" 'tuareg-electric-rb) +(define-key tuareg-interactive-mode-map "\t" 'tuareg-indent-command) +(define-key tuareg-interactive-mode-map "\C-c\C-i" 'tuareg-interrupt-caml) +(define-key tuareg-interactive-mode-map "\C-c\C-k" 'tuareg-kill-caml) +(define-key tuareg-interactive-mode-map "\C-c`" + 'tuareg-interactive-next-error-toplevel) +(define-key tuareg-interactive-mode-map "\C-m" + 'tuareg-interactive-send-input) +(define-key tuareg-interactive-mode-map "\C-j" + 'tuareg-interactive-send-input-or-indent) +(define-key tuareg-interactive-mode-map "\M-\C-m" + 'comint-send-input) +(if (functionp 'read-kbd-macro) + (define-key tuareg-interactive-mode-map (read-kbd-macro "") + 'comint-send-input)) + +(defconst tuareg-interactive-buffer-name "*caml-toplevel*") + +(defconst tuareg-interactive-toplevel-error-regexp + "[ \t]*Characters \\([0-9]+\\)-\\([0-9]+\\):" + "Regular expression extracting the character numbers +from an error message produced by ocaml toplevel.") +(defvar tuareg-interactive-last-phrase-pos-in-source 0) +(defvar tuareg-interactive-last-phrase-pos-in-toplevel 0) + +(defun tuareg-interactive-filter (text) + (if (eq major-mode 'tuareg-interactive-mode) + (save-excursion + (if (< comint-last-input-end comint-last-input-start) () + (if (and tuareg-with-xemacs tuareg-interactive-read-only-input) + (add-text-properties + comint-last-input-start comint-last-input-end + (list 'read-only t))) + (if (and tuareg-window-system + (featurep 'font-lock) + tuareg-interactive-input-font-lock) + (progn + (font-lock-fontify-region comint-last-input-start + comint-last-input-end) + (if (featurep 'sym-lock) + (sym-lock-make-symbols-atomic comint-last-input-start + comint-last-input-end)))) + (if tuareg-interactive-output-font-lock + (save-excursion + (goto-char (point-max)) + (re-search-backward comint-prompt-regexp + comint-last-input-end t) + (add-text-properties + comint-last-input-end (point) + '(face tuareg-font-lock-interactive-output-face)))) + (if tuareg-interactive-error-font-lock + (save-excursion + (goto-char comint-last-input-end) + (while (re-search-forward tuareg-interactive-error-regexp () t) + (let ((matchbeg (match-beginning 1)) + (matchend (match-end 1))) + (save-excursion + (add-text-properties + matchbeg matchend + '(face tuareg-font-lock-interactive-error-face)) + (goto-char matchbeg) + (if (looking-at tuareg-interactive-toplevel-error-regexp) + (let ((beg (string-to-int (tuareg-match-string 1))) + (end (string-to-int (tuareg-match-string 2)))) + (add-text-properties + (+ comint-last-input-start beg) + (+ comint-last-input-start end) + '(face tuareg-font-lock-error-face)) + ))))))))))) + +(define-derived-mode tuareg-interactive-mode comint-mode "Tuareg-Interactive" + "Major mode for interacting with a 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. + +Special keys for Tuareg interactive mode:\\{tuareg-interactive-mode-map}" + (if (not (eq (tuareg-install-font-lock t) 'font-lock)) () + (add-hook 'comint-output-filter-functions 'tuareg-interactive-filter) + (if (not (boundp 'after-change-functions)) () + (make-local-hook 'after-change-functions) + (put 'after-change-functions 'permanent-local t) + (remove-hook 'after-change-functions 'font-lock-after-change-function t)) + (if (not (boundp 'pre-idle-hook)) () + (make-local-hook 'pre-idle-hook) + (put 'pre-idle-hook 'permanent-local t) + (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook t))) + (setq comint-prompt-regexp "^# *") + (setq comint-process-echoes nil) + (setq comint-get-old-input 'tuareg-interactive-get-old-input) + (setq comint-scroll-to-bottom-on-output t) + (set-syntax-table tuareg-mode-syntax-table) + (setq local-abbrev-table tuareg-mode-abbrev-table) + + (easy-menu-add tuareg-interactive-mode-menu) + (tuareg-update-options-menu) + + ;; hooks for tuareg-interactive-mode + (run-hooks 'tuareg-interactive-mode-hook)) + +(defun tuareg-run-caml () + "Run a Caml toplevel process. I/O via buffer `*caml-toplevel*'." + (interactive) + (tuareg-run-process-if-needed) + (when tuareg-display-buffer-on-eval + (display-buffer tuareg-interactive-buffer-name))) + +(defun tuareg-run-process-if-needed (&optional cmd) + "Run a Caml toplevel process if needed, with an optional command name. + I/O via buffer `*caml-toplevel*'." + (if cmd + (setq tuareg-interactive-program cmd) + (if (not (comint-check-proc tuareg-interactive-buffer-name)) + (setq tuareg-interactive-program + (read-shell-command "Caml toplevel to run: " + tuareg-interactive-program)))) + (if (not (comint-check-proc tuareg-interactive-buffer-name)) + (let ((cmdlist (tuareg-args-to-list tuareg-interactive-program)) + (process-connection-type nil)) + (set-buffer (apply (function make-comint) "caml-toplevel" + (car cmdlist) nil (cdr cmdlist))) + (tuareg-interactive-mode) + (sleep-for 1)))) + +(defun tuareg-args-to-list (string) + (let ((where (string-match "[ \t]" string))) + (cond ((null where) (list string)) + ((not (= where 0)) + (cons (substring string 0 where) + (tuareg-args-to-list (substring string (+ 1 where) + (length string))))) + (t (let ((pos (string-match "[^ \t]" string))) + (if (null pos) + nil + (tuareg-args-to-list (substring string pos + (length string))))))))) + +(defun tuareg-interactive-get-old-input () + (save-excursion + (let ((end (point))) + (re-search-backward comint-prompt-regexp (point-min) t) + (if (looking-at comint-prompt-regexp) + (re-search-forward comint-prompt-regexp)) + (buffer-substring-no-properties (point) end)))) + +(defun tuareg-interactive-end-of-phrase () + (save-excursion + (end-of-line) + (tuareg-find-meaningful-word) + (tuareg-find-meaningful-word) + (looking-at ";;"))) + +(defconst tuareg-interactive-send-warning + "Note: toplevel processing requires a terminating `;;'") +(defun tuareg-interactive-send-input () + "Process if the current line ends with `;;' then send the +current phrase else insert a newline." + (interactive) + (if (tuareg-interactive-end-of-phrase) + (progn + (comint-send-input) + (goto-char (point-max))) + (insert "\n") + (message tuareg-interactive-send-warning))) + +(defun tuareg-interactive-send-input-or-indent () + "Process if the current line ends with `;;' then send the +current phrase else insert a newline and indent." + (interactive) + (if (tuareg-interactive-end-of-phrase) + (progn + (comint-send-input) + (goto-char (point-max))) + (insert "\n") + (tuareg-indent-command) + (message tuareg-interactive-send-warning))) + +(defun tuareg-eval-region (start end) + "Eval the current region in the Caml toplevel." + (interactive "r") + (save-excursion (tuareg-run-process-if-needed)) + (comint-preinput-scroll-to-bottom) + (setq tuareg-interactive-last-phrase-pos-in-source start) + (save-excursion + (goto-char start) + (tuareg-skip-blank-and-comments) + (setq start (point)) + (goto-char end) + (tuareg-skip-to-end-of-phrase) + (setq end (point)) + (let ((text (buffer-substring-no-properties start end))) + (goto-char end) + (if (string= text "") + (message "Cannot send empty commands to Caml toplevel!") + (set-buffer tuareg-interactive-buffer-name) + (goto-char (point-max)) + (setq tuareg-interactive-last-phrase-pos-in-toplevel (point)) + (if tuareg-interactive-echo-phrase + (progn + (insert (concat text ";;")) + (comint-send-input)) + (comint-send-string tuareg-interactive-buffer-name + (concat text ";;")) + (comint-send-input)))) + (when tuareg-display-buffer-on-eval + (display-buffer tuareg-interactive-buffer-name)))) + +(defun tuareg-narrow-to-phrase () + "Narrow the editting window to the surrounding Caml phrase (or block)." + (interactive) + (save-excursion + (let ((pair (tuareg-discover-phrase))) + (narrow-to-region (nth 0 pair) (nth 1 pair))))) + +(defun tuareg-eval-phrase () + "Eval the surrounding Caml phrase (or block) in the Caml toplevel." + (interactive) + (let ((end)) + (save-excursion + (let ((pair (tuareg-discover-phrase))) + (setq end (nth 2 pair)) + (tuareg-eval-region (nth 0 pair) (nth 1 pair)))) + (if tuareg-skip-after-eval-phrase + (goto-char end)))) + +(defun tuareg-eval-buffer () + "Send the buffer to the Tuareg Interactive process." + (interactive) + (tuareg-eval-region (point-min) (point-max))) + +(defun tuareg-interactive-next-error-source () + (interactive) + (let ((error-pos) (beg 0) (end 0)) + (save-excursion + (set-buffer tuareg-interactive-buffer-name) + (goto-char tuareg-interactive-last-phrase-pos-in-toplevel) + (setq error-pos + (re-search-forward tuareg-interactive-toplevel-error-regexp + (point-max) t)) + (if error-pos + (progn + (setq beg (string-to-int (tuareg-match-string 1)) + end (string-to-int (tuareg-match-string 2)))))) + (if (not error-pos) + (message "No syntax or typing error in last phrase.") + (setq beg (+ tuareg-interactive-last-phrase-pos-in-source beg) + end (+ tuareg-interactive-last-phrase-pos-in-source end)) + (add-text-properties beg end '(face tuareg-font-lock-error-face)) + (goto-char beg)))) + +(defun tuareg-interactive-next-error-toplevel () + (interactive) + (let ((error-pos) (beg 0) (end 0)) + (save-excursion + (goto-char tuareg-interactive-last-phrase-pos-in-toplevel) + (setq error-pos + (re-search-forward tuareg-interactive-toplevel-error-regexp + (point-max) t)) + (if error-pos + (setq beg (string-to-int (tuareg-match-string 1)) + end (string-to-int (tuareg-match-string 2))))) + (if (not error-pos) + (message "No syntax or typing error in last phrase.") + (setq beg (+ tuareg-interactive-last-phrase-pos-in-toplevel beg) + end (+ tuareg-interactive-last-phrase-pos-in-toplevel end)) + (add-text-properties beg end '(face tuareg-font-lock-error-face)) + (goto-char beg)))) + +(defun tuareg-interrupt-caml () + (interactive) + (if (comint-check-proc tuareg-interactive-buffer-name) + (save-excursion + (set-buffer tuareg-interactive-buffer-name) + (comint-interrupt-subjob)))) + +(defun tuareg-kill-caml () + (interactive) + (if (comint-check-proc tuareg-interactive-buffer-name) + (save-excursion + (set-buffer tuareg-interactive-buffer-name) + (comint-kill-subjob)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Menu support + +(defun tuareg-about () (interactive) + (describe-variable 'tuareg-mode-version)) +(defun tuareg-help () (interactive) + (describe-function 'tuareg-mode)) +(defun tuareg-interactive-help () (interactive) + (describe-function 'tuareg-interactive-mode)) + +(defvar tuareg-definitions-menu-last-buffer nil) +(defvar tuareg-definitions-keymaps nil) + +(defun tuareg-build-menu () + (easy-menu-define + tuareg-mode-menu (list tuareg-mode-map) + "Tuareg Mode Menu." + '("Tuareg" + ("Interactive Mode" + ["Run Caml Toplevel" tuareg-run-caml t] + ["Interrupt Caml Toplevel" tuareg-interrupt-caml + :active (comint-check-proc tuareg-interactive-buffer-name)] + ["Kill Caml Toplevel" tuareg-kill-caml + :active (comint-check-proc tuareg-interactive-buffer-name)] + ["Evaluate Region" tuareg-eval-region + ;; region-active-p for XEmacs and mark-active for Emacs + :active (if (fboundp 'region-active-p) (region-active-p) mark-active)] + ["Evaluate Phrase" tuareg-eval-phrase t] + ["Evaluate Buffer" tuareg-eval-buffer t]) + ("Caml Forms" + ["try .. with .." tuareg-insert-try-form t] + ["match .. with .." tuareg-insert-match-form t] + ["let .. in .." tuareg-insert-let-form t] + ["if .. then .. else .." tuareg-insert-if-form t] + ["while .. do .. done" tuareg-insert-while-form t] + ["for .. do .. done" tuareg-insert-for-form t] + ["begin .. end" tuareg-insert-begin-form t]) + ["Switch .ml/.mli" tuareg-find-alternate-file t] + "---" + ["Compile..." compile t] + ["Reference Manual..." tuareg-browse-manual t] + ["Caml Library..." tuareg-browse-library t] + ("Definitions" + ["Scan..." tuareg-list-definitions t]) + "---" + [ "Show type at point" caml-types-show-type + tuareg-with-caml-mode-p] + "---" + [ "Complete identifier" caml-complete + tuareg-with-caml-mode-p] + [ "Help for identifier" caml-help + tuareg-with-caml-mode-p] + [ "Add path for documentation" ocaml-add-path + tuareg-with-caml-mode-p] + [ "Open module for documentation" ocaml-open-module + tuareg-with-caml-mode-p] + [ "Close module for documentation" ocaml-close-module + tuareg-with-caml-mode-p] + "---" + ["Customize Tuareg Mode..." (customize-group 'tuareg) t] + ("Tuareg Options" ["Dummy" nil t]) + ("Tuareg Interactive Options" ["Dummy" nil t]) + "---" + ["About" tuareg-about t] + ["Help" tuareg-help t])) + (easy-menu-add tuareg-mode-menu) + (tuareg-update-options-menu) + ;; save and update definitions menu + (if tuareg-with-xemacs + (add-hook 'activate-menubar-hook 'tuareg-update-definitions-menu) + (if (not (functionp 'easy-menu-create-keymaps)) () + ;; patch for Emacs + (add-hook 'menu-bar-update-hook + 'tuareg-with-emacs-update-definitions-menu) + (make-local-variable 'tuareg-definitions-keymaps) + (setq tuareg-definitions-keymaps + (cdr (easy-menu-create-keymaps + "Definitions" tuareg-definitions-menu))) + (setq tuareg-definitions-menu-last-buffer nil)))) + +(easy-menu-define + tuareg-interactive-mode-menu tuareg-interactive-mode-map + "Tuareg Interactive Mode Menu." + '("Tuareg" + ("Interactive Mode" + ["Run Caml Toplevel" tuareg-run-caml t] + ["Interrupt Caml Toplevel" tuareg-interrupt-caml + :active (comint-check-proc tuareg-interactive-buffer-name)] + ["Kill Caml Toplevel" tuareg-kill-caml + :active (comint-check-proc tuareg-interactive-buffer-name)] + ["Evaluate Region" tuareg-eval-region :active (region-active-p)] + ["Evaluate Phrase" tuareg-eval-phrase t] + ["Evaluate Buffer" tuareg-eval-buffer t]) + "---" + ["Customize Tuareg Mode..." (customize-group 'tuareg) t] + ("Tuareg Options" ["Dummy" nil t]) + ("Tuareg Interactive Options" ["Dummy" nil t]) + "---" + ["About" tuareg-about t] + ["Help" tuareg-interactive-help t])) + +(defun tuareg-update-definitions-menu () + (if (eq major-mode 'tuareg-mode) + (easy-menu-change + '("Tuareg") "Definitions" + tuareg-definitions-menu))) + +(defun tuareg-with-emacs-update-definitions-menu () + (if (current-local-map) + (let ((keymap + (lookup-key (current-local-map) [menu-bar Tuareg Definitions]))) + (if (and + (keymapp keymap) + (not (eq tuareg-definitions-menu-last-buffer (current-buffer)))) + (setcdr keymap tuareg-definitions-keymaps) + (setq tuareg-definitions-menu-last-buffer (current-buffer)))))) + +(defun tuareg-toggle-option (symbol) + (interactive) + (set symbol (not (symbol-value symbol))) + (if (eq 'tuareg-use-abbrev-mode symbol) + (abbrev-mode tuareg-use-abbrev-mode)) ; toggle abbrev minor mode + (if tuareg-with-xemacs nil (tuareg-update-options-menu))) + +(defun tuareg-update-options-menu () + (easy-menu-change + '("Tuareg") "Tuareg Options" + (mapcar (lambda (pair) + (if (consp pair) + (vector (car pair) + (list 'tuareg-toggle-option (cdr pair)) + ':style 'toggle + ':selected (nth 1 (cdr pair)) + ':active t) + pair)) tuareg-options-list)) + (easy-menu-change + '("Tuareg") "Tuareg Interactive Options" + (mapcar (lambda (pair) + (if (consp pair) + (vector (car pair) + (list 'tuareg-toggle-option (cdr pair)) + ':style 'toggle + ':selected (nth 1 (cdr pair)) + ':active t) + pair)) tuareg-interactive-options-list))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Browse Manual + +;; From M. Quercia + +(defun tuareg-browse-manual () + "*Browse Caml reference manual." + (interactive) + (setq tuareg-manual-url (read-from-minibuffer "URL: " tuareg-manual-url)) + (funcall tuareg-browser tuareg-manual-url)) + +(defun tuareg-xemacs-w3-manual (url) + "*Browse Caml reference manual." + (w3-fetch-other-frame url)) + +(defun tuareg-netscape-manual (url) + "*Browse Caml reference manual." + (start-process-shell-command + "netscape" nil + (concat "netscape -remote 'openURL (" + url ", newwindow)' || netscape " url))) + +(defun tuareg-mmm-manual (url) + "*Browse Caml reference manual." + (start-process-shell-command + "mmm" nil + (concat "mmm_remote " url " || mmm -external " url))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Browse Library + +;; From M. Quercia + +(defun tuareg-browse-library() + "Browse the Caml library." + (interactive) + (let ((buf-name "*caml-library*") (opoint) + (dir (read-from-minibuffer "Library path: " tuareg-library-path))) + (if (and (file-directory-p dir) (file-readable-p dir)) + (progn + (setq tuareg-library-path dir) + ;; list *.ml and *.mli files + (with-output-to-temp-buffer buf-name + (buffer-disable-undo standard-output) + (save-excursion + (set-buffer buf-name) + (kill-all-local-variables) + (make-local-variable 'tuareg-library-path) + (setq tuareg-library-path dir) + ;; help + (insert "Directory \"" dir "\".\n") + (insert "Select a file with middle mouse button or RETURN.\n\n") + (insert "Interface files (.mli):\n\n") + (insert-directory (concat dir "/*.mli") "-C" t nil) + (insert "\n\nImplementation files (.ml):\n\n") + (insert-directory (concat dir "/*.ml") "-C" t nil) + ;; '.', '-' and '_' are now letters + (modify-syntax-entry ?. "w") + (modify-syntax-entry ?_ "w") + (modify-syntax-entry ?- "w") + ;; every file name is now mouse-sensitive + (goto-char (point-min)) + (while (< (point) (point-max)) + (re-search-forward "\\.ml.?\\>") + (setq opoint (point)) + (re-search-backward "\\<" (point-min) 1) + (put-text-property (point) opoint 'mouse-face 'highlight) + (goto-char (+ 1 opoint))) + ;; activate tuareg-library mode + (setq major-mode 'tuareg-library-mode) + (setq mode-name "tuareg-library") + (use-local-map tuareg-library-mode-map) + (setq buffer-read-only t))))))) + +(defvar tuareg-library-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [return] 'tuareg-library-find-file) + (define-key map [mouse-2] 'tuareg-library-mouse-find-file) + map)) + +(defun tuareg-library-find-file () + "Load the file whose name is near point." + (interactive) + (save-excursion + (if (text-properties-at (point)) + (let (beg) + (re-search-backward "\\<") (setq beg (point)) + (re-search-forward "\\>") + (find-file-read-only (concat tuareg-library-path "/" + (buffer-substring-no-properties + beg (point)))))))) + +(defun tuareg-library-mouse-find-file (event) + "Visit the file name you click on." + (interactive "e") + (let ((owindow (selected-window))) + (mouse-set-point event) + (tuareg-library-find-file) + (select-window owindow))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Definitions List + +;; Designed from original code by M. Quercia + +(defconst tuareg-definitions-regexp + "\\<\\(and\\|val\\|type\\|module\\|class\\|exception\\|let\\)\\>" + "Regexp matching definition phrases.") + +(defconst tuareg-definitions-bind-skip-regexp + (string-as-multibyte "\\<\\(rec\\|type\\|virtual\\)\\>\\|'[A-Za-z\300-\377][0-9_'A-Za-z\300-\377]*\\|('.*)") + "Regexp matching stuff to ignore after a binding keyword.") + +(defvar tuareg-definitions-menu (list ["Scan..." tuareg-list-definitions t]) + "Initial content of the definitions menu.") +(make-variable-buffer-local 'tuareg-definitions-menu) + +(defun tuareg-list-definitions () + "Parses the buffer and gathers toplevel definitions for quick +jump via the definitions menu'." + (interactive) + (message "Searching definitions...") + (save-excursion + (let ((cpt 0) (kw) (menu) + (value-list) (type-list) (module-list) (class-list) (misc-list)) + (goto-char (point-min)) + (tuareg-skip-blank-and-comments) + (while (< (point) (point-max)) + (if (looking-at tuareg-definitions-regexp) + (progn + (setq kw (tuareg-match-string 0)) + (if (string= kw "and") + (setq kw (save-match-data + (save-excursion (tuareg-find-and-match))))) + (if (or (string= kw "exception") + (string= kw "val")) (setq kw "let")) + ;; skip optional elements + (goto-char (match-end 0)) + (tuareg-skip-blank-and-comments) + (if (looking-at tuareg-definitions-bind-skip-regexp) + (goto-char (match-end 0))) + (tuareg-skip-blank-and-comments) + (if (looking-at + (string-as-multibyte + "\\<[A-Za-z\300-\377][0-9_'A-Za-z\300-\377]*\\>")) + ;; menu item : [name (goto-char ...) t] + (let* ((p (make-marker)) + (ref (vector (tuareg-match-string 0) + (list 'tuareg-goto p) t))) + (setq cpt (1+ cpt)) + (message (concat "Searching definitions... (" + (number-to-string cpt) ")")) + (set-marker p (point)) + (cond + ((string= kw "let") + (setq value-list (cons ref value-list))) + ((string= kw "type") + (setq type-list (cons ref type-list))) + ((string= kw "module") + (setq module-list (cons ref module-list))) + ((string= kw "class") + (setq class-list (cons ref class-list))) + (t (setq misc-list (cons ref misc-list)))))))) + ;; skip to next phrase or next top-level `and' + (tuareg-forward-char) + (tuareg-next-phrase t) + (let ((old-point (point)) (last-and)) + (setq last-and (point)) + (save-excursion + (while (and (re-search-backward "\\" old-point t) + (not (tuareg-in-literal-or-comment-p)) + (save-excursion (tuareg-find-and-match) + (>= old-point (point)))) + (setq last-and (point)))) + (goto-char last-and))) + ;; sort and build lists + (mapcar (lambda (pair) + (if (cdr pair) + (setq menu + (append (tuareg-split-long-list + (car pair) (tuareg-sort-definitions (cdr pair))) + menu)))) + (list (cons "Miscellaneous" misc-list) + (cons "Values" value-list) + (cons "Classes" class-list) + (cons "Types" type-list) + (cons "Modules" module-list))) + ;; update definitions menu + (setq tuareg-definitions-menu + (append menu (list "---" ["Rescan..." tuareg-list-definitions t]))) + (if (or tuareg-with-xemacs + (not (functionp 'easy-menu-create-keymaps))) () + ;; patch for Emacs 20.2 + (setq tuareg-definitions-keymaps + (cdr (easy-menu-create-keymaps + "Definitions" tuareg-definitions-menu))) + (setq tuareg-definitions-menu-last-buffer nil)) + (message "Searching definitions... done"))) + (tuareg-update-definitions-menu)) + +(defun tuareg-goto (pos) + (goto-char pos) + (recenter)) + +(defun tuareg-sort-definitions (list) + (let* ((last "") (cpt 1) + (list (sort (nreverse list) + (lambda (p q) (string< (elt p 0) (elt q 0))))) + (tail list)) + (while tail + (if (string= (elt (car tail) 0) last) + (prog2 + (setq cpt (1+ cpt)) + (aset (car tail) 0 (format "%s (%d)" last cpt))) + (setq cpt 1) + (setq last (elt (car tail) 0))) + (setq tail (cdr tail))) + list)) + +;; look for the (n-1)th or last element of a list +(defun tuareg-nth (n list) + (if (or (<= n 1) (null list) (null (cdr list))) list + (tuareg-nth (1- n) (cdr list)))) + +;; split a definition list if it is too long +(defun tuareg-split-long-list (title list) + (let ((tail (tuareg-nth tuareg-definitions-max-items list))) + (if (or (null tail) (null (cdr tail))) + ;; list not too long, cons the title + (list (cons title list)) + ;; list too long, split and add initials to the title + (let (lists) + (while list + (let ((beg (substring (elt (car list) 0) 0 1)) + (end (substring (elt (car tail) 0) 0 1))) + (setq lists (cons + (cons (format "%s %s-%s" title beg end) list) + lists)) + (setq list (cdr tail)) + (setcdr tail nil) + (setq tail (tuareg-nth tuareg-definitions-max-items list)))) + (nreverse lists))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hooks and Exit + +(defvar tuareg-load-hook nil + "This hook is run when Tuareg is loaded in. It is a good place to put +key-bindings or hack Font-Lock keywords...") + +(run-hooks 'tuareg-load-hook) + +(provide 'tuareg) +;; for compatibility with caml support modes +;; you may also link caml.el to tuareg.el +(provide 'caml) -- 2.43.0