diff options
Diffstat (limited to 'emacs/inf-caml.el')
| -rw-r--r-- | emacs/inf-caml.el | 348 |
1 files changed, 0 insertions, 348 deletions
diff --git a/emacs/inf-caml.el b/emacs/inf-caml.el deleted file mode 100644 index f24a7a71fe..0000000000 --- a/emacs/inf-caml.el +++ /dev/null @@ -1,348 +0,0 @@ -;;; inf-caml.el --- run the Caml 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 diplayed 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 Caml code in the source files. - -(defvar inferior-caml-program "ocaml" - "*Program name for invoking an inferior Caml from Emacs.") - -(defun inferior-caml-mode () - "Major mode for interacting with an inferior Caml process. -Runs a Caml toplevel as a subprocess of Emacs, with I/O through an -Emacs buffer. A history of input phrases is maintained. Phrases can -be sent from another buffer in Caml mode. - -\\{inferior-caml-mode-map}" - (interactive) - (comint-mode) - (setq comint-prompt-regexp "^# ?") - (setq major-mode 'inferior-caml-mode) - (setq mode-name "Inferior Caml") - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'require-final-newline) - (setq require-final-newline t) - (make-local-variable 'comment-start) - (setq comment-start "(*") - (make-local-variable 'comment-end) - (setq comment-end "*)") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "(\\*+ *") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (use-local-map inferior-caml-mode-map) - (run-hooks 'inferior-caml-mode-hooks)) - - -(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 () - (setq comint-output-filter-functions - (list (function inferior-caml-signal-output)))) -(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 "Caml 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 Caml process. -Input and output via buffer `*inferior-caml*'." - (interactive - (list (if (not (comint-check-proc inferior-caml-buffer-name)) - (read-from-minibuffer "Caml 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) - (end-of-buffer)) - (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 Caml 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]+:$")) - (string-to-int (match-string 1)))))) - (goto-char loc))) - - -;;; orgininal 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 retreived later, asynchronously.") - -;; enriched version of eval-phrase, to repport 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 evalutaion, stop at this phrase and -repport 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 (string-to-int (caml-match-string 1))) - (setq end (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 ouput, 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) |