compatibilite emacs 20 + fichiers read-only

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5802 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Author: Damien Doligez

emacs/Makefile

@@ -19,11 +19,11 @@ 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-xemacs.el") \
               (byte-compile-file "camldebug.el"))
 
 install:

emacs/caml-emacs.el

@@ -10,6 +10,5 @@
 (defun caml-event-point-end (e) (posn-point (event-end e)))
 (defalias 'caml-track-mouse 'track-mouse)
 (defalias 'caml-read-event 'read-event)
-(defun caml-mouse-movement-p mouse-mouvement)
 
 (provide 'caml-emacs)

emacs/caml-types.el

@@ -176,20 +176,27 @@ See `caml-types-location-re' for annotation file format.
       (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)))
+
+
 ; tree of intervals
 ; each node is a vector
 ; [ pos-left pos-right type-info child child child... ]
 ; type-info =
 ;  () if this node does not correspond to an annotated interval
 ;  (type-start . type-end)  address of the annotation in the .annot file
 
-(defun caml-types-hcons (elem table)
-  (or (cl-gethash elem table) (cl-puthash elem elem table) elem))
-
 (defun caml-types-build-tree (target-file)
   (let ((stack ())
         (accu ())
-        (table (make-hash-table :test 'equal))
+        (table (caml-types-make-hash-table))
         (type-info ()))
     (while (re-search-forward caml-types-location-re () t)
       (let ((l-file (file-name-nondirectory (match-string 1)))
@@ -389,9 +396,9 @@ and its type is displayed in the minibuffer, until the move is released."
                                         ; (message "Drag the mouse to explore types")
     (unwind-protect
         (caml-track-mouse
-         (setq region (caml-types-typed-region
-                       target-buf
-                       (caml-event-point-start event)))
+         ;(setq region (caml-types-typed-region
+         ;              target-buf
+         ;              (caml-event-point-start event)))
          (while (and event
                      (integer-or-marker-p
                       (setq cnum (caml-event-point-end event))))
@@ -430,8 +437,8 @@ and its type is displayed in the minibuffer, until the move is released."
            )
          )
       (delete-overlay caml-types-expr-ovl)
-      (if unlocked (font-lock-mode 1)
-        (remove-text-properties (car region) (cdr region) '(face)))
+      ;(if unlocked (font-lock-mode 1)
+      ;  (remove-text-properties (car region) (cdr region) '(face)))
       )))
 
 (defun caml-types-typed-region (target-buf pos)