cgit.sxemacs.org Git - packages/blob - xemacs-packages/ocaml/caml-help.el

   1 ;; caml-info.el --- contextual completion and help to caml-mode
   2
   3 ;; Didier Remy, November 2001.
   4
   5 ;; This provides two functions completion and help
   6 ;; look for caml-complete and caml-help
   7
   8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;;
  10 ;;  This is a preliminary version.
  11 ;;
  12 ;;  Possible improvements?
  13 ;;   - dump some databaes: Info, Lib, ...
  14 ;;   - accept a search path for local libraries instead of current dir
  15 ;;     (then distinguish between different modules lying in different
  16 ;;     directories)
  17 ;;   - improve the construction for info files.
  18 ;;
  19 ;;  Abstract over
  20 ;;   - the viewing method and the database, so that the documentation for
  21 ;;     and identifier could be search in
  22 ;;       * info / html / man / mli's sources
  23 ;;       * viewed in emacs or using an external previewer.
  24 ;;
  25 ;;  Take all identifiers (labels, Constructors, exceptions, etc.)
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28
  29
  30 ;; Loading or building databases.
  31 ;;
  32
  33 ;; variables to be customized
  34
  35 (defvar ocaml-lib-path 'lazy
  36   "Path for ocaml lib sources (mli files)
  37
  38 'lazy means ask ocaml to find it for your at first use.")
  39 (defun ocaml-lib-path ()
  40   "Computes if necessary and returns the path for ocaml libs"
  41   (if (listp 'ocaml-lib-path) nil
  42     (setq ocaml-lib-path
  43           (split-string
  44            (shell-command-to-string
  45             (or
  46              (and (boundp 'inferior-caml-program)
  47                       (string-match "\\([^ ]*/ocaml\\)\\( \\|$\\)"
  48                        inferior-caml-program)
  49                       (let ((file
  50                              (concat (match-string 1 inferior-caml-program)
  51                                      "c")))
  52                         (and (file-executable-p file)
  53                              (concat file " -where"))))
  54              "ocamlc -where"))))
  55     ocaml-lib-path))
  56
  57
  58
  59 ;; General purpose auxiliary functions
  60
  61 (defun ocaml-capitalize (s)
  62   (concat (capitalize (substring s 0 1)) (substring s 1)))
  63
  64 (defun ocaml-uncapitalize (s)
  65   (concat (downcase (substring s 0 1)) (substring s 1)))
  66
  67 (defun iter (f l) (while (consp l) (apply f (list (car l))) (setq l (cdr l))))
  68
  69 (defun ocaml-find-files (path filter &optional depth split)
  70   (let* ((path-string
  71           (if (stringp path)
  72               (if (file-directory-p path) path nil)
  73             (mapconcat '(lambda (d) (if (file-directory-p d) d))
  74                        path " ")))
  75          (command
  76           (and path-string
  77                (concat "find " path-string
  78                        " '(' " filter " ')' "
  79                        (if depth (concat " -maxdepth " (int-to-string depth)))
  80                        (if split nil " -printf '%\p '")
  81                        )))
  82           (files
  83            (and command (shell-command-to-string command))))
  84          (if (and split (stringp files)) (split-string files "\n") files)
  85          ))
  86
  87 ;; Specialized auxiliary functions
  88
  89
  90 ;; Global table of modules contents of modules loaded lazily.
  91
  92 (defvar ocaml-module-alist 'lazy
  93   "A-list of modules with how and where to find help information.
  94   'delay means non computed yet")
  95
  96 (defun ocaml-add-mli-modules (modules tag &optional path)
  97   (let ((files
  98          (ocaml-find-files (or path (ocaml-lib-path))
  99                            "-type f -name '*.mli'" 1 t)))
 100     (while (consp files)
 101       (if (string-match "\\([^/]*\\).mli" (car files))
 102           (let* ((module (ocaml-capitalize (match-string 1 (car files))))
 103                  (dir (file-name-directory (car files)))
 104                  (dirp (member dir (ocaml-lib-path))))
 105             (if (and (consp dirp) (string-equal dir (car dirp)))
 106                 (setq dir (car dirp)))
 107             (if (assoc module modules) nil
 108               (setq modules
 109                     (cons (cons module (cons (cons tag dir) 'lazy)) modules))
 110               )))
 111       (setq files (cdr files)))
 112     modules))
 113
 114 (defun ocaml-module-alist ()
 115   "Call by need value of valriable ocaml-module-alist"
 116   (if (listp ocaml-module-alist)
 117       nil
 118     ;; build list of mli files
 119     (setq ocaml-module-alist (ocaml-add-mli-modules nil 'lib))
 120     ;; dumping information ? TODO
 121     )
 122   ocaml-module-alist)
 123
 124 (defun ocaml-get-or-make-module (module &optional tag)
 125   (let ((info (assoc module (ocaml-module-alist))))
 126     (if info nil
 127       (setq info (cons module (cons (cons 'local default-directory) 'lazy)))
 128       (setq ocaml-module-alist (cons info ocaml-module-alist))
 129       )
 130     info))
 131
 132 ;; Symbols of module are lazily computed
 133
 134 (defun ocaml-module-filename (module)
 135   (let ((module (ocaml-uncapitalize module)) (name))
 136     (if (file-exists-p (setq name (concat module ".mli"))) nil
 137       (let ((tmp (ocaml-lib-path)))
 138         (while (consp tmp)
 139           (setq name (concat (car tmp) "/" module ".mli"))
 140           (if (file-exists-p name) (setq tmp nil)
 141             (setq name nil)))))
 142     name))
 143
 144 (defun ocaml-module-symbols (module-info)
 145   (let* ((module (car module-info))
 146          (tail (and module-info (cdr module-info)))
 147          (tag (caar tail))
 148          (dir (cdar tail))
 149          (file)
 150          (alist))
 151     (if (listp (cdr tail))
 152         (cdr tail)
 153       (if (equal tag 'info)
 154           (setq dir (car ocaml-lib-path)) ; XXX to be fixed
 155         )
 156       (setq file (concat dir (ocaml-uncapitalize module) ".mli"))
 157       (message file)
 158       (save-window-excursion
 159         (set-buffer (get-buffer-create "*caml-help*"))
 160         (if (and file (file-exists-p file))
 161             (progn
 162               (message "Scanning module %s" file)
 163               (insert-file-contents file))
 164           (message "Module %s not found" module))
 165         (while (re-search-forward
 166                 "^\\([ \t]*val\\|let\\|external\\) \\([^ (:=]*\\)" (point-max) 'move)
 167           (setq alist (cons (match-string 2) alist)))
 168         (erase-buffer)
 169         )
 170       (setcdr tail alist)
 171       alist)
 172       ))
 173
 174 ;; Local list of visible modules.
 175
 176 (defvar ocaml-visible-modules 'lazy
 177   "A-list of open modules, local to every file.")
 178 (make-variable-buffer-local 'ocaml-visible-modules)
 179 (defun ocaml-visible-modules ()
 180   (if (listp ocaml-visible-modules) nil
 181     (progn
 182       (setq ocaml-visible-modules
 183             (list (ocaml-get-or-make-module "Pervasives")))
 184       (save-excursion
 185         (goto-char (point-min))
 186         (while (re-search-forward "^ *open  *\\([A-Z][a-zA-Z'_0-9]*\\)"
 187                                   (point-max) t)
 188           (let ((module (match-string 1)))
 189             (if (member module ocaml-visible-modules) nil
 190               (setq ocaml-visible-modules
 191                     (cons (ocaml-get-or-make-module module)
 192                           ocaml-visible-modules)))))
 193         )))
 194   ocaml-visible-modules)
 195
 196 ;; Look for identifiers around point
 197
 198 (defun ocaml-qualified-identifier (&optional show)
 199   "Search for a qualified identifier (Path. entry) around point.
 200
 201 Entry may be nil.
 202 Currently, the path may only be nil or a single Module.
 203 For paths is of the form Module.Path', it returns Module
 204 and always nil for entry.
 205
 206 If defined Module and Entry are represented by a region in the buffer,
 207 and are nil otherwise.
 208
 209 For debugging purposes, it returns the string Module.entry if called
 210 with an optional non-nil argument.
 211 "
 212   (save-excursion
 213     (let ((module) (entry))
 214       (if (looking-at "[ \n]") (skip-chars-backward " "))
 215       (if (re-search-backward
 216            "[^A-Za-z0-9_.']\\([A-Za-z0-9_']*[.]\\)*[A-Za-z0-9_']*\\="
 217            (- (point) 100) t)
 218           (progn
 219             (forward-char 1)
 220             (if (looking-at "\\<\\([A-Za-z_][A-Za-z0-9_']*\\)[.]")
 221                 (progn
 222                   (setq module (cons (match-beginning 1) (match-end 1)))
 223                   (goto-char (match-end 0))))
 224             (if (looking-at "\\<\\([a-z_][A-Za-z0-9_']*\\)\\>")
 225                 (setq entry (cons (match-beginning 1) (match-end 1))))))
 226       (if show
 227           (concat
 228            (and module (buffer-substring (car module) (cdr module)))
 229            "."
 230            (and entry (buffer-substring (car entry) (cdr entry))))
 231       (cons module entry))
 232     )))
 233
 234 ;; completion around point
 235
 236 (defun ocaml-completion (pattern module)
 237   (let ((list
 238          (or
 239           (and module
 240                (list
 241                 (or (assoc module (ocaml-module-alist))
 242                     (error "Unknown module %s" module))))
 243           (ocaml-visible-modules))))
 244     (message "Completion from %s" (mapconcat 'car list " "))
 245     (if (null pattern)
 246         (apply 'append (mapcar 'ocaml-module-symbols list))
 247       (let ((pat (concat "^" (regexp-quote pattern))) (res))
 248         (iter
 249          '(lambda (l)
 250             (iter '(lambda (x)
 251                      (if (string-match pat (car l))
 252                          (if (member x res) nil (setq res (cons x res)))))
 253                   (ocaml-module-symbols l)))
 254          list)
 255         res)
 256       )))
 257
 258 (defun caml-complete (arg)
 259   "Does completion for qualified identifiers.
 260
 261 It attemps to recognize an qualified identifier Module . entry
 262 around point using function `ocaml-qualified-identifier'.
 263
 264 If Module is defined, it does completion for identifier in Module.
 265
 266 If Module is undefined, it does completion in visible modules.
 267 Then, if completion fails, it does completion among  all modules
 268 where identifier is defined."
 269   (interactive "p")
 270   (let* ((module-entry (ocaml-qualified-identifier))
 271          (module)
 272          (entry (cdr module-entry))
 273          (beg) (end) (pattern))
 274     (if (car module-entry)
 275         (progn
 276           (setq module
 277                 (buffer-substring (caar module-entry) (cdar module-entry)))
 278           (or (assoc module (ocaml-module-alist))
 279               (and (setq module
 280                          (completing-read "Module: " (ocaml-module-alist)
 281                                           nil nil module))
 282                    (save-excursion
 283                      (goto-char (caar module-entry))
 284                      (delete-region (caar module-entry) (cdar module-entry))
 285                      (insert module) t)
 286                    (setq module-entry (ocaml-qualified-identifier))
 287                    (car module-entry)
 288                    (progn (setq entry (cdr module-entry)) t))
 289               (error "Unknown module %s" module))))
 290     (if (consp (cdr module-entry))
 291         (progn
 292           (setq beg (cadr module-entry))
 293           (setq end (cddr module-entry)))
 294       (if (and module
 295            (save-excursion
 296             (goto-char (cdar module-entry))
 297             (looking-at " *[.]")))
 298           (progn
 299             (setq beg (match-end 0))
 300             (setq end beg))))
 301     (if (not (and beg end))
 302         (error "Did not find anything to complete around point")
 303
 304       (setq pattern (buffer-substring beg end))
 305       (let* ((table 'ocaml-completion)
 306              (all-completions (ocaml-completion pattern module))
 307              (completion
 308               (try-completion pattern (mapcar 'list all-completions))))
 309         (cond ((eq completion t))
 310
 311               ((null completion)
 312                (let*
 313                    ((modules (ocaml-find-module pattern))
 314                     (hist)
 315                     (module
 316                      (cond
 317                       ((null modules)
 318                        nil)
 319                       ((equal (length modules) 1)
 320                        (caar modules))
 321                       (t
 322                        (setq hist (mapcar 'car modules))
 323                        (completing-read "Module: " modules nil t
 324                                         "" (cons 'hist 0)))
 325                       )))
 326                  (if (null module)
 327                      (error "Can't find completion for \"%s\"" pattern)
 328                    (message "Completion found in module %s" module)
 329                    (if (and (consp module-entry) (consp (cdr module-entry)))
 330                        (delete-region (caar module-entry) end)
 331                      (delete-region beg end))
 332                    (insert module "." pattern))))
 333
 334               ((not (string-equal pattern completion))
 335                (delete-region beg end)
 336                (insert completion))
 337
 338               (t
 339                 (with-output-to-temp-buffer "*Completions*"
 340                   (display-completion-list all-completions))
 341                 ))
 342                ))))
 343
 344
 345 ;; Info files (only in ocamldoc style)
 346
 347
 348 (defvar ocaml-info-basename "ocaml"
 349   "Basename of ocaml info files describing library modules.
 350 Suffix .info will be added to info files.
 351 Additional suffix .gz may be added if info files are compressed.
 352 ")
 353 ;;
 354
 355 (defun ocaml-hevea-info-add-entries (entries dir name)
 356   (let*
 357       ((filter
 358         (concat "-type f -regex '.*/" name
 359                 "\\(.info\\|\\)\\(-[0-9]*\\|\\)\\([.]gz\\|\\)'"
 360                 ))
 361        (section-regexp
 362         "\\* \\(Section [1-9][0-9--]*\\)::[ \t][ \t]*Module *\\([A-Z][A-Za-z_0-9]*\\)")
 363        (files (ocaml-find-files dir filter))
 364        (command))
 365     ;; scanning info files
 366     (if (or (null files)
 367             (not (stringp files))
 368             (string-match files "^ *$"))
 369         (message "No info file found: %s." (mapconcat 'identity files " "))
 370       (message "Scanning info files %s." files)
 371       (save-window-excursion
 372         (set-buffer (get-buffer-create "*caml-help*"))
 373         (setq command
 374               (concat "zcat -f " files
 375                       " | grep -e '" section-regexp "'"))
 376         (message "Scanning files with: %s" command)
 377         (or (shell-command command (current-buffer))
 378             (error "Error while scanning"))
 379         (goto-char (point-min))
 380         (while (re-search-forward section-regexp (point-max) t)
 381           (let* ((module (match-string 2))
 382                  (section (match-string 1)))
 383             ;; (message "%s %s" module section)
 384             (if (assoc module entries) nil
 385               (setq entries
 386                     (cons (cons module (concat "(" name ")" section))
 387                           entries))
 388               )))
 389         (let ((buf (get-buffer "*caml-help*")))
 390           (if buf (kill-buffer buf)))))
 391     entries))
 392
 393 (defun ocaml-hevea-info ()
 394   "The default way to create an info data base from the value
 395 of `Info-default-directory-list' and the base name `ocaml-info-name'
 396 of files with basename `ocaml-info-basename' to look for.
 397
 398 This uses info files produced by HeVeA.
 399 "
 400   (let ((collect) (seen))
 401     (iter '(lambda (d)
 402              (if (member d seen) nil
 403                (setq collect
 404                      (ocaml-hevea-info-add-entries
 405                       collect d ocaml-info-basename))
 406                (setq done (cons d seen))))
 407           Info-directory-list)
 408     collect))
 409
 410 (defun ocaml-ocamldoc-info-add-entries (entries dir name)
 411   (let*
 412       ((module-regexp "^Node: \\([A-Z][A-Za-z_0-9]*\\)[^ ]")
 413        (command
 414         (concat
 415          "find " dir " -type f -regex '.*/" name
 416          "\\(.info\\|\\)\\([.]gz\\|\\)' -print0"
 417          " | xargs -0 zcat -f | grep '" module-regexp "'")))
 418     (message "Scanning info files in %s" dir)
 419     (save-window-excursion
 420       (set-buffer (get-buffer-create "*caml-help*"))
 421       (or (shell-command command (current-buffer)) (error "HERE"))
 422       (goto-char (point-min))
 423       (while (re-search-forward module-regexp (point-max) t)
 424         (if (equal (char-after (match-end 1)) 127)
 425             (let* ((module (match-string 1)))
 426               (if (assoc module entries) nil
 427                 (setq entries
 428                       (cons (cons module (concat "(" name ")" module))
 429                             entries))
 430                 ))))
 431       ; (kill-buffer (current-buffer))
 432       )
 433     entries))
 434
 435 (defun ocaml-ocamldoc-info ()
 436   "The default way to create an info data base from the value
 437 of `Info-default-directory-list' and the base name `ocaml-info-name'
 438 of files with basename `ocaml-info-basename' to look for.
 439
 440 This uses info files produced by ocamldoc."
 441   (require 'info)
 442   (let ((collect) (seen))
 443     (iter '(lambda (d)
 444              (if (member d seen) nil
 445                (setq collect
 446                      (ocaml-ocamldoc-info-add-entries collect d
 447                                                       ocaml-info-prefix))
 448                (setq done (cons d seen))))
 449           Info-directory-list)
 450     collect))
 451
 452 ;; Continuing
 453
 454 (defvar ocaml-info-alist nil
 455   "A-list binding module names to info entries:
 456
 457   nil means do not use info.
 458
 459   A function to build the list lazily (at the first call). The result of
 460 the function call will be assign permanently to this variable for future
 461 uses. We provide two default functions `ocaml-hevea-info' and
 462 `ocaml-ocamldoc-info'.
 463
 464   Otherwise, this value should be an alist binding module names to info
 465 entries of the form to \"(entry)section\" be taken by the `info'
 466 command. An entry may be an info module or a complete file name."
 467 )
 468
 469 (defun ocaml-info-alist ()
 470   "Call by need value of variable ocaml-info-alist"
 471   (cond
 472    ((listp ocaml-info-alist))
 473    ((functionp ocaml-info-alist)
 474     (setq ocaml-info-alist (apply ocaml-info-alist nil)))
 475    (t
 476     (error "wrong type for ocaml-info-alist")))
 477   ocaml-info-alist)
 478
 479 ;; help around point
 480
 481 (defun ocaml-find-module (symbol &optional module-list)
 482   (let ((list (or module-list (ocaml-module-alist)))
 483         (collect))
 484     (while (consp list)
 485       (if (member symbol (ocaml-module-symbols (car list)))
 486           (setq collect (cons (car list) collect)))
 487       (setq list (cdr list)))
 488     collect
 489     ))
 490
 491 (defun ocaml-buffer-substring (region)
 492   (and region (buffer-substring-no-properties (car region) (cdr region))))
 493
 494 ;; Help function.
 495
 496 (defun ocaml-goto-help (&optional module entry)
 497   "Searches info manual for MODULE and ENTRY in MODULE.
 498 If unspecified, MODULE and ENTRY are inferred from the position in the
 499 current buffer using `ocaml-qualified-identifier'."
 500   (interactive)
 501   (let ((info-section (assoc module (ocaml-info-alist))))
 502     (if info-section (info (cdr info-section))
 503       (ocaml-visible-modules)
 504       (let* ((module-info
 505               (or (assoc module (ocaml-module-alist))
 506                   (and (file-exists-p
 507                         (concat (ocaml-uncapitalize module) ".mli"))
 508                        (ocaml-get-or-make-module module))))
 509              (location (cdr (cadr module-info))))
 510         (cond
 511          (location
 512           (view-file (concat location (ocaml-uncapitalize module) ".mli"))
 513           (bury-buffer (current-buffer)))
 514          (info-section (error "Aborted"))
 515          (t (error "No help for module %s" module))))
 516       ))
 517   (if (stringp entry)
 518       (let ((here (point)))
 519         (goto-char (point-min))
 520         (or (re-search-forward
 521              (concat "\\(val\\|exception\\|external\\|[|{;]\\) +"
 522                      (regexp-quote entry))
 523              (point-max) t)
 524             (search-forward entry (point-max) t)
 525             (progn
 526               (message "Help for entry %s not found in module %s"
 527                        entry module)
 528               (goto-char here)))))
 529   )
 530
 531 (defun caml-help (arg)
 532   "Find help for qualified identifiers.
 533
 534 It attemps to recognize an qualified identifier of the form Module . entry
 535 around point using function `ocaml-qualified-identifier'.
 536
 537 If Module is undefined it finds it from indentifier and visible modules,
 538 or asks the user interactively.
 539
 540 It then opens the info documentation for Module if available or
 541 to the Module.mli file otherwises, and searches for entry.
 542
 543 With prefix arg 0, it recomputes visible modules and their content.
 544 With prefix arg 4, it prompt for Module instead of its contectual value.
 545 "
 546   (interactive "p")
 547   (let ((module) (entry))
 548     (cond
 549      ((= arg 4)
 550       (or (and
 551            (setq module
 552                 (completing-read "Module: " ocaml-module-alist nil t))
 553            (not (string-equal module "")))
 554           (error "Quit")))
 555      (t
 556       (if (= arg 0) (setq ocaml-visible-modules 'lazy))
 557       (let ((module-entry (ocaml-qualified-identifier)))
 558         (setq entry (ocaml-buffer-substring (cdr module-entry)))
 559         (setq module
 560               (or (ocaml-buffer-substring (car module-entry))
 561                   (let ((modules
 562                          (or (ocaml-find-module entry (ocaml-visible-modules))
 563                              (ocaml-find-module entry)))
 564                          (hist))
 565                     (cond
 566                      ((null modules)
 567                       (error "No module found for entry %s" entry))
 568                      ((equal (length modules) 1)
 569                       (caar modules))
 570                      (t
 571                       (setq hist (mapcar 'car modules))
 572                       (completing-read "Module: " modules nil t
 573                                        "" (cons 'hist 0)))
 574                      ))))
 575         )))
 576      (message "Help for %s%s%s" module (if entry "." "") (or entry ""))
 577      (ocaml-goto-help module entry)
 578      ))
 579
 580
 581 ;; bindings
 582
 583 (if (and (boundp 'caml-mode-map) (keymapp caml-mode-map))
 584     (progn
 585       (define-key caml-mode-map [?\C-c?\C-h] 'caml-help)
 586       (define-key caml-mode-map [?\C-c?\t] 'caml-complete)
 587       ))
 588
 589 (provide 'caml-help)