emacs/external/ml/caml-help.el

   1 ;(***********************************************************************)
   2 ;(*                                                                     *)
   3 ;(*                           Objective Caml                            *)
   4 ;(*                                                                     *)
   5 ;(*            Didier Remy, projet Cristal, INRIA Rocquencourt          *)
   6 ;(*                                                                     *)
   7 ;(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   8 ;(*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 ;(*  under the terms of the GNU General Public License.                 *)
  10 ;(*                                                                     *)
  11 ;(***********************************************************************)
  12
  13 ;(* $Id$ *)
  14
  15 ;; caml-info.el --- contextual completion and help to caml-mode
  16
  17 ;; Didier Remy, November 2001.
  18
  19 ;; This provides two functions completion and help
  20 ;; look for caml-complete and caml-help
  21
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;  This is a preliminary version.
  25 ;;
  26 ;;  Possible improvements?
  27 ;;   - dump some databaes: Info, Lib, ...
  28 ;;   - accept a search path for local libraries instead of current dir
  29 ;;     (then distinguish between different modules lying in different
  30 ;;     directories)
  31 ;;   - improve the construction for info files.
  32 ;;
  33 ;;  Abstract over
  34 ;;   - the viewing method and the database, so that the documentation for
  35 ;;     and identifier could be search in
  36 ;;       * info / html / man / mli's sources
  37 ;;       * viewed in emacs or using an external previewer.
  38 ;;
  39 ;;  Take all identifiers (labels, Constructors, exceptions, etc.)
  40 ;;
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42
  43
  44 (eval-and-compile
  45   (if (and (boundp 'running-xemacs) running-xemacs)
  46       (require 'caml-xemacs)
  47     (require 'caml-emacs)))
  48
  49 ;; Loading or building databases.
  50 ;;
  51
  52 ;; variables to be customized
  53
  54 (defvar ocaml-lib-path 'lazy
  55   "Path list for ocaml lib sources (mli files)
  56
  57 'lazy means ask ocaml to find it for your at first use.")
  58 (defun ocaml-lib-path ()
  59   "Computes if necessary and returns the path for ocaml libs"
  60   (if (listp ocaml-lib-path) nil
  61     (setq ocaml-lib-path
  62           (split-string
  63            (shell-command-to-string
  64             (or
  65              (and (boundp 'inferior-caml-program)
  66                       (string-match "\\([^ ]*/ocaml\\)\\( \\|$\\)"
  67                        inferior-caml-program)
  68                       (let ((file
  69                              (concat (match-string 1 inferior-caml-program)
  70                                      "c")))
  71                         (and (file-executable-p file)
  72                              (concat file " -where"))))
  73              "ocamlc -where")))))
  74     ocaml-lib-path)
  75
  76
  77
  78 ;; General purpose auxiliary functions
  79
  80 (defun ocaml-capitalize (s)
  81   (concat (capitalize (substring s 0 1)) (substring s 1)))
  82
  83 (defun ocaml-uncapitalize (s)
  84   (if (> (length s) 0)
  85       (concat (downcase (substring s 0 1)) (substring s 1))
  86     s))
  87
  88 (defun iter (f l) (while (consp l) (apply f (list (car l))) (setq l (cdr l))))
  89
  90 (defun ocaml-find-files (path filter &optional depth split)
  91   (let* ((path-string
  92           (if (stringp path)
  93               (if (file-directory-p path) path nil)
  94             (mapconcat '(lambda (d) (if (file-directory-p d) d))
  95                        path " ")))
  96          (command
  97           (and path-string
  98                (concat "find " path-string
  99                        " '(' " filter " ')' "
 100                        (if depth (concat " -maxdepth " (int-to-string depth)))
 101                        (if split nil " -printf '%\p '")
 102                        )))
 103           (files
 104            (and command (shell-command-to-string command))))
 105          (if (and split (stringp files)) (split-string files "\n") files)
 106          ))
 107
 108 ;; Specialized auxiliary functions
 109
 110
 111 ;; Global table of modules contents of modules loaded lazily.
 112
 113 (defvar ocaml-module-alist 'lazy
 114   "A-list of modules with how and where to find help information.
 115   'delay means non computed yet")
 116
 117 (defun ocaml-add-mli-modules (modules tag &optional path)
 118   (let ((files
 119          (ocaml-find-files (or path (ocaml-lib-path))
 120                            "-type f -name '*.mli'" 1 t)))
 121     (while (consp files)
 122       (if (string-match "\\([^/]*\\).mli" (car files))
 123           (let* ((module (ocaml-capitalize (match-string 1 (car files))))
 124                  (dir (file-name-directory (car files)))
 125                  (dirp (member dir (ocaml-lib-path))))
 126             (if (and (consp dirp) (string-equal dir (car dirp)))
 127                 (setq dir (car dirp)))
 128             (if (assoc module modules) nil
 129               (setq modules
 130                     (cons (cons module (cons (cons tag dir) 'lazy)) modules))
 131               )))
 132       (setq files (cdr files)))
 133     modules))
 134
 135 (defun ocaml-add-path (dir &optional path)
 136   "Extend  ocaml-module-alist with modules of DIR relative to PATH"
 137   (interactive "D")
 138   (let* ((old (ocaml-lib-path))
 139          (new
 140           (if (file-name-absolute-p dir) dir
 141             (concat
 142              (or (find-if '(lambda (p) (file-directory-p (concat p  "/" dir)))
 143                       (cons default-directory old))
 144                  (error "Directory not found"))
 145              "/" dir))))
 146     (setq ocaml-lib-path (cons (car old) (cons new (cdr old))))
 147     (setq ocaml-module-alist
 148           (ocaml-add-mli-modules (ocaml-module-alist) 'lib new))))
 149
 150 (defun ocaml-module-alist ()
 151   "Call by need value of variable ocaml-module-alist"
 152   (if (listp ocaml-module-alist)
 153       nil
 154     ;; build list of mli files
 155     (setq ocaml-module-alist (ocaml-add-mli-modules nil 'lib))
 156     ;; dumping information ? TODO
 157     )
 158   ocaml-module-alist)
 159
 160 (defun ocaml-get-or-make-module (module &optional tag)
 161   (let ((info (assoc module (ocaml-module-alist))))
 162     (if info nil
 163       (setq info (cons module (cons (cons 'local default-directory) 'lazy)))
 164       (setq ocaml-module-alist (cons info ocaml-module-alist))
 165       )
 166     info))
 167
 168 ;; Symbols of module are lazily computed
 169
 170 (defun ocaml-module-filename (module)
 171   (let ((module (ocaml-uncapitalize module)) (name))
 172     (if (file-exists-p (setq name (concat module ".mli"))) nil
 173       (let ((tmp (ocaml-lib-path)))
 174         (while (consp tmp)
 175           (setq name (concat (car tmp) "/" module ".mli"))
 176           (if (file-exists-p name) (setq tmp nil)
 177             (setq name nil)))))
 178     name))
 179
 180 (defun ocaml-module-symbols (module-info)
 181   (let* ((module (car module-info))
 182          (tail (and module-info (cdr module-info)))
 183          (tag (caar tail))
 184          (dir (cdar tail))
 185          (file)
 186          (alist))
 187     (if (listp (cdr tail))
 188         (cdr tail)
 189       (if (equal tag 'info)
 190           (setq dir (car ocaml-lib-path)) ; XXX to be fixed
 191         )
 192       (setq file (concat dir "/" (ocaml-uncapitalize module) ".mli"))
 193       (message file)
 194       (save-window-excursion
 195         (set-buffer (get-buffer-create "*caml-help*"))
 196         (if (and file (file-exists-p file))
 197             (progn
 198               (message "Scanning module %s" file)
 199               (insert-file-contents file))
 200           (message "Module %s not found" module))
 201         (while (re-search-forward
 202                 "\\([ \t]*val\\|let\\|external\\|  [|]\\) \\([a-zA-Z_0-9'][a-zA-Z_0-9']*\\)\\|^  *[{]* \\([a-z_][A-Za-z_0-9]*\\) : [^;\n][^;\n]*;"
 203                 (point-max) 'move)
 204           (pop-to-buffer (current-buffer))
 205           (setq alist (cons (or (match-string 2) (match-string 3)) alist)))
 206         (erase-buffer)
 207         )
 208       (setcdr tail alist)
 209       alist)
 210       ))
 211
 212 ;; Local list of visible modules.
 213
 214 (defvar ocaml-visible-modules 'lazy
 215   "A-list of open modules, local to every file.")
 216 (make-variable-buffer-local 'ocaml-visible-modules)
 217 (defun ocaml-visible-modules ()
 218   (if (listp ocaml-visible-modules) nil
 219     (progn
 220       (setq ocaml-visible-modules
 221             (list (ocaml-get-or-make-module "Pervasives")))
 222       (save-excursion
 223         (goto-char (point-min))
 224         (while (re-search-forward "^ *open  *\\([A-Z][a-zA-Z'_0-9]*\\)"
 225                                   (point-max) t)
 226           (let ((module (match-string 1)))
 227             (if (assoc module ocaml-visible-modules) nil
 228               (setq ocaml-visible-modules
 229                     (cons (ocaml-get-or-make-module module)
 230                           ocaml-visible-modules)))))
 231         )))
 232   ocaml-visible-modules)
 233
 234 (defun ocaml-open-module (arg)
 235   "*Make module of name ARG visible whe ARG is a string.
 236 When call interactively, make completion over known modules."
 237   (interactive "P")
 238   (if (not (stringp arg))
 239       (let ((modules (ocaml-module-alist)))
 240         (setq arg
 241               (completing-read "Open module: " modules))))
 242   (if (and (stringp arg) (not (equal arg "")))
 243       (progn
 244         (if (assoc arg (ocaml-visible-modules))
 245             (ocaml-close-module arg))
 246         (setq ocaml-visible-modules
 247               (cons (ocaml-get-or-make-module arg) (ocaml-visible-modules)))
 248         ))
 249   (message "%S" (mapcar 'car (ocaml-visible-modules))))
 250
 251 (defun ocaml-close-module (arg)
 252   "*Close module of name ARG when ARG is a string.
 253 When call interactively, make completion over visible modules.
 254 Otherwise if ARG is true, close all modules and reset to default. "
 255   (interactive "P")
 256   (if (= (prefix-numeric-value arg) 4)
 257       (setq ocaml-visible-modules 'lazy)
 258     (let* ((modules (ocaml-visible-modules)))
 259       (if (null modules) (error "No visible module to close"))
 260       (unless (stringp arg)
 261         (setq arg
 262               (completing-read
 263                (concat "Close module ["  (caar modules) "] : ")
 264                modules))
 265         (if (equal arg "") (setq arg (caar modules))))
 266       (setq ocaml-visible-modules
 267             (remove-if '(lambda (m) (equal (car m) arg))
 268                        ocaml-visible-modules))
 269       ))
 270   (message "%S" (mapcar 'car (ocaml-visible-modules))))
 271
 272
 273 ;; Look for identifiers around point
 274
 275 (defun ocaml-qualified-identifier (&optional show)
 276   "Search for a qualified identifier (Path. entry) around point.
 277
 278 Entry may be nil.
 279 Currently, the path may only be nil or a single Module.
 280 For paths is of the form Module.Path', it returns Module
 281 and always nil for entry.
 282
 283 If defined Module and Entry are represented by a region in the buffer,
 284 and are nil otherwise.
 285
 286 For debugging purposes, it returns the string Module.entry if called
 287 with an optional non-nil argument.
 288 "
 289   (save-excursion
 290     (let ((module) (entry))
 291       (if (looking-at "[ \n]") (skip-chars-backward " "))
 292       (if (re-search-backward
 293            "\\([^A-Za-z0-9_.']\\|\\`\\)\\([A-Za-z0-9_']*[.]\\)*[A-Za-z0-9_']*\\="
 294            (- (point) 100) t)
 295           (progn
 296             (or (looking-at "\\`[A-Za-z)-9_.]") (forward-char 1))
 297             (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)[.]")
 298                 (progn
 299                   (setq module (cons (match-beginning 1) (match-end 1)))
 300                   (goto-char (match-end 0))))
 301             (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)\\>")
 302                 (setq entry (cons (match-beginning 1) (match-end 1))))))
 303       (if show
 304           (concat
 305            (and module (buffer-substring (car module) (cdr module)))
 306            "."
 307            (and entry (buffer-substring (car entry) (cdr entry))))
 308       (cons module entry))
 309     )))
 310
 311 ;; completion around point
 312
 313 (defun ocaml-completion (pattern module)
 314   (let ((list
 315          (or
 316           (and module
 317                (list
 318                 (or (assoc module (ocaml-module-alist))
 319                     (error "Unknown module %s" module))))
 320           (ocaml-visible-modules))))
 321     (message "Completion from %s" (mapconcat 'car list " "))
 322     (if (null pattern)
 323         (apply 'append (mapcar 'ocaml-module-symbols list))
 324       (let ((pat (concat "^" (regexp-quote pattern))) (res))
 325         (iter
 326          '(lambda (l)
 327             (iter '(lambda (x)
 328                      (if (string-match pat (car l))
 329                          (if (member x res) nil (setq res (cons x res)))))
 330                   (ocaml-module-symbols l)))
 331          list)
 332         res)
 333       )))
 334
 335 (defun caml-complete (arg)
 336   "Does completion for OCaml identifiers qualified.
 337
 338 It attemps to recognize an qualified identifier Module . entry
 339 around point using function \\[ocaml-qualified-identifier].
 340
 341 If Module is defined, it does completion for identifier in Module.
 342
 343 If Module is undefined, it does completion in visible modules.
 344 Then, if completion fails, it does completion among  all modules
 345 where identifier is defined."
 346   (interactive "p")
 347   (let* ((module-entry (ocaml-qualified-identifier)) (entry)
 348          (module)
 349          (beg) (end) (pattern))
 350     (if (car module-entry)
 351         (progn
 352           (setq module
 353                 (buffer-substring (caar module-entry) (cdar module-entry)))
 354           (or (assoc module (ocaml-module-alist))
 355               (and (setq module
 356                          (completing-read "Module: " (ocaml-module-alist)
 357                                           nil nil module))
 358                    (save-excursion
 359                      (goto-char (caar module-entry))
 360                      (delete-region (caar module-entry) (cdar module-entry))
 361                      (insert module) t)
 362                    (setq module-entry (ocaml-qualified-identifier))
 363                    (car module-entry)
 364                    (progn (setq entry (cdr module-entry)) t))
 365               (error "Unknown module %s" module))))
 366     (if (consp (cdr module-entry))
 367         (progn
 368           (setq beg (cadr module-entry))
 369           (setq end (cddr module-entry)))
 370       (if (and module
 371            (save-excursion
 372             (goto-char (cdar module-entry))
 373             (looking-at " *[.]")))
 374           (progn
 375             (setq beg (match-end 0))
 376             (setq end beg))))
 377     (if (not (and beg end))
 378         (error "Did not find anything to complete around point")
 379
 380       (setq pattern (buffer-substring beg end))
 381       (let* ((all-completions (ocaml-completion pattern module))
 382              (completion
 383               (try-completion pattern (mapcar 'list all-completions))))
 384         (cond ((eq completion t))
 385
 386               ((null completion)
 387                (let*
 388                    ((modules (ocaml-find-module pattern))
 389                     (visible (intersection modules (ocaml-visible-modules)))
 390                     (hist)
 391                     (module
 392                      (cond
 393                       ((null modules)
 394                        nil)
 395                       ((equal (length modules) 1)
 396                        (caar modules))
 397                       ((equal (length visible) 1)
 398                        (caar visible))
 399                       (t
 400                        (setq hist (mapcar 'car modules))
 401                        (completing-read "Module: " modules nil t
 402                                         "" (cons hist 0)))
 403                       )))
 404                  (if (null module)
 405                      (error "Can't find completion for \"%s\"" pattern)
 406                    (message "Completion found in module %s" module)
 407                    (if (and (consp module-entry) (consp (cdr module-entry)))
 408                        (delete-region (caar module-entry) end)
 409                      (delete-region beg end))
 410                    (insert module "." pattern))))
 411
 412               ((not (string-equal pattern completion))
 413                (delete-region beg end)
 414                (goto-char beg)
 415                (insert completion))
 416
 417               (t
 418                 (with-output-to-temp-buffer "*Completions*"
 419                   (display-completion-list all-completions))
 420                 ))
 421                ))))
 422
 423
 424 ;; Info files (only in ocamldoc style)
 425
 426
 427 (defvar ocaml-info-prefix "ocaml-lib"
 428   "Prefix of ocaml info files describing library modules.
 429 Suffix .info will be added to info files.
 430 Additional suffix .gz may be added if info files are compressed.
 431 ")
 432 ;;
 433
 434 (defun ocaml-hevea-info-add-entries (entries dir name)
 435   (let*
 436       ((filter
 437         (concat "-type f -regex '.*/" name
 438                 "\\(.info\\|\\)\\(-[0-9]*\\|\\)\\([.]gz\\|\\)'"
 439                 ))
 440        (section-regexp
 441         "\\* \\(Section [1-9][0-9--]*\\)::[ \t][ \t]*Module *\\([A-Z][A-Za-z_0-9]*\\)")
 442        (files (ocaml-find-files dir filter))
 443        (command))
 444     ;; scanning info files
 445     (if (or (null files)
 446             (not (stringp files))
 447             (string-match files "^ *$"))
 448         (message "No info file found: %s." (mapconcat 'identity files " "))
 449       (message "Scanning info files %s." files)
 450       (save-window-excursion
 451         (set-buffer (get-buffer-create "*caml-help*"))
 452         (setq command
 453               (concat "zcat -f " files
 454                       " | grep -e '" section-regexp "'"))
 455         (message "Scanning files with: %s" command)
 456         (or (shell-command command (current-buffer))
 457             (error "Error while scanning"))
 458         (goto-char (point-min))
 459         (while (re-search-forward section-regexp (point-max) t)
 460           (let* ((module (match-string 2))
 461                  (section (match-string 1)))
 462             ;; (message "%s %s" module section)
 463             (if (assoc module entries) nil
 464               (setq entries
 465                     (cons (cons module (concat "(" name ")" section))
 466                           entries))
 467               )))
 468         (let ((buf (get-buffer "*caml-help*")))
 469           (if buf (kill-buffer buf)))))
 470     entries))
 471
 472 (defun ocaml-hevea-info ()
 473   "The default way to create an info data base from the value
 474 of \\[Info-default-directory-list] and the base name \\[ocaml-info-name]
 475 of files to look for.
 476
 477 This uses info files produced by HeVeA.
 478 "
 479   (let ((collect) (seen))
 480     (iter '(lambda (d)
 481              (if (member d seen) nil
 482                (setq collect
 483                      (ocaml-hevea-info-add-entries
 484                       collect d ocaml-info-prefix))
 485                (setq done (cons d seen))))
 486           Info-directory-list)
 487     collect))
 488
 489 (defun ocaml-ocamldoc-info-add-entries (entries dir name)
 490   (let*
 491       ((module-regexp "^Node: \\([A-Z][A-Za-z_0-9]*\\)[^ ]")
 492        (command
 493         (concat
 494          "find " dir " -type f -regex '.*/" name
 495          "\\(.info\\|\\)\\([.]gz\\|\\)' -print0"
 496          " | xargs -0 zcat -f | grep '" module-regexp "'")))
 497     (message "Scanning info files in %s" dir)
 498     (save-window-excursion
 499       (set-buffer (get-buffer-create "*caml-help*"))
 500       (or (shell-command command (current-buffer)) (error "HERE"))
 501       (goto-char (point-min))
 502       (while (re-search-forward module-regexp (point-max) t)
 503         (if (equal (char-after (match-end 1)) 127)
 504             (let* ((module (match-string 1)))
 505               (if (assoc module entries) nil
 506                 (setq entries
 507                       (cons (cons module (concat "(" name ")" module))
 508                             entries))
 509                 ))))
 510       ; (kill-buffer (current-buffer))
 511       )
 512     entries))
 513
 514 (defun ocaml-ocamldoc-info ()
 515   "The default way to create an info data base from the value
 516 of \\[Info-default-directory-list] and the base name \\[ocaml-info-name]
 517 of files to look for.
 518
 519 This uses info files produced by ocamldoc."
 520   (require 'info)
 521   (let ((collect) (seen))
 522     (iter '(lambda (d)
 523              (if (member d seen) nil
 524                (setq collect
 525                      (ocaml-ocamldoc-info-add-entries collect d
 526                                                       ocaml-info-prefix))
 527                (setq done (cons d seen))))
 528           Info-directory-list)
 529     collect))
 530
 531 ;; Continuing
 532
 533 (defvar ocaml-info-alist 'ocaml-ocamldoc-info
 534   "A-list binding module names to info entries:
 535
 536   nil means do not use info.
 537
 538   A function to build the list lazily (at the first call). The result of
 539 the function call will be assign permanently to this variable for future
 540 uses. We provide two default functions \\[ocaml-info-default-function]
 541 (info produced by HeVeA is the default) and \\[ocaml-info-default-function]
 542 (info produced by ocamldoc).
 543
 544   Otherwise, this value should be an alist binding module names to info
 545 entries of the form to \"(entry)section\" be taken by the \\[info]
 546 command. An entry may be an info module or a complete file name."
 547 )
 548
 549 (defun ocaml-info-alist ()
 550   "Call by need value of variable ocaml-info-alist"
 551   (cond
 552    ((listp ocaml-info-alist))
 553    ((functionp ocaml-info-alist)
 554     (setq ocaml-info-alist (apply ocaml-info-alist nil)))
 555    (t
 556     (error "wrong type for ocaml-info-alist")))
 557   ocaml-info-alist)
 558
 559 ;; help around point
 560
 561 (defun ocaml-find-module (symbol &optional module-list)
 562   (let ((list (or module-list (ocaml-module-alist)))
 563         (collect))
 564     (while (consp list)
 565       (if (member symbol (ocaml-module-symbols (car list)))
 566           (setq collect (cons (car list) collect)))
 567       (setq list (cdr list)))
 568     (nreverse collect)
 569     ))
 570
 571 (defun ocaml-buffer-substring (region)
 572   (and region (buffer-substring-no-properties (car region) (cdr region))))
 573
 574 ;; Help function.
 575
 576
 577 (defun ocaml-goto-help (&optional module entry same-window)
 578   "Searches info manual for MODULE and ENTRY in MODULE.
 579 If unspecified, MODULE and ENTRY are inferred from the position in the
 580 current buffer using \\[ocaml-qualified-identifier]."
 581   (interactive)
 582   (let ((window (selected-window))
 583         (info-section (assoc module (ocaml-info-alist))))
 584     (if info-section
 585         (caml-info-other-window (cdr info-section))
 586       (ocaml-visible-modules)
 587       (let* ((module-info
 588               (or (assoc module (ocaml-module-alist))
 589                   (and (file-exists-p
 590                         (concat (ocaml-uncapitalize module) ".mli"))
 591                        (ocaml-get-or-make-module module))))
 592              (location (cdr (cadr module-info))))
 593         (cond
 594          (location
 595           (let ((file (concat location (ocaml-uncapitalize module) ".mli")))
 596             (if (window-live-p same-window)
 597                 (progn (select-window same-window)
 598                        (view-mode-exit view-return-to-alist view-exit-action))
 599               ;; (view-buffer (find-file-noselect file) 'view))
 600               )
 601             (view-file-other-window file)
 602             (bury-buffer (current-buffer))))
 603          (info-section (error "Aborted"))
 604          (t (error "No help for module %s" module))))
 605       )
 606     (if (stringp entry)
 607         (let ((here (point))
 608               (case-fold-search nil))
 609           (goto-char (point-min))
 610           (if (or (re-search-forward
 611                    (concat "\\(val\\|exception\\|type\\|external\\|[|{;]\\) +"
 612                            (regexp-quote entry))
 613                    (point-max) t)
 614                   (re-search-forward
 615                    (concat "type [^{]*{[^}]*" (regexp-quote entry) " :")
 616                    (point-max) t)
 617                   (progn
 618                     (if (window-live-p window) (select-window window))
 619                     (error "Entry %s not found in module %s"
 620                            entry module))
 621                   ;; (search-forward entry (point-max) t)
 622                   )
 623               (recenter 1)
 624             (progn
 625               (message "Help for entry %s not found in module %s"
 626                        entry module)
 627               (goto-char here)))))
 628     (ocaml-link-activate (cdr info-section))
 629     (if (window-live-p window) (select-window window))
 630     ))
 631
 632 (defun caml-help (arg)
 633   "Find documentation for OCaml qualified identifiers.
 634
 635 It attemps to recognize an qualified identifier of the form
 636 ``Module . entry'' around point using function `ocaml-qualified-identifier'.
 637
 638 If Module is undetermined it is temptatively guessed from the identifier name
 639 and according to visible modules. If this is still unsucessful,  the user is
 640 then prompted for a Module name.
 641
 642 The documentation for Module is first seach in the info manual if available,
 643 then in the ``module.mli'' source file. The entry is then searched in the documentation.
 644
 645 Visible modules are computed only once, at the first call.
 646 Modules can be made visible explicitly with `ocaml-open-module' and
 647 hidden with `ocaml-close-module'.
 648
 649 Prefix arg 0 forces recompilation of visible modules (and their content)
 650 from the file content.
 651
 652 Prefix arg 4 prompts for Module and identifier instead of guessing values
 653 from the possition of point in the current buffer.
 654 "
 655   (interactive "p")
 656   (let ((module) (entry) (module-entry))
 657     (cond
 658      ((= arg 4)
 659       (or (and
 660            (setq module
 661                 (completing-read "Module: " (ocaml-module-alist)
 662                                  nil t "" (cons 'hist 0)))
 663            (not (string-equal module "")))
 664           (error "Quit"))
 665       (let ((symbols
 666              (mapcar 'list
 667                      (ocaml-module-symbols
 668                       (assoc module (ocaml-module-alist))))))
 669         (setq entry (completing-read "Value: " symbols nil t)))
 670       (if (string-equal entry "") (setq entry nil))
 671       )
 672      (t
 673       (if (= arg 0) (setq ocaml-visible-modules 'lazy))
 674       (setq module-entry (ocaml-qualified-identifier))
 675       (setq entry (ocaml-buffer-substring (cdr module-entry)))
 676       (setq module
 677             (or (ocaml-buffer-substring (car module-entry))
 678                 (let ((modules
 679                        (or (ocaml-find-module entry (ocaml-visible-modules))
 680                            (ocaml-find-module entry)))
 681                       (hist) (default))
 682                   (cond
 683                    ((null modules)
 684                     (error "No module found for entry %s" entry))
 685                    ((equal (length modules) 1)
 686                     (caar modules))
 687                    (t
 688                     (setq hist (mapcar 'car modules))
 689                     (setq default (car hist))
 690                     (setq module
 691                           (completing-read
 692                            (concat "Module: "
 693                                    (and default (concat "[" default "] ")))
 694                            modules nil t "" (cons 'hist 0)))
 695                     (if (string-equal module "") default module))
 696                    ))))
 697       ))
 698      (message "Help for %s%s%s" module (if entry "." "") (or entry ""))
 699      (ocaml-goto-help module entry)
 700      ))
 701
 702 ;; auto-links
 703
 704 (defconst ocaml-link-regexp
 705   "\\(type\\|and\\) \\('[a-z] +\\|(\\('[a-z], *\\)*'[a-z])\\|\\) *\\([a-zA-Z0-9_]*\\)\\( *$\\| =\\)")
 706 (defconst ocaml-longident-regexp
 707   "\\([A-Z][a-zA-Z_0]*\\)[.]\\([a-zA-Z][A-Za-z0-9_]*\\)")
 708
 709 (defvar ocaml-links nil
 710   "Local links in the current of last info node or interface file.
 711
 712 The car of the list is a key that indentifies the module to prevent
 713 recompilation when next help command is relative to the same module.
 714 The cdr is a list of elments, each of which is an string and a pair of
 715 buffer positions."
 716 )
 717 (make-variable-buffer-local 'ocaml-links)
 718
 719 (defun ocaml-info-links (section)
 720   (cdr
 721    (if (and ocaml-links section (equal (car ocaml-links) section))
 722        ocaml-links
 723      (save-excursion
 724        (goto-char (point-min))
 725        (let ((regexp (concat (if (equal major-mode 'Info-mode) "^ - " "^")
 726                              ocaml-link-regexp))
 727              (all))
 728          (while (re-search-forward regexp (point-max) t)
 729            (setq all
 730                  (cons (cons (match-string 4)
 731                              (cons (match-beginning 4)
 732                                    (match-end 4)))
 733                        all)))
 734          (setq ocaml-links (cons section all))
 735          )))))
 736
 737 (defvar ocaml-link-map (make-sparse-keymap))
 738 (define-key ocaml-link-map [mouse-2] 'ocaml-link-goto)
 739
 740 (defun ocaml-link-goto (click)
 741   (interactive "e")
 742   (let* ((pos (caml-event-point-start click))
 743          (win (caml-event-window click))
 744          (buf (window-buffer win))
 745          (window (selected-window))
 746          (link))
 747     (setq link
 748           (with-current-buffer buf
 749             (buffer-substring
 750              (previous-single-property-change (+ pos 1) 'local-map
 751                                                    buf (- pos 100))
 752              (next-single-property-change pos  'local-map
 753                                         buf (+ pos 100)))))
 754     (if (string-match (concat "^" ocaml-longident-regexp "$") link)
 755         (ocaml-goto-help (match-string 1 link) (match-string 2 link) win)
 756       (if (not (equal (window-buffer window) buf))
 757           (switch-to-buffer-other-window buf))
 758       (if (setq link (assoc link (cdr ocaml-links)))
 759           (progn
 760             (goto-char (cadr link))
 761             (recenter 1)))
 762       (if (window-live-p window) (select-window window))
 763       )))
 764
 765 (cond
 766  ((and (x-display-color-p)
 767        (not (memq 'ocaml-link-face (face-list))))
 768   (make-face 'ocaml-link-face)
 769   (set-face-foreground 'ocaml-link-face "Purple")))
 770
 771
 772 (defun ocaml-link-activate (section)
 773   (let ((links (ocaml-info-links section)))
 774     (if links
 775         (let ((regexp (concat "[^A-Za-z0-9'_]\\("
 776                               ocaml-longident-regexp "\\|"
 777                               (mapconcat 'car links "\\|")
 778                               "\\)[^A-Za-z0-9'_]"))
 779               (case-fold-search nil))
 780           (goto-char (point-min))
 781           (let ((buffer-read-only nil)
 782                 ;; use of dynamic scoping, need not be restored!
 783                 (modified-p (buffer-modified-p)))
 784             (unwind-protect
 785                 (save-excursion
 786                   (goto-char (point-min))
 787                   (while (re-search-forward regexp (point-max) t)
 788                     (put-text-property (match-beginning 1) (match-end 1)
 789                                        'mouse-face 'highlight)
 790                     (put-text-property (match-beginning 1) (match-end 1)
 791                                        'local-map ocaml-link-map)
 792                     (if (x-display-color-p)
 793                         (put-text-property (match-beginning 1) (match-end 1)
 794                                            'face 'ocaml-link-face)))
 795                   )
 796               ;; need to restore flag if buffer was unmodified.
 797               (unless modified-p (set-buffer-modified-p nil))
 798               ))
 799           ))))
 800
 801
 802
 803 ;; bindings ---now in caml.el
 804
 805 ; (and
 806 ;  (boundp 'caml-mode-map)
 807 ;  (keymapp caml-mode-map)
 808 ;  (progn
 809 ;    (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)
 810 ;    (define-key caml-mode-map [?\C-c?]] 'ocaml-close-module)
 811 ;    (define-key caml-mode-map [?\C-c?[] 'ocaml-open-module)
 812 ;    (define-key caml-mode-map [?\C-c?\C-h] 'caml-help)
 813 ;    (define-key caml-mode-map [?\C-c?\t] 'caml-complete)
 814 ;    (let ((map (lookup-key caml-mode-map [menu-bar caml])))
 815 ;      (and
 816 ;       (keymapp map)
 817 ;       (progn
 818 ;         (define-key map [separator-help] '("---"))
 819 ;         (define-key map [open] '("Open add path" . ocaml-add-path ))
 820 ;         (define-key map [close]
 821 ;           '("Close module for help" . ocaml-close-module))
 822 ;         (define-key map [open] '("Open module for help" . ocaml-open-module))
 823 ;         (define-key map [help] '("Help for identifier" . caml-help))
 824 ;         (define-key map [complete] '("Complete identifier" . caml-complete))
 825 ;         )
 826 ;    ))))
 827
 828
 829 (provide 'caml-help)