/ emacs.d / haskell / haskell-doc.el
haskell-doc.el
   1  ;;; haskell-doc.el --- show function types in echo area  -*- coding: iso-8859-1 -*-
   2  
   3  ;; Copyright (C) 2004, 2005, 2006, 2007  Free Software Foundation, Inc.
   4  ;; Copyright (C) 1997 Hans-Wolfgang Loidl
   5  
   6  ;; Author: Hans-Wolfgang Loidl <hwloidl@dcs.glasgow.ac.uk>
   7  ;; Temporary Maintainer and Hacker: Graeme E Moss <gem@cs.york.ac.uk>
   8  ;; Keywords: extensions, minor mode, language mode, Haskell
   9  ;; Created: 1997-06-17
  10  ;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-doc.el?rev=HEAD
  11  
  12  ;;; Copyright:
  13  ;;  ==========
  14  
  15  ;; This program is free software; you can redistribute it and/or modify
  16  ;; it under the terms of the GNU General Public License as published by
  17  ;; the Free Software Foundation; either version 2, or (at your option)
  18  ;; any later version.
  19  ;;
  20  ;; This program is distributed in the hope that it will be useful,
  21  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23  ;; GNU General Public License for more details.
  24  ;;
  25  ;; You should have received a copy of the GNU General Public License
  26  ;; along with this program; if not, you can either send email to this
  27  ;; program's maintainer or write to: The Free Software Foundation,
  28  ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  29  
  30  ;;; Commentary:
  31  ;;  ===========
  32  
  33  ;; This program shows the type of the Haskell function under the cursor in the
  34  ;; minibuffer.  It acts as a kind of "emacs background process", by regularly
  35  ;; checking the word under the cursor and matching it against a list of
  36  ;; prelude, library, local and global functions.
  37  
  38  ;; The preferred usage of this package is in combination with
  39  ;; `haskell-hugs-mode'.
  40  ;; In that case `haskell-doc-mode' checks an internal variable updated by
  41  ;; `imenu' to access the types of all local functions.  In `haskell-mode' this
  42  ;; is not possible.  However, types of prelude functions are still shown.
  43  
  44  ;; To show types of global functions, i.e. functions defined in a module
  45  ;; imported by the current module, call the function
  46  ;; `turn-on-haskell-doc-global-types'.  This automatically loads all modules
  47  ;; and builds `imenu' tables to get the types of all functions (again this
  48  ;; currently requires `haskell-hugs-mode').
  49  ;; Note: The modules are loaded recursively, so you might pull in
  50  ;;       many modules by just turning on global function support.
  51  ;; This features is currently not very well supported.
  52  
  53  ;; This program was inspired by the `eldoc.el' package by Noah Friedman.
  54  
  55  ;;; Installation:
  56  ;;  =============
  57  
  58  ;; One useful way to enable this minor mode is to put the following in your
  59  ;; .emacs:
  60  ;;
  61  ;;      (autoload 'turn-on-haskell-doc-mode "haskell-doc" nil t)
  62  
  63  ;;   and depending on the major mode you use for your Haskell programs:
  64  ;;      (add-hook 'hugs-mode-hook 'turn-on-haskell-doc-mode)    ; hugs-mode
  65  ;;     or
  66  ;;      (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode) ; haskell-mode
  67  
  68  ;;; Customisation:
  69  ;;  ==============
  70  
  71  ;; You can control what exactly is shown by setting the following variables to
  72  ;; either t or nil:
  73  ;;  `haskell-doc-show-global-types' (default: nil)
  74  ;;  `haskell-doc-show-reserved'     (default: t)
  75  ;;  `haskell-doc-show-prelude'      (default: t)
  76  ;;  `haskell-doc-show-strategy'     (default: t)
  77  ;;  `haskell-doc-show-user-defined' (default: t)
  78  
  79  ;; If you want to define your own strings for some identifiers define an
  80  ;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t.
  81  ;; E.g:
  82  ;;
  83  ;;   (setq haskell-doc-show-user-defined t)
  84  ;;   (setq haskell-doc-user-defined-ids
  85  ;;	(list
  86  ;;	   '("main" . "just another pathetic main function")
  87  ;;	   '("foo" . "a very dummy name")
  88  ;;	   '("bar" . "another dummy name")))
  89  
  90  ;;  The following two variables are useful to make the type fit on one line:
  91  ;;  If `haskell-doc-chop-off-context' is non-nil the context part of the type
  92  ;;  of a local fct will be eliminated (default: t).
  93  ;;  If `haskell-doc-chop-off-fctname' is non-nil the function name is not
  94  ;;  shown together with the type (default: nil).
  95  
  96  ;;; Internals:
  97  ;;  ==========
  98  
  99  ;; `haskell-doc-mode' is implemented as a minor-mode. So, you can combine it
 100  ;; with any other mode. To enable it just type
 101  ;;   M-x turn-on-haskell-doc-mode
 102  
 103  ;; These are the names of the functions that can be called directly by the
 104  ;; user (with keybindings in `haskell-hugs-mode' and `haskell-mode'):
 105  ;;  `haskell-doc-mode' ... toggle haskell-doc-mode; with prefix turn it on
 106  ;;                        unconditionally if the prefix is greater 0 otherwise
 107  ;;                        turn it off
 108  ;;                        Key: CTRL-c CTRL-o (CTRL-u CTRL-c CTRL-o)
 109  ;;  `haskell-doc-ask-mouse-for-type' ... show the type of the id under the mouse
 110  ;;                                      Key: C-S-M-mouse-3
 111  ;;  `haskell-doc-show-reserved'     ... toggle echoing of reserved id's types
 112  ;;  `haskell-doc-show-prelude'      ... toggle echoing of prelude id's types
 113  ;;  `haskell-doc-show-strategy'     ... toggle echoing of strategy id's types
 114  ;;  `haskell-doc-show-user-defined' ... toggle echoing of user def id's types
 115  ;;  `haskell-doc-check-active' ... check whether haskell-doc is active;
 116  ;;                                 Key: CTRL-c ESC-/
 117  
 118  ;;; ToDo:
 119  ;;  =====
 120  
 121  ;;   - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc
 122  ;;   - Write a parser for .hi files and make haskell-doc independent from
 123  ;;     hugs-mode. Read library interfaces via this parser.
 124  ;;   - Indicate kind of object with colours
 125  ;;   - Handle multi-line types
 126  ;;   - Encode i-am-fct info in the alist of ids and types.
 127  
 128  ;;; Bugs:
 129  ;;  =====
 130  
 131  ;;   - Some prelude fcts aren't displayed properly. This might be due to a
 132  ;;     name clash of Haskell and Elisp functions (e.g. length) which
 133  ;;     confuses emacs when reading `haskell-doc-prelude-types'
 134  
 135  ;;; Changelog:
 136  ;;  ==========
 137  ;;  haskell-doc.el,v
 138  ;;  Revision 1.26  2007/02/10 06:28:55  monnier
 139  ;;  (haskell-doc-get-current-word): Remove.
 140  ;;  Change all refs to it, to use haskell-ident-at-point instead.
 141  ;;
 142  ;;  Revision 1.25  2007/02/09 21:53:42  monnier
 143  ;;  (haskell-doc-get-current-word): Correctly distinguish
 144  ;;  variable identifiers and infix identifiers.
 145  ;;  (haskell-doc-rescan-files): Avoid switch-to-buffer.
 146  ;;  (haskell-doc-imported-list): Operate on current buffer.
 147  ;;  (haskell-doc-make-global-fct-index): Adjust call.
 148  ;;
 149  ;;  Revision 1.24  2006/11/20 20:18:24  monnier
 150  ;;  (haskell-doc-mode-print-current-symbol-info): Fix thinko.
 151  ;;
 152  ;;  Revision 1.23  2006/10/20 03:12:31  monnier
 153  ;;  Drop post-command-idle-hook in favor of run-with-idle-timer.
 154  ;;  (haskell-doc-timer, haskell-doc-buffers): New vars.
 155  ;;  (haskell-doc-mode): Use them.
 156  ;;  (haskell-doc-check-active): Update the check.
 157  ;;  (haskell-doc-mode-print-current-symbol-info): Remove the interactive spec.
 158  ;;  Don't sit-for unless it's really needed.
 159  ;;
 160  ;;  Revision 1.22  2006/09/20 18:42:35  monnier
 161  ;;  Doc fix.
 162  ;;
 163  ;;  Revision 1.21  2005/11/21 21:48:52  monnier
 164  ;;  * haskell-doc.el (haskell-doc-extract-types): Get labelled data working.
 165  ;;  (haskell-doc-prelude-types): Update via auto-generation.
 166  ;;
 167  ;;  * haskell-doc.el (haskell-doc-extract-types): Get it partly working.
 168  ;;  (haskell-doc-fetch-lib-urls): Don't use a literal if we apply
 169  ;;  `nreverse' on it later on.
 170  ;;  (haskell-doc-prelude-types): Update some parts by auto-generation.
 171  ;;  (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify.
 172  ;;
 173  ;;  * haskell-doc.el (haskell-doc-maintainer, haskell-doc-varlist)
 174  ;;  (haskell-doc-submit-bug-report, haskell-doc-ftp-site)
 175  ;;  (haskell-doc-visit-home): Remove.
 176  ;;  (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls)
 177  ;;  (haskell-doc-extract-and-insert-types): New funs.
 178  ;;  (haskell-doc-reserved-ids): Fix type of `map'.
 179  ;;
 180  ;;  Revision 1.20  2005/11/21 21:27:57  monnier
 181  ;;  (haskell-doc-extract-types): Get labelled data working.
 182  ;;  (haskell-doc-prelude-types): Update via auto-generation.
 183  ;;
 184  ;;  Revision 1.19  2005/11/21 20:44:13  monnier
 185  ;;  (haskell-doc-extract-types): Get it partly working.
 186  ;;  (haskell-doc-fetch-lib-urls): Don't use a literal if we apply
 187  ;;  `nreverse' on it later on.
 188  ;;  (haskell-doc-prelude-types): Update some parts by auto-generation.
 189  ;;  (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify.
 190  ;;
 191  ;;  Revision 1.18  2005/11/21 18:02:15  monnier
 192  ;;  (haskell-doc-maintainer, haskell-doc-varlist)
 193  ;;  (haskell-doc-submit-bug-report, haskell-doc-ftp-site)
 194  ;;  (haskell-doc-visit-home): Remove.
 195  ;;  (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls)
 196  ;;  (haskell-doc-extract-and-insert-types): New funs.
 197  ;;  (haskell-doc-reserved-ids): Fix type of `map'.
 198  ;;
 199  ;;  Revision 1.17  2005/11/20 23:55:09  monnier
 200  ;;  Add coding cookie.
 201  ;;
 202  ;;  Revision 1.16  2005/11/07 01:28:16  monnier
 203  ;;  (haskell-doc-xemacs-p, haskell-doc-emacs-p)
 204  ;;  (haskell-doc-message): Remove.
 205  ;;  (haskell-doc-is-id-char-at): Remove.
 206  ;;  (haskell-doc-get-current-word): Rewrite.
 207  ;;
 208  ;;  Revision 1.15  2005/11/04 17:11:12  monnier
 209  ;;  Add arch-tag.
 210  ;;
 211  ;;  Revision 1.14  2005/08/24 11:36:32  monnier
 212  ;;  (haskell-doc-message): Paren typo.
 213  ;;
 214  ;;  Revision 1.13  2005/08/23 19:23:27  monnier
 215  ;;  (haskell-doc-show-type): Assume that the availability
 216  ;;  of display-message won't change at runtime.
 217  ;;
 218  ;;  Revision 1.12  2005/07/18 21:04:14  monnier
 219  ;;  (haskell-doc-message): Remove.
 220  ;;  (haskell-doc-show-type): inline it.  Do nothing for if there's no doc to show.
 221  ;;
 222  ;;  Revision 1.11  2004/12/10 17:33:18  monnier
 223  ;;  (haskell-doc-minor-mode-string): Make it dynamic.
 224  ;;  (haskell-doc-install-keymap): Remove conflicting C-c C-o binding.
 225  ;;  (haskell-doc-mode): Make a nil arg turn the mode ON.
 226  ;;  (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode.
 227  ;;  (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string.
 228  ;;  (haskell-doc-show-global-types): Don't touch
 229  ;;  haskell-doc-minor-mode-string.  Call haskell-doc-make-global-fct-index.
 230  ;;  (haskell-doc-check-active): Fix message.
 231  ;;  (define-key-after): Don't define.
 232  ;;  (haskell-doc-install-keymap): Check existence of define-key-after.
 233  ;;
 234  ;;  Revision 1.10  2004/11/25 23:03:23  monnier
 235  ;;  (haskell-doc-sym-doc): Make even the last char bold.
 236  ;;
 237  ;;  Revision 1.9  2004/11/24 22:14:36  monnier
 238  ;;  (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu.
 239  ;;
 240  ;;  Revision 1.8  2004/11/22 10:45:35  simonmar
 241  ;;  Fix type of getLine
 242  ;;
 243  ;;  Revision 1.7  2004/10/14 22:27:47  monnier
 244  ;;  (turn-off-haskell-doc-mode, haskell-doc-current-info): Don't autoload.
 245  ;;
 246  ;;  Revision 1.6  2004/10/13 22:45:22  monnier
 247  ;;  (haskell-doc): New group.
 248  ;;  (haskell-doc-show-reserved, haskell-doc-show-prelude)
 249  ;;  (haskell-doc-show-strategy, haskell-doc-show-user-defined)
 250  ;;  (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname):
 251  ;;  Make them custom vars.
 252  ;;  (haskell-doc-keymap): Declare and fill it right there.
 253  ;;  (haskell-doc-mode): Simplify.
 254  ;;  (haskell-doc-toggle-var): Make it into what it was supposed to be.
 255  ;;  (haskell-doc-mode-print-current-symbol-info): Simplify.
 256  ;;  (haskell-doc-current-info): New autoloaded function.
 257  ;;  (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type.
 258  ;;  (haskell-doc-show-type): Use it.
 259  ;;  (haskell-doc-wrapped-type-p): Remove unused var `lim'.
 260  ;;  (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove.  Unused.
 261  ;;  (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded.
 262  ;;  (haskell-doc-install-keymap): Simplify.
 263  ;;
 264  ;;  Revision 1.5  2003/01/09 11:56:26  simonmar
 265  ;;  Patches from Ville Skytt� <scop@xemacs.org>, the XEmacs maintainer of
 266  ;;  the haskell-mode:
 267  ;;
 268  ;;   - Make the auto-mode-alist modifications autoload-only.
 269  ;;
 270  ;;  Revision 1.4  2002/10/14 09:55:03  simonmar
 271  ;;  Patch to update the Prelude/libraries function names and to remove
 272  ;;  support for older versions of Haskell.
 273  ;;
 274  ;;  Submitted by: Anders Lau Olsen <alauo@mip.sdu.dk>
 275  ;;
 276  ;;  Revision 1.3  2002/04/30 09:34:37  rrt
 277  ;;  Remove supporting Haskell 1.4 and 1.2 from the ToDo list. It's Far Too Late.
 278  ;;
 279  ;;  Add (require 'imenu). Thanks to N. Y. Kwok.
 280  ;;
 281  ;;  Revision 1.2  2002/04/23 14:45:10  simonmar
 282  ;;  Tweaks to the doc strings and support for customization, from
 283  ;;  Ville Skytt� <scop@xemacs.org>.
 284  ;;
 285  ;;  Revision 1.1  2001/07/19 16:17:36  rrt
 286  ;;  Add the current version of the Moss/Thorn/Marlow Emacs mode, along with its
 287  ;;  web pages and sample files. This is now the preferred mode, and the
 288  ;;  haskell.org pages are being changed to reflect that. Also includes the new
 289  ;;  GHCi mode from Chris Webb.
 290  ;;
 291  ;;  Revision 1.6  1998/12/10 16:27:25  hwloidl
 292  ;;  Minor changes ("Doc" as modeline string, mouse-3 moved to C-S-M-mouse-3)
 293  ;;
 294  ;;  Revision 1.5  1998/09/24 14:25:46  gem
 295  ;;  Fixed minor compatibility bugs with Haskell mode of Moss&Thorn.
 296  ;;  Disabled M-/ binding.
 297  ;;
 298  ;;  Revision 1.4  1997/11/12 23:51:19  hwloidl
 299  ;;  Fixed start-up problem under emacs-19.34.
 300  ;;  Added support for wrapped (multi-line) types and 2 vars to control the
 301  ;;  behaviour with long fct types
 302  ;;
 303  ;;  Revision 1.3  1997/11/03 00:48:03  hwloidl
 304  ;;  Major revision for first release.
 305  ;;  Added alists for showing prelude fcts, haskell syntax, and strategies
 306  ;;  Added mouse interface to show type under mouse
 307  ;;  Fixed bug which causes demon to fall over
 308  ;;  Works now with hugs-mode and haskell-mode under emacs 19.34,20 and xemacs 19.15
 309  ;;
 310  
 311  ;;; Code:
 312  ;;  =====
 313  
 314  ;;@menu
 315  ;;* Constants and Variables::
 316  ;;* Install as minor mode::
 317  ;;* Menubar Support::
 318  ;;* Haskell Doc Mode::
 319  ;;* Switch it on or off::
 320  ;;* Check::
 321  ;;* Top level function::
 322  ;;* Mouse interface::
 323  ;;* Print fctsym::
 324  ;;* Movement::
 325  ;;* Bug Reports::
 326  ;;* Visit home site::
 327  ;;* Index::
 328  ;;* Token::
 329  ;;@end menu
 330  
 331  ;;@node top, Constants and Variables, (dir), (dir)
 332  ;;@top
 333  
 334  ;;@node Constants and Variables, Install as minor mode, top, top
 335  ;;@section Constants and Variables
 336  
 337  ;;@menu
 338  ;;* Emacs portability::
 339  ;;* Maintenance stuff::
 340  ;;* Mode Variable::
 341  ;;* Variables::
 342  ;;* Prelude types::
 343  ;;* Test membership::
 344  ;;@end menu
 345  
 346  ;;@node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables
 347  ;;@subsection Emacs portability
 348  
 349  (require 'haskell-mode)
 350  (eval-when-compile (require 'cl))
 351  
 352  (defgroup haskell-doc nil
 353    "Show Haskell function types in echo area."
 354    :group 'haskell
 355    :prefix "haskell-doc-")
 356  
 357  ;;@node Mode Variable, Variables, Maintenance stuff, Constants and Variables
 358  ;;@subsection Mode Variable
 359  
 360  (defvar haskell-doc-mode nil
 361    "*If non-nil, show the type of the function near point or a related comment.
 362  
 363  If the identifier near point is a Haskell keyword and the variable
 364  `haskell-doc-show-reserved' is non-nil show a one line summary
 365  of the syntax.
 366  
 367  If the identifier near point is a Prelude or one of the standard library
 368  functions and `haskell-doc-show-prelude' is non-nil show its type.
 369  
 370  If the identifier near point is local \(i.e. defined in this module\) check
 371  the `imenu' list of functions for the type. This obviously requires that
 372  your language mode uses `imenu' \(`haskell-hugs-mode' 0.6 for example\).
 373  
 374  If the identifier near point is global \(i.e. defined in an imported module\)
 375  and the variable `haskell-doc-show-global-types' is non-nil show the type of its
 376  function.
 377  
 378  If the identifier near point is a standard strategy or a function, type related
 379  related to strategies and `haskell-doc-show-strategy' is non-nil show the type
 380  of the function. Strategies are special to the parallel execution of Haskell.
 381  If you're not interested in that just turn it off.
 382  
 383  If the identifier near point is a user defined function that occurs as key
 384  in the alist `haskell-doc-user-defined-ids' and the variable
 385  `haskell-doc-show-user-defined' is non-nil show the type of the function.
 386  
 387  This variable is buffer-local.")
 388  (make-variable-buffer-local 'haskell-doc-mode)
 389  
 390  (defvar haskell-doc-mode-hook nil
 391   "Hook invoked when entering `haskell-doc-mode'.")
 392  
 393  (defvar haskell-doc-index nil
 394   "Variable holding an alist matching file names to fct-type alists.
 395  The function `haskell-doc-make-global-fct-index' rebuilds this variables \(similar to an
 396  `imenu' rescan\).
 397  This variable is buffer-local.")
 398  (make-variable-buffer-local 'haskell-doc-index)
 399  
 400  (defcustom haskell-doc-show-global-types nil
 401    "If non-nil, search for the types of global functions by loading the files.
 402  This variable is buffer-local."
 403    :type 'boolean)
 404  (make-variable-buffer-local 'haskell-doc-show-global-types)
 405  
 406  (defcustom haskell-doc-show-reserved t
 407    "If non-nil, show a documentation string for reserved ids.
 408  This variable is buffer-local."
 409    :type 'boolean)
 410  (make-variable-buffer-local 'haskell-doc-show-reserved)
 411  
 412  (defcustom haskell-doc-show-prelude t
 413    "If non-nil, show a documentation string for prelude functions.
 414  This variable is buffer-local."
 415    :type 'boolean)
 416  (make-variable-buffer-local 'haskell-doc-show-prelude)
 417  
 418  (defcustom haskell-doc-show-strategy t
 419    "If non-nil, show a documentation string for strategies.
 420  This variable is buffer-local."
 421    :type 'boolean)
 422  (make-variable-buffer-local 'haskell-doc-show-strategy)
 423  
 424  (defcustom haskell-doc-show-user-defined t
 425    "If non-nil, show a documentation string for user defined ids.
 426  This variable is buffer-local."
 427    :type 'boolean)
 428  (make-variable-buffer-local 'haskell-doc-show-user-defined)
 429  
 430  (defcustom haskell-doc-chop-off-context t
 431   "If non-nil eliminate the context part in a Haskell type."
 432   :type 'boolean)
 433  
 434  (defcustom haskell-doc-chop-off-fctname nil
 435    "If non-nil omit the function name and show only the type."
 436    :type 'boolean)
 437  
 438  (defvar haskell-doc-search-distance 40  ; distance in characters
 439   "*How far to search when looking for the type declaration of fct under cursor.")
 440  
 441  ;;@node Variables, Prelude types, Mode Variable, Constants and Variables
 442  ;;@subsection Variables
 443  
 444  (defvar haskell-doc-idle-delay 0.50
 445    "*Number of seconds of idle time to wait before printing.
 446  If user input arrives before this interval of time has elapsed after the
 447  last input, no documentation will be printed.
 448  
 449  If this variable is set to 0, no idle time is required.")
 450  
 451  (defvar haskell-doc-argument-case 'identity ; 'upcase
 452    "Case to display argument names of functions, as a symbol.
 453  This has two preferred values: `upcase' or `downcase'.
 454  Actually, any name of a function which takes a string as an argument and
 455  returns another string is acceptable.")
 456  
 457  (defvar haskell-doc-mode-message-commands nil
 458    "*Obarray of command names where it is appropriate to print in the echo area.
 459  
 460  This is not done for all commands since some print their own
 461  messages in the echo area, and these functions would instantly overwrite
 462  them.  But `self-insert-command' as well as most motion commands are good
 463  candidates.
 464  
 465  It is probably best to manipulate this data structure with the commands
 466  `haskell-doc-add-command' and `haskell-doc-remove-command'.")
 467  
 468  ;;(cond ((null haskell-doc-mode-message-commands)
 469  ;;       ;; If you increase the number of buckets, keep it a prime number.
 470  ;;       (setq haskell-doc-mode-message-commands (make-vector 31 0))
 471  ;;       (let ((list '("self-insert-command"
 472  ;;                     "next-"         "previous-"
 473  ;;                     "forward-"      "backward-"
 474  ;;                     "beginning-of-" "end-of-"
 475  ;;                     "goto-"
 476  ;;                     "recenter"
 477  ;;                     "scroll-"))
 478  ;;             (syms nil))
 479  ;;         (while list
 480  ;;           (setq syms (all-completions (car list) obarray 'fboundp))
 481  ;;           (setq list (cdr list))
 482  ;;           (while syms
 483  ;;             (set (intern (car syms) haskell-doc-mode-message-commands) t)
 484  ;;             (setq syms (cdr syms)))))))
 485  
 486  ;; Bookkeeping; the car contains the last symbol read from the buffer.
 487  ;; The cdr contains the string last displayed in the echo area, so it can
 488  ;; be printed again if necessary without reconsing.
 489  (defvar haskell-doc-last-data '(nil . nil))
 490  
 491  (defvar haskell-doc-minor-mode-string
 492    '(haskell-doc-show-global-types " DOC" " Doc")
 493    "*String to display in mode line when Haskell-Doc Mode is enabled.")
 494  
 495  
 496  ;;@node Prelude types, Test membership, Variables, Constants and Variables
 497  ;;@subsection Prelude types
 498  
 499  ;;@cindex haskell-doc-reserved-ids
 500  
 501  (defvar haskell-doc-reserved-ids
 502    '(("case" . "case exp of { alts [;] }")
 503      ("class" . "class [context =>] simpleclass [where { cbody [;] }]")
 504      ("data" . "data [context =>] simpletype = constrs [deriving]")
 505      ("default" . "default (type1 , ... , typen)")
 506      ("deriving" . "deriving (dclass | (dclass1, ... , dclassn))") ; used with data or newtype
 507      ("do" . "do { stmts [;] }  stmts -> exp [; stmts] | pat <- exp ; stmts | let decllist ; stmts")
 508      ("else" . "if exp then exp else exp")
 509      ("if" . "if exp then exp else exp")
 510      ("import" . "import [qualified] modid [as modid] [impspec]")
 511      ("in" . "let decllist in exp")
 512      ("infix" . "infix [digit] ops")
 513      ("infixl" . "infixl [digit] ops")
 514      ("infixr" . "infixr [digit] ops")
 515      ("instance" . "instance [context =>] qtycls inst [where { valdefs [;] }]")
 516      ("let" . "let { decl; ...; decl [;] } in exp")
 517      ("module" . "module modid [exports] where body")
 518      ("newtype" . "newtype [context =>] simpletype = con atype [deriving]")
 519      ("of" . "case exp of { alts [;] }")
 520      ("then" . "if exp then exp else exp")
 521      ("type" . "type simpletype = type")
 522      ("where" . "exp where { decl; ...; decl [;] }") ; check that ; see also class, instance, module
 523      ("as" . "import [qualified] modid [as modid] [impspec]")
 524      ("qualified" . "import [qualified] modid [as modid] [impspec]")
 525      ("hiding" . "hiding ( import1 , ... , importn [ , ] )"))
 526   "An alist of reserved identifiers.
 527  Each element is of the form (ID . DOC) where both ID and DOC are strings.
 528  DOC should be a concise single-line string describing the construct in which
 529  the keyword is used.")
 530  
 531  ;;@cindex haskell-doc-prelude-types
 532  
 533  (defun haskell-doc-extract-types (url)
 534    (with-temp-buffer
 535      (insert-file-contents url)
 536      (goto-char (point-min))
 537      (while (search-forward "&nbsp;" nil t) (replace-match " " t t))
 538  
 539      ;; First, focus on the actual code, removing the surrouding HTML text.
 540      (goto-char (point-min))
 541      (let ((last (point-min))
 542            (modules nil))
 543        (while (re-search-forward "^module +\\([[:alnum:]]+\\)" nil t)
 544          (let ((module (match-string 1)))
 545            (if (member module modules)
 546                ;; The library nodes of the HTML doc contain modules twice:
 547                ;; once at the top, with only type declarations, and once at
 548                ;; the bottom with an actual sample implementation which may
 549                ;; include declaration of non-exported values.
 550                ;; We're now at this second occurrence is the implementation
 551                ;; which should thus be ignored.
 552                nil
 553              (push module modules)
 554              (delete-region last (point))
 555              (search-forward "</tt>")
 556              ;; Some of the blocks of code are split.
 557              (while (looking-at "\\(<[^<>]+>[ \t\n]*\\)*<tt>")
 558                (goto-char (match-end 0))
 559                (search-forward "</tt>"))
 560              (setq last (point)))))
 561        (delete-region last (point-max))
 562  
 563        ;; Then process the HTML encoding to get back to pure ASCII.
 564        (goto-char (point-min))
 565        (while (search-forward "<br>" nil t) (replace-match "\n" t t))
 566        ;; (goto-char (point-min))
 567        ;; (while (re-search-forward "<[^<>]+>" nil t) (replace-match "" t t))
 568        (goto-char (point-min))
 569        (while (search-forward "&gt;" nil t) (replace-match ">" t t))
 570        (goto-char (point-min))
 571        (while (search-forward "&lt;" nil t) (replace-match "<" t t))
 572        (goto-char (point-min))
 573        (while (search-forward "&amp;" nil t) (replace-match "&" t t))
 574        (goto-char (point-min))
 575        (if (re-search-forward "&[a-z]+;" nil t)
 576            (error "Unexpected charref %s" (match-string 0)))
 577        ;; Remove TABS.
 578        (goto-char (point-min))
 579        (while (search-forward "\t" nil t) (replace-match "        " t t))
 580  
 581        ;; Finally, extract the actual data.
 582        (goto-char (point-min))
 583        (let* ((elems nil)
 584               (space-re "[ \t\n]*\\(?:--.*\n[ \t\n]*\\)*")
 585               (comma-re (concat " *," space-re))
 586               ;; A list of identifiers.  We have to be careful to weed out
 587               ;; entries like "ratPrec = 7 :: Int".  Also ignore entries
 588               ;; which start with a < since they're actually in the HTML text
 589               ;; part.  And the list may be spread over several lines, cut
 590               ;; after a comma.
 591               (idlist-re
 592                (concat "\\([^< \t\n][^ \t\n]*"
 593                        "\\(?:" comma-re "[^ \t\n]+\\)*\\)"))
 594               ;; A type.  A few types are spread over 2 lines,
 595               ;; cut after the "=>", so we have to handle these as well.
 596               (type-re "\\(.*[^\n>]\\(?:>[ \t\n]+.*[^\n>]\\)*\\) *$")
 597               ;; A decl of a list of values, possibly indented.
 598               (val-decl-re
 599                (concat "^\\( +\\)?" idlist-re "[ \t\n]*::[ \t\n]*" type-re))
 600               (re (concat
 601                   ;; 3 possibilities: a class decl, a data decl, or val decl.
 602                   ;; First, let's match a class decl.
 603                   "^class \\(?:.*=>\\)? *\\(.*[^ \t\n]\\)[ \t\n]*where"
 604  
 605                   ;; Or a value decl:
 606                   "\\|" val-decl-re
 607  
 608                   "\\|" ;; Or a data decl.  We only handle single-arm
 609                   ;; datatypes with labels.
 610                   "^data +\\([[:alnum:]][[:alnum:] ]*[[:alnum:]]\\)"
 611                   " *=.*{\\([^}]+\\)}"
 612                   ))
 613               (re-class (concat "^[^ \t\n]\\|" re))
 614               curclass)
 615          (while (re-search-forward (if curclass re-class re) nil t)
 616            (cond
 617             ;; A class decl.
 618             ((match-end 1) (setq curclass (match-string 1)))
 619             ;; A value decl.
 620             ((match-end 4)
 621              (let ((type (match-string 4))
 622                    (vars (match-string 3))
 623                    (indented (match-end 2)))
 624                (if (string-match "[ \t\n][ \t\n]+" type)
 625                    (setq type (replace-match " " t t type)))
 626                (if (string-match " *\\(--.*\\)?\\'" type)
 627                    (setq type (substring type 0 (match-beginning 0))))
 628                (if indented
 629                    (if curclass
 630                        (if (string-match "\\`\\(.*[^ \t\n]\\) *=> *" type)
 631                            (let ((classes (match-string 1 type)))
 632                              (setq type (substring type (match-end 0)))
 633                              (if (string-match "\\`(.*)\\'" classes)
 634                                  (setq classes (substring classes 1 -1)))
 635                              (setq type (concat "(" curclass ", " classes
 636                                                 ") => " type)))
 637                        (setq type (concat curclass " => " type)))
 638                      ;; It's actually not an error: just a type annotation on
 639                      ;; some local variable.
 640                      ;; (error "Indentation outside a class in %s: %s"
 641                      ;;        module vars)
 642                      nil)
 643                  (setq curclass nil))
 644                (dolist (var (split-string vars comma-re t))
 645                  (if (string-match "(.*)" var) (setq var (substring var 1 -1)))
 646                  (push (cons var type) elems))))
 647             ;; A datatype decl.
 648             ((match-end 5)
 649              (setq curclass nil)
 650              (let ((name (match-string 5)))
 651                (save-excursion
 652                  (save-restriction
 653                    (narrow-to-region (match-beginning 6) (match-end 6))
 654                    (goto-char (point-min))
 655                    (while (re-search-forward val-decl-re nil t)
 656                      (let ((vars (match-string 2))
 657                            (type (match-string 3)))
 658                        (if (string-match "[ \t\n][ \t\n]+" type)
 659                            (setq type (replace-match " " t t type)))
 660                        (if (string-match " *\\(--.*\\)?\\'" type)
 661                            (setq type (substring type 0 (match-beginning 0))))
 662                        (if (string-match ",\\'" type)
 663                            (setq type (substring type 0 -1)))
 664                        (setq type (concat name " -> " type))
 665                        (dolist (var (split-string vars comma-re t))
 666                          (if (string-match "(.*)" var)
 667                              (setq var (substring var 1 -1)))
 668                          (push (cons var type) elems))))))))
 669  
 670             ;; The end of a class declaration.
 671             (t (setq curclass nil) (beginning-of-line))))
 672          (cons (car (last modules)) elems)))))
 673  
 674  (defun haskell-doc-fetch-lib-urls (base-url)
 675    (with-temp-buffer
 676      (insert-file-contents base-url)
 677      (goto-char (point-min))
 678      (search-forward "Part II: Libraries")
 679      (delete-region (point-min) (point))
 680      (search-forward "</table>")
 681      (delete-region (point) (point-max))
 682      (goto-char (point-min))
 683      (let ((libs (list "standard-prelude.html")))
 684        (while (re-search-forward "<a href=\"\\([^\"]+\\)\">" nil t)
 685          (push (match-string 1) libs))
 686        (mapcar (lambda (s) (expand-file-name s (file-name-directory base-url)))
 687                (nreverse libs)))))
 688  
 689  (defun haskell-doc-extract-and-insert-types (url)
 690    "Fetch the types from the online doc and insert them at point.
 691  URL is the URL of the online doc."
 692    (interactive (if current-prefix-arg
 693                     (read-file-name "URL: ")
 694                   (list "http://www.haskell.org/onlinereport/")))
 695    (let ((urls (haskell-doc-fetch-lib-urls url)))
 696      (dolist (url urls)
 697        (let ((data (haskell-doc-extract-types url)))
 698          (insert ";; " (pop data)) (indent-according-to-mode) (newline)
 699          (dolist (elem (sort data (lambda (x y) (string-lessp (car x) (car y)))))
 700            (prin1 elem (current-buffer))
 701            (indent-according-to-mode) (newline))))))
 702  
 703  (defvar haskell-doc-prelude-types
 704    ;; This list was auto generated by `haskell-doc-extract-and-insert-types'.
 705    '(
 706      ;; Prelude
 707      ("!!" . "[a] -> Int -> a")
 708      ("$" . "(a -> b) -> a -> b")
 709      ("$!" . "(a -> b) -> a -> b")
 710      ("&&" . "Bool -> Bool -> Bool")
 711      ("*" . "Num a => a -> a -> a")
 712      ("**" . "Floating a => a -> a -> a")
 713      ("+" . "Num a => a -> a -> a")
 714      ("++" . "[a] -> [a] -> [a]")
 715      ("-" . "Num a => a -> a -> a")
 716      ("." . "(b -> c) -> (a -> b) -> a -> c")
 717      ("/" . "Fractional a => a -> a -> a")
 718      ("/=" . "Eq a => a -> a -> Bool")
 719      ("<" . "Ord a => a -> a -> Bool")
 720      ("<=" . "Ord a => a -> a -> Bool")
 721      ("=<<" . "Monad m => (a -> m b) -> m a -> m b")
 722      ("==" . "Eq a => a -> a -> Bool")
 723      (">" . "Ord a => a -> a -> Bool")
 724      (">=" . "Ord a => a -> a -> Bool")
 725      (">>" . "Monad m => m a -> m b -> m b")
 726      (">>=" . "Monad m => m a -> (a -> m b) -> m b")
 727      ("^" . "(Num a, Integral b) => a -> b -> a")
 728      ("^^" . "(Fractional a, Integral b) => a -> b -> a")
 729      ("abs" . "Num a => a -> a")
 730      ("acos" . "Floating a => a -> a")
 731      ("acosh" . "Floating a => a -> a")
 732      ("all" . "(a -> Bool) -> [a] -> Bool")
 733      ("and" . "[Bool] -> Bool")
 734      ("any" . "(a -> Bool) -> [a] -> Bool")
 735      ("appendFile" . "FilePath -> String -> IO ()")
 736      ("asTypeOf" . "a -> a -> a")
 737      ("asin" . "Floating a => a -> a")
 738      ("asinh" . "Floating a => a -> a")
 739      ("atan" . "Floating a => a -> a")
 740      ("atan2" . "RealFloat a => a -> a -> a")
 741      ("atanh" . "Floating a => a -> a")
 742      ("break" . "(a -> Bool) -> [a] -> ([a],[a])")
 743      ("catch" . "IO a -> (IOError -> IO a) -> IO a")
 744      ("ceiling" . "(RealFrac a, Integral b) => a -> b")
 745      ("compare" . "Ord a => a -> a -> Ordering")
 746      ("concat" . "[[a]] -> [a]")
 747      ("concatMap" . "(a -> [b]) -> [a] -> [b]")
 748      ("const" . "a -> b -> a")
 749      ("cos" . "Floating a => a -> a")
 750      ("cosh" . "Floating a => a -> a")
 751      ("curry" . "((a, b) -> c) -> a -> b -> c")
 752      ("cycle" . "[a] -> [a]")
 753      ("decodeFloat" . "RealFloat a => a -> (Integer,Int)")
 754      ("div" . "Integral a => a -> a -> a")
 755      ("divMod" . "Integral a => a -> a -> (a,a)")
 756      ("drop" . "Int -> [a] -> [a]")
 757      ("dropWhile" . "(a -> Bool) -> [a] -> [a]")
 758      ("either" . "(a -> c) -> (b -> c) -> Either a b -> c")
 759      ("elem" . "(Eq a) => a -> [a] -> Bool")
 760      ("encodeFloat" . "RealFloat a => Integer -> Int -> a")
 761      ("enumFrom" . "Enum a => a -> [a]")
 762      ("enumFromThen" . "Enum a => a -> a -> [a]")
 763      ("enumFromThenTo" . "Enum a => a -> a -> a -> [a]")
 764      ("enumFromTo" . "Enum a => a -> a -> [a]")
 765      ("error" . "String -> a")
 766      ("even" . "(Integral a) => a -> Bool")
 767      ("exp" . "Floating a => a -> a")
 768      ("exponent" . "RealFloat a => a -> Int")
 769      ("fail" . "Monad m => String -> m a")
 770      ("filter" . "(a -> Bool) -> [a] -> [a]")
 771      ("flip" . "(a -> b -> c) -> b -> a -> c")
 772      ("floatDigits" . "RealFloat a => a -> Int")
 773      ("floatRadix" . "RealFloat a => a -> Integer")
 774      ("floatRange" . "RealFloat a => a -> (Int,Int)")
 775      ("floor" . "(RealFrac a, Integral b) => a -> b")
 776      ("fmap" . "Functor f => (a -> b) -> f a -> f b")
 777      ("foldl" . "(a -> b -> a) -> a -> [b] -> a")
 778      ("foldl1" . "(a -> a -> a) -> [a] -> a")
 779      ("foldr" . "(a -> b -> b) -> b -> [a] -> b")
 780      ("foldr1" . "(a -> a -> a) -> [a] -> a")
 781      ("fromEnum" . "Enum a => a -> Int")
 782      ("fromInteger" . "Num a => Integer -> a")
 783      ("fromIntegral" . "(Integral a, Num b) => a -> b")
 784      ("fromRational" . "Fractional a => Rational -> a")
 785      ("fst" . "(a,b) -> a")
 786      ("gcd" . "(Integral a) => a -> a -> a")
 787      ("getChar" . "IO Char")
 788      ("getContents" . "IO String")
 789      ("getLine" . "IO String")
 790      ("head" . "[a] -> a")
 791      ("id" . "a -> a")
 792      ("init" . "[a] -> [a]")
 793      ("interact" . "(String -> String) -> IO ()")
 794      ("ioError" . "IOError -> IO a")
 795      ("isDenormalized" . "RealFloat a => a -> Bool")
 796      ("isIEEE" . "RealFloat a => a -> Bool")
 797      ("isInfinite" . "RealFloat a => a -> Bool")
 798      ("isNaN" . "RealFloat a => a -> Bool")
 799      ("isNegativeZero" . "RealFloat a => a -> Bool")
 800      ("iterate" . "(a -> a) -> a -> [a]")
 801      ("last" . "[a] -> a")
 802      ("lcm" . "(Integral a) => a -> a -> a")
 803      ("length" . "[a] -> Int")
 804      ("lex" . "ReadS String")
 805      ("lines" . "String -> [String]")
 806      ("log" . "Floating a => a -> a")
 807      ("logBase" . "Floating a => a -> a -> a")
 808      ("lookup" . "(Eq a) => a -> [(a,b)] -> Maybe b")
 809      ("map" . "(a -> b) -> [a] -> [b]")
 810      ("mapM" . "Monad m => (a -> m b) -> [a] -> m [b]")
 811      ("mapM_" . "Monad m => (a -> m b) -> [a] -> m ()")
 812      ("max" . "Ord a => a -> a -> a")
 813      ("maxBound" . "Bounded a => a")
 814      ("maximum" . "(Ord a) => [a] -> a")
 815      ("maybe" . "b -> (a -> b) -> Maybe a -> b")
 816      ("min" . "Ord a => a -> a -> a")
 817      ("minBound" . "Bounded a => a")
 818      ("minimum" . "(Ord a) => [a] -> a")
 819      ("mod" . "Integral a => a -> a -> a")
 820      ("negate" . "Num a => a -> a")
 821      ("not" . "Bool -> Bool")
 822      ("notElem" . "(Eq a) => a -> [a] -> Bool")
 823      ("null" . "[a] -> Bool")
 824      ("numericEnumFrom" . "(Fractional a) => a -> [a]")
 825      ("numericEnumFromThen" . "(Fractional a) => a -> a -> [a]")
 826      ("numericEnumFromThenTo" . "(Fractional a, Ord a) => a -> a -> a -> [a]")
 827      ("numericEnumFromTo" . "(Fractional a, Ord a) => a -> a -> [a]")
 828      ("odd" . "(Integral a) => a -> Bool")
 829      ("or" . "[Bool] -> Bool")
 830      ("otherwise" . "Bool")
 831      ("pi" . "Floating a => a")
 832      ("pred" . "Enum a => a -> a")
 833      ("print" . "Show a => a -> IO ()")
 834      ("product" . "(Num a) => [a] -> a")
 835      ("properFraction" . "(RealFrac a, Integral b) => a -> (b,a)")
 836      ("putChar" . "Char -> IO ()")
 837      ("putStr" . "String -> IO ()")
 838      ("putStrLn" . "String -> IO ()")
 839      ("quot" . "Integral a => a -> a -> a")
 840      ("quotRem" . "Integral a => a -> a -> (a,a)")
 841      ("read" . "(Read a) => String -> a")
 842      ("readFile" . "FilePath -> IO String")
 843      ("readIO" . "Read a => String -> IO a")
 844      ("readList" . "Read a => ReadS [a]")
 845      ("readLn" . "Read a => IO a")
 846      ("readParen" . "Bool -> ReadS a -> ReadS a")
 847      ("reads" . "(Read a) => ReadS a")
 848      ("readsPrec" . "Read a => Int -> ReadS a")
 849      ("realToFrac" . "(Real a, Fractional b) => a -> b")
 850      ("recip" . "Fractional a => a -> a")
 851      ("rem" . "Integral a => a -> a -> a")
 852      ("repeat" . "a -> [a]")
 853      ("replicate" . "Int -> a -> [a]")
 854      ("return" . "Monad m => a -> m a")
 855      ("reverse" . "[a] -> [a]")
 856      ("round" . "(RealFrac a, Integral b) => a -> b")
 857      ("scaleFloat" . "RealFloat a => Int -> a -> a")
 858      ("scanl" . "(a -> b -> a) -> a -> [b] -> [a]")
 859      ("scanl1" . "(a -> a -> a) -> [a] -> [a]")
 860      ("scanr" . "(a -> b -> b) -> b -> [a] -> [b]")
 861      ("scanr1" . "(a -> a -> a) -> [a] -> [a]")
 862      ("seq" . "a -> b -> b")
 863      ("sequence" . "Monad m => [m a] -> m [a]")
 864      ("sequence_" . "Monad m => [m a] -> m ()")
 865      ("show" . "Show a => a -> String")
 866      ("showChar" . "Char -> ShowS")
 867      ("showList" . "Show a => [a] -> ShowS")
 868      ("showParen" . "Bool -> ShowS -> ShowS")
 869      ("showString" . "String -> ShowS")
 870      ("shows" . "(Show a) => a -> ShowS")
 871      ("showsPrec" . "Show a => Int -> a -> ShowS")
 872      ("significand" . "RealFloat a => a -> a")
 873      ("signum" . "Num a => a -> a")
 874      ("sin" . "Floating a => a -> a")
 875      ("sinh" . "Floating a => a -> a")
 876      ("snd" . "(a,b) -> b")
 877      ("span" . "(a -> Bool) -> [a] -> ([a],[a])")
 878      ("splitAt" . "Int -> [a] -> ([a],[a])")
 879      ("sqrt" . "Floating a => a -> a")
 880      ("subtract" . "(Num a) => a -> a -> a")
 881      ("succ" . "Enum a => a -> a")
 882      ("sum" . "(Num a) => [a] -> a")
 883      ("tail" . "[a] -> [a]")
 884      ("take" . "Int -> [a] -> [a]")
 885      ("takeWhile" . "(a -> Bool) -> [a] -> [a]")
 886      ("tan" . "Floating a => a -> a")
 887      ("tanh" . "Floating a => a -> a")
 888      ("toEnum" . "Enum a => Int -> a")
 889      ("toInteger" . "Integral a => a -> Integer")
 890      ("toRational" . "Real a => a -> Rational")
 891      ("truncate" . "(RealFrac a, Integral b) => a -> b")
 892      ("uncurry" . "(a -> b -> c) -> ((a, b) -> c)")
 893      ("undefined" . "a")
 894      ("unlines" . "[String] -> String")
 895      ("until" . "(a -> Bool) -> (a -> a) -> a -> a")
 896      ("unwords" . "[String] -> String")
 897      ("unzip" . "[(a,b)] -> ([a],[b])")
 898      ("unzip3" . "[(a,b,c)] -> ([a],[b],[c])")
 899      ("userError" . "String -> IOError")
 900      ("words" . "String -> [String]")
 901      ("writeFile" . "FilePath -> String -> IO ()")
 902      ("zip" . "[a] -> [b] -> [(a,b)]")
 903      ("zip3" . "[a] -> [b] -> [c] -> [(a,b,c)]")
 904      ("zipWith" . "(a->b->c) -> [a]->[b]->[c]")
 905      ("zipWith3" . "(a->b->c->d) -> [a]->[b]->[c]->[d]")
 906      ("||" . "Bool -> Bool -> Bool")
 907      ;; Ratio
 908      ("%" . "(Integral a) => a -> a -> Ratio a")
 909      ("approxRational" . "(RealFrac a) => a -> a -> Rational")
 910      ("denominator" . "(Integral a) => Ratio a -> a")
 911      ("numerator" . "(Integral a) => Ratio a -> a")
 912      ;; Complex
 913      ("cis" . "(RealFloat a) => a -> Complex a")
 914      ("conjugate" . "(RealFloat a) => Complex a -> Complex a")
 915      ("imagPart" . "(RealFloat a) => Complex a -> a")
 916      ("magnitude" . "(RealFloat a) => Complex a -> a")
 917      ("mkPolar" . "(RealFloat a) => a -> a -> Complex a")
 918      ("phase" . "(RealFloat a) => Complex a -> a")
 919      ("polar" . "(RealFloat a) => Complex a -> (a,a)")
 920      ("realPart" . "(RealFloat a) => Complex a -> a")
 921      ;; Numeric
 922      ("floatToDigits" . "(RealFloat a) => Integer -> a -> ([Int], Int)")
 923      ("fromRat" . "(RealFloat a) => Rational -> a")
 924      ("lexDigits" . "ReadS String")
 925      ("readDec" . "(Integral a) => ReadS a")
 926      ("readFloat" . "(RealFrac a) => ReadS a")
 927      ("readHex" . "(Integral a) => ReadS a")
 928      ("readInt" . "(Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a")
 929      ("readOct" . "(Integral a) => ReadS a")
 930      ("readSigned" . "(Real a) => ReadS a -> ReadS a")
 931      ("showEFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS")
 932      ("showFFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS")
 933      ("showFloat" . "(RealFloat a) => a -> ShowS")
 934      ("showGFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS")
 935      ("showHex" . "Integral a => a -> ShowS")
 936      ("showInt" . "Integral a => a -> ShowS")
 937      ("showIntAtBase" . "Integral a => a -> (Int -> Char) -> a -> ShowS")
 938      ("showOct" . "Integral a => a -> ShowS")
 939      ("showSigned" . "(Real a) => (a -> ShowS) -> Int -> a -> ShowS")
 940      ;; Ix
 941      ("inRange" . "Ix a => (a,a) -> a -> Bool")
 942      ("index" . "Ix a => (a,a) -> a -> Int")
 943      ("range" . "Ix a => (a,a) -> [a]")
 944      ("rangeSize" . "Ix a => (a,a) -> Int")
 945      ;; Array
 946      ("!" . "(Ix a) => Array a b -> a -> b")
 947      ("//" . "(Ix a) => Array a b -> [(a,b)] -> Array a b")
 948      ("accum" . "(Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]")
 949      ("accumArray" . "(Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]")
 950      ("array" . "(Ix a) => (a,a) -> [(a,b)] -> Array a b")
 951      ("assocs" . "(Ix a) => Array a b -> [(a,b)]")
 952      ("bounds" . "(Ix a) => Array a b -> (a,a)")
 953      ("elems" . "(Ix a) => Array a b -> [b]")
 954      ("indices" . "(Ix a) => Array a b -> [a]")
 955      ("ixmap" . "(Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c")
 956      ("listArray" . "(Ix a) => (a,a) -> [b] -> Array a b")
 957      ;; List
 958      ("\\\\" . "Eq a => [a] -> [a] -> [a]")
 959      ("delete" . "Eq a => a -> [a] -> [a]")
 960      ("deleteBy" . "(a -> a -> Bool) -> a -> [a] -> [a]")
 961      ("deleteFirstsBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]")
 962      ("elemIndex" . "Eq a => a -> [a] -> Maybe Int")
 963      ("elemIndices" . "Eq a => a -> [a] -> [Int]")
 964      ("find" . "(a -> Bool) -> [a] -> Maybe a")
 965      ("findIndex" . "(a -> Bool) -> [a] -> Maybe Int")
 966      ("findIndices" . "(a -> Bool) -> [a] -> [Int]")
 967      ("genericDrop" . "Integral a => a -> [b] -> [b]")
 968      ("genericIndex" . "Integral a => [b] -> a -> b")
 969      ("genericLength" . "Integral a => [b] -> a")
 970      ("genericReplicate" . "Integral a => a -> b -> [b]")
 971      ("genericSplitAt" . "Integral a => a -> [b] -> ([b],[b])")
 972      ("genericTake" . "Integral a => a -> [b] -> [b]")
 973      ("group" . "Eq a => [a] -> [[a]]")
 974      ("groupBy" . "(a -> a -> Bool) -> [a] -> [[a]]")
 975      ("inits" . "[a] -> [[a]]")
 976      ("insert" . "Ord a => a -> [a] -> [a]")
 977      ("insertBy" . "(a -> a -> Ordering) -> a -> [a] -> [a]")
 978      ("intersect" . "Eq a => [a] -> [a] -> [a]")
 979      ("intersectBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]")
 980      ("intersperse" . "a -> [a] -> [a]")
 981      ("isPrefixOf" . "Eq a => [a] -> [a] -> Bool")
 982      ("isSuffixOf" . "Eq a => [a] -> [a] -> Bool")
 983      ("mapAccumL" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])")
 984      ("mapAccumR" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])")
 985      ("maximumBy" . "(a -> a -> Ordering) -> [a] -> a")
 986      ("minimumBy" . "(a -> a -> Ordering) -> [a] -> a")
 987      ("nub" . "Eq a => [a] -> [a]")
 988      ("nubBy" . "(a -> a -> Bool) -> [a] -> [a]")
 989      ("partition" . "(a -> Bool) -> [a] -> ([a],[a])")
 990      ("sort" . "Ord a => [a] -> [a]")
 991      ("sortBy" . "(a -> a -> Ordering) -> [a] -> [a]")
 992      ("tails" . "[a] -> [[a]]")
 993      ("transpose" . "[[a]] -> [[a]]")
 994      ("unfoldr" . "(b -> Maybe (a,b)) -> b -> [a]")
 995      ("union" . "Eq a => [a] -> [a] -> [a]")
 996      ("unionBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]")
 997      ("unzip4" . "[(a,b,c,d)] -> ([a],[b],[c],[d])")
 998      ("unzip5" . "[(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])")
 999      ("unzip6" . "[(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])")
1000      ("unzip7" . "[(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])")
1001      ("zip4" . "[a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]")
1002      ("zip5" . "[a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]")
1003      ("zip6" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f]")
1004      ("zip7" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]")
1005      ("zipWith4" . "(a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]")
1006      ("zipWith5" . "(a->b->c->d->e->f) ->")
1007      ("zipWith6" . "(a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]")
1008      ("zipWith7" . "(a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]")
1009      ;; Maybe
1010      ("catMaybes" . "[Maybe a] -> [a]")
1011      ("fromJust" . "Maybe a -> a")
1012      ("fromMaybe" . "a -> Maybe a -> a")
1013      ("isJust" . "Maybe a -> Bool")
1014      ("isNothing" . "Maybe a -> Bool")
1015      ("listToMaybe" . "[a] -> Maybe a")
1016      ("mapMaybe" . "(a -> Maybe b) -> [a] -> [b]")
1017      ("maybeToList" . "Maybe a -> [a]")
1018      ;; Char
1019      ("chr" . "Int -> Char")
1020      ("digitToInt" . "Char -> Int")
1021      ("intToDigit" . "Int -> Char")
1022      ("isAlpha" . "Char -> Bool")
1023      ("isAlphaNum" . "Char -> Bool")
1024      ("isAscii" . "Char -> Bool")
1025      ("isControl" . "Char -> Bool")
1026      ("isDigit" . "Char -> Bool")
1027      ("isHexDigit" . "Char -> Bool")
1028      ("isLatin1" . "Char -> Bool")
1029      ("isLower" . "Char -> Bool")
1030      ("isOctDigit" . "Char -> Bool")
1031      ("isPrint" . "Char -> Bool")
1032      ("isSpace" . "Char -> Bool")
1033      ("isUpper" . "Char -> Bool")
1034      ("lexLitChar" . "ReadS String")
1035      ("ord" . "Char -> Int")
1036      ("readLitChar" . "ReadS Char")
1037      ("showLitChar" . "Char -> ShowS")
1038      ("toLower" . "Char -> Char")
1039      ("toUpper" . "Char -> Char")
1040      ;; Monad
1041      ("ap" . "Monad m => m (a -> b) -> m a -> m b")
1042      ("filterM" . "Monad m => (a -> m Bool) -> [a] -> m [a]")
1043      ("foldM" . "Monad m => (a -> b -> m a) -> a -> [b] -> m a")
1044      ("guard" . "MonadPlus m => Bool -> m ()")
1045      ("join" . "Monad m => m (m a) -> m a")
1046      ("liftM" . "Monad m => (a -> b) -> (m a -> m b)")
1047      ("liftM2" . "Monad m => (a -> b -> c) -> (m a -> m b -> m c)")
1048      ("liftM3" . "Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)")
1049      ("liftM4" . "Monad m => (a -> b -> c -> d -> e) -> (m a -> m b -> m c -> m d -> m e)")
1050      ("liftM5" . "Monad m => (a -> b -> c -> d -> e -> f) -> (m a -> m b -> m c -> m d -> m e -> m f)")
1051      ("mapAndUnzipM" . "Monad m => (a -> m (b,c)) -> [a] -> m ([b], [c])")
1052      ("mplus" . "MonadPlus m => m a -> m a -> m a")
1053      ("msum" . "MonadPlus m => [m a] -> m a")
1054      ("mzero" . "MonadPlus m => m a")
1055      ("unless" . "Monad m => Bool -> m () -> m ()")
1056      ("when" . "Monad m => Bool -> m () -> m ()")
1057      ("zipWithM" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]")
1058      ("zipWithM_" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()")
1059      ;; IO
1060      ("bracket" . "IO a -> (a -> IO b) -> (a -> IO c) -> IO c")
1061      ("bracket_" . "IO a -> (a -> IO b) -> IO c -> IO c")
1062      ("hClose" . "Handle -> IO ()")
1063      ("hFileSize" . "Handle -> IO Integer")
1064      ("hFlush" . "Handle -> IO ()")
1065      ("hGetBuffering" . "Handle -> IO BufferMode")
1066      ("hGetChar" . "Handle -> IO Char")
1067      ("hGetContents" . "Handle -> IO String")
1068      ("hGetLine" . "Handle -> IO String")
1069      ("hGetPosn" . "Handle -> IO HandlePosn")
1070      ("hIsClosed" . "Handle -> IO Bool")
1071      ("hIsEOF" . "Handle -> IO Bool")
1072      ("hIsOpen" . "Handle -> IO Bool")
1073      ("hIsReadable" . "Handle -> IO Bool")
1074      ("hIsSeekable" . "Handle -> IO Bool")
1075      ("hIsWritable" . "Handle -> IO Bool")
1076      ("hLookAhead" . "Handle -> IO Char")
1077      ("hPrint" . "Show a => Handle -> a -> IO ()")
1078      ("hPutChar" . "Handle -> Char -> IO ()")
1079      ("hPutStr" . "Handle -> String -> IO ()")
1080      ("hPutStrLn" . "Handle -> String -> IO ()")
1081      ("hReady" . "Handle -> IO Bool")
1082      ("hSeek" . "Handle -> SeekMode -> Integer -> IO ()")
1083      ("hSetBuffering" . "Handle -> BufferMode -> IO ()")
1084      ("hSetPosn" . "HandlePosn -> IO ()")
1085      ("hWaitForInput" . "Handle -> Int -> IO Bool")
1086      ("ioeGetErrorString" . "IOError -> String")
1087      ("ioeGetFileName" . "IOError -> Maybe FilePath")
1088      ("ioeGetHandle" . "IOError -> Maybe Handle")
1089      ("isAlreadyExistsError" . "IOError -> Bool")
1090      ("isAlreadyInUseError" . "IOError -> Bool")
1091      ("isDoesNotExistError" . "IOError -> Bool")
1092      ("isEOF" . "IO Bool")
1093      ("isEOFError" . "IOError -> Bool")
1094      ("isFullError" . "IOError -> Bool")
1095      ("isIllegalOperation" . "IOError -> Bool")
1096      ("isPermissionError" . "IOError -> Bool")
1097      ("isUserError" . "IOError -> Bool")
1098      ("openFile" . "FilePath -> IOMode -> IO Handle")
1099      ("stderr" . "Handle")
1100      ("stdin" . "Handle")
1101      ("stdout" . "Handle")
1102      ("try" . "IO a -> IO (Either IOError a)")
1103      ;; Directory
1104      ("createDirectory" . "FilePath -> IO ()")
1105      ("doesDirectoryExist" . "FilePath -> IO Bool")
1106      ("doesFileExist" . "FilePath -> IO Bool")
1107      ("executable" . "Permissions -> Bool")
1108      ("getCurrentDirectory" . "IO FilePath")
1109      ("getDirectoryContents" . "FilePath -> IO [FilePath]")
1110      ("getModificationTime" . "FilePath -> IO ClockTime")
1111      ("getPermissions" . "FilePath -> IO Permissions")
1112      ("readable" . "Permissions -> Bool")
1113      ("removeDirectory" . "FilePath -> IO ()")
1114      ("removeFile" . "FilePath -> IO ()")
1115      ("renameDirectory" . "FilePath -> FilePath -> IO ()")
1116      ("renameFile" . "FilePath -> FilePath -> IO ()")
1117      ("searchable" . "Permissions -> Bool")
1118      ("setCurrentDirectory" . "FilePath -> IO ()")
1119      ("setPermissions" . "FilePath -> Permissions -> IO ()")
1120      ("writable" . "Permissions -> Bool")
1121      ;; System
1122      ("exitFailure" . "IO a")
1123      ("exitWith" . "ExitCode -> IO a")
1124      ("getArgs" . "IO [String]")
1125      ("getEnv" . "String -> IO String")
1126      ("getProgName" . "IO String")
1127      ("system" . "String -> IO ExitCode")
1128      ;; Time
1129      ("addToClockTime" . "TimeDiff -> ClockTime -> ClockTime")
1130      ("calendarTimeToString" . "CalendarTime -> String")
1131      ("ctDay" . "CalendarTime -> Int")
1132      ("ctHour" . "CalendarTime -> Int")
1133      ("ctIsDST" . "CalendarTime -> Bool")
1134      ("ctMin" . "CalendarTime -> Int")
1135      ("ctMonth" . "CalendarTime -> Month")
1136      ("ctPicosec" . "CalendarTime -> Integer")
1137      ("ctSec" . "CalendarTime -> Int")
1138      ("ctTZ" . "CalendarTime -> Int")
1139      ("ctTZName" . "CalendarTime -> String")
1140      ("ctWDay" . "CalendarTime -> Day")
1141      ("ctYDay" . "CalendarTime -> Int")
1142      ("ctYear" . "CalendarTime -> Int")
1143      ("diffClockTimes" . "ClockTime -> ClockTime -> TimeDiff")
1144      ("formatCalendarTime" . "TimeLocale -> String -> CalendarTime -> String")
1145      ("getClockTime" . "IO ClockTime")
1146      ("tdDay" . "TimeDiff -> Int")
1147      ("tdHour" . "TimeDiff -> Int")
1148      ("tdMin" . "TimeDiff -> Int")
1149      ("tdMonth" . "TimeDiff -> Int")
1150      ("tdPicosec" . "TimeDiff -> Integer")
1151      ("tdSec" . "TimeDiff -> Int")
1152      ("tdYear" . "TimeDiff -> Int")
1153      ("toCalendarTime" . "ClockTime -> IO CalendarTime")
1154      ("toClockTime" . "CalendarTime -> ClockTime")
1155      ("toUTCTime" . "ClockTime -> CalendarTime")
1156      ;; Locale
1157      ("amPm" . "TimeLocale -> (String, String)")
1158      ("dateFmt" . "TimeLocale -> String")
1159      ("dateTimeFmt" . "TimeLocale -> String")
1160      ("defaultTimeLocale" . "TimeLocale")
1161      ("months" . "TimeLocale -> [(String, String)]")
1162      ("time12Fmt" . "TimeLocale -> String")
1163      ("timeFmt" . "TimeLocale -> String")
1164      ("wDays" . "TimeLocale -> [(String, String)]")
1165      ;; CPUTime
1166      ("cpuTimePrecision" . "Integer")
1167      ("getCPUTime" . "IO Integer")
1168      ;; Random
1169      ("genRange" . "RandomGen g => g -> (Int, Int)")
1170      ("getStdGen" . "IO StdGen")
1171      ("getStdRandom" . "(StdGen -> (a, StdGen)) -> IO a")
1172      ("mkStdGen" . "Int -> StdGen")
1173      ("newStdGen" . "IO StdGen")
1174      ("next" . "RandomGen g => g -> (Int, g)")
1175      ("random" . "(Random a, RandomGen g) => g -> (a, g)")
1176      ("randomIO" . "Random a => IO a")
1177      ("randomR" . "(Random a, RandomGen g) => (a, a) -> g -> (a, g)")
1178      ("randomRIO" . "Random a => (a,a) -> IO a")
1179      ("randomRs" . "(Random a, RandomGen g) => (a, a) -> g -> [a]")
1180      ("randoms" . "(Random a, RandomGen g) => g -> [a]")
1181      ("setStdGen" . "StdGen -> IO ()")
1182      ("split" . "RandomGen g => g -> (g, g)")
1183      )
1184    "Alist of prelude functions and their types.")
1185  
1186  ;;@cindex haskell-doc-strategy-ids
1187  
1188  (defvar haskell-doc-strategy-ids
1189   (list
1190    '("par"  . "Done -> Done -> Done ; [infixr 0]")
1191    '("seq"  . "Done -> Done -> Done ; [infixr 1]")
1192  
1193    '("using"      . "a -> Strategy a -> a ; [infixl 0]")
1194    '("demanding"  . "a -> Done -> a ; [infixl 0]")
1195    '("sparking"   . "a -> Done -> a ; [infixl 0]")
1196  
1197    '(">||" . "Done -> Done -> Done ; [infixr 2]")
1198    '(">|" .  "Done -> Done -> Done ; [infixr 3]")
1199    '("$||" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]")
1200    '("$|"  . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]")
1201    '(".|"  . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]")
1202    '(".||" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]")
1203    '("-|"  . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]")
1204    '("-||" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]")
1205  
1206    '("Done" . "type Done = ()")
1207    '("Strategy" . "type Strategy a = a -> Done")
1208  
1209    '("r0"    . "Strategy a")
1210    '("rwhnf" . "Eval a => Strategy a")
1211    '("rnf" . "Strategy a")
1212    '("NFData" . "class Eval a => NFData a where rnf :: Strategy a")
1213    '("NFDataIntegral" ."class (NFData a, Integral a) => NFDataIntegral a")
1214    '("NFDataOrd" . "class (NFData a, Ord a) => NFDataOrd a")
1215  
1216    '("markStrat" . "Int -> Strategy a -> Strategy a")
1217  
1218    '("seqPair" . "Strategy a -> Strategy b -> Strategy (a,b)")
1219    '("parPair" . "Strategy a -> Strategy b -> Strategy (a,b)")
1220    '("seqTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)")
1221    '("parTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)")
1222  
1223    '("parList"  . "Strategy a -> Strategy [a]")
1224    '("parListN"  . "(Integral b) => b -> Strategy a -> Strategy [a]")
1225    '("parListNth"  . "Int -> Strategy a -> Strategy [a]")
1226    '("parListChunk"  . "Int -> Strategy a -> Strategy [a]")
1227    '("parMap"  . "Strategy b -> (a -> b) -> [a] -> [b]")
1228    '("parFlatMap"  . "Strategy [b] -> (a -> [b]) -> [a] -> [b]")
1229    '("parZipWith"  . "Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]")
1230    '("seqList"  . "Strategy a -> Strategy [a]")
1231    '("seqListN"  . "(Integral a) => a -> Strategy b -> Strategy [b]")
1232    '("seqListNth"  . "Int -> Strategy b -> Strategy [b]")
1233  
1234    '("parBuffer"  . "Int -> Strategy a -> [a] -> [a]")
1235  
1236    '("seqArr"  . "(Ix b) => Strategy a -> Strategy (Array b a)")
1237    '("parArr"  . "(Ix b) => Strategy a -> Strategy (Array b a)")
1238  
1239    '("fstPairFstList"  . "(NFData a) => Strategy [(a,b)]")
1240    '("force"  . "(NFData a) => a -> a ")
1241    '("sforce"  . "(NFData a) => a -> b -> b")
1242    )
1243  "alist of strategy functions and their types as defined in Strategies.lhs.")
1244  
1245  (defvar haskell-doc-user-defined-ids nil
1246   "alist of functions and strings defined by the user.")
1247  
1248  ;;@node Test membership,  , Prelude types, Constants and Variables
1249  ;;@subsection Test membership
1250  
1251  ;;@cindex haskell-doc-is-of
1252  (defsubst haskell-doc-is-of (fn types)
1253    "Check whether FN is one of the functions in the alist TYPES and return the type."
1254    (assoc fn types) )
1255  
1256  ;;@node Install as minor mode, Menubar Support, Constants and Variables, top
1257  ;;@section Install as minor mode
1258  
1259  ;; Put this minor mode on the global minor-mode-alist.
1260  (or (assq 'haskell-doc-mode (default-value 'minor-mode-alist))
1261      (setq-default minor-mode-alist
1262                    (append (default-value 'minor-mode-alist)
1263                            '((haskell-doc-mode haskell-doc-minor-mode-string)))))
1264  
1265  
1266  ;;@node Menubar Support, Haskell Doc Mode, Install as minor mode, top
1267  ;;@section Menubar Support
1268  
1269  ;; get imenu
1270  (require 'imenu)
1271  
1272  ;; a dummy definition needed for xemacs (I know, it's horrible :-(
1273  
1274  ;;@cindex haskell-doc-install-keymap
1275  
1276  (defvar haskell-doc-keymap
1277    (let ((map (make-sparse-keymap)))
1278      (define-key map [visit]
1279        '("Visit FTP home site" . haskell-doc-visit-home))
1280      (define-key map [submit]
1281        '("Submit bug report" . haskell-doc-submit-bug-report))
1282      (define-key map [dummy] '("---" . nil))
1283      (define-key map [make-index]
1284        '("Make global fct index" . haskell-doc-make-global-fct-index))
1285      (define-key map [global-types-on]
1286        '("Toggle display of global types" . haskell-doc-show-global-types))
1287      (define-key map [strategy-on]
1288        '("Toggle display of strategy ids" . haskell-doc-show-strategy))
1289      (define-key map [user-defined-on]
1290        '("Toggle display of user defined ids" . haskell-doc-show-user-defined))
1291      (define-key map [prelude-on]
1292        '("Toggle display of prelude functions" . haskell-doc-show-prelude))
1293      (define-key map [reserved-ids-on]
1294        '("Toggle display of reserved ids" . haskell-doc-show-reserved))
1295      (define-key map [haskell-doc-on]
1296        '("Toggle haskell-doc mode" . haskell-doc-mode))
1297      map))
1298  
1299  (defun haskell-doc-install-keymap ()
1300    "Install a menu for `haskell-doc-mode' as a submenu of \"Hugs\"."
1301    (interactive)
1302    ;; Add the menu to the hugs menu as last entry.
1303    (let ((hugsmap (lookup-key (current-local-map) [menu-bar Hugs])))
1304      (if (not (or (featurep 'xemacs) ; XEmacs has problems here
1305  		 (not (keymapp hugsmap))
1306  		 (lookup-key hugsmap [haskell-doc])))
1307  	(if (functionp 'define-key-after)
1308  	    (define-key-after hugsmap [haskell-doc]
1309  	      (cons "Haskell-doc" haskell-doc-keymap)
1310  	      [Haskell-doc mode]))))
1311    ;; Add shortcuts for these commands.
1312    (local-set-key "\C-c\e/" 'haskell-doc-check-active)
1313    ;; Conflicts with the binding of haskell-insert-otherwise.
1314    ;; (local-set-key "\C-c\C-o" 'haskell-doc-mode)
1315    (local-set-key [(control shift meta mouse-3)]
1316  		 'haskell-doc-ask-mouse-for-type))
1317  
1318  
1319  ;;@node Haskell Doc Mode, Switch it on or off, Menubar Support, top
1320  ;;@section Haskell Doc Mode
1321  
1322  ;;@cindex haskell-doc-mode
1323  
1324  (defvar haskell-doc-timer nil)
1325  (defvar haskell-doc-buffers nil)
1326  
1327  ;;;###autoload
1328  (defun haskell-doc-mode (&optional arg)
1329    "Enter `haskell-doc-mode' for showing fct types in the echo area.
1330  See variable docstring."
1331    (interactive (list (or current-prefix-arg 'toggle)))
1332  
1333    (setq haskell-doc-mode
1334  	(cond
1335  	 ((eq arg 'toggle) (not haskell-doc-mode))
1336  	 (arg (> (prefix-numeric-value arg) 0))
1337  	 (t)))
1338  
1339    ;; First, unconditionally turn the mode OFF.
1340  
1341    (setq haskell-doc-buffers (delq (current-buffer) haskell-doc-buffers))
1342    ;; Refresh the buffers list.
1343    (dolist (buf haskell-doc-buffers)
1344      (unless (and (buffer-live-p buf)
1345                   (with-current-buffer buf haskell-doc-mode))
1346        (setq haskell-doc-buffers (delq buf haskell-doc-buffers))))
1347    ;; Turn off the idle timer (or idle post-command-hook).
1348    (when (and haskell-doc-timer (null haskell-doc-buffers))
1349      (cancel-timer haskell-doc-timer)
1350      (setq haskell-doc-timer nil))
1351    (remove-hook 'post-command-hook
1352                 'haskell-doc-mode-print-current-symbol-info 'local)
1353  
1354    (when haskell-doc-mode
1355      ;; Turning the mode ON.
1356      (push (current-buffer) haskell-doc-buffers)
1357  
1358      (if (fboundp 'run-with-idle-timer)
1359          (unless haskell-doc-timer
1360            (setq haskell-doc-timer
1361                  (run-with-idle-timer
1362                   haskell-doc-idle-delay t
1363                   'haskell-doc-mode-print-current-symbol-info)))
1364        (add-hook 'post-command-hook
1365                  'haskell-doc-mode-print-current-symbol-info nil 'local))
1366      (and haskell-doc-show-global-types
1367  	 (haskell-doc-make-global-fct-index)) ; build type index for global fcts
1368  
1369      (haskell-doc-install-keymap)
1370  
1371      (run-hooks 'haskell-doc-mode-hook))
1372  
1373    (and (interactive-p)
1374         (message "haskell-doc-mode is %s"
1375  		(if haskell-doc-mode "enabled" "disabled")))
1376    haskell-doc-mode)
1377  
1378  (defmacro haskell-doc-toggle-var (id prefix)
1379    ;; toggle variable or set it based on prefix value
1380    `(setq ,id
1381  	 (if ,prefix
1382  	     (>= (prefix-numeric-value ,prefix) 0)
1383  	   (not ,id))) )
1384  
1385  ;;@cindex haskell-doc-show-global-types
1386  (defun haskell-doc-show-global-types (&optional prefix)
1387    "Turn on global types information in `haskell-doc-mode'."
1388    (interactive "P")
1389    (haskell-doc-toggle-var haskell-doc-show-global-types prefix)
1390    (if haskell-doc-show-global-types
1391        (haskell-doc-make-global-fct-index)))
1392  
1393  ;;@cindex haskell-doc-show-reserved
1394  (defun haskell-doc-show-reserved (&optional prefix)
1395    "Toggle the automatic display of a doc string for reserved ids."
1396    (interactive "P")
1397    (haskell-doc-toggle-var haskell-doc-show-reserved prefix))
1398  
1399  ;;@cindex haskell-doc-show-prelude
1400  (defun haskell-doc-show-prelude (&optional prefix)
1401    "Toggle the automatic display of a doc string for reserved ids."
1402    (interactive "P")
1403    (haskell-doc-toggle-var haskell-doc-show-prelude prefix))
1404  
1405  ;;@cindex haskell-doc-show-strategy
1406  (defun haskell-doc-show-strategy (&optional prefix)
1407    "Toggle the automatic display of a doc string for strategy ids."
1408    (interactive "P")
1409    (haskell-doc-toggle-var haskell-doc-show-strategy prefix))
1410  
1411  ;;@cindex haskell-doc-show-user-defined
1412  (defun haskell-doc-show-user-defined (&optional prefix)
1413    "Toggle the automatic display of a doc string for user defined ids."
1414    (interactive "P")
1415    (haskell-doc-toggle-var haskell-doc-show-user-defined prefix))
1416  
1417  ;;@node Switch it on or off, Check, Haskell Doc Mode, top
1418  ;;@section Switch it on or off
1419  
1420  ;;@cindex turn-on-haskell-doc-mode
1421  
1422  ;;;###autoload
1423  (defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode)
1424  
1425  ;;@cindex  turn-off-haskell-doc-mode
1426  
1427  (defun turn-off-haskell-doc-mode ()
1428    "Unequivocally turn off `haskell-doc-mode' (which see)."
1429    (haskell-doc-mode 0))
1430  
1431  ;;@node Check, Top level function, Switch it on or off, top
1432  ;;@section Check
1433  
1434  ;;@cindex haskell-doc-check-active
1435  
1436  (defun haskell-doc-check-active ()
1437    "Check whether the print function is hooked in.
1438  Should be the same as the value of `haskell-doc-mode' but alas currently it
1439  is not."
1440    (interactive)
1441    (message "%s"
1442     (if (or (and haskell-doc-mode haskell-doc-timer)
1443             (memq 'haskell-doc-mode-print-current-symbol-info
1444                   post-command-hook))
1445         "haskell-doc is ACTIVE"
1446       (substitute-command-keys
1447        "haskell-doc is not ACTIVE \(Use \\[haskell-doc-mode] to turn it on\)"))))
1448  
1449  ;;@node Top level function, Mouse interface, Check, top
1450  ;;@section Top level function
1451  
1452  ;;@cindex haskell-doc-mode-print-current-symbol-info
1453  ;; This is the function hooked into the elisp command engine
1454  (defun haskell-doc-mode-print-current-symbol-info ()
1455    "Print the type of the symbol under the cursor.
1456  
1457  This function is run by an idle timer to print the type
1458   automatically if `haskell-doc-mode' is turned on."
1459    (and haskell-doc-mode
1460         (not executing-kbd-macro)
1461         ;; Having this mode operate in the minibuffer makes it impossible to
1462         ;; see what you're doing.
1463         (not (eq (selected-window) (minibuffer-window)))
1464         ;; take a nap, if run straight from post-command-hook.
1465         (if (fboundp 'run-with-idle-timer) t
1466           (sit-for haskell-doc-idle-delay))
1467         ;; good morning! read the word under the cursor for breakfast
1468         (haskell-doc-show-type)))
1469         ;; ;; ToDo: find surrounding fct
1470         ;; (cond ((eq current-symbol current-fnsym)
1471         ;;        (haskell-doc-show-type current-fnsym))
1472         ;;       (t
1473         ;;        (or nil ; (haskell-doc-print-var-docstring current-symbol)
1474         ;;            (haskell-doc-show-type current-fnsym)))))))
1475  
1476  (defun haskell-doc-current-info ()
1477    "Return the info about symbol at point.
1478  Meant for `eldoc-documentation-function'."
1479    (haskell-doc-sym-doc (haskell-ident-at-point)))
1480  
1481  
1482  ;;@node Mouse interface, Print fctsym, Top level function, top
1483  ;;@section Mouse interface for interactive query
1484  
1485  ;;@cindex haskell-doc-ask-mouse-for-type
1486  (defun haskell-doc-ask-mouse-for-type (event)
1487   "Read the identifier under the mouse and echo its type.
1488  This uses the same underlying function `haskell-doc-show-type' as the hooked
1489  function. Only the user interface is different."
1490   (interactive "e")
1491   (save-excursion
1492     (select-window (posn-window (event-end event)))
1493     (goto-char (posn-point (event-end event)))
1494     (haskell-doc-show-type)))
1495  
1496  
1497  ;;@node Print fctsym, Movement, Mouse interface, top
1498  ;;@section Print fctsym
1499  
1500  ;;@menu
1501  ;;* Show type::
1502  ;;* Aux::
1503  ;;* Global fct type::
1504  ;;* Local fct type::
1505  ;;@end menu
1506  
1507  ;;@node Show type, Aux, Print fctsym, Print fctsym
1508  ;;@subsection Show type
1509  
1510  ;;@cindex haskell-doc-show-type
1511  
1512  ;;;###autoload
1513  (defun haskell-doc-show-type (&optional sym)
1514    "Show the type of the function near point.
1515  For the function under point, show the type in the echo area.
1516  This information is extracted from the `haskell-doc-prelude-types' alist
1517  of prelude functions and their types, or from the local functions in the
1518  current buffer."
1519    (interactive)
1520    (unless sym (setq sym (haskell-ident-at-point)))
1521    ;; if printed before do not print it again
1522    (unless (string= sym (car haskell-doc-last-data))
1523      (let ((doc (haskell-doc-sym-doc sym)))
1524        (when doc
1525          ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all
1526          ;; messages are recorded in a log.  Do not put haskell-doc messages
1527          ;; in that log since they are legion.
1528          (if (eval-when-compile (fboundp 'display-message))
1529              ;; XEmacs 19.13 way of preventing log messages.
1530              ;;(display-message 'no-log (format <args>))
1531              ;; XEmacs 19.15 seems to be a bit different.
1532              (display-message 'message (format "%s" doc))
1533            (let ((message-log-max nil))
1534              (message "%s" doc)))))))
1535  
1536  
1537  (defun haskell-doc-sym-doc (sym)
1538    "Show the type of the function near point.
1539  For the function under point, show the type in the echo area.
1540  This information is extracted from the `haskell-doc-prelude-types' alist
1541  of prelude functions and their types, or from the local functions in the
1542  current buffer."
1543    (let ((i-am-prelude nil)
1544          (i-am-fct nil)
1545          (type nil)
1546  	(is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids))
1547  	(is-prelude  (haskell-doc-is-of sym haskell-doc-prelude-types))
1548  	(is-strategy (haskell-doc-is-of sym haskell-doc-strategy-ids))
1549  	(is-user-defined (haskell-doc-is-of sym haskell-doc-user-defined-ids))
1550  	(is-prelude  (haskell-doc-is-of sym haskell-doc-prelude-types)))
1551     (cond
1552  	  ;; if reserved id (i.e. Haskell keyword
1553  	  ((and haskell-doc-show-reserved
1554  	       is-reserved)
1555  	   (setq type (cdr is-reserved))
1556             (setcdr haskell-doc-last-data type))
1557  	  ;; if built-in function get type from docstring
1558            ((and (not (null haskell-doc-show-prelude))
1559  		is-prelude)
1560             (setq type (cdr is-prelude)) ; (cdr (assoc sym haskell-doc-prelude-types)))
1561  	   (if (= 2 (length type)) ; horrible hack to remove bad formatting
1562  	       (setq type (car (cdr type))))
1563  	   (setq i-am-prelude t)
1564  	   (setq i-am-fct t)
1565             (setcdr haskell-doc-last-data type))
1566  	  ((and haskell-doc-show-strategy
1567  	       is-strategy)
1568  	   (setq i-am-fct t)
1569  	   (setq type (cdr is-strategy))
1570             (setcdr haskell-doc-last-data type))
1571  	  ((and haskell-doc-show-user-defined
1572  	       is-user-defined)
1573  	   ;; (setq i-am-fct t)
1574  	   (setq type (cdr is-user-defined))
1575             (setcdr haskell-doc-last-data type))
1576            (t
1577  	   (let ( (x (haskell-doc-get-and-format-fct-type sym)) )
1578  	     (if (null x)
1579  		 (setcdr haskell-doc-last-data nil) ; if not found reset last data
1580  	       (setq type (car x))
1581  	       (setq i-am-fct (string= "Variables" (cdr x)))
1582  	       (if (and haskell-doc-show-global-types (null type))
1583  		   (setq type (haskell-doc-get-global-fct-type sym)))
1584  	       (setcdr haskell-doc-last-data type)))) )
1585      ;; ToDo: encode i-am-fct info into alist of types
1586      (and type
1587  	 ;; drop `::' if it's not a fct
1588  	 (let ( (str (cond ((and i-am-fct (not haskell-doc-chop-off-fctname))
1589  			    (format "%s :: %s" sym type))
1590  			   (t
1591  			    (format "%s" type)))) )
1592  	   (if i-am-prelude
1593  	       (add-text-properties 0 (length str) '(face bold) str))
1594  	   str))))
1595  
1596  
1597  ;; ToDo: define your own notion of `near' to find surrounding fct
1598  ;;(defun haskell-doc-fnsym-in-current-sexp ()
1599  ;;  (let* ((p (point))
1600  ;;         (sym (progn
1601  ;;		(forward-word -1)
1602  ;;                (while (and (forward-word -1) ; (haskell-doc-forward-sexp-safe -1)
1603  ;;                            (> (point) (point-min))))
1604  ;;                (cond ((or (= (point) (point-min))
1605  ;;                           (memq (or (char-after (point)) 0)
1606  ;;                                 '(?\( ?\"))
1607  ;;                           ;; If we hit a quotation mark before a paren, we
1608  ;;                           ;; are inside a specific string, not a list of
1609  ;;                           ;; symbols.
1610  ;;                           (eq (or (char-after (1- (point))) 0) ?\"))
1611  ;;                       nil)
1612  ;;                      (t (condition-case nil
1613  ;;                             (read (current-buffer))
1614  ;;                           (error nil)))))))
1615  ;;    (goto-char p)
1616  ;;    (if sym
1617  ;;	(format "%s" sym)
1618  ;;      sym)))
1619  
1620  ;;    (and (symbolp sym)
1621  ;;         sym)))
1622  
1623  ;;@node Aux, Global fct type, Show type, Print fctsym
1624  ;;@subsection Aux
1625  
1626  ;; ToDo: handle open brackets to decide if it's a wrapped type
1627  
1628  ;;@cindex haskell-doc-grab-line
1629  (defun haskell-doc-grab-line (fct-and-pos)
1630   "Get the type of an \(FCT POSITION\) pair from the current buffer."
1631   ;; (if (null fct-and-pos)
1632   ;;     "" ; fn is not a local fct
1633    (let ( (str ""))
1634     (goto-char (cdr fct-and-pos))
1635     (beginning-of-line)
1636     ;; search for start of type (phsp give better bound?)
1637     (if (null (search-forward "::" (+ (point) haskell-doc-search-distance) t))
1638         ""
1639       (setq str (haskell-doc-grab))        ; leaves point at end of line
1640       (while (haskell-doc-wrapped-type-p)  ; while in a multi-line type expr
1641         (forward-line 1)
1642         (beginning-of-line)
1643         (skip-chars-forward " \t")
1644         (setq str (concat str (haskell-doc-grab))))
1645       (haskell-doc-string-nub-ws           ; squeeze string
1646        (if haskell-doc-chop-off-context    ; no context
1647  	  (haskell-doc-chop-off-context str)
1648  	str)))))
1649   ;; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str))))
1650  
1651  ;;@cindex haskell-doc-wrapped-type-p
1652  (defun haskell-doc-wrapped-type-p ()
1653   "Check whether the type under the cursor is wrapped over several lines.
1654  The cursor must be at the end of a line, which contains the type.
1655  Currently, only the following is checked:
1656  If this line ends with a `->' or the next starts with an `->' it is a
1657  multi-line type \(same for `=>'\).
1658  `--' comments are ignored.
1659  ToDo: Check for matching parenthesis!. "
1660   (save-excursion
1661     (let ( (here (point))
1662  	  (lim (progn (beginning-of-line) (point)))
1663  	  ;; (foo "")
1664  	  (res nil)
1665  	  )
1666     (goto-char here)
1667     (search-backward "--" lim t) ; skip over `--' comment
1668     (skip-chars-backward " \t")
1669     (if (bolp)                   ; skip empty lines
1670        (progn
1671         (forward-line 1)
1672         (end-of-line)
1673         (setq res (haskell-doc-wrapped-type-p)))
1674     (forward-char -1)
1675     ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char))))
1676     (if (or (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=))
1677  		(char-equal (following-char) ?>)) ; (or -!> =!>
1678  	   (char-equal (following-char) ?,))      ;     !,)
1679         (setq res t)
1680       (forward-line)
1681       (let ((here (point)))
1682         (goto-char here)
1683         (skip-chars-forward " \t")
1684         (if (looking-at "--")  ; it is a comment line
1685  	   (progn
1686  	     (forward-line 1)
1687  	     (end-of-line)
1688  	     (setq res (haskell-doc-wrapped-type-p)))
1689  	 (forward-char 1)
1690  	 ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char))))
1691  	 ;; (message "|%s|" foo)
1692  	 (if (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=))
1693  		  (char-equal (following-char) ?>)) ; -!> or =!>
1694  	     (setq res t))))))
1695     res)))
1696  
1697  ;;@cindex haskell-doc-grab
1698  (defun haskell-doc-grab ()
1699    "Return the text from point to the end of the line, chopping off comments.
1700  Leaves point at end of line."
1701    (let ((str (buffer-substring-no-properties
1702                (point) (progn (end-of-line) (point)))))
1703      (if (string-match "--" str)
1704          (substring str 0 (match-beginning 0))
1705        str)))
1706  
1707  ;;@cindex haskell-doc-string-nub-ws
1708  (defun haskell-doc-string-nub-ws (str)
1709    "Replace all sequences of whitespaces in STR by just one whitespace.
1710  ToDo: Also eliminate leading and trainling whitespace."
1711    (let ((i -1))
1712      (while (setq i (string-match " [ \t\n]+\\|[\t\n]+" str (1+ i)))
1713        (setq str (replace-match " " t t str)))
1714      str))
1715  
1716  ;; ToDo: make this more efficient!!
1717  ;;(defun haskell-doc-string-nub-ws (str)
1718  ;;  "Replace all sequences of whitespaces in STR by just one whitespace."
1719  ;;  (let ( (res "")
1720  ;;	 (l (length str))
1721  ;;	 (i 0)
1722  ;;	 (j 0)
1723  ;;	 (in-ws nil))
1724  ;;   (while (< i l)
1725  ;;     (let* ( (c (string-to-char (substring str i (1+ i))))
1726  ;;	    (is-ws (eq (char-syntax c) ? )) )
1727  ;;       (if (not (and in-ws is-ws))
1728  ;;	     (setq res (concat res (char-to-string c))))
1729  ;;       (setq in-ws is-ws)
1730  ;;       (setq i (1+ i))))
1731  ;;   res))
1732  
1733  ;;@cindex haskell-doc-chop-off-context
1734  (defun haskell-doc-chop-off-context (str)
1735   "Eliminate the contex in a type represented by the string STR."
1736   (let ((i (string-match "=>" str)) )
1737     (if (null i)
1738         str
1739       (substring str (+ i 2)))))
1740  
1741  ;;@cindex haskell-doc-get-imenu-info
1742  (defun haskell-doc-get-imenu-info (obj kind)
1743    "Returns a string describing OBJ of KIND \(Variables, Types, Data\)."
1744    (cond ((or (eq major-mode 'haskell-hugs-mode)
1745               ;; GEM: Haskell Mode does not work with Haskell Doc
1746               ;;      under XEmacs 20.x
1747               (and (eq major-mode 'haskell-mode)
1748                    (not (and (featurep 'xemacs)
1749                              (string-match "^20" emacs-version)))))
1750  	 (let* ((imenu-info-alist (cdr (assoc kind imenu--index-alist)))
1751                  ;; (names (mapcar 'car imenu-info-alist))
1752                  (x (assoc obj imenu-info-alist)))
1753  	     (if x
1754  		 (haskell-doc-grab-line x)
1755  	       nil)))
1756  	  (t
1757             ;; (error "Cannot get local functions in %s mode, sorry" major-mode))) )
1758  	   nil)))
1759  
1760  ;;@node Global fct type, Local fct type, Aux, Print fctsym
1761  ;;@subsection Global fct type
1762  
1763  ;; ToDo:
1764  ;;  - modular way of defining a mapping of module name to file
1765  ;;  - use a path to search for file (not just current directory)
1766  
1767  ;;@cindex haskell-doc-imported-list
1768  
1769  (defun haskell-doc-imported-list ()
1770    "Return a list of the imported modules in current buffer"
1771    (interactive "fName of outer `include' file: ") ;  (buffer-file-name))
1772    (let ((imported-file-list (list buffer-file-name)))
1773      (widen)
1774      (goto-char (point-min))
1775      (while (re-search-forward "^\\s-*import\\s-+\\([^ \t\n]+\\)" nil t)
1776        (let ((basename (match-string 1)))
1777          (dolist (ext '(".hs" ".lhs"))
1778            (let ((file (concat basename ext)))
1779              (if (file-exists-p file)
1780                  (push file imported-file-list))))))
1781      (nreverse imported-file-list)
1782      ;;(message imported-file-list)
1783      ))
1784  
1785  ;; ToDo: generalise this to "Types" etc (not just "Variables")
1786  
1787  ;;@cindex haskell-doc-rescan-files
1788  
1789  (defun haskell-doc-rescan-files (filelist)
1790   "Does an `imenu' rescan on every file in FILELIST and returns the fct-list.
1791  This function switches to and potentially loads many buffers."
1792   (save-current-buffer
1793     (mapcar (lambda (f)
1794               (set-buffer (find-file-noselect f))
1795               (imenu--make-index-alist)
1796               (cons f
1797                     (mapcar (lambda (x)
1798                               `(,(car x) . ,(haskell-doc-grab-line x)))
1799                             (cdr (assoc "Variables" imenu--index-alist)))))
1800             filelist)))
1801  
1802  ;;@cindex haskell-doc-make-global-fct-index
1803  
1804  (defun haskell-doc-make-global-fct-index ()
1805   "Scan imported files for types of global fcts and update `haskell-doc-index'."
1806   (interactive)
1807   (setq haskell-doc-index
1808         (haskell-doc-rescan-files (haskell-doc-imported-list))))
1809  
1810  ;; ToDo: use a separate munge-type function to format type concisely
1811  
1812  ;;@cindex haskell-doc-get-global-fct-type
1813  
1814  (defun haskell-doc-get-global-fct-type (&optional sym)
1815   "Get type for function symbol SYM by examining `haskell-doc-index'."
1816    (interactive) ;  "fName of outer `include' file: \nsFct:")
1817    (save-excursion
1818      ;; (switch-to-buffer "*scratch*")
1819      ;; (goto-char (point-max))
1820      ;; ;; Produces a list of fct-type alists
1821      ;; (if (null sym)
1822      ;;     (setq sym (progn (forward-word -1) (read (current-buffer)))))
1823    (or sym
1824        (current-word))
1825    (let* ( (fn sym) ; (format "%s" sym))
1826  	  (fal haskell-doc-index)
1827  	  (res "") )
1828      (while (not (null fal))
1829        (let* ( (l (car fal))
1830  	      (f (car l))
1831  	      (x (assoc fn (cdr l))) )
1832  	(if (not (null x))
1833  	    (let* ( (ty (cdr x)) ; the type as string
1834  		    (idx (string-match "::" ty))
1835  		    (str (if (null idx)
1836  			     ty
1837  			   (substring ty (+ idx 2)))) )
1838  	      (setq res (format "[%s] %s" f str))))
1839  	  (setq fal (cdr fal))))
1840      res))) ; (message res)) )
1841  
1842  ;;@node Local fct type,  , Global fct type, Print fctsym
1843  ;;@subsection Local fct type
1844  
1845  ;;@cindex haskell-doc-get-and-format-fct-type
1846  
1847  (defun haskell-doc-get-and-format-fct-type (fn)
1848   "Get the type and kind of FN by checking local and global functions."
1849   (save-excursion
1850     (save-match-data
1851       (let ((docstring "")
1852  	   (doc nil)
1853  	   )
1854         ;; is it a local function?
1855         (setq docstring (haskell-doc-get-imenu-info fn "Variables"))
1856         (if (not (null docstring))
1857  		;; (string-match (format "^%s\\s-+::\\s-+\\(.*\\)$" fn) docstring))
1858  	   (setq doc `(,docstring . "Variables"))) ; `(,(match-string 1 docstring) . "Variables") ))
1859         ;; is it a type declaration?
1860         (setq docstring (haskell-doc-get-imenu-info fn "Types"))
1861         (if (not (null docstring))
1862  		;; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring))
1863  	     (setq doc `(,docstring . "Types"))) ; `(,(match-string 0 docstring) . "Types")) )
1864         (if (not (null docstring))
1865  		;; (string-match (format "^\\s-*data.*%s.*$" fn) docstring))
1866  	 (setq doc `(,docstring . "Data"))) ; (setq doc `(,(match-string 0 docstring) . "Data")) )
1867         ;; return the result
1868         doc ))))
1869  
1870  
1871  ;;@appendix
1872  
1873  ;;@node Index, Token, Visit home site, top
1874  ;;@section Index
1875  
1876  ;;@index
1877  ;;* haskell-doc-ask-mouse-for-type::
1878  ;;* haskell-doc-check-active::
1879  ;;* haskell-doc-chop-off-context::
1880  ;;* haskell-doc-get-and-format-fct-type::
1881  ;;* haskell-doc-get-global-fct-type::
1882  ;;* haskell-doc-get-imenu-info::
1883  ;;* haskell-doc-grab::
1884  ;;* haskell-doc-grab-line::
1885  ;;* haskell-doc-imported-list::
1886  ;;* haskell-doc-install-keymap::
1887  ;;* haskell-doc-is-of::
1888  ;;* haskell-doc-make-global-fct-index::
1889  ;;* haskell-doc-mode::
1890  ;;* haskell-doc-mode-print-current-symbol-info::
1891  ;;* haskell-doc-prelude-types::
1892  ;;* haskell-doc-rescan-files::
1893  ;;* haskell-doc-reserved-ids::
1894  ;;* haskell-doc-show-global-types::
1895  ;;* haskell-doc-show-prelude::
1896  ;;* haskell-doc-show-reserved::
1897  ;;* haskell-doc-show-strategy::
1898  ;;* haskell-doc-show-type::
1899  ;;* haskell-doc-show-user-defined::
1900  ;;* haskell-doc-strategy-ids::
1901  ;;* haskell-doc-string-nub-ws::
1902  ;;* haskell-doc-submit-bug-report::
1903  ;;* haskell-doc-visit-home::
1904  ;;* haskell-doc-wrapped-type-p::
1905  ;;* turn-off-haskell-doc-mode::
1906  ;;* turn-on-haskell-doc-mode::
1907  ;;@end index
1908  
1909  ;;@node Token,  , Index, top
1910  ;;@section Token
1911  
1912  (provide 'haskell-doc)
1913  
1914  ;; arch-tag: 6492eb7e-7048-47ac-a331-da09e1eb6254
1915  ;;; haskell-doc.el ends here