caml-mode-master/0000755000175000017500000000000013454350246014105 5ustar treinentreinencaml-mode-master/caml.el0000644000175000017500000021543713454350246015357 0ustar treinentreinen;;; caml.el --- OCaml code editing commands for Emacs ;; Copyright (C) 1997-2017 Institut National de Recherche en Informatique et en Automatique. ;; Author: Jacques Garrigue ;; Ian T Zimmerman ;; Maintainer: Damien Doligez ;; Created: July 1993 ;; Keywords: OCaml ;; Homepage: https://github.com/ocaml/ocaml/ ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; A major mode for editing OCaml code (see ) in Emacs. ;; Some of its major features include: ;; - syntax highlighting (font lock); ;; - automatic indentation; ;; - querying the type of expressions (using compiler generated annot files); ;; - running an OCaml REPL within Emacs; ;; - scans declarations and places them in a menu. ;; The original indentation code was the work of Ian T Zimmerman and ;; was adapted for OCaml by Jacques Garrigue in July 1997. ;;; Code: ;;user customizable variables (defvar caml-quote-char "'" "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defvar caml-imenu-enable nil "*Enable Imenu support.") (defvar caml-mode-indentation 2 "*Used for \\[caml-unindent-command].") (defvar caml-lookback-limit 5000 "*How far to look back for syntax things in caml mode.") (defvar caml-max-indent-priority 8 "*Bounds priority of operators permitted to affect caml indentation. Priorities are assigned to `interesting' caml operators as follows: all keywords 0 to 7 8 type, val, ... + 0 7 :: ^ 6 @ 5 := <- 4 if 3 fun, let, match ... 2 module 1 opening keywords 0.") (defvar caml-apply-extra-indent 2 "*How many spaces to add to indentation for an application in caml mode.") (make-variable-buffer-local 'caml-apply-extra-indent) (defvar caml-begin-indent 2 "*How many spaces to indent from a \"begin\" keyword in caml mode.") (make-variable-buffer-local 'caml-begin-indent) (defvar caml-class-indent 2 "*How many spaces to indent from a \"class\" keyword in caml mode.") (make-variable-buffer-local 'caml-class-indent) (defvar caml-exception-indent 2 "*How many spaces to indent from an \"exception\" keyword in caml mode.") (make-variable-buffer-local 'caml-exception-indent) (defvar caml-for-indent 2 "*How many spaces to indent from a \"for\" keyword in caml mode.") (make-variable-buffer-local 'caml-for-indent) (defvar caml-fun-indent 2 "*How many spaces to indent from a \"fun\" keyword in caml mode.") (make-variable-buffer-local 'caml-fun-indent) (defvar caml-function-indent 4 "*How many spaces to indent from a \"function\" keyword in caml mode.") (make-variable-buffer-local 'caml-function-indent) (defvar caml-if-indent 2 "*How many spaces to indent from an \"if\" keyword in caml mode.") (make-variable-buffer-local 'caml-if-indent) (defvar caml-if-else-indent 0 "*How many spaces to indent from an \"if .. else\" line in caml mode.") (make-variable-buffer-local 'caml-if-else-indent) (defvar caml-inherit-indent 2 "*How many spaces to indent from an \"inherit\" keyword in caml mode.") (make-variable-buffer-local 'caml-inherit-indent) (defvar caml-initializer-indent 2 "*How many spaces to indent from an \"initializer\" keyword in caml mode.") (make-variable-buffer-local 'caml-initializer-indent) (defvar caml-include-indent 2 "*How many spaces to indent from an \"include\" keyword in caml mode.") (make-variable-buffer-local 'caml-include-indent) (defvar caml-let-indent 2 "*How many spaces to indent from a \"let\" keyword in caml mode.") (make-variable-buffer-local 'caml-let-indent) (defvar caml-let-in-indent 0 "*How many spaces to indent from a \"let .. in\" keyword in caml mode.") (make-variable-buffer-local 'caml-let-in-indent) (defvar caml-match-indent 2 "*How many spaces to indent from a \"match\" keyword in caml mode.") (make-variable-buffer-local 'caml-match-indent) (defvar caml-method-indent 2 "*How many spaces to indent from a \"method\" keyword in caml mode.") (make-variable-buffer-local 'caml-method-indent) (defvar caml-module-indent 2 "*How many spaces to indent from a \"module\" keyword in caml mode.") (make-variable-buffer-local 'caml-module-indent) (defvar caml-object-indent 2 "*How many spaces to indent from an \"object\" keyword in caml mode.") (make-variable-buffer-local 'caml-object-indent) (defvar caml-of-indent 2 "*How many spaces to indent from an \"of\" keyword in caml mode.") (make-variable-buffer-local 'caml-of-indent) (defvar caml-parser-indent 4 "*How many spaces to indent from a \"parser\" keyword in caml mode.") (make-variable-buffer-local 'caml-parser-indent) (defvar caml-sig-indent 2 "*How many spaces to indent from a \"sig\" keyword in caml mode.") (make-variable-buffer-local 'caml-sig-indent) (defvar caml-struct-indent 2 "*How many spaces to indent from a \"struct\" keyword in caml mode.") (make-variable-buffer-local 'caml-struct-indent) (defvar caml-try-indent 2 "*How many spaces to indent from a \"try\" keyword in caml mode.") (make-variable-buffer-local 'caml-try-indent) (defvar caml-type-indent 4 "*How many spaces to indent from a \"type\" keyword in caml mode.") (make-variable-buffer-local 'caml-type-indent) (defvar caml-val-indent 2 "*How many spaces to indent from a \"val\" keyword in caml mode.") (make-variable-buffer-local 'caml-val-indent) (defvar caml-while-indent 2 "*How many spaces to indent from a \"while\" keyword in caml mode.") (make-variable-buffer-local 'caml-while-indent) (defvar caml-::-indent 2 "*How many spaces to indent from a \"::\" operator in caml mode.") (make-variable-buffer-local 'caml-::-indent) (defvar caml-@-indent 2 "*How many spaces to indent from a \"@\" operator in caml mode.") (make-variable-buffer-local 'caml-@-indent) (defvar caml-:=-indent 2 "*How many spaces to indent from a \":=\" operator in caml mode.") (make-variable-buffer-local 'caml-:=-indent) (defvar caml-<--indent 2 "*How many spaces to indent from a \"<-\" operator in caml mode.") (make-variable-buffer-local 'caml-<--indent) (defvar caml-->-indent 2 "*How many spaces to indent from a \"->\" operator in caml mode.") (make-variable-buffer-local 'caml-->-indent) (defvar caml-lb-indent 2 "*How many spaces to indent from a \"\[\" operator in caml mode.") (make-variable-buffer-local 'caml-lb-indent) (defvar caml-lc-indent 2 "*How many spaces to indent from a \"\{\" operator in caml mode.") (make-variable-buffer-local 'caml-lc-indent) (defvar caml-lp-indent 1 "*How many spaces to indent from a \"\(\" operator in caml mode.") (make-variable-buffer-local 'caml-lp-indent) (defvar caml-and-extra-indent nil "*Extra indent for caml lines starting with the \"and\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-and-extra-indent) (defvar caml-do-extra-indent nil "*Extra indent for caml lines starting with the \"do\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-do-extra-indent) (defvar caml-done-extra-indent nil "*Extra indent for caml lines starting with the \"done\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-done-extra-indent) (defvar caml-else-extra-indent nil "*Extra indent for caml lines starting with the \"else\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-else-extra-indent) (defvar caml-end-extra-indent nil "*Extra indent for caml lines starting with the \"end\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-end-extra-indent) (defvar caml-in-extra-indent nil "*Extra indent for caml lines starting with the \"in\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-in-extra-indent) (defvar caml-then-extra-indent nil "*Extra indent for caml lines starting with the \"then\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-then-extra-indent) (defvar caml-to-extra-indent -1 "*Extra indent for caml lines starting with the \"to\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-to-extra-indent) (defvar caml-with-extra-indent nil "*Extra indent for caml lines starting with the \"with\" keyword. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-with-extra-indent) (defvar caml-comment-indent 3 "*Indent inside comments.") (make-variable-buffer-local 'caml-comment-indent) (defvar caml-|-extra-indent -2 "*Extra indent for caml lines starting with the | operator. Usually negative. nil is align on master.") (make-variable-buffer-local 'caml-|-extra-indent) (defvar caml-rb-extra-indent -2 "*Extra indent for caml lines starting with ]. Usually negative. nil is align on master.") (defvar caml-rc-extra-indent -2 "*Extra indent for caml lines starting with }. Usually negative. nil is align on master.") (defvar caml-rp-extra-indent -1 "*Extra indent for caml lines starting with ). Usually negative. nil is align on master.") (defvar caml-electric-indent t "*Non-nil means electrically indent lines starting with |, ] or }. Many people find electric keys irritating, so you can disable them if you are one.") (defvar caml-electric-close-vector t "*Non-nil means electrically insert a | before a vector-closing ]. Many people find electric keys irritating, so you can disable them if you are one. You should probably have this on, though, if you also have `caml-electric-indent' on, which see.") ;;code (if (or (not (fboundp 'indent-line-to)) (not (fboundp 'buffer-substring-no-properties))) (require 'caml-compat)) (defvar caml-shell-active nil "Non nil when a subshell is running.") (defvar caml-mode-map nil "Keymap used in Caml mode.") (if caml-mode-map () (setq caml-mode-map (make-sparse-keymap)) (define-key caml-mode-map "|" 'caml-electric-pipe) (define-key caml-mode-map "}" 'caml-electric-pipe) (define-key caml-mode-map "]" 'caml-electric-rb) (define-key caml-mode-map "\t" 'caml-indent-command) (define-key caml-mode-map [backtab] 'caml-unindent-command) ;itz 04-21-96 instead of defining a new function, use defadvice ;that way we get out effect even when we do \C-x` in compilation buffer ; (define-key caml-mode-map "\C-x`" 'caml-next-error) (if (featurep 'xemacs) (define-key caml-mode-map 'backspace 'backward-delete-char-untabify) (define-key caml-mode-map "\177" 'backward-delete-char-untabify)) ;; caml-types (define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type) ; "type" (define-key caml-mode-map [?\C-c?\C-f] 'caml-types-show-call) ; "function" (define-key caml-mode-map [?\C-c?\C-l] 'caml-types-show-ident) ; "let" ;; must be a mouse-down event. Can be any button and any prefix (define-key caml-mode-map [?\C-c down-mouse-1] 'caml-types-explore) ;; caml-help (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path) (define-key caml-mode-map [?\C-c?\]] 'ocaml-close-module) (define-key caml-mode-map [?\C-c?\[] 'ocaml-open-module) (define-key caml-mode-map [?\C-c?\C-h] 'caml-help) (define-key caml-mode-map [?\C-c?\t] 'caml-complete) ;; others (define-key caml-mode-map "\C-cb" 'caml-insert-begin-form) (define-key caml-mode-map "\C-cf" 'caml-insert-for-form) (define-key caml-mode-map "\C-ci" 'caml-insert-if-form) (define-key caml-mode-map "\C-cl" 'caml-insert-let-form) (define-key caml-mode-map "\C-cm" 'caml-insert-match-form) (define-key caml-mode-map "\C-ct" 'caml-insert-try-form) (define-key caml-mode-map "\C-cw" 'caml-insert-while-form) (define-key caml-mode-map "\C-c`" 'caml-goto-phrase-error) (define-key caml-mode-map "\C-c\C-a" 'caml-find-alternate-file) (define-key caml-mode-map "\C-c\C-c" 'compile) (define-key caml-mode-map "\C-c\C-e" 'caml-eval-phrase) (define-key caml-mode-map "\C-c\C-[" 'caml-backward-to-less-indent) (define-key caml-mode-map "\C-c\C-]" 'caml-forward-to-less-indent) (define-key caml-mode-map "\C-c\C-q" 'caml-indent-phrase) (define-key caml-mode-map "\C-c\C-r" 'caml-eval-region) (define-key caml-mode-map "\C-c\C-s" 'caml-show-subshell) (define-key caml-mode-map "\M-\C-h" 'caml-mark-phrase) (define-key caml-mode-map "\M-\C-q" 'caml-indent-phrase) (define-key caml-mode-map "\M-\C-x" 'caml-eval-phrase) (if (featurep 'xemacs) nil (let ((map (make-sparse-keymap "Caml")) (forms (make-sparse-keymap "Forms"))) (define-key caml-mode-map "\C-c\C-d" 'caml-show-imenu) (define-key caml-mode-map [menu-bar] (make-sparse-keymap)) (define-key caml-mode-map [menu-bar caml] (cons "Caml" map)) ;; caml-help (define-key map [open] '("Open add path" . ocaml-add-path )) (define-key map [close] '("Close module for help" . ocaml-close-module)) (define-key map [open] '("Open module for help" . ocaml-open-module)) (define-key map [help] '("Help for identifier" . caml-help)) (define-key map [complete] '("Complete identifier" . caml-complete)) (define-key map [separator-help] '("---")) ;; caml-types (define-key map [show-type] '("Show type at point" . caml-types-show-type )) (define-key map [separator-types] '("---")) ;; others (define-key map [camldebug] '("Call debugger..." . camldebug)) (define-key map [run-caml] '("Start subshell..." . run-caml)) (define-key map [compile] '("Compile..." . compile)) (define-key map [switch-view] '("Switch view" . caml-find-alternate-file)) (define-key map [separator-format] '("--")) (define-key map [forms] (cons "Forms" forms)) (define-key map [show-imenu] '("Show index" . caml-show-imenu)) (put 'caml-show-imenu 'menu-enable '(not caml-imenu-shown)) (define-key map [show-subshell] '("Show subshell" . caml-show-subshell)) (put 'caml-show-subshell 'menu-enable 'caml-shell-active) (define-key map [eval-phrase] '("Eval phrase" . caml-eval-phrase)) (put 'caml-eval-phrase 'menu-enable 'caml-shell-active) (define-key map [indent-phrase] '("Indent phrase" . caml-indent-phrase)) (define-key forms [while] '("while .. do .. done" . caml-insert-while-form)) (define-key forms [try] '("try .. with .." . caml-insert-try-form)) (define-key forms [match] '("match .. with .." . caml-insert-match-form)) (define-key forms [let] '("let .. in .." . caml-insert-let-form)) (define-key forms [if] '("if .. then .. else .." . caml-insert-if-form)) (define-key forms [begin] '("for .. do .. done" . caml-insert-for-form)) (define-key forms [begin] '("begin .. end" . caml-insert-begin-form))))) (defvar caml-mode-xemacs-menu (if (featurep 'xemacs) '("Caml" [ "Indent phrase" caml-indent-phrase :keys "C-M-q" ] [ "Eval phrase" caml-eval-phrase :active caml-shell-active :keys "C-M-x" ] [ "Show subshell" caml-show-subshell caml-shell-active ] ("Forms" [ "while .. do .. done" caml-insert-while-form t] [ "try .. with .." caml-insert-try-form t ] [ "match .. with .." caml-insert-match-form t ] [ "let .. in .." caml-insert-let-form t ] [ "if .. then .. else .." caml-insert-if-form t ] [ "for .. do .. done" caml-insert-for-form t ] [ "begin .. end" caml-insert-begin-form t ]) "---" [ "Switch view" caml-find-alternate-file t ] [ "Compile..." compile t ] [ "Start subshell..." run-caml t ] "---" [ "Show type at point" caml-types-show-type t ] "---" [ "Complete identifier" caml-complete t ] [ "Help for identifier" caml-help t ] [ "Add path for documentation" ocaml-add-path t ] [ "Open module for documentation" ocaml-open t ] [ "Close module for documentation" ocaml-close t ] )) "Menu to add to the menubar when running Xemacs.") (defvar caml-mode-syntax-table nil "Syntax table in use in Caml mode buffers.") (if caml-mode-syntax-table () (let ((n (if (featurep 'xemacs) "" "n"))) (setq caml-mode-syntax-table (make-syntax-table)) ; backslash is an escape sequence (modify-syntax-entry ?\\ "\\" caml-mode-syntax-table) ; ( is first character of comment start (modify-syntax-entry ?\( (concat "()1" n) caml-mode-syntax-table) ; * is second character of comment start, ; and first character of comment end (modify-syntax-entry ?* (concat ". 23" n) caml-mode-syntax-table) ; ) is last character of comment end (modify-syntax-entry ?\) ")(4" caml-mode-syntax-table) ; backquote was a string-like delimiter (for character literals) ; (modify-syntax-entry ?` "\"" caml-mode-syntax-table) ; quote and underscore are part of words (modify-syntax-entry ?' "w" caml-mode-syntax-table) (modify-syntax-entry ?_ "w" caml-mode-syntax-table) ; ISO-latin accented letters and EUC kanjis are part of words (let ((i 160)) (while (< i 256) (modify-syntax-entry i "w" caml-mode-syntax-table) (setq i (1+ i)))))) (defvar caml-mode-abbrev-table nil "Abbrev table used for Caml mode buffers.") (if caml-mode-abbrev-table nil (define-abbrev-table 'caml-mode-abbrev-table (mapcar (lambda (keyword) `(,keyword ,keyword caml-abbrev-hook nil t)) '("and" "do" "done" "else" "end" "in" "then" "with")))) ;; Other internal variables (defvar caml-imenu-shown nil "Non-nil if we have computed definition list.") (make-variable-buffer-local 'caml-imenu-shown) (defconst caml-imenu-search-regexp (concat "\\_\\|" "^[ \t]*\\(let\\|class\\|type\\|m\\(odule\\|ethod\\)" "\\|functor\\|and\\|val\\)[ \t]+" "\\(\\('[a-zA-Z0-9]+\\|([^)]+)" "\\|mutable\\|private\\|rec\\|type\\)[ \t]+\\)?" "\\([a-zA-Z][a-zA-Z0-9_']*\\)")) ;;; The major mode (eval-when-compile (if (featurep 'xemacs) nil (require 'imenu))) ;; (defvar caml-mode-hook nil "Hook for `caml-mode'.") (defun caml-mode () "Major mode for editing OCaml code. \\{caml-mode-map}" (interactive) (kill-all-local-variables) (setq major-mode 'caml-mode) (setq mode-name "caml") (use-local-map caml-mode-map) (set-syntax-table caml-mode-syntax-table) (setq local-abbrev-table caml-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "(*") (make-local-variable 'comment-end) (setq comment-end "*)") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+ *") (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (make-local-variable 'indent-line-function) (setq indent-line-function 'caml-indent-command) ;itz Fri Sep 25 13:23:49 PDT 1998 (make-local-variable 'add-log-current-defun-function) (setq add-log-current-defun-function 'caml-current-defun) ;garrigue 27-11-96 (setq case-fold-search nil) ;garrigue july 97 (if (featurep 'xemacs) (if (and (featurep 'menubar) current-menubar) (progn ;; make a local copy of the menubar, so our modes don't ;; change the global menubar (set-buffer-menubar current-menubar) (add-submenu nil caml-mode-xemacs-menu))) ;imenu support (not for Xemacs) (make-local-variable 'imenu-create-index-function) (setq imenu-create-index-function 'caml-create-index-function) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression caml-imenu-search-regexp) (if (and caml-imenu-enable (< (buffer-size) 10000)) (caml-show-imenu))) (run-hooks 'caml-mode-hook)) ;; Disabled because it assumes make and does not play well with ocamlbuild. ;; See PR#4469 for details. ;; (defun caml-set-compile-command () ;; "Hook to set compile-command locally, unless there is a Makefile or ;; a _build directory or a _tags file in the current directory." ;; (interactive) ;; (unless (or (null buffer-file-name) ;; (file-exists-p "makefile") ;; (file-exists-p "Makefile") ;; (file-exists-p "_build") ;; (file-exists-p "_tags")) ;; (let* ((filename (file-name-nondirectory buffer-file-name)) ;; (basename (file-name-sans-extension filename)) ;; (command nil)) ;; (cond ;; ((string-match ".*\\.mli\$" filename) ;; (setq command "ocamlc -c")) ;; ((string-match ".*\\.ml\$" filename) ;; (setq command "ocamlc -c") ; (concat "ocamlc -o " basename) ;; ) ;; ((string-match ".*\\.mll\$" filename) ;; (setq command "ocamllex")) ;; ((string-match ".*\\.mll\$" filename) ;; (setq command "ocamlyacc")) ;; ) ;; (if command ;; (progn ;; (make-local-variable 'compile-command) ;; (setq compile-command (concat command " " filename)))) ;; ))) ;; (add-hook 'caml-mode-hook 'caml-set-compile-command) ;;; Auxiliary function. Garrigue 96-11-01. (defun caml-find-alternate-file () "Find the `.mli' file for the open `.ml' file, or vice versa." (interactive) (let ((name (buffer-file-name))) (if (string-match "^\\(.*\\)\\.\\(ml\\|mli\\)$" name) (find-file (concat (caml-match-string 1 name) (if (string= "ml" (caml-match-string 2 name)) ".mli" ".ml")))))) ;;; subshell support (defun caml-eval-region (start end) "Evaluate the region. Send the current region bounded by START and END to the inferior OCaml process." (interactive"r") (require 'inf-caml) (inferior-caml-eval-region start end)) ;; old version ---to be deleted later ; ; (defun caml-eval-phrase () ; "Send the current OCaml phrase to the inferior Caml process." ; (interactive) ; (save-excursion ; (let ((bounds (caml-mark-phrase))) ; (inferior-caml-eval-region (car bounds) (cdr bounds))))) (defun caml-eval-phrase (arg &optional min max) "Send the phrase containing the point to the CAML process. With a prefix argument send as many phrases as its numeric value, If an error occurs during evaluation, stop at this phrase and report the error. Return nil if noerror and position of error if any. If ARG's numeric value is zero or negative, evaluate the current phrase or as many as prefix arg, ignoring evaluation errors. This allows to jump other erroneous phrases. Optional arguments MIN MAX defines a region within which the phrase should lies." (interactive "p") (require 'inf-caml) (inferior-caml-eval-phrase arg min max)) (defun caml-eval-buffer (arg) "Evaluate the buffer from the beginning to the phrase under the point. With a prefix ARG, evaluate past the whole buffer, no stopping at the current point." (interactive "p") (let ((here (point)) err) (goto-char (point-min)) (setq err (caml-eval-phrase 500 (point-min) (if arg (point-max) here))) (if err (set-mark err)) (goto-char here))) (defun caml-show-subshell () "Start an inferior subshell." (interactive) (require 'inf-caml) (inferior-caml-show-subshell)) ;;; Imenu support (defun caml-show-imenu () "Open `imenu'." (interactive) (require 'imenu) (switch-to-buffer (current-buffer)) (imenu-add-to-menubar "Defs") (setq caml-imenu-shown t)) (defun caml-prev-index-position-function () "Locate the previous imenu entry." (let (found data) (while (and (setq found (re-search-backward caml-imenu-search-regexp nil 'move)) (progn (setq data (match-data)) t) (or (caml-in-literal-p) (caml-in-comment-p) (if (looking-at "in") (caml-find-in-match))))) (set-match-data data) found)) (defun caml-create-index-function () "Create an index alist for OCaml files. See `imenu-create-index-function'." (let (value-alist type-alist class-alist method-alist module-alist and-alist all-alist menu-alist (prev-pos (point-max)) index) (goto-char prev-pos) (imenu-progress-message prev-pos 0 t) ;; collect definitions (while (caml-prev-index-position-function) (setq index (cons (caml-match-string 5) (point))) (imenu-progress-message prev-pos nil t) (setq all-alist (cons index all-alist)) (cond ((looking-at "[ \t]*and") (setq and-alist (cons index and-alist))) ((looking-at "[ \t]*let") (setq value-alist (cons index (append and-alist value-alist))) (setq and-alist nil)) ((looking-at "[ \t]*type") (setq type-alist (cons index (append and-alist type-alist))) (setq and-alist nil)) ((looking-at "[ \t]*class") (setq class-alist (cons index (append and-alist class-alist))) (setq and-alist nil)) ((looking-at "[ \t]*val") (setq value-alist (cons index value-alist))) ((looking-at "[ \t]*\\(module\\|functor\\)") (setq module-alist (cons index module-alist))) ((looking-at "[ \t]*method") (setq method-alist (cons index method-alist))))) ;; build menu (mapc (lambda (pair) (if (symbol-value (cdr pair)) (setq menu-alist (cons (cons (car pair) (sort (symbol-value (cdr pair)) 'imenu--sort-by-name)) menu-alist)))) '(("Values" . value-alist) ("Types" . type-alist) ("Modules" . module-alist) ("Methods" . method-alist) ("Classes" . class-alist))) (if all-alist (setq menu-alist (cons (cons "Index" all-alist) menu-alist))) (imenu-progress-message prev-pos 100 t) menu-alist)) ;;; Indentation stuff (defun caml-in-indentation () "Test if inside indentation. This function tests whether all characters between beginning of line and point are blanks." (save-excursion (skip-chars-backward " \t") (bolp))) ;;; The command ;;; Sorry, I didn't like the previous behaviour... Garrigue 96/11/01 (defun caml-indent-command (&optional p) "Indent the current line in Caml mode. Compute new indentation based on Caml syntax. If prefixed P, indent the line all the way to where point is." (interactive "*p") (cond ((and p (> p 1)) (indent-line-to (current-column))) ((caml-in-indentation) (indent-line-to (caml-compute-final-indent))) (t (save-excursion (indent-line-to (caml-compute-final-indent)))))) (defun caml-unindent-command () "Decrease indentation by one level in Caml mode. Works only if the point is at the beginning of an indented line \(i.e., all characters between beginning of line and point are blanks\). Does nothing otherwise. The unindent size is given by the variable `caml-mode-indentation'." (interactive "*") (let* ((begline (save-excursion (beginning-of-line) (point))) (current-offset (- (point) begline))) (if (and (>= current-offset caml-mode-indentation) (caml-in-indentation)) (backward-delete-char-untabify caml-mode-indentation)))) ;;; ;;; Error processing ;;; ;; Error positions are given in bytes, not in characters ;; This function switches to monobyte mode (if (not (fboundp 'char-bytes)) (defalias 'forward-byte 'forward-char) (defun caml-char-bytes (ch) (let ((l (char-bytes ch))) (if (> l 1) (- l 1) l))) (defun forward-byte (count) (if (> count 0) (while (> count 0) (let ((char (char-after))) (if (null char) (setq count 0) (setq count (- count (caml-char-bytes (char-after)))) (forward-char)))) (while (< count 0) (let ((char (char-after))) (if (null char) (setq count 0) (setq count (+ count (caml-char-bytes (char-before)))) (backward-char)))) ))) (require 'compile) ;; In Emacs 19, the regexps in compilation-error-regexp-alist do not ;; match the error messages when the language is not English. ;; Hence we add a regexp. ;; FIXME do we (still) have i18n of error messages ??? (defconst caml-error-regexp "^[ A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]" "Regular expression matching the error messages produced by ocamlc.") ;; Newer emacs versions support line/char ranges ;; We will adapt OCaml to output error messages in a compatible format. ;; In the meantime we add new formats here in addition to the old one. (defconst caml-error-regexp-newstyle (concat "^[ A-\377]+ \"\\([^\"\n]+\\)\", line \\([0-9]+\\)," "char \\([0-9]+\\) to line \\([0-9]+\\), char \\([0-9]+\\):") "Regular expression matching the error messages produced by ocamlc/ocamlopt.") (defconst caml-error-regexp-new-newstyle (concat "^[ A-\377]+ \"\\([^\"\n]+\\)\", line \\([0-9]+\\), " "characters \\([0-9]+\\)-\\([0-9]+\\):") "Regular expression matching the error messages produced by ocamlc/ocamlopt.") (if (boundp 'compilation-error-regexp-alist) (progn (or (assoc caml-error-regexp compilation-error-regexp-alist) (setq compilation-error-regexp-alist (cons (list caml-error-regexp 1 2) compilation-error-regexp-alist))) (or (assoc caml-error-regexp-newstyle compilation-error-regexp-alist) (setq compilation-error-regexp-alist (cons (list caml-error-regexp-newstyle 1 '(2 . 4) '(3 . 5)) compilation-error-regexp-alist))) (or (assoc caml-error-regexp-new-newstyle compilation-error-regexp-alist) (setq compilation-error-regexp-alist (cons (list caml-error-regexp-new-newstyle 1 2 '(3 . 4)) compilation-error-regexp-alist))))) ;; A regexp to extract the range info (defconst caml-error-chars-regexp ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):?" "Regular expression used by `next-error'. This regular expression extracts the character numbers from an error message produced by ocamlc.") ;; Wrapper around next-error. (defvar caml-error-overlay nil) (defvar caml-next-error-skip-warnings-flag nil) (if (fboundp 'string-to-number) (defalias 'caml-string-to-int 'string-to-number) (defalias 'caml-string-to-int 'string-to-int)) ;;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 caml-next-error activate) "Read the extra positional information provided by the OCaml compiler. Puts the point and the mark exactly around the erroneous program fragment. The erroneous fragment is also temporarily highlighted if possible." (if (eq major-mode 'caml-mode) (let (skip bol beg end) (save-excursion (with-current-buffer (if (boundp 'compilation-last-buffer) compilation-last-buffer ;Emacs 19 "*compilation*") ;Emacs 18 (save-excursion (goto-char (window-point (get-buffer-window (current-buffer)))) (if (looking-at caml-error-chars-regexp) (setq beg (caml-string-to-int (buffer-substring (match-beginning 1) (match-end 1))) end (caml-string-to-int (buffer-substring (match-beginning 2) (match-end 2))))) (forward-line 1) (beginning-of-line) (if (and (looking-at "Warning") caml-next-error-skip-warnings-flag) (setq skip 't))))) (cond (skip (next-error)) (beg (setq end (- end beg)) (beginning-of-line) (forward-byte beg) (setq beg (point)) (forward-byte end) (setq end (point)) (goto-char beg) (push-mark end t) (cond ((fboundp 'make-overlay) (if caml-error-overlay () (setq caml-error-overlay (make-overlay 1 1)) (overlay-put caml-error-overlay 'face 'region)) (unwind-protect (progn (move-overlay caml-error-overlay beg end (current-buffer)) (sit-for 60)) (delete-overlay caml-error-overlay))))))))) (defun caml-next-error-skip-warnings (&rest args) "Same as `next-error' but skip warnings. For the arguments ARGS, see `next-error'." (let ((old-flag caml-next-error-skip-warnings-flag)) (unwind-protect (progn (setq caml-next-error-skip-warnings-flag 't) (apply 'next-error args)) (setq caml-next-error-skip-warnings-flag old-flag)))) ;; Usual match-string doesn't work properly with font-lock-mode ;; on some emacs. (defun caml-match-string (num &optional string) "Return string of text matched by last search, without properties. NUM specifies which parenthesized expression in the last regexp. Value is nil if NUMth pair didn't match, or there were less than NUM pairs. Zero means the entire text matched by the whole regexp or whole string. Uses STRING is given and otherwise extracts from buffer." (let* ((data (match-data)) (begin (nth (* 2 num) data)) (end (nth (1+ (* 2 num)) data))) (if string (substring string begin end) (buffer-substring-no-properties begin end)))) ;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of ;; comfort when sending phrases to the toplevel and getting errors. (defun caml-goto-phrase-error () "Find the error location in current OCaml phrase." (interactive) (require 'inf-caml) (let ((bounds (save-excursion (caml-mark-phrase)))) (inferior-caml-goto-error (car bounds) (cdr bounds)))) ;;; Phrases ;itz the heuristics used to see if we're `between two phrases' ;didn't seem right to me. (defconst caml-phrase-start-keywords (concat "\\_<\\(class\\|ex\\(ternal\\|ception\\)\\|functor" "\\|let\\|module\\|open\\|type\\|val\\)\\_>") "Keywords starting phrases in files.") (defun caml-at-phrase-start-p () "Check if at the start of a phrase. A phrase starts when a toplevel keyword is at the beginning of a line." (and (bolp) (or (looking-at "#") (looking-at caml-phrase-start-keywords)))) (defun caml-skip-comments-forward () "Skip forward past comments." (skip-chars-forward " \n\t") (while (or (looking-at comment-start-skip) (caml-in-comment-p)) (if (= (following-char) ?\)) (forward-char) (search-forward comment-end)) (skip-chars-forward " \n\t"))) (defun caml-skip-comments-backward () "Skip backward past comments." (skip-chars-backward " \n\t") (while (and (eq (preceding-char) ?\)) (eq (char-after (- (point) 2)) ?*)) (backward-char) (while (caml-in-comment-p) (search-backward comment-start)) (skip-chars-backward " \n\t"))) (defconst caml-phrase-sep-keywords (concat ";;\\|" caml-phrase-start-keywords)) (defun caml-find-phrase (&optional min-pos max-pos) "Find the CAML phrase containing the point. Return the position of the beginning of the phrase, and move point to the end. Optionally operates between MIN-POS and MAX-POS." (interactive) (if (not min-pos) (setq min-pos (point-min))) (if (not max-pos) (setq max-pos (point-max))) (let (beg end use-semi kwop) ;(caml-skip-comments-backward) (cond ; shall we have special processing for semicolons? ;((and (eq (char-before (- (point) 1)) ?\;) (eq (char-before) ?\;)) ; (forward-char) ; (caml-skip-comments-forward) ; (setq beg (point)) ; (while (and (search-forward ";;" max-pos 'move) ; (or (caml-in-comment-p) (caml-in-literal-p))))) (t (caml-skip-comments-forward) (if (caml-at-phrase-start-p) (forward-char)) (while (and (cond ((re-search-forward caml-phrase-sep-keywords max-pos 'move) (goto-char (match-beginning 0)) t)) (or (not (or (bolp) (looking-at ";;"))) (caml-in-comment-p) (caml-in-literal-p))) (forward-char)) (setq end (+ (point) (if (looking-at ";;") 2 0))) (while (and (setq kwop (caml-find-kwop caml-phrase-sep-keywords min-pos)) (not (string= kwop ";;")) (not (bolp)))) (if (string= kwop ";;") (forward-char 2)) (if (not kwop) (goto-char min-pos)) (caml-skip-comments-forward) (setq beg (point)) (if (>= beg end) (error "No phrase before point")) (goto-char end))) (caml-skip-comments-forward) beg)) (defun caml-mark-phrase (&optional min-pos max-pos) "Put mark at end of this OCaml phrase, point at beginning. Optionally operates between MIN-POS and MAX-POS." (interactive) (let* ((beg (caml-find-phrase min-pos max-pos)) (end (point))) (push-mark) (goto-char beg) (cons beg end))) ;;itz Fri Sep 25 12:58:13 PDT 1998 support for adding change-log entries (defun caml-current-defun () "Return the location of the definition around the point." (save-excursion (caml-mark-phrase) (if (not (looking-at caml-phrase-start-keywords)) nil (re-search-forward caml-phrase-start-keywords) (let ((done nil)) (while (not done) (cond ((looking-at "\\s ") (skip-syntax-forward " ")) ((char-equal (following-char) ?\( ) (forward-sexp 1)) ((char-equal (following-char) ?') (skip-syntax-forward "w_")) (t (setq done t))))) (re-search-forward "\\(\\sw\\|\\s_\\)+") (match-string 0)))) (defun caml-overlap (b1 e1 b2 e2) "Return non-nil if the closed ranges B1..E1 and B2..E2 overlap." (<= (max b1 b2) (min e1 e2))) (defun caml-in-literal-p () "Return non-nil if point is inside a caml literal." (let* ((start-literal (concat "[\"" caml-quote-char "]")) (char-literal (concat "\\([^\\]\\|\\\\\\.\\|\\\\[0-9][0-9][0-9]\\)" caml-quote-char)) (pos (point)) (eol (progn (end-of-line 1) (point))) state in-str) (beginning-of-line 1) (while (and (not state) (re-search-forward start-literal eol t) (<= (point) pos)) (cond ((string= (caml-match-string 0) "\"") (setq in-str t) (while (and in-str (not state) (re-search-forward "\"\\|\\\\\"" eol t)) (if (> (point) pos) (setq state t)) (if (string= (caml-match-string 0) "\"") (setq in-str nil))) (if in-str (setq state t))) ((looking-at char-literal) (if (and (>= pos (match-beginning 0)) (< pos (match-end 0))) (setq state t) (goto-char (match-end 0)))))) (goto-char pos) state)) (defun caml-forward-comment () "Skip one (eventually nested) comment." (let ((count 1) match) (while (> count 0) (if (not (re-search-forward "(\\*\\|\\*)" nil 'move)) (setq count -1) (setq match (caml-match-string 0)) (cond ((caml-in-literal-p) nil) ((string= match comment-start) (setq count (1+ count))) (t (setq count (1- count)))))) (= count 0))) (defun caml-backward-comment () "Skip one (eventually nested) comment." (let ((count 1) match) (while (> count 0) (if (not (re-search-backward "(\\*\\|\\*)" nil 'move)) (setq count -1) (setq match (caml-match-string 0)) (cond ((caml-in-literal-p) nil) ((string= match comment-start) (setq count (1- count))) (t (setq count (1+ count)))))) (= count 0))) (defun caml-in-comment-p () "Return non-nil if point is inside a caml comment. Returns nil for the parenthesis opening a comment." (nth 4 (syntax-ppss))) ;; Various constants and regexps (defconst caml-before-expr-prefix (concat "\\_<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else" "\\|i\\(f\\|n\\(herit\\|itializer\\)?\\)" "\\|f\\(or\\|un\\(ct\\(ion\\|or\\)\\)?\\)" "\\|l\\(and\\|or\\|s[lr]\\|xor\\)\\|m\\(atch\\|od\\)" "\\|o[fr]\\|parser\\|s\\(ig\\|truct\\)\\|t\\(hen\\|o\\|ry\\)" "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\_>\\|:begin\\_>" "\\|[=<>@^|&+-*/$%][!$%*+-./:<=>?@^|~]*\\|:[:=]\\|[[({,;]") "Keywords that may appear immediately before an expression. Used to distinguish it from toplevel let construct.") (defconst caml-matching-kw-regexp (concat "\\_<\\(and\\|do\\(ne\\|wnto\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)" "\\|with\\)\\_>\\|[^[|]|") "Regexp used in caml mode for skipping back over nested blocks.") (defconst caml-matching-kw-alist '(("|" . caml-find-pipe-match) (";" . caml-find-semi-match) ("," . caml-find-comma-match) ("end" . caml-find-end-match) ("done" . caml-find-done-match) ("in" . caml-find-in-match) ("with" . caml-find-with-match) ("else" . caml-find-else-match) ("then" . caml-find-then-match) ("to" . caml-find-done-match) ("downto" . caml-find-done-match) ("do" . caml-find-done-match) ("and" . caml-find-and-match)) "Association list used in caml mode for skipping back over nested blocks.") (defconst caml-kwop-regexps (make-vector 9 nil) "Array of regexps representing caml keywords of different priorities.") (defun caml-in-shebang-line () "Check if in shebang." (save-excursion (beginning-of-line) (and (= 1 (point)) (looking-at "#!")))) (defun caml-in-expr-p () "Check if in expression." (let ((pos (point)) (in-expr t)) (caml-find-kwop (concat caml-before-expr-prefix "\\|" caml-matching-kw-regexp "\\|" (aref caml-kwop-regexps caml-max-indent-priority))) (cond ; special case for #! at beginning of file ((caml-in-shebang-line) (setq in-expr nil)) ; special case for ;; ((and (> (point) 1) (= (preceding-char) ?\;) (= (following-char) ?\;)) (setq in-expr nil)) ((looking-at caml-before-expr-prefix) (if (not (looking-at "(\\*")) (goto-char (match-end 0))) (skip-chars-forward " \t\n") (while (looking-at "(\\*") (forward-char) (caml-forward-comment) (skip-chars-forward " \t\n")) (if (<= pos (point)) (setq in-expr nil)))) (goto-char pos) in-expr)) (defun caml-at-sexp-close-p () "Check if at end of sexp." (or (char-equal ?\) (following-char)) (char-equal ?\] (following-char)) (char-equal ?\} (following-char)))) (defun caml-find-kwop (kwop-regexp &optional min-pos) "Look back for a caml keyword or operator matching KWOP-REGEXP. Second optional argument MIN-POS bounds the search. Ignore occurrences inside literals. If found, return a list of two values: the actual text of the keyword or operator, and a boolean indicating whether the keyword was one we looked for explicitly {non-nil}, or on the other hand one of the block-terminating keywords." (let ((start-literal (concat "[\"" caml-quote-char "]")) found kwop) (while (and (> (point) 1) (not found) (re-search-backward kwop-regexp min-pos 'move)) (setq kwop (caml-match-string 0)) (cond ((looking-at "(\\*") (if (> (point) 1) (backward-char))) ((caml-in-comment-p) (search-backward "(" min-pos 'move)) ((looking-at start-literal)) ((caml-in-literal-p) (re-search-backward start-literal min-pos 'move)) ;ugly hack ((setq found t)))) (if found (if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!! kwop (forward-char 1) "|") nil))) ; Association list of indentation values based on governing keywords. ; ;Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is ;non-nil for operator-type nodes, which affect indentation in a ;different way from keywords: subsequent lines are indented to the ;actual occurrence of an operator, but relative to the indentation of ;the line where the governing keyword occurs. (defconst caml-no-indent 0) (defconst caml-kwop-alist '(("begin" nil 6 caml-begin-indent) (":begin" nil 6 caml-begin-indent) ; hack ("class" nil 0 caml-class-indent) ("constraint" nil 0 caml-val-indent) ("sig" nil 1 caml-sig-indent) ("struct" nil 1 caml-struct-indent) ("exception" nil 0 caml-exception-indent) ("for" nil 6 caml-for-indent) ("fun" nil 3 caml-fun-indent) ("function" nil 3 caml-function-indent) ("if" nil 6 caml-if-indent) ("if-else" nil 6 caml-if-else-indent) ("include" nil 0 caml-include-indent) ("inherit" nil 0 caml-inherit-indent) ("initializer" nil 0 caml-initializer-indent) ("let" nil 6 caml-let-indent) ("let-in" nil 6 caml-let-in-indent) ("match" nil 6 caml-match-indent) ("method" nil 0 caml-method-indent) ("module" nil 0 caml-module-indent) ("object" nil 6 caml-object-indent) ("of" nil 7 caml-of-indent) ("open" nil 0 caml-no-indent) ("parser" nil 3 caml-parser-indent) ("try" nil 6 caml-try-indent) ("type" nil 0 caml-type-indent) ("val" nil 0 caml-val-indent) ("when" nil 2 caml-if-indent) ("while" nil 6 caml-while-indent) ("::" t 5 caml-::-indent) ("@" t 4 caml-@-indent) ("^" t 4 caml-@-indent) (":=" nil 3 caml-:=-indent) ("<-" nil 3 caml-<--indent) ("->" nil 2 caml-->-indent) ("\[" t 8 caml-lb-indent) ("{" t 8 caml-lc-indent) ("\(" t 8 caml-lp-indent) ("|" nil 2 caml-no-indent) (";;" nil 0 caml-no-indent)) ; if-else and let-in are not keywords but idioms ; "|" is not in the regexps ; all these 3 values correspond to hard-coded names "Association list of indentation values based on governing keywords. Each element is of the form (KEYWORD OP-TYPE PRIO INDENT). OP-TYPE is non-nil for operator-type nodes, which affect indentation in a different way from keywords: subsequent lines are indented to the actual occurrence of an operator, but relative to the indentation of the line where the governing keyword occurs.") ;;Originally, we had caml-kwop-regexp create these at runtime, from an ;;additional field in caml-kwop-alist. That proved way too slow, ;;although I still can't understand why. itz (aset caml-kwop-regexps 0 (concat "\\_<\\(begin\\|object\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\_>" "\\|:begin\\>\\|[[({]\\|;;")) (aset caml-kwop-regexps 1 (concat (aref caml-kwop-regexps 0) "\\|\\_<\\(class\\|module\\)\\_>")) (aset caml-kwop-regexps 2 (concat (aref caml-kwop-regexps 1) "\\|\\_<\\(fun\\(ction\\)?\\|initializer\\|let\\|m\\(atch\\|ethod\\)" "\\|parser\\|try\\|val\\)\\_>\\|->")) (aset caml-kwop-regexps 3 (concat (aref caml-kwop-regexps 2) "\\|\\_")) (aset caml-kwop-regexps 4 (concat (aref caml-kwop-regexps 3) "\\|:=\\|<-")) (aset caml-kwop-regexps 5 (concat (aref caml-kwop-regexps 4) "\\|@")) (aset caml-kwop-regexps 6 (concat (aref caml-kwop-regexps 5) "\\|::\\|\\^")) (aset caml-kwop-regexps 7 (concat (aref caml-kwop-regexps 0) "\\|\\_<\\(constraint\\|exception\\|in\\(herit\\|clude\\)" "\\|o\\(f\\|pen\\)\\|type\\|val\\)\\_>")) (aset caml-kwop-regexps 8 (concat (aref caml-kwop-regexps 6) "\\|\\_<\\(constraint\\|exception\\|in\\(herit\\|clude\\)" "\\|o\\(f\\|pen\\)\\|type\\)\\>")) (defun caml-find-done-match () "Move the point to the begining of a loop. Return whether it is \"for\" or \"while\"." (let ((unbalanced 1) (kwop t)) (while (and (not (= 0 unbalanced)) kwop) (setq kwop (caml-find-kwop "\\_<\\(done\\|for\\|while\\)\\_>")) (cond ((not kwop)) ((string= kwop "done") (setq unbalanced (1+ unbalanced))) (t (setq unbalanced (1- unbalanced))))) kwop)) (defun caml-find-end-match () "Move the point at the beginning of a block closed by \"end\". Return the keyword \"begin\", \"object\", \"sig\", \"struct\" indicating the type of block." (let ((unbalanced 1) (kwop t)) (while (and (not (= 0 unbalanced)) kwop) (setq kwop (caml-find-kwop "\\_<\\(end\\|begin\\|object\\|s\\(ig\\|truct\\)\\)\\_>\\|:begin\\_>\\|;;")) (cond ((not kwop)) ((string= kwop ";;") (setq kwop nil) (forward-line 1)) ((string= kwop "end") (setq unbalanced (1+ unbalanced))) ( t (setq unbalanced (1- unbalanced))))) (if (string= kwop ":begin") "begin" kwop))) (defun caml-find-in-match () "Move the point backward to the \"let\" binding the current expression." (let ((unbalanced 1) (kwop t)) (while (and (not (= 0 unbalanced)) kwop) (setq kwop (caml-find-kwop "\\_<\\(in\\|let\\|end\\)\\_>")) (cond ((not kwop)) ((string= kwop "end") (caml-find-end-match)) ((string= kwop "in") (setq unbalanced (1+ unbalanced))) (t (setq unbalanced (1- unbalanced))))) kwop)) (defun caml-find-with-match () "Move the point backward to the keyword starting the current \"with\"." (let ((unbalanced 1) (kwop t)) (while (and (not (= 0 unbalanced)) kwop) (setq kwop (caml-find-kwop "\\_<\\(with\\|try\\|m\\(atch\\|odule\\)\\|functor\\)\\_>\\|[{}()]")) (cond ((not kwop)) ((caml-at-sexp-close-p) (caml-find-paren-match (following-char))) ((string= kwop "with") (setq unbalanced (1+ unbalanced))) ((or (string= kwop "module") (string= kwop "functor") (string= kwop "{") (string= kwop "(")) (setq unbalanced 0)) (t (setq unbalanced (1- unbalanced))))) kwop)) (defun caml-find-paren-match (close) "Move the point backward to the opening parenthesis of the current expr. Which parenthesis is determined by providing the closing one as CLOSE." (let ((unbalanced 1) (regexp (cond ((= close ?\)) "[()]") ((= close ?\]) "[][]") ((= close ?\}) "[{}]")))) (while (and (> unbalanced 0) (caml-find-kwop regexp)) (if (= close (following-char)) (setq unbalanced (1+ unbalanced)) (setq unbalanced (1- unbalanced)))))) (defun caml-find-then-match (&optional from-else) "Move the point backward to the \"if\" of the current \"then\". Assumes the point is at the beginning of the \"then\" keyword unless FROM-ELSE is non-nil in which case the point must be before \"else\"." (let ((bol (if from-else (save-excursion (progn (beginning-of-line) (point))))) kwop done matching-fun) (while (not done) (setq kwop (caml-find-kwop "\\_<\\(e\\(nd\\|lse\\)\\|done\\|then\\|if\\|with\\)\\_>\\|[])};]")) (cond ((not kwop) (setq done t)) ((caml-at-sexp-close-p) (caml-find-paren-match (following-char))) ((string= kwop "if") (setq done t)) ((string= kwop "then") (if (not from-else) (setq kwop (caml-find-then-match)))) ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist))) (setq kwop (funcall matching-fun))))) (if (and bol (>= (point) bol)) "if-else" kwop))) (defun caml-find-pipe-match () (let ((done nil) (kwop) (re (concat "\\_<\\(try\\|match\\|with\\|function\\|parser\\|type" "\\|e\\(nd\\|lse\\)\\|done\\|then\\|in\\)\\_>" "\\|[^[|]|\\|[])}]"))) (while (not done) (setq kwop (caml-find-kwop re)) (cond ((not kwop) (setq done t)) ((looking-at "[^[|]\\(|\\)") (goto-char (match-beginning 1)) (setq kwop "|") (setq done t)) ((caml-at-sexp-close-p) (caml-find-paren-match (following-char))) ((string= kwop "with") (setq kwop (caml-find-with-match)) (setq done t)) ((string= kwop "parser") (if (re-search-backward "\\_" (- (point) 5) t) (setq kwop (caml-find-with-match))) (setq done t)) ((string= kwop "done") (caml-find-done-match)) ((string= kwop "end") (caml-find-end-match)) ((string= kwop "then") (caml-find-then-match)) ((string= kwop "else") (caml-find-else-match)) ((string= kwop "in") (caml-find-in-match)) (t (setq done t)))) kwop)) (defun caml-find-and-match () (let ((done nil) (kwop)) (while (not done) (setq kwop (caml-find-kwop "\\_<\\(object\\|exception\\|let\\|type\\|end\\|in\\)\\_>")) (cond ((not kwop) (setq done t)) ((string= kwop "end") (caml-find-end-match)) ((string= kwop "in") (caml-find-in-match)) (t (setq done t)))) kwop)) (defun caml-find-else-match () (caml-find-then-match t)) (defun caml-find-semi-match () (caml-find-kwop-skipping-blocks 2)) (defun caml-find-comma-match () (caml-find-kwop-skipping-blocks 3)) (defun caml-find-kwop-skipping-blocks (prio) "Look back for a caml keyword matching `caml-kwop-regexps' [PRIO]. Skip nested blocks." (let ((done nil) (kwop nil) (matching-fun) (kwop-list (aref caml-kwop-regexps prio))) (while (not done) (setq kwop (caml-find-kwop (concat caml-matching-kw-regexp (cond ((> prio 3) "\\|[])},;]\\|") ((> prio 2) "\\|[])};]\\|") (t "\\|[])}]\\|")) kwop-list))) (cond ((not kwop) (setq done t)) ((caml-at-sexp-close-p) (caml-find-paren-match (following-char))) ((or (string= kwop ";;") (and (string= kwop ";") (= (preceding-char) ?\;))) (forward-line 1) (setq kwop ";;") (setq done t)) ((and (>= prio 2) (string= kwop "|")) (setq done t)) ((string= kwop "end") (caml-find-end-match)) ((string= kwop "done") (caml-find-done-match)) ((string= kwop "in") (cond ((and (caml-find-in-match) (>= prio 2)) (setq kwop "let-in") (setq done t)))) ((and (string= kwop "parser") (>= prio 2) (re-search-backward "\\_" (- (point) 5) t)) (setq kwop (caml-find-with-match)) (setq done t)) ((setq matching-fun (cdr-safe (assoc kwop caml-matching-kw-alist))) (setq kwop (funcall matching-fun)) (if (looking-at kwop-list) (setq done t))) (t (let* ((kwop-info (assoc kwop caml-kwop-alist)) (is-op (and (nth 1 kwop-info) ; check that we are not at beginning of line (let ((pos (point)) bti) (back-to-indentation) (setq bti (point)) (goto-char pos) (< bti pos))))) (if (and is-op (looking-at (concat (regexp-quote kwop) "|?[ \t]*\\(\n\\|(\\*\\)"))) (setq kwop-list (aref caml-kwop-regexps (nth 2 kwop-info))) (setq done t)))))) kwop)) (defun caml-compute-basic-indent (prio) "Compute indent of current caml line, ignoring leading keywords. Find the `governing node' for current line. Compute desired indentation based on the node and the indentation alists. Assumes point is exactly at line indentation. Does not preserve point." (let* (in-expr (kwop (cond ((looking-at ";;") (beginning-of-line 1)) ((looking-at "|\\([^]|]\\|\\'\\)") (caml-find-pipe-match)) ((and (looking-at caml-phrase-start-keywords) (caml-in-expr-p)) (caml-find-end-match)) ((and (looking-at caml-matching-kw-regexp) (assoc (caml-match-string 0) caml-matching-kw-alist)) (funcall (cdr-safe (assoc (caml-match-string 0) caml-matching-kw-alist)))) ((looking-at (aref caml-kwop-regexps caml-max-indent-priority)) (let* ((kwop (caml-match-string 0)) (kwop-info (assoc kwop caml-kwop-alist)) (prio (if kwop-info (nth 2 kwop-info) caml-max-indent-priority))) (if (and (looking-at (aref caml-kwop-regexps 0)) (not (looking-at "object")) (caml-in-expr-p)) (setq in-expr t)) (caml-find-kwop-skipping-blocks prio))) (t (if (and (= prio caml-max-indent-priority) (caml-in-expr-p)) (setq in-expr t)) (caml-find-kwop-skipping-blocks prio)))) (kwop-info (assoc kwop caml-kwop-alist)) (indent-diff (cond ((not kwop-info) (beginning-of-line 1) 0) ((looking-at "[[({][|<]?[ \t]*") (length (caml-match-string 0))) ((nth 1 kwop-info) (symbol-value (nth 3 kwop-info))) (t (let ((pos (point))) (back-to-indentation) ; (if (looking-at "\\_") (goto-char pos)) (- (symbol-value (nth 3 kwop-info)) (if (looking-at "|") caml-|-extra-indent 0)))))) (extra (if in-expr caml-apply-extra-indent 0))) (+ indent-diff extra (current-column)))) (defconst caml-leading-kwops-regexp (concat "\\_<\\(and\\|do\\(ne\\|wnto\\)?\\|e\\(lse\\|nd\\)\\|in" "\\|t\\(hen\\|o\\)\\|with\\)\\_>\\|[]|})]") "Regexp matching caml keywords which need special indentation.") (defconst caml-leading-kwops-alist '(("and" caml-and-extra-indent 2) ("do" caml-do-extra-indent 0) ("done" caml-done-extra-indent 0) ("else" caml-else-extra-indent 3) ("end" caml-end-extra-indent 0) ("in" caml-in-extra-indent 2) ("then" caml-then-extra-indent 3) ("to" caml-to-extra-indent 0) ("downto" caml-to-extra-indent 0) ("with" caml-with-extra-indent 2) ("|" caml-|-extra-indent 2) ("]" caml-rb-extra-indent 0) ("}" caml-rc-extra-indent 0) (")" caml-rp-extra-indent 0)) "Association list of special caml keyword indent values. Each member is of the form (KEYWORD EXTRA-INDENT PRIO) where EXTRA-INDENT is the variable holding extra indentation amount for KEYWORD (usually negative) and PRIO is upper bound on priority of matching nodes to determine KEYWORD's final indentation.") (defun caml-compute-final-indent () (save-excursion (back-to-indentation) (cond ((and (bolp) (looking-at comment-start-skip)) (current-column)) ((caml-in-comment-p) (let ((closing (looking-at "\\*)")) (comment-mark (looking-at "\\*"))) (caml-backward-comment) (looking-at comment-start-skip) (+ (current-column) (cond (closing 1) (comment-mark 1) (t (- (match-end 0) (match-beginning 0))))))) (t (let* ((leading (looking-at caml-leading-kwops-regexp)) (assoc-val (if leading (assoc (caml-match-string 0) caml-leading-kwops-alist))) (extra (if leading (symbol-value (nth 1 assoc-val)) 0)) (prio (if leading (nth 2 assoc-val) caml-max-indent-priority)) (basic (caml-compute-basic-indent prio))) (max 0 (if extra (+ extra basic) (current-column)))))))) (defun caml-split-string () "Called whenever a line is broken inside a caml string literal." (insert-before-markers "\"^\"") (backward-char 1)) (defadvice indent-new-comment-line (around caml-indent-new-comment-line activate) "Handle multi-line strings in caml mode." ;this advice doesn't make sense in other modes. I wish there were a ;cleaner way to do this: I haven't found one. (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p))) (split-mark)) (if (not hooked) nil (setq split-mark (set-marker (make-marker) (point))) (caml-split-string)) ad-do-it (if (not hooked) nil (goto-char split-mark) (set-marker split-mark nil)))) (defadvice newline-and-indent (around caml-newline-and-indent activate) "Handle multi-line strings in caml mode." (let ((hooked (and (eq major-mode 'caml-mode) (caml-in-literal-p))) (split-mark)) (if (not hooked) nil (setq split-mark (set-marker (make-marker) (point))) (caml-split-string)) ad-do-it (if (not hooked) nil (goto-char split-mark) (set-marker split-mark nil)))) (defun caml-electric-pipe () "If inserting a | or } operator at beginning of line, reindent the line. Unfortunately there is a situation where this mechanism gets confused. It's when | is the first character of a |] sequence. This is a misfeature of caml syntax and cannot be fixed, however, as a workaround, the electric ] inserts | itself if the matching [ is followed by |." (interactive "*") (let ((electric (and caml-electric-indent (caml-in-indentation) (not (caml-in-comment-p))))) (self-insert-command 1) (if electric (save-excursion (caml-indent-command))))) (defun caml-electric-rb () "If inserting a ] operator at beginning of line, reindent the line. Also, if the matching [ is followed by a | and this ] is not preceded by |, insert one." (interactive "*") (let* ((prec (preceding-char)) (use-pipe (and caml-electric-close-vector (not (caml-in-comment-p)) (not (caml-in-literal-p)) (or (not (numberp prec)) (not (char-equal ?| prec))))) (electric (and caml-electric-indent (caml-in-indentation) (not (caml-in-comment-p))))) (self-insert-command 1) (if electric (save-excursion (caml-indent-command))) (if (and use-pipe (save-excursion (condition-case nil (prog2 (backward-list 1) (looking-at "\\[|")) (error "")))) (save-excursion (backward-char 1) (insert "|"))))) (defun caml-abbrev-hook () "If inserting a leading keyword at beginning of line, reindent the line." ;itz unfortunately we need a special case (if (and (not (caml-in-comment-p)) (not (= last-command-event ?_))) (let* ((bol (save-excursion (beginning-of-line) (point))) (kw (save-excursion (and (re-search-backward "^[ \t]*\\(\\sw+\\)\\=" bol t) (caml-match-string 1))))) (if kw (let ((indent (save-excursion (goto-char (match-beginning 1)) (caml-indent-command) (current-column))) (abbrev-correct (if (= last-command-event ?\ ) 1 0))) (indent-to (- indent (or (symbol-value (nth 1 (assoc kw caml-leading-kwops-alist))) 0) abbrev-correct))))))) ; (defun caml-indent-phrase () ; (interactive "*") ; (let ((bounds (caml-mark-phrase))) ; (indent-region (car bounds) (cdr bounds) nil))) ;;; Additional commands by Didier to report errors in toplevel mode (defun caml-skip-blank-forward () (if (looking-at "[ \t\n]*\\((\\*\\([^*]\\|[^(]\\*[^)]\\)*\\*)[ \t\n]*\\)*") (goto-char (match-end 0)))) ;; to mark phrases, so that repeated calls will take several of them ;; knows little about OCaml except literals and comments, so it should work ;; with other dialects as long as ;; marks the end of phrase. (defun caml-indent-phrase (arg) "Indent the current phrase. With prefix ARG, indent that many phrases starting with the current phrase." (interactive "p") (save-excursion (let ((beg (caml-find-phrase))) (while (progn (setq arg (- arg 1)) (> arg 0)) (caml-find-phrase)) (indent-region beg (point) nil)))) (defun caml-indent-buffer () "Indent the whole buffer." (interactive) (indent-region (point-min) (point-max) nil)) (defun caml-backward-to-less-indent (&optional n) "Move cursor back N lines with less or same indentation." (interactive "p") (beginning-of-line 1) (if (< n 0) (caml-forward-to-less-indent (- n)) (while (> n 0) (let ((i (current-indentation))) (forward-line -1) (while (or (> (current-indentation) i) (caml-in-comment-p) (looking-at (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)"))) (forward-line -1))) (setq n (1- n)))) (back-to-indentation)) (defun caml-forward-to-less-indent (&optional n) "Move cursor back N lines with less or same indentation." (interactive "p") (beginning-of-line 1) (if (< n 0) (caml-backward-to-less-indent (- n)) (while (> n 0) (let ((i (current-indentation))) (forward-line 1) (while (or (> (current-indentation) i) (caml-in-comment-p) (looking-at (concat "[ \t]*\\(\n\\|" comment-start-skip "\\)"))) (forward-line 1))) (setq n (1- n)))) (back-to-indentation)) (defun caml-insert-begin-form () "Insert a nicely formatted begin-end form, leaving a mark after end." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-begin-indent c))) (insert "begin\n\nend") (push-mark) (indent-line-to c) (forward-line -1) (indent-line-to i))) (defun caml-insert-for-form () "Insert a nicely formatted for-do-done form, leaving a mark after do(ne)." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-for-indent c))) (insert "for do\n\ndone") (push-mark) (indent-line-to c) (forward-line -1) (indent-line-to i) (push-mark) (beginning-of-line 1) (backward-char 4))) (defun caml-insert-if-form () "Insert nicely formatted if-then-else form leaving mark after then, else." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-if-indent c))) (insert "if\n\nthen\n\nelse\n") (indent-line-to i) (push-mark) (forward-line -1) (indent-line-to c) (forward-line -1) (indent-line-to i) (push-mark) (forward-line -1) (indent-line-to c) (forward-line -1) (indent-line-to i))) (defun caml-insert-match-form () "Insert nicely formatted match-with form leaving mark after with." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-match-indent c))) (insert "match\n\nwith\n") (indent-line-to i) (push-mark) (forward-line -1) (indent-line-to c) (forward-line -1) (indent-line-to i))) (defun caml-insert-let-form () "Insert nicely formatted let-in form leaving mark after in." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation))) (insert "let in\n") (indent-line-to c) (push-mark) (forward-line -1) (forward-char (+ c 4)))) (defun caml-insert-try-form () "Insert nicely formatted try-with form leaving mark after with." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-try-indent c))) (insert "try\n\nwith\n") (indent-line-to i) (push-mark) (forward-line -1) (indent-line-to c) (forward-line -1) (indent-line-to i))) (defun caml-insert-while-form () "Insert nicely formatted while-do-done form leaving mark after do, done." (interactive "*") (let ((prec (preceding-char))) (if (and (numberp prec) (not (char-equal ?\ (char-syntax prec)))) (insert " "))) (let* ((c (current-indentation)) (i (+ caml-if-indent c))) (insert "while do\n\ndone") (push-mark) (indent-line-to c) (forward-line -1) (indent-line-to i) (push-mark) (beginning-of-line 1) (backward-char 4))) (autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) (autoload 'caml-types-show-type "caml-types" "Show the type of expression or pattern at point." t) (autoload 'caml-types-explore "caml-types" "Explore type annotations by mouse dragging." t) (autoload 'caml-help "caml-help" "Show documentation for qualified OCaml identifier." t) (autoload 'caml-complete "caml-help" "Does completion for documented qualified OCaml identifier." t) (autoload 'ocaml-open-module "caml-help" "Add module in documentation search path." t) (autoload 'ocaml-close-module "caml-help" "Remove module from documentation search path." t) (autoload 'ocaml-add-path "caml-help" "Add search path for documentation." t) (provide 'caml) ;;; caml.el ends here caml-mode-master/caml-mode-site-file.el0000644000175000017500000000553113454350246020150 0ustar treinentreinen;;; caml-mode-site-file.el --- Automatically extracted autoloads. ;;; Code: (add-to-list 'load-path (or (file-name-directory load-file-name) (car load-path))) ;;;### (autoloads nil "caml" "caml.el" (0 0 0 0)) ;;; Generated autoloads from caml.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml" '("caml-"))) ;;;*** ;;;### (autoloads nil "caml-emacs" "caml-emacs.el" (0 0 0 0)) ;;; Generated autoloads from caml-emacs.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-emacs" '("caml-"))) ;;;*** ;;;### (autoloads nil "caml-font" "caml-font.el" (0 0 0 0)) ;;; Generated autoloads from caml-font.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-font" '("inferior-caml-" "caml-font-"))) ;;;*** ;;;### (autoloads nil "caml-font-old" "caml-font-old.el" (0 0 0 0)) ;;; Generated autoloads from caml-font-old.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-font-old" '("inferior-caml-" "caml-"))) ;;;*** ;;;### (autoloads nil "caml-help" "caml-help.el" (0 0 0 0)) ;;; Generated autoloads from caml-help.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-help" '("ocaml-" "caml-"))) ;;;*** ;;;### (autoloads nil "caml-hilit" "caml-hilit.el" (0 0 0 0)) ;;; Generated autoloads from caml-hilit.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-hilit" '("caml-"))) ;;;*** ;;;### (autoloads nil "caml-types" "caml-types.el" (0 0 0 0)) ;;; Generated autoloads from caml-types.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-types" '("caml-" "next-annotation"))) ;;;*** ;;;### (autoloads nil "caml-xemacs" "caml-xemacs.el" (0 0 0 0)) ;;; Generated autoloads from caml-xemacs.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "caml-xemacs" '("caml-"))) ;;;*** ;;;### (autoloads nil "camldebug" "camldebug.el" (0 0 0 0)) ;;; Generated autoloads from camldebug.el (defvar camldebug-command-name "ocamldebug" "\ *Pathname for executing camldebug.") (autoload 'camldebug "camldebug" "\ Run camldebug on program FILE in buffer *camldebug-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for camldebug. If you wish to change this, use the camldebug commands `cd DIR' and `directory'. \(fn PATH)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "camldebug" '("current-camldebug-buffer" "camldebug-" "def-camldebug"))) ;;;*** ;;;### (autoloads nil "inf-caml" "inf-caml.el" (0 0 0 0)) ;;; Generated autoloads from inf-caml.el (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inf-caml" '("caml-" "inferior-caml-" "run-caml"))) ;;;*** ;;;### (autoloads nil nil ("caml-compat.el") (0 0 0 0)) ;;;*** caml-mode-master/caml-emacs.el0000644000175000017500000000402713454350246016434 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Didier Remy, projet Cristal, INRIA Rocquencourt * ;* * ;* Copyright 2003 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; for caml-help.el (defalias 'caml-info-other-window 'info-other-window) ;; for caml-types.el (defalias 'caml-line-beginning-position 'line-beginning-position) (defalias 'caml-read-event 'read-event) (defalias 'caml-window-edges 'window-edges) (defun caml-mouse-vertical-position () (cddr (mouse-position))) (defalias 'caml-ignore-event-p 'integer-or-marker-p) (defalias 'caml-mouse-movement-p 'mouse-movement-p) (defalias 'caml-sit-for 'sit-for) (defalias 'caml-track-mouse 'track-mouse) (defun caml-event-window (e) (posn-window (event-start e))) (defun caml-event-point-start (e) (posn-point (event-start e))) (defun caml-event-point-end (e) (posn-point (event-end e))) (defun caml-release-event-p (original event) (and (equal (event-basic-type original) (event-basic-type event)) (let ((modifiers (event-modifiers event))) (or (member 'drag modifiers) (member 'click modifiers))))) (defalias 'caml-string-to-int (if (fboundp 'string-to-number) 'string-to-number 'string-to-int)) (provide 'caml-emacs) caml-mode-master/caml-xemacs.el0000644000175000017500000000437613454350246016633 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Didier Remy, projet Cristal, INRIA Rocquencourt * ;* * ;* Copyright 2003 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** (require 'overlay) ;; for caml-help.el (defun caml-info-other-window (arg) (save-excursion (info arg)) (view-buffer-other-window "*info*")) ;; for caml-types.el (defun caml-line-beginning-position () (save-excursion (beginning-of-line) (point))) (defalias 'caml-read-event 'next-event) (defalias 'caml-window-edges 'window-pixel-edges) (defun caml-mouse-vertical-position () (let ((e (mouse-position-as-motion-event))) (and e (event-y-pixel e)))) (defalias 'caml-mouse-movement-p 'motion-event-p) (defun caml-event-window (e) (and (mouse-event-p e) (event-window e))) (defun caml-event-point-start (e) (event-closest-point e)) (defun caml-event-point-end (e) (event-closest-point e)) (defun caml-ignore-event-p (e) (if (and (key-press-event-p e) (equal (key-binding e) 'keyboard-quit)) (keyboard-quit)) (not (mouse-event-p e))) (defun caml-sit-for (sec &optional mili) (sit-for (+ sec (if mili (* 0.001 mili) 0)))) (defmacro caml-track-mouse (&rest body) (cons 'progn body)) (defun caml-release-event-p (original event) (and (button-release-event-p event) (equal (event-button original) (event-button event)))) (if (fboundp 'string-to-number) (defalias 'caml-string-to-int 'string-to-number) (defalias 'caml-string-to-int 'string-to-int)) (provide 'caml-xemacs) caml-mode-master/caml-font.el0000644000175000017500000004016413454350246016314 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Jacques Garrigue, Ian T Zimmerman, Damien Doligez * ;* * ;* Copyright 1997 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; caml-font: font-lock support for OCaml files ;; now with perfect parsing of comments and strings (require 'font-lock) (defvar caml-font-stop-face (progn (make-face 'caml-font-stop-face) (set-face-foreground 'caml-font-stop-face "White") (set-face-background 'caml-font-stop-face "Red") 'caml-font-stop-face)) (defvar caml-font-doccomment-face (progn (make-face 'caml-font-doccomment-face) (set-face-foreground 'caml-font-doccomment-face "Red") 'caml-font-doccomment-face)) (defconst caml-font-lock-keywords `( ;modules and constructors ("`?\\<[A-Z][A-Za-z0-9_']*\\>" . font-lock-function-name-face) ;definition (,(regexp-opt '("and" "as" "constraint" "class" "exception" "external" "fun" "function" "functor" "in" "inherit" "initializer" "let" "method" "mutable" "module" "of" "private" "rec" "type" "val" "virtual") 'words) . font-lock-type-face) ;blocking (,(regexp-opt '("begin" "end" "object" "sig" "struct") 'words) . font-lock-keyword-face) ;linenums ("# *[0-9]+" . font-lock-preprocessor-face) ;infix operators (,(regexp-opt '("asr" "land" "lor" "lsl" "lsr" "lxor" "mod") 'words) . font-lock-builtin-face) ;control (,(concat "[|#&]\\|->\\|" (regexp-opt '("do" "done" "downto" "else" "for" "if" "ignore" "lazy" "match" "new" "or" "then" "to" "try" "when" "while" "with") 'words)) . font-lock-constant-face) ("\\<\\(raise\\|failwith\\|invalid_arg\\)\\>" . font-lock-comment-face) ;labels (and open) ("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1 font-lock-variable-name-face) ("\\<\\(assert\\|open\\|include\\)\\>\\|[~?][ (]*[a-z][a-zA-Z0-9_']*" . font-lock-variable-name-face))) (defun caml-font-syntactic-face (s) (let ((in-string (nth 3 s)) (in-comment (nth 4 s)) (start (nth 8 s))) (cond (in-string 'font-lock-string-face) (in-comment (save-excursion (goto-char start) (cond ((looking-at "(\\*\\*/\\*\\*)") 'caml-font-stop-face) ((looking-at "(\\*\\*[^*]") 'caml-font-doccomment-face) (t 'font-lock-comment-face))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; In order to correctly fontify an OCaml buffer, it is necessary to ; lex the buffer to tell what is a comment and what is a string. ; We do this incrementally in a hook ; (font-lock-extend-after-change-region-function), which is called ; whenever the buffer changes. It sets the syntax-table property ; on each beginning and end of chars, strings, and comments. ; This mode handles correctly all the strange cases in the following ; OCaml code. ; ; let l' _ = ();; ; let _' _ = ();; ; let l' = ();; ; let b2_' = ();; ; let a'a' = ();; ; let f2 _ _ = ();; ; let f3 _ _ _ = ();; ; let f' _ _ _ _ _ = ();; ; let hello = ();; ; ; (* ==== easy stuff ==== *) ; ; (* a comment *) ; (* "a string" in a comment *) ; (* "another string *)" in a comment *) ; (* not a string '"' in a comment *) ; "a string";; ; '"';; (* not a string *) ; ; (* ==== hard stuff ==== *) ; ; l'"' not not a string ";; ; _'"' also not not a string";; ; f2 0l'"';; (* not not not a string *) ; f2 0_'"';; (* also not not not a string *) ; f3 0.0l'"' not not not not a string ";; ; f3 0.0_'"';; (* not not not not not a string *) ; f2 0b01_'"';; (* not not not a string *) ; f3 0b2_'"' not not not not a string ";; ; f3 0b02_'"';; (* not not not not not a string *) ; '\'';; (* a char *) ; ' ; ';; (* a char *) ; '^M ; ';; (* also a char [replace ^M with one CR character] *) ; a'a';; (* not a char *) ; type ' ; a' t = X;; (* also not a char *) ; ; (* ==== far-out stuff ==== *) ; ; f'"'" "*) print_endline "hello";;(* \"" ;; ; (* f'"'" "*) print_endline "hello";;(* \"" ;; *) (defconst caml-font-ident-re (concat "[A-Za-z_\300-\326\330-\366\370-\377]" "[A-Za-z_\300-\326\330-\366\370-\377'0-9]*") ) (defconst caml-font-int-re (concat "\\(0[xX][0-9A-Fa-f][0-9A-Fa-f_]*\\|0[oO][0-7][0-7_]*" "\\|0[bB][01][01_]*\\)[lLn]?") ) ; decimal integers are folded into the RE for floats to get longest-match ; without using posix-looking-at (defconst caml-font-decimal-re "[0-9][0-9_]*\\([lLn]\\|\\.[0-9_]*\\)?\\([eE][+-]?[0-9][0-9_]*\\)?" ) ; match any ident or numeral token (defconst caml-font-ident-or-num-re (concat caml-font-ident-re "\\|" caml-font-int-re "\\|" caml-font-decimal-re) ) ; match any char token (defconst caml-font-char-re (concat "'\\(\015\012\\|[^\\']\\|" "\\(\\\\\\([\\'\"ntbr ]\\|[0-9][0-9][0-9]\\|o[0-3][0-7][0-7]" "\\|x[0-9A-Fa-f][0-9A-Fa-f]\\)\\)\\)'") ) ; match a quote followed by a newline (defconst caml-font-quote-newline-re "'\\(\015\012\\|[\012\015]\\)" ) ; match an opening delimiter for a quoted string (defconst caml-font-quoted-string-start-re "{\\([a-z]*\\)|" ) ; match any token or sequence of tokens that cannot contain a ; quote, double quote, a start of comment or quoted string, or a newline ; note: this is only to go faster than one character at a time (defconst caml-font-other-re "[^A-Za-z_0-9\012\015\300-\326\330-\366\370-\377'\"({]+" ) ; match any sequence of non-special characters in a comment ; note: this is only to go faster than one character at a time (defconst caml-font-other-comment-re "[^A-Za-z_\300-\326\330-\366\370-\377{(*\"'\012\015]+" ) ; match any sequence of non-special characters in a string ; note: this is only to go faster than one character at a time (defconst caml-font-other-string-re "[^|\\\"\012\015]" ) ; match a newline (defconst caml-font-newline-re "\\(\015\012\\|[\012\015]\\)" ) ; Put the 'caml-font-state property with the given state on the ; character before pos. Return nil if it was already there, t if not. (defun caml-font-put-state (pos state) (if (equal state (get-text-property (1- pos) 'caml-font-state)) nil (put-text-property (1- pos) pos 'caml-font-state state) t) ) ; Same as looking-at, but erase properties 'caml-font-state and ; 'syntax-table from the matched range (defun caml-font-looking-at (re) (let ((result (looking-at re))) (when result (remove-text-properties (match-beginning 0) (match-end 0) '(syntax-table nil caml-font-state nil))) result) ) ; Annotate the buffer starting at point in state (st . depth) ; Set the 'syntax-table property on beginnings and ends of: ; - strings ; - chars ; - comments ; Also set the 'caml-font-state property on each LF character that is ; not preceded by a single quote. The property gives the state of the ; lexer (nil or t) after reading that character. ; Leave the point at a point where the pre-existing 'caml-font-state ; property is consistent with the new parse, or at the end of the buffer. ; depth is the depth of nested comments at this point ; it must be a non-negative integer ; st can be: ; nil -- we are in the base state ; t -- we are within a string ; a string -- we are within a quoted string and st is the closing delimiter (defun caml-font-annotate (st depth) (let ((continue t)) (while (and continue (not (eobp))) (cond ((and (equal st nil) (= depth 0)) ; base state, outside comment (cond ((caml-font-looking-at caml-font-ident-or-num-re) (goto-char (match-end 0))) ((caml-font-looking-at caml-font-char-re) (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "|")) (put-text-property (1- (match-end 0)) (match-end 0) 'syntax-table (string-to-syntax "|")) (goto-char (match-end 0))) ((caml-font-looking-at caml-font-quote-newline-re) (goto-char (match-end 0))) ((caml-font-looking-at "\"") (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "|")) (goto-char (match-end 0)) (setq st t)) ((caml-font-looking-at caml-font-quoted-string-start-re) (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "|")) (goto-char (match-end 0)) (setq st (concat "|" (match-string 1) "}"))) ((caml-font-looking-at "(\\*") (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "!")) (goto-char (match-end 0)) (setq depth 1)) ((looking-at caml-font-newline-re) (goto-char (match-end 0)) (setq continue (caml-font-put-state (match-end 0) '(nil . 0)))) ((caml-font-looking-at caml-font-other-re) (goto-char (match-end 0))) (t (remove-text-properties (point) (1+ (point)) '(syntax-table nil caml-font-state nil)) (goto-char (1+ (point)))))) ((equal st nil) ; base state inside comment (cond ((caml-font-looking-at "(\\*") (goto-char (match-end 0)) (setq depth (1+ depth))) ((caml-font-looking-at "\\*)") (goto-char (match-end 0)) (setq depth (1- depth)) (when (= depth 0) (put-text-property (1- (point)) (point) 'syntax-table (string-to-syntax "!")))) ((caml-font-looking-at "\"") (goto-char (match-end 0)) (setq st t)) ((caml-font-looking-at caml-font-char-re) (goto-char (match-end 0))) ((caml-font-looking-at caml-font-quote-newline-re) (goto-char (match-end 0))) ((caml-font-looking-at "''") (goto-char (match-end 0))) ((looking-at caml-font-newline-re) (goto-char (match-end 0)) (setq continue (caml-font-put-state (match-end 0) (cons nil depth)))) ((caml-font-looking-at caml-font-ident-re) (goto-char (match-end 0))) ((caml-font-looking-at caml-font-other-comment-re) (goto-char (match-end 0))) (t (remove-text-properties (point) (1+ (point)) '(syntax-table nil caml-font-state nil)) (goto-char (1+ (point)))))) ((equal st t) ; string state inside or outside a comment (cond ((caml-font-looking-at "\"") (when (= depth 0) (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "|"))) (goto-char (1+ (point))) (setq st nil)) ((caml-font-looking-at "\\\\[\"\\]") (goto-char (match-end 0))) ((looking-at caml-font-newline-re) (goto-char (match-end 0)) (setq continue (caml-font-put-state (match-end 0) (cons t depth)))) ((caml-font-looking-at caml-font-other-string-re) (goto-char (match-end 0))) (t (remove-text-properties (point) (1+ (point)) '(syntax-table nil caml-font-state nil)) (goto-char (1+ (point)))))) ((stringp st) ; quoted-string state inside or outside comment (cond ((caml-font-looking-at st) (when (= depth 0) (put-text-property (1- (match-end 0)) (match-end 0) 'syntax-table (string-to-syntax "|"))) (goto-char (match-end 0)) (setq st nil)) ((caml-font-looking-at caml-font-other-string-re) (goto-char (match-end 0))) (t (remove-text-properties (point) (1+ (point)) '(syntax-table nil caml-font-state nil)) (goto-char (1+ (point)))))) (t ; should not happen (remove-text-properties (point) (1+ (point)) '(syntax-table nil caml-font-state nil)))))) ) ; This is the hook function for font-lock-extend-after-change-function ; It finds the nearest saved state at the left of the changed text, ; calls caml-font-annotate to set the 'caml-font-state and 'syntax-table ; properties, then returns the range that was parsed by caml-font-annotate. (defun caml-font-extend-after-change (beg end &optional old-len) (save-excursion (save-match-data (let ((caml-font-modified (buffer-modified-p)) start-at end-at state) (remove-text-properties beg end '(syntax-table nil caml-font-state nil)) (setq start-at (or (and (> beg (point-min)) (get-text-property (1- beg) 'caml-font-state) beg) (previous-single-property-change beg 'caml-font-state) (point-min))) (setq state (or (and (> start-at (point-min)) (get-text-property (1- start-at) 'caml-font-state)) (cons nil 0))) (goto-char start-at) (caml-font-annotate (car state) (cdr state)) (setq end-at (point)) (restore-buffer-modified-p caml-font-modified) (cons start-at end-at)))) ) ; We don't use the normal caml-mode syntax table because it contains an ; approximation of strings and comments that interferes with our ; annotations. (defconst caml-font-syntax-table (let ((tbl (make-syntax-table))) (modify-syntax-entry ?' "w" tbl) (modify-syntax-entry ?_ "w" tbl) (modify-syntax-entry ?\" "." tbl) (let ((i 192)) (while (< i 256) (or (= i 215) (= i 247) (modify-syntax-entry i "w" tbl)) (setq i (1+ i)))) tbl)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; font-lock commands are similar for caml-mode and inferior-caml-mode (defun caml-font-set-font-lock () (setq parse-sexp-lookup-properties t) (setq font-lock-defaults (list 'caml-font-lock-keywords ; keywords nil ; keywords-only nil ; case-fold nil ; syntax-alist nil ; syntax-begin (cons 'font-lock-syntax-table caml-font-syntax-table) '(font-lock-extend-after-change-region-function . caml-font-extend-after-change) '(font-lock-syntactic-face-function . caml-font-syntactic-face) )) (caml-font-extend-after-change (point-min) (point-max) 0) (font-lock-mode 1) ) (add-hook 'caml-mode-hook 'caml-font-set-font-lock) (defconst inferior-caml-font-lock-keywords `(("^[#-]" . font-lock-comment-face) ,@caml-font-lock-keywords)) (defun inferior-caml-set-font-lock () (setq parse-sexp-lookup-properties t) (setq font-lock-defaults (list 'inferior-caml-font-lock-keywords ; keywords nil ; keywords-only nil ; case-fold nil ; syntax-alist nil ; syntax-begin (cons 'font-lock-syntax-table caml-font-syntax-table) '(font-lock-extend-after-change-region-function . caml-font-extend-after-change) '(font-lock-syntactic-face-function . caml-font-syntactic-face) )) (caml-font-extend-after-change (point-min) (point-max) 0) (font-lock-mode 1) ) (add-hook 'inferior-caml-mode-hooks 'inferior-caml-set-font-lock) (provide 'caml-font) caml-mode-master/caml-compat.el0000644000175000017500000000336513454350246016633 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Xavier Leroy, projet Cristal, INRIA Rocquencourt * ;* * ;* Copyright 1998 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; function definitions for old versions of emacs ;; indent-line-to (if (not (fboundp 'indent-line-to)) (defun indent-line-to (column) "Indent current line to COLUMN. This function removes or adds spaces and tabs at beginning of line only if necessary. It leaves point at end of indentation." (if (= (current-indentation) column) (back-to-indentation) (beginning-of-line 1) (delete-horizontal-space) (indent-to column)))) ;; buffer-substring-no-properties (cond ((fboundp 'buffer-substring-no-properties)) ((fboundp 'buffer-substring-without-properties) (defalias 'buffer-substring-no-properties 'buffer-substring-without-properties)) (t (defalias 'buffer-substring-no-properties 'buffer-substring))) (provide 'caml-compat) caml-mode-master/caml-hilit.el0000644000175000017500000000526713454350246016464 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Jacques Garrigue and Ian T Zimmerman * ;* * ;* Copyright 1997 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ; Highlighting patterns for hilit19 under caml-mode ; defined also in caml.el (defvar caml-quote-char "'" "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defconst caml-mode-patterns (list ;comments '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)" 2 comment) ;string (list 'hilit-string-find (string-to-char caml-quote-char) 'string) (list (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|" "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char) nil 'string) ;labels '("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1 brown) '("[~?][ (]*[a-z][a-zA-Z0-9_']*" nil brown) ;modules '("\\<\\(assert\\|open\\|include\\)\\>" nil brown) '("`?\\<[A-Z][A-Za-z0-9_\']*\\>" nil MidnightBlue) ;definition (list (concat "\\<\\(a\\(nd\\|s\\)\\|c\\(onstraint\\|lass\\)" "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?" "\\|in\\(herit\\)?\\|let\\|m\\(ethod\\|utable\\|odule\\)" "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type" "\\|v\\(al\\|irtual\\)\\)\\>") nil 'ForestGreen) ;blocking '("\\<\\(object\\|struct\\|sig\\|begin\\|end\\)\\>" 2 include) ;control (list (concat "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|i\\(f\\|gnore\\)" "\\|lazy\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)" "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>" "\\|\|\\|->\\|&\\|#") nil 'keyword) '(";" nil struct)) "Hilit19 patterns used for OCaml mode") (hilit-set-mode-patterns 'caml-mode caml-mode-patterns) (hilit-set-mode-patterns 'inferior-caml-mode (append (list ;inferior '("^[#-]" nil firebrick)) caml-mode-patterns)) (provide 'caml-hilit) caml-mode-master/.gitignore0000644000175000017500000000002313454350246016070 0ustar treinentreinen*.tgz caml-mode.*/ caml-mode-master/COPYING0000644000175000017500000004313113454350246015142 0ustar treinentreinen GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. caml-mode-master/caml-types.el0000644000175000017500000010055313454350246016511 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Damien Doligez, projet Moscova, INRIA Rocquencourt * ;* * ;* Copyright 2003 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ; An emacs-lisp complement to the "-annot" option of ocamlc and ocamlopt. ;; XEmacs compatibility (eval-and-compile (if (and (boundp 'running-xemacs) running-xemacs) (require 'caml-xemacs) (require 'caml-emacs))) (defun caml-types-feedback (info format) "Displays INFO using the given FORMAT." (message (format format info)) (with-current-buffer caml-types-buffer (erase-buffer) (insert info))) (defvar caml-types-build-dirs '("_build" "_obuild") "List of possible compilation directories created by build systems. It is expected that the files under `caml-types-build-dir' preserve the paths relative to the parent directory of `caml-types-build-dir'.") (make-variable-buffer-local 'caml-types-build-dir) (defvar caml-annot-dir nil "A directory, generally relative to the file location, containing the .annot file. Intended to be set as a local variable in the .ml file. See \"Specifying File Variables\" in the Emacs info manual.") (make-variable-buffer-local 'caml-annot-dir) (put 'caml-annot-dir 'safe-local-variable #'stringp) (defvar caml-types-location-re nil "Regexp to parse *.annot files. Annotation files *.annot may be generated with the \"-annot\" option of ocamlc and ocamlopt. Their format is: file ::= block * block ::= position position annotation * position ::= filename num num num annotation ::= keyword open-paren data close-paren is a space character (ASCII 0x20) is a line-feed character (ASCII 0x0A) num is a sequence of decimal digits filename is a string with the lexical conventions of OCaml open-paren is an open parenthesis (ASCII 0x28) close-paren is a closed parenthesis (ASCII 0x29) data is any sequence of characters where is always followed by at least two space characters. - in each block, the two positions are respectively the start and the end of the range described by the block. - in a position, the filename is the name of the file, the first num is the line number, the second num is the offset of the beginning of the line, the third num is the offset of the position itself. - the char number within the line is the difference between the third and second nums. The current list of keywords is: type call ident") (defvar caml-types-position-re nil) (let* ((caml-types-filename-re "\"\\(\\([^\\\"]\\|\\\\.\\)*\\)\"") (caml-types-number-re "\\([0-9]*\\)")) (setq caml-types-position-re (concat caml-types-filename-re " " caml-types-number-re " " caml-types-number-re " " caml-types-number-re)) (setq caml-types-location-re (concat "^" caml-types-position-re " " caml-types-position-re))) (defface caml-types-expr-face '((((class color) (background light)) :background "#88FF44") (((class color) (background dark)) :background "dark green")) "Face for highlighting expressions and types") (defvar caml-types-expr-ovl (make-overlay 1 1)) (overlay-put caml-types-expr-ovl 'face 'caml-types-expr-face) (defface caml-types-typed-face '((t :background "#FF8844")) "Face for highlighting typed expressions.") (defvar caml-types-typed-ovl (make-overlay 1 1)) (overlay-put caml-types-typed-ovl 'face 'caml-types-typed-face) (defface caml-types-scope-face '((((class color) (background light)) :background "#BBFFFF") (((class color) (background dark)) :background "dark blue")) "Face for highlighting variable scopes.") (defvar caml-types-scope-ovl (make-overlay 1 1)) (overlay-put caml-types-scope-ovl 'face 'caml-types-scope-face) (defface caml-types-def-face '((t :background "#FF4444")) "Face for highlighting binding occurrences.") (defvar caml-types-def-ovl (make-overlay 1 1)) (overlay-put caml-types-def-ovl 'face 'caml-types-def-face) (defface caml-types-occ-face '((((class color) (background light)) :background "#44FF44") (((class color) (background dark)) :background "dark green")) "Face for highlighting variable occurrences.") (defvar caml-types-occ-ovl (make-overlay 1 1)) (overlay-put caml-types-occ-ovl 'face 'caml-types-occ-face) (defvar caml-types-annotation-tree nil) (defvar caml-types-annotation-date nil) (make-variable-buffer-local 'caml-types-annotation-tree) (make-variable-buffer-local 'caml-types-annotation-date) (defvar caml-types-buffer-name "*caml-types*" "Name of buffer for displaying caml types.") (defvar caml-types-buffer nil "Buffer for displaying caml types.") (defun caml-types-show-type (arg) "Show the type of expression or pattern at point. The smallest expression or pattern that contains point is temporarily highlighted. Its type is highlighted in the .annot file and the mark is set to the beginning of the type. The type is also displayed in the mini-buffer. Hints on using the type display: . If you want the type of an identifier, put point within any occurrence of this identifier. . If you want the result type of a function application, put point at the first space after the function name. . If you want the type of a list, put point on a bracket, on a semicolon, or on the :: constructor. . Even if type checking fails, you can still look at the types in the file, up to where the type checker failed. Types are also displayed in the buffer *caml-types*, which is displayed when the command is called with Prefix argument 4. See also `caml-types-explore' for exploration by mouse dragging. See `caml-types-location-re' for annotation file format." (interactive "p") (let* ((target-buf (current-buffer)) (target-file (file-name-nondirectory (buffer-file-name))) (target-line (1+ (count-lines (point-min) (caml-line-beginning-position)))) (target-bol (caml-line-beginning-position)) (target-cnum (point))) (caml-types-preprocess (buffer-file-name)) (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)) (let* ((targ-loc (vector target-file target-line target-bol target-cnum)) (node (caml-types-find-location targ-loc "type" () caml-types-annotation-tree))) (cond ((null node) (delete-overlay caml-types-expr-ovl) (message "Point is not within a typechecked expression or pattern.")) (t (let ((left (caml-types-get-pos target-buf (elt node 0))) (right (caml-types-get-pos target-buf (elt node 1))) (type (cdr (assoc "type" (elt node 2))))) (move-overlay caml-types-expr-ovl left right target-buf) (caml-types-feedback type "type: %s"))))) (if (and (= arg 4) (not (window-live-p (get-buffer-window caml-types-buffer)))) (display-buffer caml-types-buffer)) (unwind-protect (caml-sit-for 60) (delete-overlay caml-types-expr-ovl)))) (defun caml-types-show-call (arg) "Show the kind of call at point. The smallest function call that contains point is temporarily highlighted. Its kind is highlighted in the .annot file and the mark is set to the beginning of the kind. The kind is also displayed in the mini-buffer. The kind is also displayed in the buffer *caml-types*, which is displayed when the command is called with Prefix argument 4. See `caml-types-location-re' for annotation file format." (interactive "p") (let* ((target-buf (current-buffer)) (target-file (file-name-nondirectory (buffer-file-name))) (target-line (1+ (count-lines (point-min) (caml-line-beginning-position)))) (target-bol (caml-line-beginning-position)) (target-cnum (point))) (caml-types-preprocess (buffer-file-name)) (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)) (let* ((targ-loc (vector target-file target-line target-bol target-cnum)) (node (caml-types-find-location targ-loc "call" () caml-types-annotation-tree))) (cond ((null node) (delete-overlay caml-types-expr-ovl) (message "Point is not within a function call.")) (t (let ((left (caml-types-get-pos target-buf (elt node 0))) (right (caml-types-get-pos target-buf (elt node 1))) (kind (cdr (assoc "call" (elt node 2))))) (move-overlay caml-types-expr-ovl left right target-buf) (caml-types-feedback kind "%s call"))))) (if (and (= arg 4) (not (window-live-p (get-buffer-window caml-types-buffer)))) (display-buffer caml-types-buffer)) (unwind-protect (caml-sit-for 60) (delete-overlay caml-types-expr-ovl)))) (defun caml-types-show-ident (arg) "Show the binding of identifier at point. The identifier that contains point is temporarily highlighted. Its binding is highlighted in the .annot file and the mark is set to the beginning of the binding. The binding is also displayed in the mini-buffer. The binding is also displayed in the buffer *caml-types*, which is displayed when the command is called with Prefix argument 4. See `caml-types-location-re' for annotation file format." (interactive "p") (let* ((target-buf (current-buffer)) (target-file (file-name-nondirectory (buffer-file-name))) (target-line (1+ (count-lines (point-min) (caml-line-beginning-position)))) (target-bol (caml-line-beginning-position)) (target-cnum (point))) (caml-types-preprocess (buffer-file-name)) (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)) (let* ((targ-loc (vector target-file target-line target-bol target-cnum)) (node (caml-types-find-location targ-loc "ident" () caml-types-annotation-tree))) (cond ((null node) (delete-overlay caml-types-expr-ovl) (message "Point is not within an identifier.")) (t (let ((left (caml-types-get-pos target-buf (elt node 0))) (right (caml-types-get-pos target-buf (elt node 1))) (kind (cdr (assoc "ident" (elt node 2))))) (move-overlay caml-types-expr-ovl left right target-buf) (let* ((loc-re (concat caml-types-position-re " " caml-types-position-re)) (end-re (concat caml-types-position-re " --")) (def-re (concat "def \\([^ ]*\\) " loc-re)) (def-end-re (concat "def \\([^ ]*\\) " end-re)) (internal-re (concat "int_ref \\([^ ]*\\) " loc-re)) (external-re "ext_ref \\(.*\\)")) (cond ((string-match def-re kind) (let ((var-name (match-string 1 kind)) (l-file (file-name-nondirectory (match-string 2 kind))) (l-line (caml-string-to-int (match-string 4 kind))) (l-bol (caml-string-to-int (match-string 5 kind))) (l-cnum (caml-string-to-int (match-string 6 kind))) (r-file (file-name-nondirectory (match-string 7 kind))) (r-line (caml-string-to-int (match-string 9 kind))) (r-bol (caml-string-to-int (match-string 10 kind))) (r-cnum (caml-string-to-int (match-string 11 kind)))) (let* ((lpos (vector l-file l-line l-bol l-cnum)) (rpos (vector r-file r-line r-bol r-cnum)) (left (caml-types-get-pos target-buf lpos)) (right (caml-types-get-pos target-buf rpos))) (message (format "local variable %s is bound here" var-name)) (move-overlay caml-types-scope-ovl left right target-buf)))) ((string-match def-end-re kind) (let ((var-name (match-string 1 kind)) (l-file (file-name-nondirectory (match-string 2 kind))) (l-line (caml-string-to-int (match-string 4 kind))) (l-bol (caml-string-to-int (match-string 5 kind))) (l-cnum (caml-string-to-int (match-string 6 kind)))) (let* ((lpos (vector l-file l-line l-bol l-cnum)) (left (caml-types-get-pos target-buf lpos)) (right (buffer-size target-buf))) (message (format "global variable %s is bound here" var-name)) (move-overlay caml-types-scope-ovl left right target-buf)))) ((string-match internal-re kind) (let ((var-name (match-string 1 kind)) (l-file (file-name-nondirectory (match-string 2 kind))) (l-line (caml-string-to-int (match-string 4 kind))) (l-bol (caml-string-to-int (match-string 5 kind))) (l-cnum (caml-string-to-int (match-string 6 kind))) (r-file (file-name-nondirectory (match-string 7 kind))) (r-line (caml-string-to-int (match-string 9 kind))) (r-bol (caml-string-to-int (match-string 10 kind))) (r-cnum (caml-string-to-int (match-string 11 kind)))) (let* ((lpos (vector l-file l-line l-bol l-cnum)) (rpos (vector r-file r-line r-bol r-cnum)) (left (caml-types-get-pos target-buf lpos)) (right (caml-types-get-pos target-buf rpos))) (move-overlay caml-types-def-ovl left right target-buf) (message (format "%s is bound at line %d char %d" var-name l-line (- l-cnum l-bol)))))) ((string-match external-re kind) (let ((fullname (match-string 1 kind))) (caml-types-feedback fullname "external ident: %s"))))))))) (if (and (= arg 4) (not (window-live-p (get-buffer-window caml-types-buffer)))) (display-buffer caml-types-buffer)) (unwind-protect (caml-sit-for 60) (delete-overlay caml-types-expr-ovl) (delete-overlay caml-types-def-ovl) (delete-overlay caml-types-scope-ovl)))) (defun caml-types-preprocess (target-path) (let* ((type-path (caml-types-locate-type-file target-path)) (type-date (nth 5 (file-attributes (file-chase-links type-path)))) (target-date (nth 5 (file-attributes target-file)))) (unless (and caml-types-annotation-tree type-date caml-types-annotation-date (not (caml-types-date< caml-types-annotation-date type-date))) (if (and type-date target-date (caml-types-date< type-date target-date)) (error (format "`%s' is more recent than `%s'" target-path type-path))) (message "Reading annotation file...") (let* ((type-buf (caml-types-find-file type-path)) (tree (with-current-buffer type-buf (widen) (goto-char (point-min)) (caml-types-build-tree (file-name-nondirectory target-path))))) (setq caml-types-annotation-tree tree caml-types-annotation-date type-date) (kill-buffer type-buf) (message "done"))))) (defun caml-types-parent-dir (d) (file-name-directory (directory-file-name d))) (defun caml-types-locate-type-file (target-path) "Given the path to an OCaml file, try to locate and return the corresponding .annot file." (let ((sibling (concat (file-name-sans-extension target-path) ".annot"))) (if (file-exists-p sibling) sibling (let* ((dir (file-name-directory sibling))) (if caml-annot-dir ;; Use the relative path set by the user (let* ((annot-dir (expand-file-name caml-annot-dir dir)) (fname (file-name-nondirectory sibling)) (path-fname (expand-file-name fname annot-dir))) (if (file-exists-p path-fname) path-fname (error (concat "No annotation file in " caml-annot-dir ". Compile with option \"-annot\".")))) ;; Else, try to get the .annot from one of build dirs. (let* ((is-build (regexp-opt caml-types-build-dirs)) (project-dir (locate-dominating-file dir (lambda(d) (directory-files d nil is-build)))) (annot (if project-dir (locate-file (file-relative-name sibling project-dir) (mapcar (lambda(d) (expand-file-name d project-dir)) caml-types-build-dirs))))) (if annot annot (error (concat "No annotation file. Compile with option " "\"-annot\" or set `caml-annot-dir'."))))))))) (defun caml-types-date< (date1 date2) (or (< (car date1) (car date2)) (and (= (car date1) (car date2)) (< (nth 1 date1) (nth 1 date2))))) ; we use an obarray for hash-consing the strings within each tree (defun caml-types-make-hash-table () (make-vector 255 0)) (defun caml-types-hcons (elem table) (symbol-name (intern elem table))) (defun next-annotation () (forward-char 1) (if (re-search-forward "^[a-z\"]" () t) (forward-char -1) (goto-char (point-max))) (looking-at "[a-z]")) ; tree of intervals ; each node is a vector ; [ pos-left pos-right annotation child child child... ] ; annotation is a list of: ; (kind . info) where kind = "type" "call" etc. ; and info = the contents of the annotation (defun caml-types-build-tree (target-file) (let ((stack ()) (accu ()) (table (caml-types-make-hash-table)) (annotation ())) (while (re-search-forward caml-types-location-re () t) (let ((l-file (file-name-nondirectory (match-string 1))) (l-line (caml-string-to-int (match-string 3))) (l-bol (caml-string-to-int (match-string 4))) (l-cnum (caml-string-to-int (match-string 5))) (r-file (file-name-nondirectory (match-string 6))) (r-line (caml-string-to-int (match-string 8))) (r-bol (caml-string-to-int (match-string 9))) (r-cnum (caml-string-to-int (match-string 10)))) (unless (caml-types-not-in-file l-file r-file target-file) (setq annotation ()) (while (next-annotation) (cond ((looking-at "^\\([a-z]+\\)(\n \\(\\(.*\n \\)*.*\\)\n)") (let ((kind (caml-types-hcons (match-string 1) table)) (info (caml-types-hcons (match-string 2) table))) (setq annotation (cons (cons kind info) annotation)))))) (setq accu ()) (while (and stack (caml-types-pos-contains l-cnum r-cnum (car stack))) (setq accu (cons (car stack) accu)) (setq stack (cdr stack))) (let* ((left-pos (vector l-file l-line l-bol l-cnum)) (right-pos (vector r-file r-line r-bol r-cnum)) (node (caml-types-make-node left-pos right-pos annotation accu))) (setq stack (cons node stack)))))) (if (null stack) (error "No annotations found for this source file") (let* ((left-pos (elt (car (last stack)) 0)) (right-pos (elt (car stack) 1))) (if (null (cdr stack)) (car stack) (caml-types-make-node left-pos right-pos () (nreverse stack))))))) (defun caml-types-not-in-file (l-file r-file target-file) (or (and (not (string= l-file target-file)) (not (string= l-file ""))) (and (not (string= r-file target-file)) (not (string= r-file ""))))) (defun caml-types-make-node (left-pos right-pos annotation children) (let ((result (make-vector (+ 3 (length children)) ())) (i 3)) (aset result 0 left-pos) (aset result 1 right-pos) (aset result 2 annotation) (while children (aset result i (car children)) (setq children (cdr children)) (setq i (1+ i))) result)) (defun caml-types-pos-contains (l-cnum r-cnum node) (and (<= l-cnum (elt (elt node 0) 3)) (>= r-cnum (elt (elt node 1) 3)))) (defun caml-types-find-location (targ-pos kind curr node) (if (not (caml-types-pos-inside targ-pos node)) curr (if (and (elt node 2) (assoc kind (elt node 2))) (setq curr node)) (let ((i (caml-types-search node targ-pos))) (if (and (> i 3) (caml-types-pos-inside targ-pos (elt node (1- i)))) (caml-types-find-location targ-pos kind curr (elt node (1- i))) curr)))) ; trouve le premier fils qui commence apres la position ; ou (length node) si tous commencent avant (defun caml-types-search (node pos) (let ((min 3) (max (length node)) med) (while (< min max) (setq med (/ (+ min max) 2)) (if (caml-types-pos<= (elt (elt node med) 0) pos) (setq min (1+ med)) (setq max med))) min)) (defun caml-types-pos-inside (pos node) (let ((left-pos (elt node 0)) (right-pos (elt node 1))) (and (caml-types-pos<= left-pos pos) (caml-types-pos> right-pos pos)))) (defun caml-types-find-interval (buf targ-pos node) (let ((nleft (elt node 0)) (nright (elt node 1)) (left ()) (right ()) i) (cond ((not (caml-types-pos-inside targ-pos node)) (if (not (caml-types-pos<= nleft targ-pos)) (setq right nleft)) (if (not (caml-types-pos> nright targ-pos)) (setq left nright))) (t (setq left nleft right nright) (setq i (caml-types-search node targ-pos)) (if (< i (length node)) (setq right (elt (elt node i) 0))) (if (> i 3) (setq left (elt (elt node (1- i)) 1))))) (cons (if left (caml-types-get-pos buf left) (with-current-buffer buf (point-min))) (if right (caml-types-get-pos buf right) (with-current-buffer buf (point-max)))))) ;; Warning: these comparison functions are not symmetric. ;; The first argument determines the format: ;; when its file component is empty, only the cnum is compared. (defun caml-types-pos<= (pos1 pos2) (let ((file1 (elt pos1 0)) (line1 (elt pos1 1)) (bol1 (elt pos1 2)) (cnum1 (elt pos1 3)) (file2 (elt pos2 0)) (line2 (elt pos2 1)) (bol2 (elt pos2 2)) (cnum2 (elt pos2 3))) (if (string= file1 "") (<= cnum1 cnum2) (and (string= file1 file2) (or (< line1 line2) (and (= line1 line2) (<= (- cnum1 bol1) (- cnum2 bol2)))))))) (defun caml-types-pos> (pos1 pos2) (let ((file1 (elt pos1 0)) (line1 (elt pos1 1)) (bol1 (elt pos1 2)) (cnum1 (elt pos1 3)) (file2 (elt pos2 0)) (line2 (elt pos2 1)) (bol2 (elt pos2 2)) (cnum2 (elt pos2 3))) (if (string= file1 "") (> cnum1 cnum2) (and (string= file1 file2) (or (> line1 line2) (and (= line1 line2) (> (- cnum1 bol1) (- cnum2 bol2)))))))) (defun caml-types-get-pos (buf pos) (save-excursion (set-buffer buf) (goto-line (elt pos 1)) (forward-char (- (elt pos 3) (elt pos 2))) (point))) ; find-file-read-only-noselect seems to be missing from emacs... (defun caml-types-find-file (name) (let (buf) (cond ((setq buf (get-file-buffer name)) (unless (verify-visited-file-modtime buf) (if (buffer-modified-p buf) (find-file-noselect name) (with-current-buffer buf (revert-buffer t t))))) ((and (file-readable-p name) (setq buf (find-file-noselect name))) (with-current-buffer buf (toggle-read-only 1))) (t (error (format "Can't read the annotation file `%s'" name)))) buf)) (defun caml-types-mouse-ignore (event) (interactive "e") nil) (defun caml-types-time () (let ((time (current-time))) (+ (* (mod (cadr time) 1000) 1000) (/ (cadr (cdr time)) 1000)))) (defun caml-types-explore (event) "Explore type annotations by mouse dragging. The expression under the mouse is highlighted and its type is displayed in the minibuffer, until the move is released, much as `caml-types-show-type'. The function uses two overlays. . One overlay delimits the largest region whose all subnodes are well-typed. . Another overlay delimits the current node under the mouse (whose type annotation is being displayed)." (interactive "e") (set-buffer (window-buffer (caml-event-window event))) (let* ((target-buf (current-buffer)) (target-file (file-name-nondirectory (buffer-file-name))) (target-line) (target-bol) target-pos Left Right limits cnum node mes type region (window (caml-event-window event)) target-tree (speed 100) (last-time (caml-types-time)) (original-event event)) (select-window window) (unwind-protect (progn (caml-types-preprocess (buffer-file-name)) (setq target-tree caml-types-annotation-tree) (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)) ;; (message "Drag the mouse to explore types") (unwind-protect (caml-track-mouse (while event (cond ;; we ignore non mouse events ((caml-ignore-event-p event)) ;; we stop when the original button is released ((caml-release-event-p original-event event) (setq event nil)) ;; we scroll when the motion is outside the window ((and (caml-mouse-movement-p event) (not (and (equal window (caml-event-window event)) (integer-or-marker-p (caml-event-point-end event))))) (let* ((win (caml-window-edges window)) (top (nth 1 win)) (bottom (- (nth 3 win) 1)) mouse time) (while (and (caml-sit-for 0 (/ 500 speed)) (setq time (caml-types-time)) (> (- time last-time) (/ 500 speed)) (setq mouse (caml-mouse-vertical-position)) (or (< mouse top) (>= mouse bottom))) (setq last-time time) (cond ((< mouse top) (setq speed (- top mouse)) (condition-case nil (scroll-down 1) (error (message "Beginning of buffer!")))) ((>= mouse bottom) (setq speed (+ 1 (- mouse bottom))) (condition-case nil (scroll-up 1) (error (message "End of buffer!"))))) (setq speed (* speed speed))))) ;; main action, when the motion is inside the window ;; or on original button down event ((or (caml-mouse-movement-p event) (equal original-event event)) (setq cnum (caml-event-point-end event)) (if (and region (<= (car region) cnum) (< cnum (cdr region))) ;; mouse remains in outer region nil ;; otherwise, reset the outer region (setq region (caml-types-typed-make-overlay target-buf (caml-event-point-start event)))) (if (and limits (>= cnum (car limits)) (< cnum (cdr limits))) ;; inner region is unchanged nil ;; recompute the inner region and type annotation (setq target-bol (save-excursion (goto-char cnum) (caml-line-beginning-position)) target-line (1+ (count-lines (point-min) target-bol)) target-pos (vector target-file target-line target-bol cnum)) (save-excursion (setq node (caml-types-find-location target-pos "type" () target-tree)) (set-buffer caml-types-buffer) (erase-buffer) (cond ((null node) (delete-overlay caml-types-expr-ovl) (setq type "*no type information*") (setq limits (caml-types-find-interval target-buf target-pos target-tree))) (t (let ((left (caml-types-get-pos target-buf (elt node 0))) (right (caml-types-get-pos target-buf (elt node 1)))) (move-overlay caml-types-expr-ovl left right target-buf) (setq limits (caml-types-find-interval target-buf target-pos node) type (cdr (assoc "type" (elt node 2))))))) (setq mes (format "type: %s" type)) (insert type))) (message mes))) ;; we read next event, unless it is nil, and loop back. (if event (setq event (caml-read-event))))) ;; delete overlays at end of exploration (delete-overlay caml-types-expr-ovl) (delete-overlay caml-types-typed-ovl))) ;; When an error occurs, the mouse release event has not been read. ;; We could wait for mouse release to prevent execution of ;; a binding of mouse release, such as cut or paste. ;; In most common cases, next event will be the mouse release. ;; However, it could also be a key stroke before mouse release. ;; Emacs does not allow to test whether mouse is up or down. ;; Not sure it is robust to loop for mouse release after an error ;; occurred, as is done for exploration. ;; So far, we just ignore next event. (Next line also be uncommenting.) (if event (caml-read-event))))) (defun caml-types-typed-make-overlay (target-buf pos) (interactive "p") (let ((start pos) (end pos) len node left right) (setq len (length caml-types-annotation-tree)) (while (> len 3) (setq len (- len 1)) (setq node (aref caml-types-annotation-tree len)) (if (and (equal target-buf (current-buffer)) (setq left (caml-types-get-pos target-buf (elt node 0)) right (caml-types-get-pos target-buf (elt node 1))) (<= left pos) (> right pos)) (setq start (min start left) end (max end right)))) (move-overlay caml-types-typed-ovl (max (point-min) (- start 1)) (min (point-max) (+ end 1)) target-buf) (cons start end))) (defun caml-types-version () "Internal version number of caml-types.el." (interactive) (message "4")) (provide 'caml-types) caml-mode-master/camldebug.el0000644000175000017500000010202313454350246016350 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Jacques Garrigue and Ian T Zimmerman * ;* * ;* Copyright 1997 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;;; Run camldebug under Emacs ;;; Derived from gdb.el. ;;; gdb.el is Copyright (C) 1988 Free Software Foundation, Inc, and is part ;;; of GNU Emacs ;;; Modified by Jerome Vouillon, 1994. ;;; Modified by Ian T. Zimmerman, 1996. ;;; Modified by Xavier Leroy, 1997. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 1, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;;itz 04-06-96 I pondered basing this on gud. The potential advantages ;;were: automatic bugfix , keymaps and menus propagation. ;;Disadvantages: gud is not so clean itself, there is little common ;;functionality it abstracts (most of the stuff is done in the ;;debugger specific parts anyway), and, most seriously, gud sees it ;;fit to add C-x C-a bindings to the _global_ map, so there would be a ;;conflict between camldebug and gdb, for instance. While it's OK to ;;assume that a sane person doesn't use gdb and dbx at the same time, ;;it's not so OK (IMHO) for gdb and camldebug. ;; Xavier Leroy, 21/02/97: adaptation to ocamldebug. (require 'comint) (require 'shell) (require 'caml) (require 'derived) (require 'thingatpt) ;;; Variables. (defvar camldebug-last-frame) (defvar camldebug-delete-prompt-marker) (defvar camldebug-filter-accumulator nil) (defvar camldebug-last-frame-displayed-p) (defvar camldebug-filter-function) (defvar camldebug-prompt-pattern "^(ocd) *" "A regexp to recognize the prompt for ocamldebug.") (defvar camldebug-overlay-event nil "Overlay for displaying the current event.") (defvar camldebug-overlay-under nil "Overlay for displaying the current event.") (defvar camldebug-event-marker nil "Marker for displaying the current event.") (defvar camldebug-track-frame t "*If non-nil, always display current frame position in another window.") (cond (window-system (make-face 'camldebug-event) (make-face 'camldebug-underline) (if (not (face-differs-from-default-p 'camldebug-event)) (invert-face 'camldebug-event)) (if (not (face-differs-from-default-p 'camldebug-underline)) (set-face-underline-p 'camldebug-underline t)) (setq camldebug-overlay-event (make-overlay 1 1)) (overlay-put camldebug-overlay-event 'face 'camldebug-event) (setq camldebug-overlay-under (make-overlay 1 1)) (overlay-put camldebug-overlay-under 'face 'camldebug-underline)) (t (setq camldebug-event-marker (make-marker)) (setq overlay-arrow-string "=>"))) ;;; Camldebug mode. (define-derived-mode camldebug-mode comint-mode "Inferior CDB" "Major mode for interacting with an inferior ocamldebug process. The following commands are available: \\{camldebug-mode-map} \\[camldebug-display-frame] displays in the other window the last line referred to in the camldebug buffer. \\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug window, call camldebug to step, backstep or next and then update the other window with the current file and position. If you are in a source file, you may select a point to break at, by doing \\[camldebug-break]. Commands: Many commands are inherited from comint mode. Additionally we have: \\[camldebug-display-frame] display frames file in other window \\[camldebug-step] advance one line in program C-x SPACE sets break point at current line." (mapcar 'make-local-variable '(camldebug-last-frame-displayed-p camldebug-last-frame camldebug-delete-prompt-marker camldebug-filter-function camldebug-filter-accumulator paragraph-start)) (setq camldebug-last-frame nil camldebug-delete-prompt-marker (make-marker) camldebug-filter-accumulator "" camldebug-filter-function 'camldebug-marker-filter comint-prompt-regexp camldebug-prompt-pattern comint-dynamic-complete-functions (cons 'camldebug-complete comint-dynamic-complete-functions) paragraph-start comint-prompt-regexp camldebug-last-frame-displayed-p t) (make-local-variable 'shell-dirtrackp) (setq shell-dirtrackp t) (setq comint-input-sentinel 'shell-directory-tracker)) ;;; Keymaps. (defun camldebug-numeric-arg (arg) (and arg (prefix-numeric-value arg))) (defmacro def-camldebug (name key &optional doc args) "Define camldebug-NAME to be a command sending NAME ARGS and bound to KEY, with optional doc string DOC. Certain %-escapes in ARGS are interpreted specially if present. These are: %m module name of current module. %d directory of current source file. %c number of current character position %e text of the caml variable surrounding point. The `current' source file is the file of the current buffer (if we're in a caml buffer) or the source file current at the last break or step (if we're in the camldebug buffer), and the `current' module name is the filename stripped of any *.ml* suffixes (this assumes the usual correspondence between module and file naming is observed). The `current' position is that of the current buffer (if we're in a source file) or the position of the last break or step (if we're in the camldebug buffer). If a numeric is present, it overrides any ARGS flags and its string representation is simply concatenated with the COMMAND." (let* ((fun (intern (format "camldebug-%s" name)))) (list 'progn (if doc (list 'defun fun '(arg) doc '(interactive "P") (list 'camldebug-call name args '(camldebug-numeric-arg arg)))) (list 'define-key 'camldebug-mode-map (concat "\C-c" key) (list 'quote fun)) (list 'define-key 'caml-mode-map (concat "\C-x\C-a" key) (list 'quote fun))))) (def-camldebug "step" "\C-s" "Step one event forward.") (def-camldebug "backstep" "\C-k" "Step one event backward.") (def-camldebug "run" "\C-r" "Run the program.") (def-camldebug "reverse" "\C-v" "Run the program in reverse.") (def-camldebug "last" "\C-l" "Go to latest time in execution history.") (def-camldebug "backtrace" "\C-t" "Print the call stack.") (def-camldebug "finish" "\C-f" "Finish executing current function.") (def-camldebug "print" "\C-p" "Print value of symbol at point." "%e") (def-camldebug "display" "\C-d" "Display value of symbol at point." "%e") (def-camldebug "next" "\C-n" "Step one event forward (skip functions)") (def-camldebug "up" "<" "Go up N stack frames (numeric arg) with display") (def-camldebug "down" ">" "Go down N stack frames (numeric arg) with display") (def-camldebug "break" "\C-b" "Set breakpoint at current line." "@ \"%m\" # %c") (defun camldebug-mouse-display (click) "Display value of $NNN clicked on." (interactive "e") (let* ((start (event-start click)) (window (car start)) (pos (car (cdr start))) symb) (save-excursion (select-window window) (goto-char pos) (setq symb (thing-at-point 'symbol)) (if (string-match "^\\$[0-9]+$" symb) (camldebug-call "display" symb))))) (define-key camldebug-mode-map [mouse-2] 'camldebug-mouse-display) (defun camldebug-kill-filter (string) ;gob up stupid questions :-) (setq camldebug-filter-accumulator (concat camldebug-filter-accumulator string)) (if (not (string-match "\\(.* \\)(y or n) " camldebug-filter-accumulator)) nil (setq camldebug-kill-output (cons t (match-string 1 camldebug-filter-accumulator))) (setq camldebug-filter-accumulator "")) (if (string-match comint-prompt-regexp camldebug-filter-accumulator) (let ((output (substring camldebug-filter-accumulator (match-beginning 0)))) (setq camldebug-kill-output (cons nil (substring camldebug-filter-accumulator 0 (1- (match-beginning 0))))) (setq camldebug-filter-accumulator "") output) "")) (def-camldebug "kill" "\C-k") (defun camldebug-kill () "Kill the program." (interactive) (let ((camldebug-kill-output)) (save-excursion (set-buffer current-camldebug-buffer) (let ((proc (get-buffer-process (current-buffer))) (camldebug-filter-function 'camldebug-kill-filter)) (camldebug-call "kill") (while (not (and camldebug-kill-output (zerop (length camldebug-filter-accumulator)))) (accept-process-output proc)))) (if (not (car camldebug-kill-output)) (error (cdr camldebug-kill-output)) (sit-for 0 300) (camldebug-call-1 (if (y-or-n-p (cdr camldebug-kill-output)) "y" "n"))))) ;;FIXME: camldebug doesn't output the Hide marker on kill (defun camldebug-goto-filter (string) ;accumulate onto previous output (setq camldebug-filter-accumulator (concat camldebug-filter-accumulator string)) (if (not (or (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+" camldebug-goto-position "-[0-9]+[ \t]*\\(before\\).*\n") camldebug-filter-accumulator) (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)" "[ \t]+[0-9]+-" camldebug-goto-position "[ \t]*\\(after\\).*\n") camldebug-filter-accumulator))) nil (setq camldebug-goto-output (match-string 2 camldebug-filter-accumulator)) (setq camldebug-filter-accumulator (substring camldebug-filter-accumulator (1- (match-end 0))))) (if (not (string-match comint-prompt-regexp camldebug-filter-accumulator)) nil (setq camldebug-goto-output (or camldebug-goto-output 'fail)) (setq camldebug-filter-accumulator "")) (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) (setq camldebug-filter-accumulator (match-string 1 camldebug-filter-accumulator))) "") (def-camldebug "goto" "\C-g") (defun camldebug-goto (&optional time) "Go to the execution time TIME. Without TIME, the command behaves as follows: In the camldebug buffer, if the point at buffer end, goto time 0\; otherwise, try to obtain the time from context around point. In a caml mode buffer, try to find the time associated in execution history with the current point location. With a negative TIME, move that many lines backward in the camldebug buffer, then try to obtain the time from context around point." (interactive "P") (cond (time (let ((ntime (camldebug-numeric-arg time))) (if (>= ntime 0) (camldebug-call "goto" nil ntime) (save-selected-window (select-window (get-buffer-window current-camldebug-buffer)) (save-excursion (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ " nil t (- 1 ntime)) (camldebug-goto nil) (error "I don't have %d times in my history" (- 1 ntime)))))))) ((eq (current-buffer) current-camldebug-buffer) (let ((time (cond ((eobp) 0) ((save-excursion (beginning-of-line 1) (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ ")) (caml-string-to-int (match-string 1))) ((caml-string-to-int (camldebug-format-command "%e")))))) (camldebug-call "goto" nil time))) (t (let ((module (camldebug-module-name (buffer-file-name))) (camldebug-goto-position (int-to-string (1- (point)))) (camldebug-goto-output) (address)) ;get a list of all events in the current module (save-excursion (set-buffer current-camldebug-buffer) (let* ((proc (get-buffer-process (current-buffer))) (camldebug-filter-function 'camldebug-goto-filter)) (camldebug-call-1 (concat "info events " module)) (while (not (and camldebug-goto-output (zerop (length camldebug-filter-accumulator)))) (accept-process-output proc)) (setq address (if (eq camldebug-goto-output 'fail) nil (re-search-backward (concat "^Time : \\([0-9]+\\) - pc : " camldebug-goto-output " - module " module "$") nil t) (match-string 1))))) (if address (camldebug-call "goto" nil (caml-string-to-int address)) (error "No time at %s at %s" module camldebug-goto-position)))))) (defun camldebug-delete-filter (string) (setq camldebug-filter-accumulator (concat camldebug-filter-accumulator string)) (if (not (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in " (regexp-quote camldebug-delete-file) ", character " camldebug-delete-position "\n") camldebug-filter-accumulator)) nil (setq camldebug-delete-output (match-string 2 camldebug-filter-accumulator)) (setq camldebug-filter-accumulator (substring camldebug-filter-accumulator (1- (match-end 0))))) (if (not (string-match comint-prompt-regexp camldebug-filter-accumulator)) nil (setq camldebug-delete-output (or camldebug-delete-output 'fail)) (setq camldebug-filter-accumulator "")) (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) (setq camldebug-filter-accumulator (match-string 1 camldebug-filter-accumulator))) "") (def-camldebug "delete" "\C-d") (defun camldebug-delete (&optional arg) "Delete the breakpoint numbered ARG. Without ARG, the command behaves as follows: In the camldebug buffer, try to obtain the time from context around point. In a caml mode buffer, try to find the breakpoint associated with the current point location. With a negative ARG, look for the -ARGth breakpoint pattern in the camldebug buffer, then try to obtain the breakpoint info from context around point." (interactive "P") (cond (arg (let ((narg (camldebug-numeric-arg arg))) (if (> narg 0) (camldebug-call "delete" nil narg) (save-excursion (set-buffer current-camldebug-buffer) (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file " nil t (- 1 narg)) (camldebug-delete nil) (error "I don't have %d breakpoints in my history" (- 1 narg))))))) ((eq (current-buffer) current-camldebug-buffer) (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ") (arg (cond ((eobp) (save-excursion (re-search-backward bpline nil t)) (caml-string-to-int (match-string 1))) ((save-excursion (beginning-of-line 1) (looking-at bpline)) (caml-string-to-int (match-string 1))) ((caml-string-to-int (camldebug-format-command "%e")))))) (camldebug-call "delete" nil arg))) (t (let ((camldebug-delete-file (concat (camldebug-format-command "%m") ".ml")) (camldebug-delete-position (camldebug-format-command "%c"))) (save-excursion (set-buffer current-camldebug-buffer) (let ((proc (get-buffer-process (current-buffer))) (camldebug-filter-function 'camldebug-delete-filter) (camldebug-delete-output)) (camldebug-call-1 "info break") (while (not (and camldebug-delete-output (zerop (length camldebug-filter-accumulator)))) (accept-process-output proc)) (if (eq camldebug-delete-output 'fail) (error "No breakpoint in %s at %s" camldebug-delete-file camldebug-delete-position) (camldebug-call "delete" nil (caml-string-to-int camldebug-delete-output))))))))) (defun camldebug-complete-filter (string) (setq camldebug-filter-accumulator (concat camldebug-filter-accumulator string)) (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n" camldebug-filter-accumulator) (setq camldebug-complete-list (cons (match-string 2 camldebug-filter-accumulator) camldebug-complete-list)) (setq camldebug-filter-accumulator (substring camldebug-filter-accumulator (1- (match-end 0))))) (if (not (string-match comint-prompt-regexp camldebug-filter-accumulator)) nil (setq camldebug-complete-list (or camldebug-complete-list 'fail)) (setq camldebug-filter-accumulator "")) (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator) (setq camldebug-filter-accumulator (match-string 1 camldebug-filter-accumulator))) "") (defun camldebug-complete () "Perform completion on the camldebug command preceding point." (interactive) (let* ((end (point)) (command (save-excursion (beginning-of-line) (and (looking-at comint-prompt-regexp) (goto-char (match-end 0))) (buffer-substring (point) end))) (camldebug-complete-list nil) (command-word)) ;; Find the word break. This match will always succeed. (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command) (setq command-word (match-string 2 command)) ;itz 04-21-96 if we are trying to complete a word of nonzero ;length, chop off the last character. This is a nasty hack, but it ;works - in general, not just for this set of words: the comint ;call below will weed out false matches - and it avoids further ;mucking with camldebug's lexer. (if (> (length command-word) 0) (setq command (substring command 0 (1- (length command))))) (let ((camldebug-filter-function 'camldebug-complete-filter)) (camldebug-call-1 (concat "complete " command)) (set-marker camldebug-delete-prompt-marker nil) (while (not (and camldebug-complete-list (zerop (length camldebug-filter-accumulator)))) (accept-process-output (get-buffer-process (current-buffer))))) (if (eq camldebug-complete-list 'fail) (setq camldebug-complete-list nil)) (setq camldebug-complete-list (sort camldebug-complete-list 'string-lessp)) (comint-dynamic-simple-complete command-word camldebug-complete-list))) (define-key camldebug-mode-map "\C-l" 'camldebug-refresh) (define-key camldebug-mode-map "\t" 'comint-dynamic-complete) (define-key camldebug-mode-map "\M-?" 'comint-dynamic-list-completions) (define-key caml-mode-map "\C-x " 'camldebug-break) (defvar current-camldebug-buffer nil) ;;;###autoload (defvar camldebug-command-name "ocamldebug" "*Pathname for executing camldebug.") ;;;###autoload (defun camldebug (path) "Run camldebug on program FILE in buffer *camldebug-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for camldebug. If you wish to change this, use the camldebug commands `cd DIR' and `directory'." (interactive "fRun ocamldebug on file: ") (setq path (expand-file-name path)) (let ((file (file-name-nondirectory path))) (pop-to-buffer (concat "*camldebug-" file "*")) (setq default-directory (file-name-directory path)) (message "Current directory is %s" default-directory) (make-comint (concat "camldebug-" file) (substitute-in-file-name camldebug-command-name) nil "-emacs" "-cd" default-directory file) (set-process-filter (get-buffer-process (current-buffer)) 'camldebug-filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'camldebug-sentinel) (camldebug-mode) (camldebug-set-buffer))) (defun camldebug-set-buffer () (if (eq major-mode 'camldebug-mode) (setq current-camldebug-buffer (current-buffer)) (save-selected-window (pop-to-buffer current-camldebug-buffer)))) ;;; Filter and sentinel. (defun camldebug-marker-filter (string) (setq camldebug-filter-accumulator (concat camldebug-filter-accumulator string)) (let ((output "") (begin)) ;; Process all the complete markers in this chunk. (while (setq begin (string-match "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n" camldebug-filter-accumulator)) (setq camldebug-last-frame (if (char-equal ?H (aref camldebug-filter-accumulator (1+ (1+ begin)))) nil (let ((isbefore (string= "before" (match-string 5 camldebug-filter-accumulator))) (startpos (caml-string-to-int (match-string 3 camldebug-filter-accumulator))) (endpos (caml-string-to-int (match-string 4 camldebug-filter-accumulator)))) (list (match-string 2 camldebug-filter-accumulator) (if isbefore startpos endpos) isbefore startpos endpos ))) output (concat output (substring camldebug-filter-accumulator 0 begin)) ;; Set the accumulator to the remaining text. camldebug-filter-accumulator (substring camldebug-filter-accumulator (match-end 0)) camldebug-last-frame-displayed-p nil)) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; camldebug-filter-accumulator until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "\032.*\\'" camldebug-filter-accumulator) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring camldebug-filter-accumulator 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq camldebug-filter-accumulator (substring camldebug-filter-accumulator (match-beginning 0)))) (setq output (concat output camldebug-filter-accumulator) camldebug-filter-accumulator "")) output)) (defun camldebug-filter (proc string) (let ((output)) (if (buffer-name (process-buffer proc)) (let ((process-window)) ;; it does not seem necessary to save excursion here, ;; since set-buffer as a temporary effect. ;; comint-output-filter explicitly avoids it. ;; in version 23, it prevents the marker to stay at end of buffer ;; (save-excursion (set-buffer (process-buffer proc)) ;; If we have been so requested, delete the debugger prompt. (if (marker-buffer camldebug-delete-prompt-marker) (progn (delete-region (process-mark proc) camldebug-delete-prompt-marker) (set-marker camldebug-delete-prompt-marker nil))) (setq output (funcall camldebug-filter-function string)) ;; Don't display the specified file unless ;; (1) point is at or after the position where output appears ;; and (2) this buffer is on the screen. (setq process-window (and camldebug-track-frame (not camldebug-last-frame-displayed-p) (>= (point) (process-mark proc)) (get-buffer-window (current-buffer)))) ;; Insert the text, moving the process-marker. (comint-output-filter proc output) ;; ) ;; this was the end of save-excursion. ;; if save-excursion is used (comint-next-prompt 1) would be needed ;; to move the mark past then next prompt, but this is not as good ;; as solution. (if process-window (save-selected-window (select-window process-window) (camldebug-display-frame))))))) (defun camldebug-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed ;; Stop displaying an arrow in a source file. (camldebug-remove-current-event) (set-process-buffer proc nil)) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (camldebug-remove-current-event) ;; Fix the mode line. (setq mode-line-process (concat ": " (symbol-name (process-status proc)))) (let* ((obuf (current-buffer))) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer (unwind-protect (progn ;; Write something in *compilation* and hack its mode line, (set-buffer (process-buffer proc)) ;; Force mode line redisplay soon (set-buffer-modified-p (buffer-modified-p)) (if (eobp) (insert ?\n mode-name " " msg) (save-excursion (goto-char (point-max)) (insert ?\n mode-name " " msg))) ;; If buffer and mode line will show that the process ;; is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc)) ;; Restore old buffer, but don't restore old point ;; if obuf is the cdb buffer. (set-buffer obuf)))))) (defun camldebug-refresh (&optional arg) "Fix up a possibly garbled display, and redraw the mark." (interactive "P") (camldebug-display-frame) (recenter arg)) (defun camldebug-display-frame () "Find, obey and delete the last filename-and-line marker from CDB. The marker looks like \\032\\032Mfilename:startchar:endchar:beforeflag\\n. Obeying it means displaying in another window the specified file and line." (interactive) (camldebug-set-buffer) (if (not camldebug-last-frame) (camldebug-remove-current-event) (camldebug-display-line (nth 0 camldebug-last-frame) (nth 3 camldebug-last-frame) (nth 4 camldebug-last-frame) (nth 2 camldebug-last-frame))) (setq camldebug-last-frame-displayed-p t)) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its character CHARACTER is visible. ;; Put the mark on this character in that buffer. (defun camldebug-display-line (true-file schar echar kind) (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen (pop-up-windows t) (buffer (find-file-noselect true-file)) (window (display-buffer buffer t)) (spos) (epos) (pos)) (save-excursion (set-buffer buffer) (save-restriction (widen) (setq spos (+ (point-min) schar)) (setq epos (+ (point-min) echar)) (setq pos (if kind spos epos)) (camldebug-set-current-event spos epos (current-buffer) kind)) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) (set-window-point window pos))) ;;; Events. (defun camldebug-remove-current-event () (if window-system (progn (delete-overlay camldebug-overlay-event) (delete-overlay camldebug-overlay-under)) (setq overlay-arrow-position nil))) (defun camldebug-set-current-event (spos epos buffer before) (if window-system (if before (progn (move-overlay camldebug-overlay-event spos (1+ spos) buffer) (move-overlay camldebug-overlay-under (+ spos 1) epos buffer)) (move-overlay camldebug-overlay-event (1- epos) epos buffer) (move-overlay camldebug-overlay-under spos (- epos 1) buffer)) (save-excursion (set-buffer buffer) (goto-char spos) (beginning-of-line) (move-marker camldebug-event-marker (point)) (setq overlay-arrow-position camldebug-event-marker)))) ;;; Miscellaneous. (defun camldebug-module-name (filename) (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) ;;; The camldebug-call function must do the right thing whether its ;;; invoking keystroke is from the camldebug buffer itself (via ;;; major-mode binding) or a caml buffer. In the former case, we want ;;; to supply data from camldebug-last-frame. Here's how we do it: (defun camldebug-format-command (str) (let* ((insource (not (eq (current-buffer) current-camldebug-buffer))) (frame (if insource nil camldebug-last-frame)) (result)) (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str)) (let ((key (string-to-char (substring str (match-beginning 2)))) (cmd (substring str (match-beginning 1) (match-end 1))) (subst)) (setq str (substring str (match-end 2))) (cond ((eq key ?m) (setq subst (camldebug-module-name (if insource (buffer-file-name) (nth 0 frame))))) ((eq key ?d) (setq subst (file-name-directory (if insource (buffer-file-name) (nth 0 frame))))) ((eq key ?c) (setq subst (int-to-string (if insource (1- (point)) (nth 1 frame))))) ((eq key ?e) (setq subst (thing-at-point 'symbol)))) (setq result (concat result cmd subst)))) ;; There might be text left in STR when the loop ends. (concat result str))) (defun camldebug-call (command &optional fmt arg) "Invoke camldebug COMMAND displaying source in other window. Certain %-escapes in FMT are interpreted specially if present. These are: %m module name of current module. %d directory of current source file. %c number of current character position %e text of the caml variable surrounding point. The `current' source file is the file of the current buffer (if we're in a caml buffer) or the source file current at the last break or step (if we're in the camldebug buffer), and the `current' module name is the filename stripped of any *.ml* suffixes (this assumes the usual correspondence between module and file naming is observed). The `current' position is that of the current buffer (if we're in a source file) or the position of the last break or step (if we're in the camldebug buffer). If ARG is present, it overrides any FMT flags and its string representation is simply concatenated with the COMMAND." ;; Make sure debugger buffer is displayed in a window. (camldebug-set-buffer) (message "Command: %s" (camldebug-call-1 command fmt arg))) (defun camldebug-call-1 (command &optional fmt arg) ;; Record info on the last prompt in the buffer and its position. (save-excursion (set-buffer current-camldebug-buffer) (goto-char (process-mark (get-buffer-process current-camldebug-buffer))) (let ((pt (point))) (beginning-of-line) (if (looking-at comint-prompt-regexp) (set-marker camldebug-delete-prompt-marker (point))))) (let ((cmd (cond (arg (concat command " " (int-to-string arg))) (fmt (camldebug-format-command (concat command " " fmt))) (command)))) (process-send-string (get-buffer-process current-camldebug-buffer) (concat cmd "\n")) cmd)) (provide 'camldebug) caml-mode-master/README.md0000644000175000017500000001127113454350246015366 0ustar treinentreinen[![MELPA](https://melpa.org/packages/caml-badge.svg)](https://melpa.org/#/caml) OCaml Emacs mode ================ The files in this archive define a `caml-mode` for Emacs, for editing [OCaml][] programs, as well as an inferior-caml-mode, to run a toplevel. Caml-mode supports indentation, compilation and error retrieving, sending phrases to the toplevel. Moreover support for hilit, font-lock and imenu was added. This package is based on the original `caml-mode` for caml-light by Xavier Leroy, extended with indentation by Ian Zimmerman. For details see [README.itz](README.itz), which is the README from Ian Zimmerman's package. Installation ------------ ### MELPA The easiest way of installing this package is through [MELPA][]. If you haven't already done so, [configure it](https://melpa.org/#/getting-started) and run [M-x package-list-packages](https://www.gnu.org/software/emacs/manual/html_node/emacs/Packages.html#Packages). ### OPAM Alternatively, you can use [OPAM][] and install `caml-mode` and `user-setup`: opam install caml-mode user-setup ### Manual instllation To use this package, just put the `.el` files in your Emacs load path, and add the following lines in your [Init File][]. (add-to-list 'auto-mode-alist '("\\.ml[iylp]?$" . caml-mode)) (autoload 'caml-mode "caml" "Major mode for editing OCaml code." t) (autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) (autoload 'camldebug "camldebug" "Run ocamldebug on program." t) (add-to-list 'interpreter-mode-alist '("ocamlrun" . caml-mode)) (add-to-list 'interpreter-mode-alist '("ocaml" . caml-mode)) or put the `.el` files in, eg. `/usr/share/emacs/site-lisp/caml-mode/` and add the following line in addtion to the four lines above: (add-to-list 'load-path "/usr/share/emacs/site-lisp/caml-mode") To install the mode itself, edit the Makefile and do % make install To install ocamltags, do % make install-ocamltags To use highlighting capabilities, add **one** of the following two lines to your [Init File][]. The second one works better on recent versions of Emacs. (if window-system (require 'caml-hilit)) (if window-system (require 'caml-font)) [`caml.el`](caml.el) and [`inf-caml.el`](inf-caml.el) can be used collectively, but it might be a good idea to copy `caml-hilit.el` or `caml-font.el` to you own directory, and edit it to your taste and colors. Main key bindings ----------------- TAB indent current line M-C-q indent phrase M-C-h mark phrase C-c C-a switch between interface and implementation C-c C-c compile (usually `make`) C-x` goto next error (also mouse button 2 in the compilation log) Once you have started caml by M-x run-caml: M-C-x send phrase to inferior caml process C-c C-r send region to inferior caml process C-c C-s show inferior caml process C-c` goto error in expression sent by M-C-x For other bindings, see C-h b. Some remarks about the style supported -------------------------------------- Since OCaml's syntax is very liberal (more than 100 shift-reduce conflicts with yacc), automatic indentation is far from easy. Moreover, you expect the indentation to be not purely syntactic, but also semantic: reflecting the meaning of your program. This mode tries to be intelligent. For instance some operators are indented differently in the middle and at the end of a line (thanks to Ian Zimmerman). Also, we do not indent after `if .. then .. else`, when `else` is on the same line, to reflect that this idiom is equivalent to a return instruction in a more imperative language, or after the `in` of `let .. in`, since you may see that as an assignment. However, you may want to use a different indentation style. This is made partly possible by a number of variables at the beginning of `caml.el`. Try to set them. However this only changes the size of indentations, not really the look of your program. This is enough to disable the two idioms above, but to do anything more you will have to edit the code... Enjoy! This mode does not force you to put `;;` in your program. This means that we had to use a heuristic to decide where a phrase starts and stops, to speed up the code. A phrase starts when any of the keywords `let`, `type`, `class`, `module`, `functor`, `exception`, `val`, `external`, appears at the beginning of a line. Using the first column for such keywords in other cases may confuse the phrase selection function. [OCaml]: http://ocaml.org/ [OPAM]: https://opam.ocaml.org/ [MELPA]: https://melpa.org/ [Init File]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Init-File.html caml-mode-master/caml-mode.opam0000644000175000017500000000150213454350246016617 0ustar treinentreinenopam-version: "2.0" name: "caml-mode" version: "4.06" authors: [ "Damien Doligez" "Jacques Garrigue" "Xavier Leroy" "Didier Remy" "Ian T Zimmerman" ] maintainer: "Christophe.Troestler@umons.ac.be" license: "GNU General Public License" homepage: "https://github.com/ocaml/ocaml" dev-repo: "git+https://github.com/ocaml/ocaml.git" bug-reports: "http://caml.inria.fr/mantis/" install: [ [make "install" "EMACSDIR=%{share}%/emacs/site-lisp"] [make "install-ocamltags" "BINDIR=%{bin}%"] ] remove: [ [make "uninstall" "EMACSDIR=%{share}%/emacs/site-lisp"] [make "uninstall-ocamltags" "BINDIR=%{bin}%"] ] depends: ["ocaml" "conf-emacs"] post-messages: """ If you have not yet done so, please add in ~/.emacs.d/init.el or in ~/.emacs to following line: (add-to-list 'load-path "%{share}%/emacs/site-lisp/")""" {success} caml-mode-master/README.itz0000644000175000017500000001643213454350246015600 0ustar treinentreinenDESCRIPTION: This directory contains files to help editing OCaml code, running a OCaml toplevel, and running the OCaml debugger under the Gnu Emacs editor. AUTHORS: Ian T Zimmerman added indentation to caml mode, beefed up camldebug to work much like gud/gdb. Xavier Leroy (Xavier.Leroy@inria.fr), Jerome Vouillon (Jerome.Vouillon@ens.fr). camldebug.el is derived from FSF code. CONTENTS: caml.el A major mode for editing OCaml code in Gnu Emacs inf-caml.el To run a OCaml toplevel under Emacs, with input and output in an Emacs buffer. camldebug.el To run the OCaml debugger under Emacs. NOTE FOR EMACS 18 USERS: This package will no longer work with Emacs 18.x. Sorry. You really should consider upgrading to Emacs 19. USAGE: Add the following lines to your .emacs file: (setq auto-mode-alist (cons '("\\.ml[iylp]?" . caml-mode) auto-mode-alist)) (autoload 'caml-mode "caml" "Major mode for editing OCaml code." t) (autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) (autoload 'camldebug "camldebug" "Run the OCaml debugger." t) The Caml major mode is triggered by visiting a file with extension .ml, .mli, .mly. .mll or .mlp, or manually by M-x caml-mode. It gives you the correct syntax table for the OCaml language. For a brief description of the indentation capabilities, see below under NEWS. The Caml mode also allows you to run batch Caml compilations from Emacs (using M-x compile) and browse the errors (C-x `). Typing C-x ` sets the point at the beginning of the erroneous program fragment, and the mark at the end. Under Emacs 19, the program fragment is temporarily highlighted. M-x run-caml starts an OCaml toplevel with input and output in an Emacs buffer named *inferior-caml*. This gives you the full power of Emacs to edit the input to the OCaml toplevel. This mode is based on comint so you get all the usual comint features, including command history. After M-x run-caml, typing C-c C-e or M-C-x in a buffer in Caml mode sends the current phrase (containing the point) to the OCaml toplevel, and evaluates it. M-x camldebug FILE starts the OCaml debugger camldebug on the executable FILE, with input and output in an Emacs buffer named *camldebug-FILE*. For a brief description of the commands available in this buffer, see NEWS below. NEWS: Ok, so this is the really important part of this file :-) I took the original package from the contrib subdirectory of the caml-light distribution, and hacked on it. First, I added real syntax dependent indentation to caml mode. Like Xavier has said, it was hard (and I knew it would be), but I refused to believe it was impossible, partly because I knew of a Standard ML mode with indentation (written by Matthew Morley). Indentation works pretty much like in other programming modes. C-j at the end of a line starts a new line properly indented. M-C-\ indents the current region (this may take a while :-)). I incorporated a slightly different TAB function, one that I use in other modes: if TAB is pressed while the point is not in line indentation, the line is indented to the column where point is (instead of just inserting a TAB character - you can always to that with C-q C-i). This way, you can indent a line any time, regardless of where the point lies, by hitting TAB twice in succession. If you don't like this behaviour (but you should), it's quite easy to add to your startup code like this: (defun caml-old-style-indent () (if (caml-in-indentation) (caml-indent-command) (insert "\t"))) (add-hook 'caml-mode-hook (function (lambda () (define-key 'caml-mode-map "\t" caml-old-style-indent)))) You can customize the appearance of your caml code by twiddling the variables listed at the start of caml.el. Good luck. :-) Other news in caml mode are the various caml-insert-*-form commands. I believe they are self-explanatory - just do a C-h m in a caml buffer to see what you've got. The ohter major news is that I changed camldebug mode considerably. I took many clues from the gud "Grand Unified Debugger" mode distributed with modern versions of Emacs. The main benefit here is that you can do debugger commands _from your caml source buffer_. Commands with the C-c prefix in the debugger buffer have counterparts which do the same thing (well, a similar thing) in the source buffer, with the C-x C-a prefix. I made the existing debugger commands smarter in that they now attempt to guess the correct parameter to the underlying camldebug command. A numeric argument will always override that guess. For example, the guess for C-c C-b (camldebug-break) is to set a breakpoint at the current event (which was the only behaviour provided with the old camldebug.el). But C-u 1 C-c C-b will now send "break 1" to the camldebug process, setting a break at code address 1. This also allowed me to add many more commands for which the underlying camldebug commands require a parameter. The best way to learn about them is to do C-h m in the camldebug buffer, and then C-h f for the commands you'll see listed. Finally, I added command completion. To use it, you'll have to apply the provided patch to the debugger itself (contrib/debugger/command_line_interpreter.ml), and recompile it (you'll get one warning from the compiler; it is safe to ignore it). Then hitting TAB in the following situation, for example: (cdb) pri_ will complete the "pri" to "print". CAVEATS: I don't use X and haven't tested this stuff under the X mode of emacs. It is entirely possible (though not very probable) that I introduced some undesirable interaction between X (fontification, highlighting,...) and caml mode. I will welcome reports of such problems (see REPORTING below), but I won't be able to do much about them unless you also provide a patch. I don't know if the informational messages produced by camldebug are internationalized. If they are, the debugger mode won't work unless you set the language to English. The mode uses the messages to synchronize with camldebug, and looks for fixed Emacs regular expressions that match them. This may be fixed (if necessary) in a future release. BUGS: In the debugger buffer, it's possible to overflow your mental stack by asking for help on help on help on help on help on help on help on help... THANKS: Xavier Leroy for Caml-light. Used together with the Emacs interface, it is about the most pleasant programming environment I've known on any platform. Eric Raymond for gud, which camldebug mode apes. Barry Warsaw for elp, without which I wouldn't have been able to get the indentation code to perform acceptably. Gareth Rees for suggestions how to speed up Emacs regular expression search, even if I didn't use them in the end. Bill Dubuque for alerting me to the necessity of guarding against C-g inside Emacs code which modifies syntax tables. REPORTING: Bug reports (preferably with patches), suggestions, donations etc. to: Ian T Zimmerman +-------------------------------------------+ Box 13445 I With so many executioners available, I Berkeley CA 94712 USA I suicide is a really foolish thing to do. I mailto:itz@rahul.net +-------------------------------------------+ caml-mode-master/CHANGES.md0000644000175000017500000000525413454350246015505 0ustar treinentreinenVersion 3.10.1 -------------- * use `caml-font.el` from Olivier Andrieu old version is left as caml-font-old.el for compatibility Version 3.07 ------------ * support for showing type information _Damien Doligez_ Version 3.05 ------------ * improved interaction with inferior caml mode * access help from the source * fixes in indentation code Version 3.03 ------------ * process `;;` properly Version 3.00 ------------ * adapt to new label syntax * intelligent indentation of parenthesis Version 2.02 ------------ * improved ocamltags _ITZ and JG_ * added support for multibyte characters in Emacs 20 Version 2.01+ ------------- * corrected a bug in `caml-font.el` _Adam P. Jenkins_ * corrected abbreviations and added `ocamltags` script _Ian T Zimmerman_ Version 2.01 ------------ * code for interactive errors added by ITZ Version 2.00 ------------ * changed the algorithm to skip comments * adapted for the new object syntax Version 1.07 ------------ * `next-error` bug fix by John Malecki * `camldebug.el` modified by Xavier Leroy Version 1.06 ------------ * new keywords in Objective Caml 1.06 * compatibility with GNU Emacs 20 * changed from caml-imenu-disable to caml-imenu-enable (off by default) Version 1.05 ------------ * a few indentation bugs corrected. `let`, `val` ... are now indented correctly even when you write them at the beginning of a line. * added a Caml menu, and Imenu support. Imenu menu can be disabled by setting the variable `caml-imenu-disable` to `t`. Xemacs support for the Menu, but no Imenu. * key bindings closer to lisp-mode. * O'Labl compatibility (":" is part of words) may be switched off by setting `caml-olabl-disable` to `t`. * `camldebug.el` was updated by Xavier Leroy. Version 1.03b ------------- * many bugs corrected. * (partial) compatibility with Caml-Light added. (setq caml-quote-char "`") (setq inferior-caml-program "camllight") Literals will be correctly understood and highlighted. However, indentation rules are still OCaml's: this just happens to work well in most cases, but is only intended for occasional use. * as many people asked for it, application is now indented. This seems to work well: this time differences in indentation between the compiler's source and this mode are really exceptionnal. On the other hand, you may think that some special cases are strange. No miracle. * nicer behaviour when sending a phrase/region to the inferior caml process. Version 1.03 ------------ * support of OCaml and Objective Label. * an indentation very close to mine, which happens to be the same as Xavier's, since the sources of the OCaml compiler do not change if you indent them in this mode. * highlighting. caml-mode-master/caml-font-old.el0000644000175000017500000001047013454350246017065 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Jacques Garrigue and Ian T Zimmerman * ;* * ;* Copyright 1997 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; useful colors (cond ((x-display-color-p) (require 'font-lock) ;; extra faces for documentation (make-face 'Stop) (set-face-foreground 'Stop "White") (set-face-background 'Stop "Red") (make-face 'Doc) (set-face-foreground 'Doc "Red") (setq font-lock-stop-face 'Stop) (setq font-lock-doccomment-face 'Doc) )) ; The same definition is in caml.el: ; we don't know in which order they will be loaded. (defvar caml-quote-char "'" "*Quote for character constants. \"'\" for OCaml, \"`\" for Caml-Light.") (defconst caml-font-lock-keywords (list ;stop special comments '("\\(^\\|[^\"]\\)\\((\\*\\*/\\*\\*)\\)" 2 font-lock-stop-face) ;doccomments '("\\(^\\|[^\"]\\)\\((\\*\\*[^*]*\\([^)*][^*]*\\*+\\)*)\\)" 2 font-lock-doccomment-face) ;comments '("\\(^\\|[^\"]\\)\\((\\*[^*]*\\*+\\([^)*][^*]*\\*+\\)*)\\)" 2 font-lock-comment-face) ;character literals (cons (concat caml-quote-char "\\(\\\\\\([ntbr" caml-quote-char "\\]\\|" "[0-9][0-9][0-9]\\)\\|.\\)" caml-quote-char "\\|\"[^\"\\]*\\(\\\\\\(.\\|\n\\)[^\"\\]*\\)*\"") 'font-lock-string-face) ;modules and constructors '("`?\\<[A-Z][A-Za-z0-9_']*\\>" . font-lock-function-name-face) ;definition (cons (concat "\\<\\(a\\(nd\\|s\\)\\|c\\(onstraint\\|lass\\)" "\\|ex\\(ception\\|ternal\\)\\|fun\\(ct\\(ion\\|or\\)\\)?" "\\|in\\(herit\\|itializer\\)?\\|let" "\\|m\\(ethod\\|utable\\|odule\\)" "\\|of\\|p\\(arser\\|rivate\\)\\|rec\\|type" "\\|v\\(al\\|irtual\\)\\)\\>") 'font-lock-type-face) ;blocking '("\\<\\(begin\\|end\\|object\\|s\\(ig\\|truct\\)\\)\\>" . font-lock-keyword-face) ;control (cons (concat "\\<\\(do\\(ne\\|wnto\\)?\\|else\\|for\\|i\\(f\\|gnore\\)" "\\|lazy\\|match\\|new\\|or\\|t\\(hen\\|o\\|ry\\)" "\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\)\\>" "\\|\|\\|->\\|&\\|#") 'font-lock-reference-face) '("\\" . font-lock-comment-face) ;labels (and open) '("\\(\\([~?]\\|\\<\\)[a-z][a-zA-Z0-9_']*:\\)[^:=]" 1 font-lock-variable-name-face) '("\\<\\(assert\\|open\\|include\\)\\>\\|[~?][ (]*[a-z][a-zA-Z0-9_']*" . font-lock-variable-name-face))) (defconst inferior-caml-font-lock-keywords (append (list ;inferior '("^[#-]" . font-lock-comment-face)) caml-font-lock-keywords)) ;; font-lock commands are similar for caml-mode and inferior-caml-mode (defun caml-mode-font-hook () (cond ((fboundp 'global-font-lock-mode) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(caml-font-lock-keywords nil nil ((?' . "w") (?_ . "w"))))) (t (setq font-lock-keywords caml-font-lock-keywords))) (make-local-variable 'font-lock-keywords-only) (setq font-lock-keywords-only t) (font-lock-mode 1)) (add-hook 'caml-mode-hook 'caml-mode-font-hook) (defun inferior-caml-mode-font-hook () (cond ((fboundp 'global-font-lock-mode) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(inferior-caml-font-lock-keywords nil nil ((?' . "w") (?_ . "w"))))) (t (setq font-lock-keywords inferior-caml-font-lock-keywords))) (make-local-variable 'font-lock-keywords-only) (setq font-lock-keywords-only t) (font-lock-mode 1)) (add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-font-hook) (provide 'caml-font) caml-mode-master/ocamltags.in0000644000175000017500000001252113454350246016410 0ustar treinentreinen":" ; @EMACS@ -batch -l $0 "$@" ; status=$? ; : '--*-Emacs-Lisp-*--' <<';' ;************************************************************************** ;* * ;* OCaml * ;* * ;* Jacques Garrigue and Ian T Zimmerman * ;* * ;* Copyright 1998 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; Copyright (C) 1998 Ian Zimmerman ;; 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. (require 'caml) ;;itz Fri Oct 30 13:08:37 PST 1998 support for creating TAGS files ;; itz Sun Dec 27 10:26:08 PST 1998 adapted very slightly from ;; Jacques' caml-create-index-function (defun caml-tags-create-index-function () (let (all-alist index) (goto-char (point-max)) ;; collect definitions (while (caml-prev-index-position-function) (if (looking-at "[ \t]*val") nil (setq index (cons (caml-match-string 5) (point))) (setq all-alist (cons index all-alist)))) all-alist)) (defun caml-tags-file (filename) (let* ((output-buffer (current-buffer)) (basename (file-name-nondirectory filename)) (backpatch (prog2 (insert " \n" basename) (point)))) (find-file-read-only filename) (caml-mode) (let ((all-alist (caml-tags-create-index-function)) (done nil) (current-line 1) (last-point (point-min))) (mapcar (lambda (pair) (let ((tag-name (car pair)) (tag-pos (cdr pair))) (goto-char tag-pos) (setq current-line (+ current-line (count-lines last-point (point)))) (setq last-point (point)) (end-of-line 1) (let ((output-line (format "%s%s%d,%d\n" (buffer-substring last-point (point)) tag-name current-line tag-pos))) (save-excursion (set-buffer output-buffer) (insert output-line))))) all-alist)) (kill-buffer (current-buffer)) (set-buffer output-buffer) (let ((index-size (- (point) backpatch))) (goto-char backpatch) (insert "," (int-to-string index-size) "\n") (goto-char (point-max))))) (defsubst prefix-p (prefix str) (and (<= (length prefix) (length str)) (string= prefix (substring str 0 (length prefix))))) (defsubst eat-args (n) (setq command-line-args-left (nthcdr n command-line-args-left))) ;; see Emacs source file print.c (defun print-error-message (data) (let ((errname (car data)) errmsg is-file-error tail i) (if (eq errname 'error) (progn (setq data (cdr data)) (if (not (consp data)) (setq data nil)) (setq errmsg (car data)) (setq is-file-error nil)) (setq errmsg (get errname 'error-message)) (setq is-file-error (memq 'file-error (get errname 'error-conditions)))) (setq tail (cdr-safe data)) (if (and is-file-error tail) (setq errmsg (car tail) tail (cdr tail))) (if (stringp errmsg) (princ errmsg) (princ "peculiar error")) (setq i 0) (while (consp tail) (princ (if (eq i 0) ": " ", ")) (if is-file-error (princ (car tail)) (prin1 (car tail))) (setq tail (cdr tail) i (1+ i))) (princ "\n"))) (setq gc-cons-threshold 1000000) (setq output-file "TAGS") (setq append-flag nil) (setq status 0) (condition-case foobar (progn (while (and command-line-args-left (let ((arg (car command-line-args-left))) (cond ((prefix-p arg "-output-file") (setq output-file (nth 1 command-line-args-left)) (eat-args 2) t) ((prefix-p arg "-append") (setq append-flag t) (eat-args 1) t) (t nil))))) (find-file output-file) (if append-flag (goto-char (point-max)) (erase-buffer)) (while command-line-args-left (caml-tags-file (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left))) (save-buffer 0)) (error (setq status 1) (print-error-message foobar))) (kill-emacs status) ; ":" ; exit $status caml-mode-master/inf-caml.el0000644000175000017500000003334113454350246016121 0ustar treinentreinen;************************************************************************** ;* * ;* OCaml * ;* * ;* Xavier Leroy and Jacques Garrigue * ;* * ;* Copyright 1997 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;;; inf-caml.el --- run the OCaml toplevel in an Emacs buffer ;; Xavier Leroy, july 1993. ;; modified by Jacques Garrigue, july 1997. (require 'comint) (require 'caml) ;; User modifiable variables ;; Whether you want the output buffer to be displayed when you send a phrase (defvar caml-display-when-eval t "*If true, display the inferior caml buffer when evaluating expressions.") ;; End of User modifiable variables (defvar inferior-caml-mode-map nil) (if inferior-caml-mode-map nil (setq inferior-caml-mode-map (copy-keymap comint-mode-map))) ;; Augment Caml mode, so you can process OCaml code in the source files. (defvar inferior-caml-program "ocaml" "*Program name for invoking an inferior OCaml from Emacs.") (defun inferior-caml-mode () "Major mode for interacting with an inferior OCaml process. Runs an OCaml toplevel as a subprocess of Emacs, with I/O through an Emacs buffer. A history of input phrases is maintained. Phrases can be sent from another buffer in Caml mode. \\{inferior-caml-mode-map}" (interactive) (comint-mode) (setq comint-prompt-regexp "^# ?") (setq major-mode 'inferior-caml-mode) (setq mode-name "Inferior Caml") (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "(*") (make-local-variable 'comment-end) (setq comment-end "*)") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+ *") (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (use-local-map inferior-caml-mode-map) (run-hooks 'inferior-caml-mode-hooks)) (defconst inferior-caml-buffer-subname "inferior-caml") (defconst inferior-caml-buffer-name (concat "*" inferior-caml-buffer-subname "*")) ;; for compatibility with xemacs (defun caml-sit-for (second &optional mili redisplay) (if (and (boundp 'running-xemacs) running-xemacs) (sit-for (if mili (+ second (* mili 0.001)) second) redisplay) (sit-for second mili redisplay))) ;; To show result of evaluation at toplevel (defvar inferior-caml-output nil) (defun inferior-caml-signal-output (s) (if (string-match "[^ ]" s) (setq inferior-caml-output t))) (defun inferior-caml-mode-output-hook () (set-variable 'comint-output-filter-functions (list (function inferior-caml-signal-output)) t)) (add-hook 'inferior-caml-mode-hooks 'inferior-caml-mode-output-hook) ;; To launch ocaml whenever needed (defun caml-run-process-if-needed (&optional cmd) (if (comint-check-proc inferior-caml-buffer-name) nil (if (not cmd) (if (comint-check-proc inferior-caml-buffer-name) (setq cmd inferior-caml-program) (setq cmd (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (setq inferior-caml-program cmd) (let ((cmdlist (inferior-caml-args-to-list cmd)) (process-connection-type nil)) (set-buffer (apply (function make-comint) inferior-caml-buffer-subname (car cmdlist) nil (cdr cmdlist))) (inferior-caml-mode) (display-buffer inferior-caml-buffer-name) t) (setq caml-shell-active t) )) ;; patched to from original run-caml sharing code with ;; caml-run-process-when-needed (defun run-caml (&optional cmd) "Run an inferior OCaml process. Input and output via buffer `*inferior-caml*'." (interactive (list (if (not (comint-check-proc inferior-caml-buffer-name)) (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (caml-run-process-if-needed cmd) (switch-to-buffer-other-window inferior-caml-buffer-name)) (defun inferior-caml-args-to-list (string) (let ((where (string-match "[ \t]" string))) (cond ((null where) (list string)) ((not (= where 0)) (cons (substring string 0 where) (inferior-caml-args-to-list (substring string (+ 1 where) (length string))))) (t (let ((pos (string-match "[^ \t]" string))) (if (null pos) nil (inferior-caml-args-to-list (substring string pos (length string))))))))) (defun inferior-caml-show-subshell () (interactive) (caml-run-process-if-needed) (display-buffer inferior-caml-buffer-name) ; Added by Didier to move the point of inferior-caml to end of buffer (let ((buf (current-buffer)) (caml-buf (get-buffer inferior-caml-buffer-name)) (count 0)) (while (and (< count 10) (not (equal (buffer-name (current-buffer)) inferior-caml-buffer-name))) (next-multiframe-window) (setq count (+ count 1))) (if (equal (buffer-name (current-buffer)) inferior-caml-buffer-name) (goto-char (point-max))) (while (> count 0) (previous-multiframe-window) (setq count (- count 1))) ) ) ;; patched by Didier to move cursor after evaluation (defun inferior-caml-eval-region (start end) "Send the current region to the inferior OCaml process." (interactive "r") (save-excursion (caml-run-process-if-needed)) (save-excursion (goto-char end) (caml-skip-comments-backward) (comint-send-region inferior-caml-buffer-name start (point)) ;; normally, ";;" are part of the region (if (and (>= (point) 2) (prog2 (backward-char 2) (looking-at ";;"))) (comint-send-string inferior-caml-buffer-name "\n") (comint-send-string inferior-caml-buffer-name ";;\n")) ;; the user may not want to see the output buffer (if caml-display-when-eval (display-buffer inferior-caml-buffer-name t)))) ;; jump to errors produced by ocaml compiler (defun inferior-caml-goto-error (start end) "Jump to the location of the last error as indicated by inferior toplevel." (interactive "r") (let ((loc (+ start (save-excursion (set-buffer (get-buffer inferior-caml-buffer-name)) (re-search-backward (concat comint-prompt-regexp "[ \t]*Characters[ \t]+\\([0-9]+\\)-[0-9]+:$")) (caml-string-to-int (match-string 1)))))) (goto-char loc))) ;;; original inf-caml.el ended here ;; as eval-phrase, but ignores errors. (defun inferior-caml-just-eval-phrase (arg &optional min max) "Send the phrase containing the point to the CAML process. With prefix-arg send as many phrases as its numeric value, ignoring possible errors during evaluation. Optional arguments min max defines a region within which the phrase should lies." (interactive "p") (let ((beg)) (while (> arg 0) (setq arg (- arg 1)) (setq beg (caml-find-phrase min max)) (caml-eval-region beg (point))) beg)) (defvar caml-previous-output nil "Tells the beginning of output in the shell-output buffer, so that the output can be retrieved later, asynchronously.") ;; enriched version of eval-phrase, to report errors. (defun inferior-caml-eval-phrase (arg &optional min max) "Send the phrase containing the point to the CAML process. With prefix-arg send as many phrases as its numeric value, If an error occurs during evaluation, stop at this phrase and report the error. Return nil if noerror and position of error if any. If arg's numeric value is zero or negative, evaluate the current phrase or as many as prefix arg, ignoring evaluation errors. This allows to jump other erroneous phrases. Optional arguments min max defines a region within which the phrase should lies." (interactive "p") (if (save-excursion (caml-run-process-if-needed)) (progn (setq inferior-caml-output nil) (caml-wait-output 10 1))) (if (< arg 1) (inferior-caml-just-eval-phrase (max 1 (- 0 arg)) min max) (let ((proc (get-buffer-process inferior-caml-buffer-name)) (buf (current-buffer)) previous-output orig beg end err) (save-window-excursion (while (and (> arg 0) (not err)) (setq previous-output (marker-position (process-mark proc))) (setq caml-previous-output previous-output) (setq inferior-caml-output nil) (setq orig (inferior-caml-just-eval-phrase 1 min max)) (caml-wait-output) (switch-to-buffer inferior-caml-buffer-name nil) (goto-char previous-output) (cond ((re-search-forward " *Characters \\([01-9][01-9]*\\)-\\([1-9][01-9]*\\):\n[^W]" (point-max) t) (setq beg (caml-string-to-int (caml-match-string 1))) (setq end (caml-string-to-int (caml-match-string 2))) (switch-to-buffer buf) (goto-char orig) (forward-byte end) (setq end (point)) (goto-char orig) (forward-byte beg) (setq beg (point)) (setq err beg) ) ((looking-at "Toplevel input:\n[>]\\([^\n]*\\)\n[>]\\(\\( *\\)^*\\)\n") (let ((expr (caml-match-string 1)) (column (- (match-end 3) (match-beginning 3))) (width (- (match-end 2) (match-end 3)))) (if (string-match "^\\(.*\\)[<]EOF[>]$" expr) (setq expr (substring expr (match-beginning 1) (match-end 1)))) (switch-to-buffer buf) (re-search-backward (concat "^" (regexp-quote expr) "$") (- orig 10)) (goto-char (+ (match-beginning 0) column)) (setq end (+ (point) width))) (setq err beg)) ((looking-at "Toplevel input:\n>[.]*\\([^.].*\n\\)\\([>].*\n\\)*[>]\\(.*[^.]\\)[.]*\n") (let* ((e1 (caml-match-string 1)) (e2 (caml-match-string 3)) (expr (concat (regexp-quote e1) "\\(.*\n\\)*" (regexp-quote e2)))) (switch-to-buffer buf) (re-search-backward expr orig 'move) (setq end (match-end 0))) (setq err beg)) (t (switch-to-buffer buf))) (setq arg (- arg 1)) ) (pop-to-buffer inferior-caml-buffer-name) (if err (goto-char (point-max)) (goto-char previous-output) (goto-char (point-max))) (pop-to-buffer buf)) (if err (progn (beep) (caml-overlay-region (point) end)) (if inferior-caml-output (message "No error") (message "No output yet...") )) err))) (defun caml-overlay-region (beg end &optional wait) (interactive "%r") (cond ((fboundp 'make-overlay) (if caml-error-overlay () (setq caml-error-overlay (make-overlay 1 1)) (overlay-put caml-error-overlay 'face 'region)) (unwind-protect (progn (move-overlay caml-error-overlay beg end (current-buffer)) (beep) (if wait (read-event) (caml-sit-for 60))) (delete-overlay caml-error-overlay))))) ;; wait some amount for output, that is, until inferior-caml-output is set ;; to true. Hence, interleaves sitting for shorts delays and checking the ;; flag. Give up after some time. Typing into the source buffer will cancel ;; waiting, i.e. may report 'No result yet' (defun caml-wait-output (&optional before after) (let ((c 1)) (caml-sit-for 0 (or before 1)) (let ((c 1)) (while (and (not inferior-caml-output) (< c 99) (caml-sit-for 0 c t)) (setq c (+ c 1)))) (caml-sit-for (or after 0) 1))) ;; To insert the last output from caml at point (defun caml-insert-last-output () "Insert the result of the evaluation of previous phrase" (interactive) (let ((pos (process-mark (get-buffer-process inferior-caml-buffer-name)))) (insert-buffer-substring inferior-caml-buffer-name caml-previous-output (- pos 2)))) ;; additional bindings ;(let ((map (lookup-key caml-mode-map [menu-bar caml]))) ; (define-key map [indent-buffer] '("Indent buffer" . caml-indent-buffer)) ; (define-key map [eval-buffer] '("Eval buffer" . caml-eval-buffer)) ;) ;(define-key caml-mode-map "\C-c\C-b" 'caml-eval-buffer) (provide 'inf-caml) caml-mode-master/caml-help.el0000644000175000017500000007636413454350246016311 0ustar treinentreinen;;; caml-help.el --- Contextual completion and help to caml-mode ;************************************************************************** ;* * ;* OCaml * ;* * ;* Didier Remy, projet Cristal, INRIA Rocquencourt * ;* * ;* Copyright 2001 Institut National de Recherche en Informatique et * ;* en Automatique. * ;* * ;* All rights reserved. This file is distributed under the terms of * ;* the GNU General Public License. * ;* * ;************************************************************************** ;; Author: Didier Remy, November 2001. ;;; Commentary: ;; This provides two functions: completion and help. ;; Look for caml-complete and caml-help. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; This is a preliminary version. ;; ;; Possible improvements? ;; - dump some databases: Info, Lib, ... ;; - accept a search path for local libraries instead of current dir ;; (then distinguish between different modules lying in different ;; directories) ;; - improve the construction for info files. ;; ;; Abstract over ;; - the viewing method and the database, so that the documentation for ;; an identifier could be ;; * searched in info / html / man / mli's sources ;; * viewed in Emacs or using an external previewer. ;; ;; Take all identifiers (labels, Constructors, exceptions, etc.) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: (eval-and-compile (if (featurep 'xemacs) (require 'caml-xemacs) (require 'caml-emacs))) ;; Loading or building databases. ;; ;; variables to be customized (defvar ocaml-lib-path 'lazy "Path list for ocaml lib sources (mli files). `lazy' means ask ocaml to find it for you at first use.") (defun ocaml-lib-path () "Compute if necessary and return the path for ocaml libs." (if (listp ocaml-lib-path) nil (setq ocaml-lib-path (split-string (shell-command-to-string (or (and (boundp 'inferior-caml-program) (string-match "\\([^ ]*/ocaml\\)\\( \\|$\\)" inferior-caml-program) (let ((file (concat (match-string 1 inferior-caml-program) "c"))) (and (file-executable-p file) (concat file " -where")))) "ocamlc -where"))))) ocaml-lib-path) ;; General purpose auxiliary functions (defun ocaml-capitalize (s) (concat (capitalize (substring s 0 1)) (substring s 1))) (defun ocaml-uncapitalize (s) (if (> (length s) 0) (concat (downcase (substring s 0 1)) (substring s 1)) s)) (defun ocaml-find-files (path filter &optional depth split) (let* ((path-string (if (stringp path) (if (file-directory-p path) path nil) (mapconcat (lambda (d) (if (file-directory-p d) d)) path " "))) (command (and path-string (concat "find " path-string " '(' " filter " ')' " (if depth (concat " -maxdepth " (int-to-string depth))) (if split nil " -printf '%\p '") ))) (files (and command (shell-command-to-string command)))) (if (and split (stringp files)) (split-string files "\n") files) )) ;; Specialized auxiliary functions ;; Global table of modules contents of modules loaded lazily. (defvar ocaml-module-alist 'lazy "A-list of modules with how and where to find help information. `delay' means non computed yet.") (defun ocaml-add-mli-modules (modules tag &optional path) (let ((files (ocaml-find-files (or path (ocaml-lib-path)) "-type f -name '*.mli'" 1 t))) (while (consp files) (if (string-match "\\([^/]*\\).mli" (car files)) (let* ((module (ocaml-capitalize (match-string 1 (car files)))) (dir (file-name-directory (car files))) (dirp (member dir (ocaml-lib-path)))) (if (and (consp dirp) (string-equal dir (car dirp))) (setq dir (car dirp))) (if (assoc module modules) nil (setq modules (cons (cons module (cons (cons tag dir) 'lazy)) modules)) ))) (setq files (cdr files))) modules)) (defun ocaml-add-path (dir &optional path) "Extend `ocaml-module-alist' with modules of DIR relative to PATH." (interactive "D") (let* ((old (ocaml-lib-path)) (new (if (file-name-absolute-p dir) dir (concat (or (find-if (lambda (p) (file-directory-p (concat p "/" dir))) (cons default-directory old)) (error "Directory not found")) "/" dir)))) (setq ocaml-lib-path (cons (car old) (cons new (cdr old)))) (setq ocaml-module-alist (ocaml-add-mli-modules (ocaml-module-alist) 'lib new)))) (defun ocaml-module-alist () "Call by need value of variable `ocaml-module-alist'." (if (listp ocaml-module-alist) nil ;; build list of mli files (setq ocaml-module-alist (ocaml-add-mli-modules nil 'lib)) ;; dumping information ? TODO ) ocaml-module-alist) (defun ocaml-get-or-make-module (module &optional tag) (let ((info (assoc module (ocaml-module-alist)))) (if info nil (setq info (cons module (cons (cons 'local default-directory) 'lazy))) (setq ocaml-module-alist (cons info ocaml-module-alist)) ) info)) ;; Symbols of module are lazily computed (defun ocaml-module-filename (module) (let ((module (ocaml-uncapitalize module)) (name)) (if (file-exists-p (setq name (concat module ".mli"))) nil (let ((tmp (ocaml-lib-path))) (while (consp tmp) (setq name (concat (car tmp) "/" module ".mli")) (if (file-exists-p name) (setq tmp nil) (setq name nil))))) name)) (defun ocaml-module-symbols (module-info) (let* ((module (car module-info)) (tail (and module-info (cdr module-info))) (tag (caar tail)) (dir (cdar tail)) (file) (alist)) (if (listp (cdr tail)) (cdr tail) (if (equal tag 'info) (setq dir (car ocaml-lib-path)) ; XXX to be fixed ) (setq file (concat dir "/" (ocaml-uncapitalize module) ".mli")) (message file) (save-window-excursion (set-buffer (get-buffer-create "*caml-help*")) (if (and file (file-exists-p file)) (progn (message "Scanning module %s" file) (insert-file-contents file)) (message "Module %s not found" module)) (while (re-search-forward (concat "\\([ \t]*val\\|let\\|exception\\|external\\| [|]\\) \\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)" "\\|^ *[{]* \\([a-z_][A-Za-z_0-9]*\\) : [^;\n][^;\n]*;") (point-max) 'move) (pop-to-buffer (current-buffer)) (setq alist (cons (or (match-string 2) (match-string 3)) alist))) (erase-buffer) ) (setcdr tail alist) alist) )) ;; Local list of visible modules. (defvar ocaml-visible-modules 'lazy "A-list of open modules, local to every file.") (make-variable-buffer-local 'ocaml-visible-modules) (defun ocaml-visible-modules () (if (listp ocaml-visible-modules) nil (progn (setq ocaml-visible-modules (list (ocaml-get-or-make-module "Pervasives"))) (save-excursion (goto-char (point-min)) (while (re-search-forward "^ *open *\\([A-Z][a-zA-Z'_0-9]*\\)" (point-max) t) (let ((module (match-string 1))) (if (assoc module ocaml-visible-modules) nil (setq ocaml-visible-modules (cons (ocaml-get-or-make-module module) ocaml-visible-modules))))) ))) ocaml-visible-modules) (defun ocaml-open-module (arg) "*Make module of name ARG visible when ARG is a string. When call interactively, make completion over known modules." (interactive "P") (if (not (stringp arg)) (let ((modules (ocaml-module-alist))) (setq arg (completing-read "Open module: " modules)))) (if (and (stringp arg) (not (equal arg ""))) (progn (if (assoc arg (ocaml-visible-modules)) (ocaml-close-module arg)) (setq ocaml-visible-modules (cons (ocaml-get-or-make-module arg) (ocaml-visible-modules))) )) (message "%S" (mapcar 'car (ocaml-visible-modules)))) (defun ocaml-close-module (arg) "*Close module of name ARG when ARG is a string. When call interactively, make completion over visible modules. Otherwise if ARG is true, close all modules and reset to default." (interactive "P") (if (= (prefix-numeric-value arg) 4) (setq ocaml-visible-modules 'lazy) (let* ((modules (ocaml-visible-modules))) (if (null modules) (error "No visible module to close")) (unless (stringp arg) (setq arg (completing-read (concat "Close module [" (caar modules) "] : ") modules)) (if (equal arg "") (setq arg (caar modules)))) (setq ocaml-visible-modules (remove-if (lambda (m) (equal (car m) arg)) ocaml-visible-modules)) )) (message "%S" (mapcar 'car (ocaml-visible-modules)))) ;; Look for identifiers around point (defun ocaml-qualified-identifier (&optional show) "Search for a qualified identifier (Path. entry) around point. Entry may be nil. Currently, the path may only be nil or a single Module. For paths is of the form Module.Path', it returns Module and always nil for entry. If defined Module and Entry are represented by a region in the buffer, and are nil otherwise. For debugging purposes, it returns the string Module.entry if called with an optional non-nil argument." (save-excursion (let ((module) (entry)) (if (looking-at "[ \n]") (skip-chars-backward " ")) (if (re-search-backward "\\([^A-Za-z0-9_.']\\|\\`\\)\\([A-Za-z0-9_']*[.]\\)*[A-Za-z0-9_']*\\=" (- (point) 100) t) (progn (or (looking-at "\\`[A-Za-z)-9_.]") (forward-char 1)) (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)[.]") (progn (setq module (cons (match-beginning 1) (match-end 1))) (goto-char (match-end 0)))) (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)\\>") (setq entry (cons (match-beginning 1) (match-end 1)))))) (if show (concat (and module (buffer-substring (car module) (cdr module))) "." (and entry (buffer-substring (car entry) (cdr entry)))) (cons module entry)) ))) ;; completion around point (defun ocaml-completion (pattern module) (let ((list (or (and module (list (or (assoc module (ocaml-module-alist)) (error "Unknown module %s" module)))) (ocaml-visible-modules)))) (message "Completion from %s" (mapconcat 'car list " ")) (if (null pattern) (apply 'append (mapcar 'ocaml-module-symbols list)) (let ((pat (concat "^" (regexp-quote pattern))) (res)) (mapc (lambda (l) (mapc (lambda (x) (if (string-match pat (car l)) (if (member x res) nil (setq res (cons x res))))) (ocaml-module-symbols l))) list) res) ))) (defun caml-complete (arg) "Does completion for OCaml identifiers qualified. It attemps to recognize a qualified identifier Module . entry around point using function \\[ocaml-qualified-identifier]. If Module is defined, it does completion for identifier in Module. If Module is undefined, it does completion in visible modules. Then, if completion fails, it does completion among all modules where identifier is defined." (interactive "p") (let* ((module-entry (ocaml-qualified-identifier)) (entry) (module) (beg) (end) (pattern)) (if (car module-entry) (progn (setq module (buffer-substring (caar module-entry) (cdar module-entry))) (or (assoc module (ocaml-module-alist)) (and (setq module (completing-read "Module: " (ocaml-module-alist) nil nil module)) (save-excursion (goto-char (caar module-entry)) (delete-region (caar module-entry) (cdar module-entry)) (insert module) t) (setq module-entry (ocaml-qualified-identifier)) (car module-entry) (progn (setq entry (cdr module-entry)) t)) (error "Unknown module %s" module)))) (if (consp (cdr module-entry)) (progn (setq beg (cadr module-entry)) (setq end (cddr module-entry))) (if (and module (save-excursion (goto-char (cdar module-entry)) (looking-at " *[.]"))) (progn (setq beg (match-end 0)) (setq end beg)))) (if (not (and beg end)) (error "Did not find anything to complete around point") (setq pattern (buffer-substring beg end)) (let* ((all-completions (ocaml-completion pattern module)) (completion (try-completion pattern (mapcar 'list all-completions)))) (cond ((eq completion t)) ((null completion) (let* ((modules (ocaml-find-module pattern)) (visible (intersection modules (ocaml-visible-modules))) (hist) (module (cond ((null modules) nil) ((equal (length modules) 1) (caar modules)) ((equal (length visible) 1) (caar visible)) (t (setq hist (mapcar 'car modules)) (completing-read "Module: " modules nil t "" (cons hist 0))) ))) (if (null module) (error "Can't find completion for \"%s\"" pattern) (message "Completion found in module %s" module) (if (and (consp module-entry) (consp (cdr module-entry))) (delete-region (caar module-entry) end) (delete-region beg end)) (insert module "." pattern)))) ((not (string-equal pattern completion)) (delete-region beg end) (goto-char beg) (insert completion)) (t (with-output-to-temp-buffer "*Completions*" (display-completion-list all-completions)) )) )))) ;; Info files (only in ocamldoc style) (defvar ocaml-info-prefix "ocaml-lib" "Prefix of ocaml info files describing library modules. Suffix .info will be added to info files. Additional suffix .gz may be added if info files are compressed.") ;; (defun ocaml-hevea-info-add-entries (entries dir name) (let* ((filter (concat "-type f -regex '.*/" name "\\(.info\\|\\)\\(-[0-9]*\\|\\)\\([.]gz\\|\\)'" )) (section-regexp "\\* \\(Section [1-9][0-9--]*\\)::[ \t][ \t]*Module *\\([A-Z][A-Za-z_0-9]*\\)") (files (ocaml-find-files dir filter)) (command)) ;; scanning info files (if (or (null files) (not (stringp files)) (string-match files "^ *$")) (message "No info file found: %s." (mapconcat 'identity files " ")) (message "Scanning info files %s." files) (save-window-excursion (set-buffer (get-buffer-create "*caml-help*")) (setq command (concat "zcat -f " files " | grep -e '" section-regexp "'")) (message "Scanning files with: %s" command) (or (shell-command command (current-buffer)) (error "Error while scanning")) (goto-char (point-min)) (while (re-search-forward section-regexp (point-max) t) (let* ((module (match-string 2)) (section (match-string 1))) ;; (message "%s %s" module section) (if (assoc module entries) nil (setq entries (cons (cons module (concat "(" name ")" section)) entries)) ))) (let ((buf (get-buffer "*caml-help*"))) (if buf (kill-buffer buf))))) entries)) (defun ocaml-hevea-info () "The default way to create an info data base from the value of \\[Info-default-directory-list] and the base name \\[ocaml-info-name] of files to look for. This uses info files produced by HeVeA." (let ((collect) (seen)) (mapc (lambda (d) (if (member d seen) nil (setq collect (ocaml-hevea-info-add-entries collect d ocaml-info-prefix)) (setq seen (cons d seen)))) Info-directory-list) collect)) (defun ocaml-ocamldoc-info-add-entries (entries dir name) (let* ((module-regexp "^Node: \\([A-Z][A-Za-z_0-9]*\\)[^ ]") (command (concat "find " dir " -type f -regex '.*/" name "\\(.info\\|\\)\\([.]gz\\|\\)' -print0" " | xargs -0 zcat -f | grep '" module-regexp "'"))) (message "Scanning info files in %s" dir) (save-window-excursion (set-buffer (get-buffer-create "*caml-help*")) (or (shell-command command (current-buffer)) (error "Could not run:%s" command)) (goto-char (point-min)) (while (re-search-forward module-regexp (point-max) t) (if (equal (char-after (match-end 1)) 127) (let* ((module (match-string 1))) (if (assoc module entries) nil (setq entries (cons (cons module (concat "(" name ")" module)) entries)) )))) ; (kill-buffer (current-buffer)) ) entries)) (defun ocaml-ocamldoc-info () "The default way to create an info data base from the value of \\[Info-default-directory-list] and the base name \\[ocaml-info-name] of files to look for. This uses info files produced by ocamldoc." (require 'info) (let ((collect) (seen)) (mapc (lambda (d) (if (member d seen) nil (setq collect (ocaml-ocamldoc-info-add-entries collect d ocaml-info-prefix)) (setq seen (cons d seen)))) Info-directory-list) collect)) ;; Continuing (defvar ocaml-info-alist 'ocaml-ocamldoc-info "A-list binding module names to info entries: nil means do not use info. A function to build the list lazily (at the first call). The result of the function call will be assign permanently to this variable for future uses. We provide two default functions `ocaml-hevea-info' \(info produced by HeVeA is the default) and `ocaml-ocamldoc-info' \(info produced by ocamldoc). Otherwise, this value should be an alist binding module names to info entries of the form to \"(entry)section\" be taken by the \\[info] command. An entry may be an info module or a complete file name." ) (defun ocaml-info-alist () "Call by need value of variable `ocaml-info-alist'." (cond ((listp ocaml-info-alist)) ((functionp ocaml-info-alist) (setq ocaml-info-alist (apply ocaml-info-alist nil))) (t (error "wrong type for ocaml-info-alist"))) ocaml-info-alist) ;; help around point (defun ocaml-find-module (symbol &optional module-list) (let ((list (or module-list (ocaml-module-alist))) (collect)) (while (consp list) (if (member symbol (ocaml-module-symbols (car list))) (setq collect (cons (car list) collect))) (setq list (cdr list))) (nreverse collect) )) (defun ocaml-buffer-substring (region) (and region (buffer-substring-no-properties (car region) (cdr region)))) ;; Help function. (defvar view-return-to-alist) (defvar view-exit-action) (defun ocaml-goto-help (&optional module entry same-window) "Search info manual for MODULE and ENTRY in MODULE. If unspecified, MODULE and ENTRY are inferred from the position in the current buffer using \\[ocaml-qualified-identifier]." (interactive) (let ((window (selected-window)) (info-section (assoc module (ocaml-info-alist)))) (if info-section (caml-info-other-window (cdr info-section)) (ocaml-visible-modules) (let* ((module-info (or (assoc module (ocaml-module-alist)) (and (file-exists-p (concat (ocaml-uncapitalize module) ".mli")) (ocaml-get-or-make-module module)))) (location (cdr (cadr module-info)))) (cond (location (let ((file (concat location (ocaml-uncapitalize module) ".mli"))) (if (window-live-p same-window) (progn (select-window same-window) (view-mode-exit view-return-to-alist view-exit-action)) ;; (view-buffer (find-file-noselect file) 'view)) ) (view-file-other-window file) (bury-buffer (current-buffer)))) (info-section (error "Aborted")) (t (error "No help for module %s" module)))) ) (if (stringp entry) (let ((here (point)) (regex (regexp-quote entry)) (case-fold-search nil)) (goto-char (point-min)) (if (or (re-search-forward (concat "\\(val\\|exception\\|type\\|external\\|[|{;]\\) +" regex) ;; (concat "\\(val\\|exception\\|external\\) +\\(" ;; regex "\\|( *" regex " *)\\)") (point-max) t) (re-search-forward (concat "type [^{]*{[^}]*" regex " :") ;; (concat "\\(type\\|[|{;]\\) +" regex) (point-max) t) (progn (if (window-live-p window) (select-window window)) (error "Entry %s not found in module %s" entry module)) ;; (search-forward entry (point-max) t) ) (ocaml-help-show -1) (progn (message "Help for entry %s not found in module %s" entry module) (goto-char here))) )) (ocaml-link-activate (cdr info-section)) (if (window-live-p window) (select-window window)) )) (defface ocaml-help-face '((t :background "#88FF44")) "Face to highlight expressions and types.") (defvar ocaml-help-ovl (let ((ovl (make-overlay 1 1))) (overlay-put ovl 'face 'ocaml-help-face) ovl)) (defun caml-help (arg) "Find documentation for OCaml qualified identifiers. It attempts to recognize a qualified identifier of the form ``Module . entry'' around point using function `ocaml-qualified-identifier'. If Module is undetermined it is temptatively guessed from the identifier name and according to visible modules. If this is still unsuccessful, the user is then prompted for a Module name. The documentation for Module is first searched in the info manual, if available, then in the ``module.mli'' source file. The entry is then searched in the documentation. Visible modules are computed only once, at the first call. Modules can be made visible explicitly with `ocaml-open-module' and hidden with `ocaml-close-module'. Prefix arg 0 forces recompilation of visible modules (and their content) from the file content. Prefix arg 4 prompts for Module and identifier instead of guessing values from the position of point in the current buffer." (interactive "p") (delete-overlay ocaml-help-ovl) (let ((module) (entry) (module-entry)) (cond ((= arg 4) (or (and (setq module (completing-read "Module: " (ocaml-module-alist) nil t "" (cons 'hist 0))) (not (string-equal module ""))) (error "Quit")) (let ((symbols (mapcar 'list (ocaml-module-symbols (assoc module (ocaml-module-alist)))))) (setq entry (completing-read (format "Value: %s." module) symbols nil t))) (if (string-equal entry "") (setq entry nil)) ) (t (if (= arg 0) (setq ocaml-visible-modules 'lazy)) (setq module-entry (ocaml-qualified-identifier)) (setq entry (ocaml-buffer-substring (cdr module-entry))) (setq module (or (ocaml-buffer-substring (car module-entry)) (let ((modules (or (ocaml-find-module entry (ocaml-visible-modules)) (ocaml-find-module entry))) (hist) (default)) (cond ((null modules) (error "No module found for entry %s" entry)) ((equal (length modules) 1) (caar modules)) (t (setq hist (mapcar 'car modules)) (setq default (car hist)) (setq module (completing-read (concat "Module: " (and default (concat "[" default "] "))) modules nil t "" (cons 'hist 0))) (if (string-equal module "") default module)) )))) )) (message "Help for %s%s%s" module (if entry "." "") (or entry "")) (ocaml-goto-help module entry) )) ;; auto-links (defconst ocaml-link-regexp "\\(type\\|and\\) \\('[a-z] +\\|(\\('[a-z], *\\)*'[a-z])\\|\\) *\\([a-zA-Z0-9_]*\\)\\( *$\\| =\\)") (defconst ocaml-longident-regexp "\\([A-Z][a-zA-Z_0]*\\)[.]\\([a-zA-Z][A-Za-z0-9_]*\\)") (defvar ocaml-links nil "Local links in the current of last info node or interface file. The car of the list is a key that identifies the module to prevent recompilation when next help command is relative to the same module. The cdr is a list of elements, each of which is a string and a pair of buffer positions." ) (make-variable-buffer-local 'ocaml-links) (defun ocaml-info-links (section) (cdr (if (and ocaml-links section (equal (car ocaml-links) section)) ocaml-links (save-excursion (goto-char (point-min)) (let ((regexp (concat (if (equal major-mode 'Info-mode) "^ - " "^") ocaml-link-regexp)) (all)) (while (re-search-forward regexp (point-max) t) (setq all (cons (cons (match-string 4) (cons (match-beginning 4) (match-end 4))) all))) (setq ocaml-links (cons section all)) ))))) (defvar ocaml-link-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'ocaml-link-goto) map)) (defun ocaml-help-show (arg) (let ((right (point)) (left (progn (forward-word arg) (point)))) (goto-char right) (move-overlay ocaml-help-ovl left right (current-buffer)) (recenter 1) )) (defun ocaml-link-goto (click) "Follow link at point." (interactive "e") (let* ((pos (caml-event-point-start click)) (win (caml-event-window click)) (buf (window-buffer win)) (window (selected-window)) (link)) (setq link (with-current-buffer buf (buffer-substring (previous-single-property-change (+ pos 1) 'local-map buf (- pos 100)) (next-single-property-change pos 'local-map buf (+ pos 100))))) (if (string-match (concat "^" ocaml-longident-regexp "$") link) (ocaml-goto-help (match-string 1 link) (match-string 2 link) win) (if (not (equal (window-buffer window) buf)) (switch-to-buffer-other-window buf)) (if (setq link (assoc link (cdr ocaml-links))) (progn (goto-char (cadr link)) (ocaml-help-show 1))) (if (window-live-p window) (select-window window)) ))) (defface ocaml-link-face '((((class color)) :foreground "Purple")) "Face to highlight hyperlinks.") (defun ocaml-link-activate (section) (let ((links (ocaml-info-links section))) (if links (let ((regexp (concat "[^A-Za-z0-9'_]\\(" ocaml-longident-regexp "\\|" (mapconcat 'car links "\\|") "\\)[^A-Za-z0-9'_]")) (case-fold-search nil)) (save-excursion (goto-char (point-min)) (let ((buffer-read-only nil) ;; use of dynamic scoping, need not be restored! (modified-p (buffer-modified-p))) (unwind-protect (save-excursion (goto-char (point-min)) (while (re-search-forward regexp (point-max) t) (put-text-property (match-beginning 1) (match-end 1) 'mouse-face 'highlight) (put-text-property (match-beginning 1) (match-end 1) 'local-map ocaml-link-map) (if (x-display-color-p) (put-text-property (match-beginning 1) (match-end 1) 'face 'ocaml-link-face))) ) ;; need to restore flag if buffer was unmodified. (unless modified-p (set-buffer-modified-p nil)) )) ))))) ;; bindings ---now in caml.el ; (and ; (boundp 'caml-mode-map) ; (keymapp caml-mode-map) ; (progn ; (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path) ; (define-key caml-mode-map [?\C-c?]] 'ocaml-close-module) ; (define-key caml-mode-map [?\C-c?[] 'ocaml-open-module) ; (define-key caml-mode-map [?\C-c?\C-h] 'caml-help) ; (define-key caml-mode-map [?\C-c?\t] 'caml-complete) ; (let ((map (lookup-key caml-mode-map [menu-bar caml]))) ; (and ; (keymapp map) ; (progn ; (define-key map [separator-help] '("---")) ; (define-key map [open] '("Open add path" . ocaml-add-path )) ; (define-key map [close] ; '("Close module for help" . ocaml-close-module)) ; (define-key map [open] '("Open module for help" . ocaml-open-module)) ; (define-key map [help] '("Help for identifier" . caml-help)) ; (define-key map [complete] '("Complete identifier" . caml-complete)) ; ) ; )))) (provide 'caml-help) ;;; caml-help.el ends here caml-mode-master/Makefile0000644000175000017500000001040213454350246015542 0ustar treinentreinen#************************************************************************** #* * #* OCaml * #* * #* Xavier Leroy, projet Cristal, INRIA Rocquencourt * #* * #* Copyright 1997 Institut National de Recherche en Informatique et * #* en Automatique. * #* * #* All rights reserved. This file is distributed under the terms of * #* the GNU General Public License. * #* * #************************************************************************** VERSION = $(shell grep "^version" caml-mode.opam \ | sed -e 's/version: *"\([^"]*\)"/\1/') DESCRIPTION = $(shell grep ';;; caml.el ---' caml.el \ | sed 's/[^-]*--- *\(.*\)/\1/') DIST_DIR = caml-mode-$(VERSION) OPAM_DIR = caml-mode.$(VERSION) TARBALL = caml-mode-$(VERSION).tgz # Files to install FILES= caml-font.el caml-hilit.el caml.el camldebug.el \ inf-caml.el caml-compat.el caml-help.el caml-types.el \ caml-xemacs.el caml-emacs.el caml-mode-site-file.el DIST_FILES = $(FILES) Makefile README* COPYING* CHANGES.md ocamltags.in # Where to install. If empty, automatically determined. #EMACSDIR= # Name of Emacs executable EMACS=emacs # Where to install ocamltags script SCRIPTDIR = $(BINDIR) # Command for byte-compiling the files COMPILECMD=(progn \ (setq load-path (cons "." load-path)) \ (byte-compile-file "caml-xemacs.el") \ (byte-compile-file "caml-emacs.el") \ (byte-compile-file "caml.el") \ (byte-compile-file "inf-caml.el") \ (byte-compile-file "caml-help.el") \ (byte-compile-file "caml-types.el") \ (byte-compile-file "caml-font.el") \ (byte-compile-file "camldebug.el")) caml-mode-site-file.el: $(SOURCES) (echo ";;; $@ --- Automatically extracted autoloads.";\ echo ";;; Code:";\ echo "(add-to-list 'load-path";\ echo " (or (file-name-directory load-file-name) (car load-path)))";\ echo " ") >$@ $(EMACS) --batch --eval '(setq generated-autoload-file "'`pwd`'/$@")' -f batch-update-autoloads "." install: @if test "$(EMACSDIR)" = ""; then \ $(EMACS) --batch --eval 't; see PR#5403'; \ set xxx `($(EMACS) --batch --eval "(mapcar 'print load-path)") \ 2>/dev/null | \ sed -n -e 's/^"\(.*\/site-lisp\).*/\1/gp' | \ sort -u`; \ if test "$$2" = "" -o "$$3" != ""; then \ echo "Cannot determine Emacs site-lisp directory:"; \ shift; while test "$$1" != ""; do echo "\t$$1"; shift; done; \ else \ $(MAKE) EMACSDIR="$$2" simple-install; \ fi; \ else \ $(MAKE) simple-install; \ fi # install the .el files, but do not compile them. install-el: $(MAKE) NOCOMPILE=true install simple-install: @echo "Installing in $(EMACSDIR)..." if test -d $(EMACSDIR); then : ; else mkdir -p $(EMACSDIR); fi $(INSTALL_DATA) $(FILES) $(EMACSDIR) if [ -z "$(NOCOMPILE)" ]; then \ cd $(EMACSDIR); $(EMACS) --batch --eval '$(COMPILECMD)'; \ fi ocamltags: ocamltags.in sed -e 's:@EMACS@:$(EMACS):' ocamltags.in >ocamltags chmod a+x ocamltags install-ocamltags: ocamltags $(INSTALL_DATA) ocamltags $(SCRIPTDIR)/ocamltags # OPAM .PHONY: opam opam: $(TARBALL) mkdir -p $(OPAM_DIR) cp -a caml-mode.opam $(OPAM_DIR)/opam echo "url {" >> $(OPAM_DIR)/opam echo " src: \"`pwd`/https://github.com/ocaml/caml-mode/releases/download/$(VERSION)/$(TARBALL)\"" >> $(OPAM_DIR)/opam echo " checksum: \"md5=`md5sum $(TARBALL) | cut -d ' ' -f 1`\"" \ >> $(OPAM_DIR)/opam echo "}" >> $(OPAM_DIR)/opam $(TARBALL): $(DIST_FILES) mkdir -p $(DIST_DIR) for f in $(DIST_FILES); do cp $$f $(DIST_DIR); done echo "(define-package \"caml\" \"$(VERSION)\" \"$(DESCRIPTION)\" \ )" > $(DIST_DIR)/caml-pkg.el tar acvf $@ $(DIST_DIR) $(RM) -rf $(DIST_DIR) # This is for testing purposes compile-only: $(EMACS) --batch --eval '$(COMPILECMD)' clean: rm -f ocamltags *~ \#*# *.elc $(RM) -r $(TARBALL) $(OPAM_DIR)