diff options
| -rw-r--r-- | emacs/caml-help.el | 59 | ||||
| -rw-r--r-- | emacs/caml.el | 64 | ||||
| -rw-r--r-- | emacs/inf-caml.el | 310 |
3 files changed, 374 insertions, 59 deletions
diff --git a/emacs/caml-help.el b/emacs/caml-help.el index 79e2116c7..e7df774ff 100644 --- a/emacs/caml-help.el +++ b/emacs/caml-help.el @@ -3,7 +3,7 @@ ;; Didier Remy, November 2001. ;; This provides two functions completion and help -;; look for ocaml-complete and ocaml-help +;; look for caml-complete and caml-help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -157,7 +157,7 @@ command. An entry may be an info module or a complete file name." (setq file (concat dir (ocaml-uncapitalize module) ".mli")) (message file) (save-window-excursion - (set-buffer (get-buffer-create "*ocaml-help*")) + (set-buffer (get-buffer-create "*caml-help*")) (if (and file (file-exists-p file)) (progn (message "Scanning module %s" file) @@ -194,7 +194,7 @@ command. An entry may be an info module or a complete file name." ))) ocaml-visible-modules) -;; Look for identifiers aroun poin +;; Look for identifiers around point (defun ocaml-current-position () "Return a pair (MODULE . ENTRY) such that point is above ENTRY and @@ -202,20 +202,21 @@ MODULE is the module preceeding ENTRY. Both are a pair of position (BEG . END) in the buffer and can be nil if undefined." - (let ((module) (entry)) - (save-excursion - (backward-word 1) - (if (looking-at "\\([A-Z][A-Za-z0-9_]*\\)[.]") - (setq module (cons (match-beginning 1) (match-end 1))) - (if (looking-at "[a-z_][A-Za-z0-9_]*") - (progn - (setq entry (cons (match-beginning 0) (match-end 0))) - (backward-word 1) - (if (looking-at - (concat "\\([A-Z][A-Za-z0-_]*\\)[.]" - (regexp-quote (match-string 0)))) - (setq module (cons (match-beginning 1) (match-end 1))))))) - (cons module entry)))) + (save-excursion + (let ((module) (entry)) + (if (re-search-backward + "\\(\\<[A-Z][A-Za-z0-9_]*\\>\\.\\|[^.]\\)\\<[A-Za-z0-9_]*\\=" + (- (point) 100) t) + (progn + (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-z_'][A-Za-z0-9_']*\\)\\>") + (progn (message "TROIS") + (setq entry (cons (match-beginning 1) (match-end 1))))))) + (cons module entry)) + )) ;; completion around point @@ -241,7 +242,7 @@ undefined." res) ))) -(defun ocaml-complete (arg) +(defun caml-complete (arg) "Complete symbol define in libraries" (interactive "p") (let* ((module-entry (ocaml-current-position)) @@ -328,7 +329,7 @@ undefined." (string-match files "^ *$")) (message "No info file found: %s." (mapconcat 'identity files " ")) (message "Scanning info files %s." files) - (set-buffer (get-buffer-create "*ocaml-help*")) + (set-buffer (get-buffer-create "*caml-help*")) (setq command (concat "gunzip -c -f " files " | grep -e '" ocaml-info-section-regexp "'")) @@ -395,14 +396,18 @@ current buffer using \\[ocaml-current-position]." (let ((info-section (assoc module (ocaml-info-alist)))) (if info-section (info (cdr info-section)) (ocaml-visible-modules) - (let* ((module-info (assoc module (ocaml-module-alist))) + (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 (cdadr module-info))) (cond (location (view-file (concat location (ocaml-uncapitalize module) ".mli")) (bury-buffer (current-buffer))) (info-section (error "Aborted")) - (t (error "No help for module %s" (car module))))) + (t (error "No help for module %s" module)))) )) (if (stringp entry) (let ((here (point))) @@ -417,13 +422,15 @@ current buffer using \\[ocaml-current-position]." (goto-char here))))) ) -(defun ocaml-help (arg) +(defun caml-help (arg) (interactive "p") (let ((module) (entry)) (cond - ((= arg 4) - (or (setq module + ((or (= arg 4)) + (or (and + (setq module (completing-read "Module: " ocaml-module-alist nil t)) + (not (string-equal module ""))) (error "Quit"))) (t (if (= arg 0) (setq ocaml-visible-modules 'lazy)) @@ -455,8 +462,8 @@ current buffer using \\[ocaml-current-position]." (if (boundp 'caml-mode-map) (progn - (define-key caml-mode-map [?\C-c?\C-h] 'ocaml-help) - (define-key caml-mode-map [?\C-c?\t] 'ocaml-complete) + (define-key caml-mode-map [?\C-c?\C-h] 'caml-help) + (define-key caml-mode-map [?\C-c?\t] 'caml-complete) )) (provide 'caml-help) diff --git a/emacs/caml.el b/emacs/caml.el index 7be02ea0b..d97e62535 100644 --- a/emacs/caml.el +++ b/emacs/caml.el @@ -476,17 +476,49 @@ have caml-electric-indent on, which see.") (interactive"r") (inferior-caml-eval-region start end)) -(defun caml-eval-phrase () - "Send the current Caml phrase to the inferior Caml process." - (interactive) - (save-excursion - (let ((bounds (caml-mark-phrase))) - (inferior-caml-eval-region (car bounds) (cdr bounds))))) +;; old version ---to be deleted later +; +; (defun caml-eval-phrase () +; "Send the current Caml 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 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") + (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 prefix arg, evaluate past the whole buffer, no stopping at +the current point." + (interactive "p") + (let ((here (point)) ((error)) + (goto-char (point-min)) + (setq error + (caml-eval-phrase 500 (point-min) (if arg (point-max) here)))) + (if error (set-mark (error))) + (goto-char here))) (defun caml-show-subshell () (interactive) (inferior-caml-show-subshell)) + ;;; Imenu support (defun caml-show-imenu () (interactive) @@ -1580,10 +1612,22 @@ by |, insert one." 0) abbrev-correct))))))) -(defun caml-indent-phrase () - (interactive "*") - (let ((bounds (caml-mark-phrase))) - (indent-region (car bounds) (cdr bounds) nil))) +; (defun caml-indent-phrase () +; (interactive "*") +; (let ((bounds (caml-mark-phrase))) +; (indent-region (car bounds) (cdr bounds) nil))) + +(defun caml-indent-phrase (arg) + (interactive "p") + (save-excursion + (let ((beg (caml-find-phrase))) + (while (progn (setq arg (- arg 1)) (> arg 0)) + (caml-find-region)) + (indent-region beg (point) nil)))) + +(defun caml-indent-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." diff --git a/emacs/inf-caml.el b/emacs/inf-caml.el index 0eba00eeb..bbe084cc7 100644 --- a/emacs/inf-caml.el +++ b/emacs/inf-caml.el @@ -6,6 +6,17 @@ (require 'comint) +;; User modifiable variables + +;; Whether you want the output buffer to be diplayed when you send a phrase + +(defvar caml-display-when-eval nil + "*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 @@ -49,20 +60,62 @@ be sent from another buffer in Caml mode. (use-local-map inferior-caml-mode-map) (run-hooks 'inferior-caml-mode-hooks)) -(defun run-caml (cmd) + +(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) + )) + +;; 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 (read-from-minibuffer "Caml command to run: " - inferior-caml-program))) - (setq inferior-caml-program cmd) - (if (not (comint-check-proc "*inferior-caml*")) - (let ((cmdlist (inferior-caml-args-to-list cmd)) - (process-connection-type nil)) - (set-buffer (apply (function make-comint) - "inferior-caml" (car cmdlist) nil (cdr cmdlist))) - (inferior-caml-mode))) - (setq caml-shell-active t) - (inferior-caml-show-subshell)) + (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))) @@ -79,25 +132,54 @@ Input and output via buffer `*inferior-caml*'." (defun inferior-caml-show-subshell () (interactive) - (display-buffer "*inferior-caml*")) + (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 4) + (not (equal (buffer-name (current-buffer)) + inferior-caml-buffer-name))) + (goto-next-window) + (setq count (+ count 1))) + (if (equal (buffer-name (current-buffer)) + inferior-caml-buffer-name) + (end-of-buffer)) + (while + (> count 0) + (goto-previous-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-window-excursion - (if (not (bufferp (get-buffer "*inferior-caml*"))) - (call-interactively 'run-caml))) - (comint-send-region "*inferior-caml*" start end) - (comint-send-string "*inferior-caml*" ";;\n") - (if (not (get-buffer-window "*inferior-caml*" t)) - (display-buffer "*inferior-caml*"))) + (interactive "r") + (save-excursion (caml-run-process-if-needed)) + (save-excursion + (comint-send-region inferior-caml-buffer-name start end) + (goto-char end) + (skip-chars-backward " \t\n") + ;; normally, ";;" are part of the region + (if (not (and (>= (point) 2) + (prog2 (backward-char 2) (looking-at ";;")))) + (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*")) + (set-buffer (get-buffer inferior-caml-buffer-name)) (re-search-backward (concat comint-prompt-regexp "[ \t]*Characters[ \t]+\\([0-9]+\\)-[0-9]+:$")) @@ -105,6 +187,188 @@ Input and output via buffer `*inferior-caml*'." (goto-char loc))) -;;; inf-caml.el ends here +;;; orgininal inf-caml.el ended here + +;;; 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 of Ocaml appar literals and comments, so it should work +;; with other dialects as long as ;; marks the end of phrase. + +(defun caml-find-phrase (&optional min-pos max-pos) + "Find the CAML phrase containing the point. +Return the positin of the beginning of the phrase, and move point +to the end. +" + (interactive) + (while + (and (search-backward ";;" min-pos 'move) + (or (caml-in-literal-p) + (and caml-last-comment-start (caml-in-comment-p))) + )) + (if (looking-at ";;") (forward-char 2)) + (caml-skip-blank-forward) + (let ((beg (point))) + (while + (and (search-forward ";;" max-pos 1) + (or (caml-in-literal-p) + (and caml-last-comment-start (caml-in-comment-p))) + )) + (if (eobp) (newline)) + beg)) + +;; 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)) + (comint-send-string inferior-caml-buffer-name "\n") + ) + 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) (error)) + (save-window-excursion + (while (and (> arg 0) (not error)) + (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 (+ orig (string-to-int (caml-match-string 1)))) + (setq end (+ orig (string-to-int (caml-match-string 2)))) + (switch-to-buffer buf) + (goto-char beg) + (setq error 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 error 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 error beg)) + (t + (switch-to-buffer buf))) + (setq arg (- arg 1)) + ) + (pop-to-buffer inferior-caml-buffer-name) + (if error + (goto-char (point-max)) + (goto-char previous-output) + (goto-char (point-max))) + (pop-to-buffer buf)) + (if error (progn (beep) (caml-overlay-region (point) end)) + (if inferior-caml-output + (message "No error") + (message "No output yet...") + )) + error))) + +(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) |