[nongnu] externals/caml d2f1cc7 052/197: better interaction with toplevel

[Stefan Monnier]

branch: externals/caml
commit d2f1cc7bc57e6a1ecb4a2af8696b1d8b720a74c1
Author: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>
Commit: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>

    better interaction with toplevel
    
    
    git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4565 
f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 caml.el     | 257 ++++++++++++++++++++++++++++++------------------------------
 inf-caml.el |  48 +++++++-----
 2 files changed, 156 insertions(+), 149 deletions(-)

diff --git a/caml.el b/caml.el
index 7ed7348..36d9d1c 100644
--- a/caml.el
+++ b/caml.el
@@ -15,9 +15,6 @@
 (defvar caml-imenu-enable nil
   "*Enable Imenu support.")
 
-(defvar caml-olabl-enable nil
-  "*Enable O'Labl support")
-
 (defvar caml-mode-indentation 2
   "*Used for \\[caml-unindent-command].")
 
@@ -260,10 +257,10 @@ have caml-electric-indent on, which see.")
     (require 'caml-compat))
 
 (defvar caml-shell-active nil
-  "*Non nil when a subshell is running.")
+  "Non nil when a subshell is running.")
 
-;; is it really ok ? Conform to Xemacs definition
-(if (not (boundp 'running-xemacs)) (setq running-xemacs nil))
+(defvar running-xemacs nil
+  "Non nil when using xemacs.")
 
 (defvar caml-mode-map nil
   "Keymap used in Caml mode.")
@@ -370,8 +367,6 @@ have caml-electric-indent on, which see.")
   ; quote and underscore are part of words
   (modify-syntax-entry ?' "w" caml-mode-syntax-table)
   (modify-syntax-entry ?_ "w" caml-mode-syntax-table)
-  ; : is part of words (labels) in O'Labl
-  (if caml-olabl-enable (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)
@@ -391,6 +386,39 @@ have caml-electric-indent on, which see.")
   (define-abbrev caml-mode-abbrev-table "then" "then" 'caml-abbrev-hook)
   (define-abbrev caml-mode-abbrev-table "with" "with" 'caml-abbrev-hook))
 
+;; Other internal variables
+
+(defvar caml-last-noncomment-pos nil
+  "Caches last buffer position determined not inside a caml comment.")
+(make-variable-buffer-local 'caml-last-noncomment-pos)
+
+;;last-noncomment-pos can be a simple position, because we nil it
+;;anyway whenever buffer changes upstream. last-comment-start and -end
+;;have to be markers, because we preserve them when the changes' end
+;;doesn't overlap with the comment's start.
+
+(defvar caml-last-comment-start nil
+  "A marker caching last determined caml comment start.")
+(make-variable-buffer-local 'caml-last-comment-start)
+
+(defvar caml-last-comment-end nil
+  "A marker caching last determined caml comment end.")
+(make-variable-buffer-local 'caml-last-comment-end)
+
+(make-variable-buffer-local 'before-change-function)
+
+(defvar caml-imenu-shown nil
+  "True if we have computed definition list.")
+(make-variable-buffer-local 'caml-imenu-shown)
+
+(defconst caml-imenu-search-regexp
+  (concat "\\<in\\>\\|"
+          "^[ \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 (and (boundp 'running-xemacs) running-xemacs) nil
@@ -452,8 +480,6 @@ have caml-electric-indent on, which see.")
     (setq imenu-create-index-function 'caml-create-index-function)
     (make-local-variable 'imenu-generic-expression)
     (setq imenu-generic-expression caml-imenu-search-regexp)
-    (make-local-variable 'caml-imenu-shown)
-    (setq caml-imenu-shown nil)
     (if (and caml-imenu-enable (< (buffer-size) 10000))
         (caml-show-imenu)))
   (run-hooks 'caml-mode-hook))
@@ -509,11 +535,11 @@ should lies."
 With prefix arg, evaluate past the whole buffer, no stopping at
 the current point."
   (interactive "p")
-  (let ((here (point)) ((error))
+  (let ((here (point)) err)
     (goto-char (point-min))
-    (setq error
-          (caml-eval-phrase 500 (point-min) (if arg (point-max) here))))
-    (if error (set-mark (error)))
+    (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 ()
@@ -530,13 +556,6 @@ the current point."
   (imenu-add-to-menubar "Defs")
   (setq caml-imenu-shown t))
 
-(defconst caml-imenu-search-regexp
-  (concat "\\<in\\>\\|"
-          "^[ \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_']*\\)"))
 (defun caml-prev-index-position-function ()
   (let (found data)
     (while (and (setq found
@@ -789,52 +808,72 @@ whole string."
        (or (looking-at "#")
            (looking-at caml-phrase-start-keywords))))
 
-(defun caml-mark-phrase ()
-  "Put mark at end of this Caml phrase, point at beginning.
+(defun caml-skip-comments-forward ()
+  (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")))
 
-The Caml phrase is the phrase just before the point.
-Completely rewritten by J. Garrigue, to handle both Objective Caml
-and Caml-Light syntax. \";;\" is left out of the region, and
-eventually added when sending to the subprocess."
+(defun caml-skip-comments-backward ()
+  (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.
+"
   (interactive)
-  (let (use-semi end)
-    (if (and (looking-at ";;") (not (caml-in-comment-p))) nil
+  (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
-                     (concat ";;\\|" caml-phrase-start-keywords) nil 'move)
+                   ((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 use-semi (looking-at ";;"))
-    (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"))
-    (push-mark)
-    (setq end (point))
-    (cond
-     (use-semi
-      (if (caml-find-kwop ";;") (forward-char 2)
-        (goto-char (point-min)))
-      (skip-chars-forward " \n\t")
-      (while (or (looking-at comment-start-skip) (caml-in-comment-p))
-        (if (= (following-char) ?\)) (forward-char)
-          (search-forward comment-end))
-        (skip-chars-forward " \n\t")))
-     (t
-      (if (not (caml-find-kwop caml-phrase-start-keywords))
-          (error "No phrase preceding point"))
-      (while (and (or (not (bolp))
-                      (caml-in-comment-p)
-                      (caml-in-literal-p))
-                  (caml-find-kwop caml-phrase-start-keywords)))))
-    (cons (point) end)))
+        (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 (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 Caml phrase, point at beginning.
+"
+  (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 ()
   (save-excursion
@@ -854,25 +893,6 @@ eventually added when sending to the subprocess."
       (re-search-forward "\\(\\sw\\|\\s_\\)+")
       (match-string 0))))
 
-(defvar caml-last-noncomment-pos nil
-  "Caches last buffer position determined not inside a caml comment.")
-(make-variable-buffer-local 'caml-last-noncomment-pos)
-
-;;last-noncomment-pos can be a simple position, because we nil it
-;;anyway whenever buffer changes upstream. last-comment-start and -end
-;;have to be markers, because we preserve them when the changes' end
-;;doesn't overlap with the comment's start.
-
-(defvar caml-last-comment-start nil
-  "A marker caching last determined caml comment start.")
-(make-variable-buffer-local 'caml-last-comment-start)
-
-(defvar caml-last-comment-end nil
-  "A marker caching last determined caml comment end.")
-(make-variable-buffer-local 'caml-last-comment-end)
-
-(make-variable-buffer-local 'before-change-function)
-
 (defun caml-overlap (b1 e1 b2 e2)
   (<= (max b1 b2) (min e1 e2)))
 
@@ -1006,6 +1026,8 @@ Returns nil for the parenthesis openning a comment."
             (set-marker caml-last-comment-end (point)))
           begin))))))
 
+;; Various constants and regexps
+
 (defconst caml-before-expr-prefix
   (concat "\\<\\(asr\\|begin\\|class\\|do\\(wnto\\)?\\|else"
           "\\|i\\(f\\|n\\(herit\\|itializer\\)?\\)"
@@ -1018,6 +1040,31 @@ Returns nil for the parenthesis openning a comment."
   "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\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)"
+   "\\|with\\)\\>\\|[^[|]|")
+  "Regexp used in caml mode for skipping back over nested blocks.")
+
+(defconst caml-matching-kw-alist
+  '(("|" . caml-find-pipe-match)
+    (";" . caml-find-semi-match)
+    ("," . caml-find-comma-match)
+    ("end" . caml-find-end-match)
+    ("done" . caml-find-done-match)
+    ("in"  . caml-find-in-match)
+    ("with" . caml-find-with-match)
+    ("else" . caml-find-else-match)
+    ("then" . caml-find-then-match)
+    ("to" . caml-find-done-match)
+    ("do" . caml-find-done-match)
+    ("and" . caml-find-and-match))
+
+  "Association list used in caml mode for skipping back over nested blocks.")
+
+(defconst caml-kwop-regexps (make-vector 9 nil)
+  "Array of regexps representing caml keywords of different priorities.")
+
 (defun caml-in-expr-p ()
   (let ((pos (point)) (in-expr t))
     (caml-find-kwop
@@ -1044,8 +1091,9 @@ Used to distinguish it from toplevel let construct.")
       (char-equal ?\] (following-char))
       (char-equal ?} (following-char))))
 
-(defun caml-find-kwop (kwop-regexp)
+(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 occurences inside literals. If found, return a list of two
 values: the actual text of the keyword or operator, and a boolean
@@ -1056,16 +1104,16 @@ keywords."
   (let ((start-literal (concat "[\"" caml-quote-char "]"))
         found kwop)
     (while (and (> (point) 1) (not found)
-                (re-search-backward kwop-regexp nil 'move))
+                (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 "(" nil 'move))
+        (search-backward "(" min-pos 'move))
        ((looking-at start-literal))
        ((caml-in-literal-p)
-        (re-search-backward start-literal nil 'move))  ;ugly hack
+        (re-search-backward start-literal min-pos 'move))  ;ugly hack
        ((setq found t))))
     (if found
         (if (not (string-match "\\`[^|[]|[^]|]?\\'" kwop)) ;arrrrgh!!
@@ -1139,9 +1187,6 @@ the line where the governing keyword occurs.")
 ;;additional field in caml-kwop-alist. That proved way too slow,
 ;;although I still can't understand why. itz
 
-(defconst caml-kwop-regexps (make-vector 9 nil)
-  "Array of regexps representing caml keywords of different priorities.")
-
 (aset caml-kwop-regexps 0
       (concat
        "\\<\\(begin\\|object\\|for\\|s\\(ig\\|truct\\)\\|while\\)\\>"
@@ -1305,28 +1350,6 @@ the line where the governing keyword occurs.")
 (defun caml-find-comma-match ()
   (caml-find-kwop-skipping-blocks 3))
 
-(defconst caml-matching-kw-regexp
-  (concat
-   "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in\\|t\\(hen\\|o\\)"
-   "\\|with\\)\\>\\|[^[|]|")
-  "Regexp used in caml mode for skipping back over nested blocks.")
-
-(defconst caml-matching-kw-alist
-  '(("|" . caml-find-pipe-match)
-    (";" . caml-find-semi-match)
-    ("," . caml-find-comma-match)
-    ("end" . caml-find-end-match)
-    ("done" . caml-find-done-match)
-    ("in"  . caml-find-in-match)
-    ("with" . caml-find-with-match)
-    ("else" . caml-find-else-match)
-    ("then" . caml-find-then-match)
-    ("to" . caml-find-done-match)
-    ("do" . caml-find-done-match)
-    ("and" . caml-find-and-match))
-
-  "Association list used in caml mode for skipping back over nested blocks.")
-
 (defun caml-find-kwop-skipping-blocks (prio)
   "Look back for a caml keyword matching caml-kwop-regexps [PRIO].
 
@@ -1631,28 +1654,6 @@ by |, insert one."
 ;; knows little about Ocaml appart 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))
-
 (defun caml-indent-phrase (arg)
   "Indent current phrase
 with prefix arg, indent that many phrases starting with the current phrase."
@@ -1806,7 +1807,7 @@ with prefix arg, indent that many phrases starting with 
the current phrase."
     (beginning-of-line 1)
     (backward-char 4)))
 
-(autoload 'run-caml "inf-caml.el")
+(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
 
 ;;; caml.el ends here
 
diff --git a/inf-caml.el b/inf-caml.el
index 77b9b6a..357d1f5 100644
--- a/inf-caml.el
+++ b/inf-caml.el
@@ -11,7 +11,7 @@
 
 ;; Whether you want the output buffer to be diplayed when you send a phrase
 
-(defvar caml-display-when-eval nil
+(defvar caml-display-when-eval t
   "*If true, display the inferior caml buffer when evaluating expressions.")
 
 
@@ -102,6 +102,7 @@ be sent from another buffer in Caml mode.
       (inferior-caml-mode)
       (display-buffer inferior-caml-buffer-name)
       t)
+    (setq caml-shell-active t)
     ))
 
 ;; patched to from original run-caml sharing code with
@@ -140,17 +141,17 @@ Input and output via buffer `*inferior-caml*'."
         (caml-buf  (get-buffer inferior-caml-buffer-name))
         (count 0))
     (while
-        (and (< count 4)
+        (and (< count 10)
              (not (equal (buffer-name (current-buffer))
                          inferior-caml-buffer-name)))
-      (goto-next-window)
+      (next-multiframe-window)
       (setq count (+ count 1)))
     (if  (equal (buffer-name (current-buffer))
                 inferior-caml-buffer-name)
         (end-of-buffer))
     (while
         (> count 0)
-      (goto-previous-window)
+      (previous-multiframe-window)
       (setq count (- count 1)))
     )
 )
@@ -164,7 +165,7 @@ Input and output via buffer `*inferior-caml*'."
   (save-excursion
     (comint-send-region inferior-caml-buffer-name start end)
     (goto-char end)
-    (skip-chars-backward " \t\n")
+    (caml-skip-comments-backward)
     ;; normally, ";;" are part of the region
     (if (not (and (>= (point) 2)
                  (prog2 (backward-char 2) (looking-at ";;"))))
@@ -237,9 +238,9 @@ should lies."
   (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))
+          previous-output orig beg end err)
       (save-window-excursion
-        (while (and (> arg 0) (not error))
+        (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)
@@ -250,11 +251,16 @@ should lies."
           (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))))
+                (setq beg (string-to-int (caml-match-string 1)))
+                 (setq end (string-to-int (caml-match-string 2)))
                  (switch-to-buffer buf)
-                 (goto-char beg)
-                 (setq error beg)
+                (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")
@@ -269,7 +275,7 @@ should lies."
                     (- orig 10))
                    (goto-char (+ (match-beginning 0) column))
                    (setq end (+ (point) width)))
-                 (setq error beg))
+                 (setq err beg))
                 ((looking-at
                   "Toplevel 
input:\n>[.]*\\([^.].*\n\\)\\([>].*\n\\)*[>]\\(.*[^.]\\)[.]*\n")
                  (let* ((e1 (caml-match-string 1))
@@ -280,23 +286,23 @@ should lies."
                    (switch-to-buffer buf)
                    (re-search-backward expr orig 'move)
                    (setq end (match-end 0)))
-                 (setq error beg))
+                 (setq err beg))
                 (t
                  (switch-to-buffer buf)))
           (setq arg (- arg 1))
           )
         (pop-to-buffer inferior-caml-buffer-name)
-        (if error
+        (if err
             (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 err (progn (beep) (caml-overlay-region (point) end))
         (if inferior-caml-output
             (message "No error")
           (message "No output yet...")
           ))
-      error)))
+      err)))
 
 (defun caml-overlay-region (beg end &optional wait)
   (interactive "%r")
@@ -333,11 +339,11 @@ should lies."
 
 ;; 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)
+;(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)