[nongnu] externals/caml 42d2eda 126/197: Fixed caml-help (would loose the position of the symbol search for).

[Stefan Monnier]

branch: externals/caml
commit 42d2eda8cdefc40f1b341c89b0363d3d7ea16e5e
Author: Didier Rémy <Didier.Remy@inria.fr>
Commit: Didier Rémy <Didier.Remy@inria.fr>

    Fixed caml-help (would loose the position of the symbol search for).
    Added highlighting of the symbol searched for.
    
    
    git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10608 
f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 caml-help.el  | 34 ++++++++++++++++++++++++++------
 caml-types.el | 63 ++++++++++++++++++++++++++++++++++++++---------------------
 2 files changed, 69 insertions(+), 28 deletions(-)

diff --git a/caml-help.el b/caml-help.el
index 2adba67..59d8a3b 100644
--- a/caml-help.el
+++ b/caml-help.el
@@ -199,7 +199,7 @@
               (insert-file-contents file))
           (message "Module %s not found" module))
         (while (re-search-forward
-                "\\([ \t]*val\\|let\\|external\\|  [|]\\) 
\\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)\\|^  *[{]* \\([a-z_][A-Za-z_0-9]*\\) : 
[^;\n][^;\n]*;"
+                "\\([ \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)))
@@ -606,14 +606,18 @@ current buffer using \\[ocaml-qualified-identifier]."
       )
     (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\\|[|{;]\\) +"
-                           (regexp-quote entry))
+                           regex)
+                   ;; (concat "\\(val\\|exception\\|external\\) +\\("
+                   ;;         regex "\\|( *" regex " *)\\)")
                    (point-max) t)
                   (re-search-forward
-                   (concat "type [^{]*{[^}]*" (regexp-quote entry) " :")
+                   (concat "type [^{]*{[^}]*" regex " :")
+                   ;; (concat "\\(type\\|[|{;]\\) +" regex)
                    (point-max) t)
                   (progn
                     (if (window-live-p window) (select-window window))
@@ -621,7 +625,7 @@ current buffer using \\[ocaml-qualified-identifier]."
                            entry module))
                   ;; (search-forward entry (point-max) t)
                   )
-              (recenter 1)
+              (ocaml-help-show -1)
             (progn
               (message "Help for entry %s not found in module %s"
                        entry module)
@@ -656,6 +660,7 @@ Prefix arg 4 prompts for Module and identifier instead of 
guessing values
 from the possition of point in the current buffer.
 "
   (interactive "p")
+  (delete-overlay ocaml-help-ovl)
   (let ((module) (entry) (module-entry))
     (cond
      ((= arg 4)
@@ -669,7 +674,8 @@ from the possition of point in the current buffer.
              (mapcar 'list
                      (ocaml-module-symbols
                       (assoc module (ocaml-module-alist))))))
-        (setq entry (completing-read "Value: " symbols nil t)))
+        (setq entry
+              (completing-read (format "Value: %s." module) symbols nil t)))
       (if (string-equal entry "") (setq entry nil))
       )
      (t
@@ -740,6 +746,22 @@ buffer positions."
 (defvar ocaml-link-map (make-sparse-keymap))
 (define-key ocaml-link-map [mouse-2] 'ocaml-link-goto)
 
+(defvar ocaml-help-ovl (make-overlay 1 1))
+(make-face 'ocaml-help-face)
+(set-face-doc-string 'ocaml-help-face
+                     "face for hilighting expressions and types")
+(if (not (face-differs-from-default-p 'ocaml-help-face))
+    (set-face-background 'ocaml-help-face "#88FF44"))
+(overlay-put ocaml-help-ovl 'face 'ocaml-help-face)
+
+(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)
   (interactive "e")
   (let* ((pos (caml-event-point-start click))
@@ -761,7 +783,7 @@ buffer positions."
       (if (setq link (assoc link (cdr ocaml-links)))
           (progn
             (goto-char (cadr link))
-            (recenter 1)))
+            (ocaml-help-show 1)))
       (if (window-live-p window) (select-window window))
       )))
 
diff --git a/caml-types.el b/caml-types.el
index 05b1a2c..33bc562 100644
--- a/caml-types.el
+++ b/caml-types.el
@@ -326,10 +326,11 @@ See `caml-types-location-re' for annotation file format.
   (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)))
+    (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...")
@@ -338,30 +339,47 @@ See `caml-types-location-re' for annotation file format.
                     (widen)
                     (goto-char (point-min))
                     (caml-types-build-tree
-                     (file-name-nondirectory target-path)))))
+                     ; (file-name-nondirectory type-path)
+                     type-path
+                     ))))
         (setq caml-types-annotation-tree tree
               caml-types-annotation-date type-date)
         (kill-buffer type-buf)
         (message "done"))
       )))
 
+(defun caml-types-annot-sibling-file (sibling)
+  (message "?: %S" sibling)
+  (let ((sibling-gz (concat sibling ".gz")))
+    (if (file-exists-p sibling)
+        (if (file-newer-than-file-p sibling sibling-gz)
+            sibling sibling-gz)
+      (if (file-exists-p sibling-gz) sibling-gz nil)
+    )))
+
+
+(defun parent-dir (d) (file-name-directory (directory-file-name d)))
+
 (defun caml-types-locate-type-file (target-path)
- (let ((sibling (concat (file-name-sans-extension target-path) ".annot")))
-   (if (file-exists-p sibling)
-       sibling
-     (defun parent-dir (d) (file-name-directory (directory-file-name d)))
-     (let ((project-dir (file-name-directory sibling))
-           type-path)
-       (while (not (file-exists-p
-                    (setq type-path
-                          (expand-file-name
-                           (file-relative-name sibling project-dir)
-                           (expand-file-name "_build" project-dir)))))
-         (if (equal project-dir (parent-dir project-dir))
-             (error (concat "No annotation file. "
-                            "You should compile with option \"-annot\".")))
-         (setq project-dir (parent-dir project-dir)))
-       type-path))))
+  (let ((sibling (concat (file-name-sans-extension target-path) ".annot"))
+        (found))
+    (if (setq found (caml-types-annot-sibling-file sibling))
+        found
+      (let ((project-dir (file-name-directory sibling))
+            type-path type-path-gz)
+        (while (not
+                (setq found
+                      (caml-types-annot-sibling-file
+                       (setq type-path
+                             (expand-file-name
+                              (file-relative-name sibling project-dir)
+                              (expand-file-name "_build" project-dir))))
+                      ))
+          (if (equal project-dir (parent-dir project-dir))
+              (error (concat "No annotation file found. "
+                             "You should compile with option \"-annot\".")))
+          (setq project-dir (parent-dir project-dir)))
+        found))))
 
 (defun caml-types-date< (date1 date2)
   (or (< (car date1) (car date2))
@@ -573,7 +591,8 @@ See `caml-types-location-re' for annotation file format.
    (t
     (error (format "Can't read the annotation file `%s'" name)))
     )
-  buf))
+  buf)
+)
 
 (defun caml-types-mouse-ignore (event)
   (interactive "e")