ghc/CONTRIB/haskell-modes/yale/chak/haskell.el

   1 ;;; ==================================================================
   2 ;;; File:               haskell.el                                 ;;;
   3 ;;;                                                                ;;;
   4 ;;;                     Author:         A. Satish Pai              ;;;
   5 ;;;                                     Maria M. Gutierrez         ;;;
   6 ;;;                                     Dan Rabin (Jul-1991)       ;;;
   7 ;;; ==================================================================
   8 ;;; Time-stamp: <Sat Oct  7 1995 17:48:39 Stardate: [-31]6403.50 hwloidl>
   9 ;;; ==================================================================
  10 ;;;
  11 ;;; extended by Manuel M.T. Chakravarty with rudimentary editing features
  12 ;;; (including better syntax table) and support for the font-lock-mode;
  13 ;;; changes are marked with !chak!
  14 ;;;
  15 ;;; using this mode on a 19.x Emacs running under a window system automagically
  16 ;;; applies the font-lock-mode; this feature can be switched off by setting
  17 ;;; `haskell-auto-font-lock' to `nil'
  18
  19 ;;; Description: Haskell mode for GNU Emacs.
  20
  21 ;;; Related files:  comint.el
  22
  23 ;;; Contents:
  24
  25 ;;;  Update Log
  26
  27 ;;;  Known bugs / problems
  28 ;;;  - the haskell editing mode (indentation, etc) is still missing.
  29 ;;;  - the handling for errors from haskell needs to be rethought.
  30 ;;;  - general cleanup of code.
  31
  32
  33 ;;;  Errors generated
  34
  35 ;;; ==================================================================
  36 ;;; Haskell mode for editing files, and an Inferior Haskell mode to
  37 ;;; run a Haskell process. This file contains stuff snarfed and
  38 ;;; modified from tea.el, scheme.el, etc. This file may be freely
  39 ;;; modified; however, if you have any bug-corrections or useful
  40 ;;; improvements, I'd appreciate it if you sent me the mods so that
  41 ;;; I can merge them into the version I maintain.
  42 ;;;
  43 ;;; The inferior Haskell mode requires comint.el.
  44 ;;;
  45 ;;; You might want to add this to your .emacs to go automagically
  46 ;;; into Haskell mode while finding .hs files.
  47 ;;;
  48 ;;;   (setq auto-mode-alist
  49 ;;;         (cons '("\\.hs$" . haskell-mode)
  50 ;;;                auto-mode-alist)_)
  51 ;;;
  52 ;;; To use this file, set up your .emacs to autoload this file for
  53 ;;; haskell-mode. For example:
  54 ;;;
  55 ;;;    (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc"
  56 ;;;       "Load Haskell mode" t)
  57 ;;;
  58 ;;;    (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc"
  59 ;;;       "Load Haskell mode" t)
  60 ;;;
  61 ;;; [Note: The path name given above is Yale specific!! Modify as
  62 ;;; required.]
  63 ;;; ================================================================
  64
  65 ;;; Announce your existence to the world at large.
  66
  67 (provide 'haskell)
  68
  69
  70 ;;; Load these other files.
  71
  72 (require 'comint)        ; Olin Shivers' comint mode is the substratum
  73
  74 ;;; !chak!
  75 ;;;
  76 (if (and window-system (string-match "19." emacs-version))
  77     (require 'font-lock))
  78
  79
  80 \f
  81 ;;; ================================================================
  82 ;;; Declare a bunch of variables.
  83 ;;; ================================================================
  84
  85
  86 ;;; User settable (via M-x set-variable and M-x edit-options)
  87
  88 (defvar haskell-program-name (getenv "HASKELLPROG")
  89   "*Program invoked by the haskell command.")
  90
  91 (defvar haskell-auto-create-process t
  92   "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.")
  93
  94 (defvar haskell-auto-switch-input t
  95   "*If not nil, jump to *haskell* buffer automatically on input request.")
  96
  97 (defvar haskell-ask-before-saving t
  98   "*If not nil, ask before saving random haskell-mode buffers.")
  99
 100 (defvar haskell-initial-printers '("interactive")
 101   "*Printers to set when starting a new Haskell process.")
 102
 103
 104 ;;; Pad/buffer Initialization variables
 105
 106 (defvar *haskell-buffer* "*haskell*"
 107   "Name of the haskell process buffer")
 108
 109 (defvar haskell-main-pad "\*Main-pad\*"
 110   "Scratch pad associated with module Main")
 111
 112 (defvar haskell-main-module "Main")
 113
 114
 115 (defvar *last-loaded* nil)
 116 (defvar *last-module* haskell-main-module)
 117 (defvar *last-pad* haskell-main-pad)
 118
 119
 120 ;;; These are used for haskell-tutorial mode.
 121
 122 (defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs")
 123 (defvar *ht-temp-buffer* nil)
 124 (defvar *ht-file-buffer* "Haskell-Tutorial-Master")
 125
 126 ;;; !chak! variables for font-lock-mode support
 127 ;;;
 128
 129 (defvar haskell-auto-font-lock t
 130   "Use font-lock-mode by default.")
 131
 132 (defvar haskell-font-lock-keywords
 133   (list
 134    "\\bcase\\b" "\\bclass\\b" "\\bdata\\b" "\\bdefault\\b" "\\bderiving\\b"
 135    "\\belse\\b" "\\bhiding\\b" "\\bif\\b" "\\bimport\\b" "\\bin\\b"
 136    "\\binfix\\b" "\\binfixl\\b" "\\binfixr\\b" "\\binstance\\b"
 137    "\\binterface\\b" "\\blet\\b" "\\bmodule\\b" "\\bof\\b" "\\brenaming\\b"
 138    "\\bthen\\b" "\\bto\\b" "\\btype\\b" "\\bwhere\\b"
 139    ;'("\\S_\\(\\.\\.\\|::\\|=>\\|=\\|@\\||\\|~\\|-\\|<-\\|->\\)\\S_" . 1)
 140    '("\\bdata\\b\\s *\\(\\w+\\)\\(\\w\\|\\s \\)*=[^>]" 1 font-lock-type-face)
 141    '("\\bdata\\b\\(\\s \\|(\\|)\\|\\w\\)*=>\\s *\n?\\s *\\(\\w+\\)" 2
 142      font-lock-type-face)
 143    '("\\btype\\b\\s *\\(\\w+\\)" 1 font-lock-type-face)
 144    '("\\(\\w+\\)\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face)
 145    '("(\\(\\s_+\\))\\s *::\\(\\s \\|$\\)" 1 font-lock-function-name-face)
 146 ;   '("\\($\\|[^\\\\]\\)\\('[^\\\\]'\\)" 2 font-lock-string-face t)
 147    '("\\('\\([^\\\\]\\|\\\\'\\)'\\)" 1 font-lock-string-face t)
 148    )
 149   "Additional expressions to highlight in Haskell mode.")
 150
 151
 152 \f
 153 ;;; ================================================================
 154 ;;; Haskell editing mode stuff
 155 ;;; ================================================================
 156
 157 ;;; Leave this place alone...
 158 ;;; The definitions below have been pared down to the bare
 159 ;;; minimum; they will be restored later.
 160 ;;;
 161 ;;; -Satish 2/5.
 162
 163 ;;; Keymap for Haskell mode
 164 (defvar haskell-mode-map (make-sparse-keymap)
 165   "Keymap used for haskell-mode")
 166
 167 (defun haskell-establish-key-bindings (keymap)
 168   (define-key keymap "\C-ce"    'haskell-eval)
 169   (define-key keymap "\C-cr"    'haskell-run)
 170   (define-key keymap "\C-ct"    'haskell-report-type)
 171   (define-key keymap "\C-cm"    'haskell-run-main)
 172   (define-key keymap "\C-c\C-r" 'haskell-run-file)
 173   (define-key keymap "\C-cp"    'haskell-get-pad)
 174   (define-key keymap "\C-c\C-o" 'haskell-optimizers)
 175   (define-key keymap "\C-c\C-p" 'haskell-printers)
 176   (define-key keymap "\C-cc"    'haskell-compile)
 177   (define-key keymap "\C-cl"    'haskell-load)
 178   (define-key keymap "\C-ch"    'haskell-switch)
 179   (define-key keymap "\C-c\C-k" 'haskell-kill)
 180   (define-key keymap "\C-c:"    'haskell-command)
 181   (define-key keymap "\C-cq"    'haskell-exit)
 182   (define-key keymap "\C-ci"    'haskell-interrupt)
 183   (define-key keymap "\C-cu"    'haskell-edit-unit))
 184
 185
 186 (haskell-establish-key-bindings haskell-mode-map)
 187
 188
 189 (defvar haskell-mode-syntax-table nil
 190   "Syntax table used for haskell-mode")
 191
 192 ;; !chak! taken from lisp-mode
 193 ;;
 194 (defvar haskell-mode-abbrev-table nil
 195   "Abbrev table used for the haskell-mode")
 196
 197 ;; !chak! took syntax table from haskell mode distributed with GHC and modified
 198 ;;        it; we treat numbers as parts of words and operators as elements of
 199 ;;        the syntactic class `_'
 200 ;;
 201 (if haskell-mode-syntax-table
 202     ()
 203   (let ((i 0))
 204     (setq haskell-mode-syntax-table (make-syntax-table))
 205     (while (< i ?0)
 206       (modify-syntax-entry i "." haskell-mode-syntax-table)
 207       (setq i (1+ i)))
 208     (while (< i (1+ ?9))
 209       (modify-syntax-entry i "w" haskell-mode-syntax-table)
 210       (setq i (1+ i)))
 211     (while (< i ?A)
 212       (modify-syntax-entry i "." haskell-mode-syntax-table)
 213       (setq i (1+ i)))
 214     (while (< i (1+ ?Z))
 215       (modify-syntax-entry i "w" haskell-mode-syntax-table)
 216       (setq i (1+ i)))
 217     (while (< i ?a)
 218       (modify-syntax-entry i "." haskell-mode-syntax-table)
 219       (setq i (1+ i)))
 220     (while (< i (1+ ?z))
 221       (modify-syntax-entry i "w" haskell-mode-syntax-table)
 222       (setq i (1+ i)))
 223     (while (< i 128)
 224       (modify-syntax-entry i "." haskell-mode-syntax-table)
 225       (setq i (1+ i)))
 226     (modify-syntax-entry ?   " " haskell-mode-syntax-table)
 227     (modify-syntax-entry ?\t " " haskell-mode-syntax-table)
 228     (modify-syntax-entry ?\n ">" haskell-mode-syntax-table)
 229     (modify-syntax-entry ?\f ">" haskell-mode-syntax-table)
 230     (modify-syntax-entry ?!  "_" haskell-mode-syntax-table)
 231     (modify-syntax-entry ?#  "_" haskell-mode-syntax-table)
 232     (modify-syntax-entry ?$  "_" haskell-mode-syntax-table)
 233     (modify-syntax-entry ?%  "_" haskell-mode-syntax-table)
 234     (modify-syntax-entry ?&  "_" haskell-mode-syntax-table)
 235     (modify-syntax-entry ?*  "_" haskell-mode-syntax-table)
 236     (modify-syntax-entry ?+  "_" haskell-mode-syntax-table)
 237     (modify-syntax-entry ?.  "_" haskell-mode-syntax-table)
 238     (modify-syntax-entry ?/  "_" haskell-mode-syntax-table)
 239     (modify-syntax-entry ?<  "_" haskell-mode-syntax-table)
 240     (modify-syntax-entry ?=  "_" haskell-mode-syntax-table)
 241     (modify-syntax-entry ?>  "_" haskell-mode-syntax-table)
 242     (modify-syntax-entry ??  "_" haskell-mode-syntax-table)
 243     (modify-syntax-entry ?@  "_" haskell-mode-syntax-table)
 244     (modify-syntax-entry ?^  "_" haskell-mode-syntax-table)
 245     (modify-syntax-entry ?|  "_" haskell-mode-syntax-table)
 246     (modify-syntax-entry ?~  "_" haskell-mode-syntax-table)
 247     (modify-syntax-entry ?\" "\"" haskell-mode-syntax-table)
 248     (modify-syntax-entry ?\' "w" haskell-mode-syntax-table)
 249     (modify-syntax-entry ?_  "w" haskell-mode-syntax-table)
 250     (modify-syntax-entry ?\\ "_" haskell-mode-syntax-table)
 251     (modify-syntax-entry ?\( "()" haskell-mode-syntax-table)
 252     (modify-syntax-entry ?\) ")(" haskell-mode-syntax-table)
 253     (modify-syntax-entry ?\[ "(]" haskell-mode-syntax-table)
 254     (modify-syntax-entry ?\] ")[" haskell-mode-syntax-table)
 255     (modify-syntax-entry ?{  "(}1" haskell-mode-syntax-table)
 256     (modify-syntax-entry ?}  "){4" haskell-mode-syntax-table)
 257     (modify-syntax-entry ?-  "_ 123" haskell-mode-syntax-table)
 258     ))
 259
 260 ;; !chak! taken from lisp-mode
 261 ;;
 262 (define-abbrev-table 'haskell-mode-abbrev-table ())
 263
 264 ;; !chak! adapted from lisp-mode
 265 ;;
 266 (defun haskell-mode-variables (haskell-syntax)
 267   (cond (haskell-syntax
 268           (set-syntax-table haskell-mode-syntax-table)))
 269   (setq local-abbrev-table haskell-mode-abbrev-table)
 270   (make-local-variable 'paragraph-start)
 271   (setq paragraph-start (concat "^$\\|" page-delimiter))
 272   (make-local-variable 'paragraph-separate)
 273   (setq paragraph-separate paragraph-start)
 274   (make-local-variable 'paragraph-ignore-fill-prefix)
 275   (setq paragraph-ignore-fill-prefix t)
 276   (make-local-variable 'indent-line-function)
 277   (setq indent-line-function 'haskell-indent-line)
 278 ;  (make-local-variable 'indent-region-function)
 279 ;  (setq indent-region-function 'haskell-indent-region)
 280   (make-local-variable 'parse-sexp-ignore-comments)
 281   (setq parse-sexp-ignore-comments t)
 282 ;  (make-local-variable 'outline-regexp)
 283 ;  (setq outline-regexp ";;; \\|(....")
 284   (make-local-variable 'comment-start)
 285   (setq comment-start "--")
 286   (make-local-variable 'comment-start-skip)
 287   (setq comment-start-skip "-- *")
 288   (make-local-variable 'comment-column)
 289   (setq comment-column 40)
 290 ;  (make-local-variable 'comment-indent-function)
 291 ;  (setq comment-indent-function 'haskell-comment-indent)
 292   (make-local-variable 'font-lock-keywords)
 293   (setq font-lock-keywords haskell-font-lock-keywords)
 294   )
 295
 296 ;; !chak!
 297 ;;
 298 (defun haskell-indent-line ()
 299   "Simple indentation function using `indent-relative'."
 300   (interactive)
 301   (save-excursion
 302     (beginning-of-line)
 303     (delete-horizontal-space)
 304     (indent-relative)
 305     )
 306   )
 307
 308 ;;; Command for invoking the Haskell mode
 309 (defun haskell-mode nil
 310   "Major mode for editing Haskell code to run in Emacs
 311 The following commands are available:
 312 \\{haskell-mode-map}
 313
 314 A Haskell process can be fired up with \"M-x haskell\".
 315
 316 Customization: Entry to this mode runs the hooks that are the value of variable
 317 haskell-mode-hook.
 318
 319 Windows:
 320
 321 There are 3 types of windows associated with Haskell mode.  They are:
 322    *haskell*:  which is the process window.
 323    Pad:        which are buffers available for each module.  It is here
 324                where you want to test things before preserving them in a
 325                file.  Pads are always associated with a module.
 326                When issuing a command:
 327                  The pad and its associated module are sent to the Haskell
 328                  process prior to the execution of the command.
 329    .hs:        These are the files where Haskell programs live.  They
 330                have .hs as extension.
 331                When issuing a command:
 332                  The file is sent to the Haskell process prior to the
 333                  execution of the command.
 334
 335 Commands:
 336
 337 Each command behaves differently according to the type of the window in which
 338 the cursor is positioned when the command is issued .
 339
 340 haskell-eval:   \\[haskell-eval]
 341   Always promts user for a Haskell expression to be evaluated.  If in a
 342   .hs file buffer, then the cursor tells which module is the current
 343   module and the pad for that module (if any) gets loaded as well.
 344
 345 haskell-run:    \\[haskell-run]
 346   Always queries for a variable of type Dialogue to be evaluated.
 347
 348 haskell-run-main:    \\[haskell-run-main]
 349   Run Dialogue named main in the current module.
 350
 351 haskell-report-type:   \\[haskell-report-type]
 352   Like haskell-eval, but prints the type of the expression without
 353   evaluating it.
 354
 355 haskell-mode:   \\[haskell-mode]
 356   Puts the current buffer in haskell mode.
 357
 358 haskell-compile:   \\[haskell-compile]
 359   Compiles file in current buffer.
 360
 361 haskell-load:   \\[haskell-load]
 362   Loads file in current buffer.
 363
 364 haskell-run-file:   \\[haskell-run-file]
 365   Runs file in the current buffer.
 366
 367 haskell-pad:   \\[haskell-pad]
 368   Creates a scratch pad for the current module.
 369
 370 haskell-optimizers:  \\[haskell-optimizers]
 371   Shows the list of available optimizers.  Commands for turning them on/off.
 372
 373 haskell-printers:  \\[haskell-printers]
 374   Shows the list of available printers.  Commands for turning them on/off.
 375
 376 haskell-command:   \\[haskell-command]
 377   Prompts for a command to be sent to the command interface.  You don't
 378   need to put the : before the command.
 379
 380 haskell-quit:   \\[haskell-quit]
 381   Terminates the haskell process.
 382
 383 haskell-switch:   \\[haskell-switch]
 384   Switches to the inferior Haskell buffer (*haskell*) and positions the
 385   cursor at the end of the buffer.
 386
 387 haskell-kill:  \\[haskell-kill]
 388   Kill the current contents of the *haskell* buffer.
 389
 390 haskell-interrupt:   \\[haskell-interrupt]
 391   Interrupts haskell process and resets it.
 392
 393 haskell-edit-unit:   \\[haskell-edit-unit]
 394   Edit the .hu file for the unit containing this file.
 395 "
 396   (interactive)
 397   (kill-all-local-variables)
 398   (use-local-map haskell-mode-map)
 399   (setq major-mode 'haskell-mode)
 400   (setq mode-name "Haskell")
 401   (make-local-variable 'indent-line-function)
 402   (setq indent-line-function 'indent-relative-maybe)
 403   ;(setq local-abbrev-table haskell-mode-abbrev-table)
 404   (set-syntax-table haskell-mode-syntax-table)
 405   ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list??
 406   (haskell-mode-variables t)                                    ; !chak!
 407   (cond (haskell-auto-font-lock                                 ; !chak!
 408          (font-lock-mode 1)                                     ; !chak!
 409          ))                                                     ; !chak!
 410   (run-hooks 'haskell-mode-hook))
 411
 412
 413 \f
 414 ;;;================================================================
 415 ;;; Inferior Haskell stuff
 416 ;;;================================================================
 417
 418
 419 (defvar inferior-haskell-mode-map (copy-keymap comint-mode-map))
 420
 421 (haskell-establish-key-bindings inferior-haskell-mode-map)
 422 (define-key inferior-haskell-mode-map "\C-m"     'haskell-send-input)
 423
 424 (defvar haskell-source-modes '(haskell-mode)
 425   "*Used to determine if a buffer contains Haskell source code.
 426 If it's loaded into a buffer that is in one of these major modes,
 427 it's considered a Haskell source file.")
 428
 429 (defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*"
 430   "Regular expression capturing the Haskell system prompt.")
 431
 432 (defvar haskell-prompt-ring ()
 433   "Keeps track of input to haskell process from the minibuffer")
 434
 435 (defun inferior-haskell-mode-variables ()
 436   nil)
 437
 438
 439 ;;; INFERIOR-HASKELL-MODE (adapted from comint.el)
 440
 441 (defun inferior-haskell-mode ()
 442   "Major mode for interacting with an inferior Haskell process.
 443
 444 The following commands are available:
 445 \\{inferior-haskell-mode-map}
 446
 447 A Haskell process can be fired up with \"M-x haskell\".
 448
 449 Customization: Entry to this mode runs the hooks on comint-mode-hook and
 450 inferior-haskell-mode-hook (in that order).
 451
 452 You can send text to the inferior Haskell process from other buffers containing
 453 Haskell source.
 454
 455
 456 Windows:
 457
 458 There are 3 types of windows in the inferior-haskell-mode.  They are:
 459    *haskell*:  which is the process window.
 460    Pad:        which are buffers available for each module.  It is here
 461                where you want to test things before preserving them in a
 462                file.  Pads are always associated with a module.
 463                When issuing a command:
 464                  The pad and its associated module are sent to the Haskell
 465                  process prior to the execution of the command.
 466    .hs:        These are the files where Haskell programs live.  They
 467                have .hs as extension.
 468                When issuing a command:
 469                  The file is sent to the Haskell process prior to the
 470                  execution of the command.
 471
 472 Commands:
 473
 474 Each command behaves differently according to the type of the window in which
 475 the cursor is positioned when the command is issued.
 476
 477 haskell-eval:   \\[haskell-eval]
 478   Always promts user for a Haskell expression to be evaluated.  If in a
 479   .hs file, then the cursor tells which module is the current module and
 480   the pad for that module (if any) gets loaded as well.
 481
 482 haskell-run:    \\[haskell-run]
 483   Always queries for a variable of type Dialogue to be evaluated.
 484
 485 haskell-run-main:    \\[haskell-run-main]
 486   Run Dialogue named main.
 487
 488 haskell-report-type:   \\[haskell-report-type]
 489   Like haskell-eval, but prints the type of the expression without
 490   evaluating it.
 491
 492 haskell-mode:   \\[haskell-mode]
 493   Puts the current buffer in haskell mode.
 494
 495 haskell-compile:   \\[haskell-compile]
 496   Compiles file in current buffer.
 497
 498 haskell-load:   \\[haskell-load]
 499   Loads file in current buffer.
 500
 501 haskell-run-file:   \\[haskell-run-file]
 502   Runs file in the current buffer.
 503
 504 haskell-pad:   \\[haskell-pad]
 505   Creates a scratch pad for the current module.
 506
 507 haskell-optimizers:  \\[haskell-optimizers]
 508   Shows the list of available optimizers.  Commands for turning them on/off.
 509
 510 haskell-printers:  \\[haskell-printers]
 511   Shows the list of available printers.  Commands for turning them on/off.
 512
 513 haskell-command:   \\[haskell-command]
 514   Prompts for a command to be sent to the command interface.  You don't
 515   need to put the : before the command.
 516
 517 haskell-quit:   \\[haskell-quit]
 518   Terminates the haskell process.
 519
 520 haskell-switch:   \\[haskell-switch]
 521   Switches to the inferior Haskell buffer (*haskell*) and positions the
 522   cursor at the end of the buffer.
 523
 524 haskell-kill:  \\[haskell-kill]
 525   Kill the current contents of the *haskell* buffer.
 526
 527 haskell-interrupt:   \\[haskell-interrupt]
 528   Interrupts haskell process and resets it.
 529
 530 haskell-edit-unit:   \\[haskell-edit-unit]
 531   Edit the .hu file for the unit containing this file.
 532
 533 The usual comint functions are also available. In particular, the
 534 following are all available:
 535
 536 comint-bol: Beginning of line, but skip prompt. Bound to C-a by default.
 537 comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in
 538             which case send EOF to process. Bound to C-d by default.
 539
 540 Note however, that the default keymap bindings provided shadow some of
 541 the default comint mode bindings, so that you may want to bind them
 542 to your choice of keys.
 543
 544 Comint mode's dynamic completion of filenames in the buffer is available.
 545 (Q.v. comint-dynamic-complete, comint-dynamic-list-completions.)
 546
 547 If you accidentally suspend your process, use \\[comint-continue-subjob]
 548 to continue it."
 549
 550   (interactive)
 551   (comint-mode)
 552   (setq comint-prompt-regexp haskell-prompt-pattern)
 553   ;; Customise in inferior-haskell-mode-hook
 554   (inferior-haskell-mode-variables)
 555   (setq major-mode 'inferior-haskell-mode)
 556   (setq mode-name "Inferior Haskell")
 557   (setq mode-line-process '(": %s : busy"))
 558   (use-local-map inferior-haskell-mode-map)
 559   (setq comint-input-filter 'haskell-input-filter)
 560   (setq comint-input-sentinel 'ignore)
 561   (setq comint-get-old-input 'haskell-get-old-input)
 562   (run-hooks 'inferior-haskell-mode-hook)
 563     ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
 564     ;The test is so we don't lose history if we run comint-mode twice in
 565     ;a buffer.
 566   (setq haskell-prompt-ring (make-ring comint-input-ring-size)))
 567
 568
 569 (defun haskell-input-filter (str)
 570   "Don't save whitespace."
 571   (not (string-match "\\s *" str)))
 572
 573
 574 \f
 575 ;;; ==================================================================
 576 ;;; Random utilities
 577 ;;; ==================================================================
 578
 579
 580 ;;; This keeps track of the status of the haskell process.
 581 ;;; Values are:
 582 ;;; busy -- The process is busy.
 583 ;;; ready -- The process is ready for a command.
 584 ;;; input -- The process is waiting for input.
 585 ;;; debug -- The process is in the debugger.
 586
 587 (defvar *haskell-status* 'busy
 588   "Status of the haskell process")
 589
 590 (defun set-haskell-status (value)
 591   (setq *haskell-status* value)
 592   (haskell-update-mode-line))
 593
 594 (defun get-haskell-status ()
 595   *haskell-status*)
 596
 597 (defun haskell-update-mode-line ()
 598   (save-excursion
 599     (set-buffer *haskell-buffer*)
 600     (cond ((eq *haskell-status* 'ready)
 601            (setq mode-line-process '(": %s: ready")))
 602           ((eq *haskell-status* 'input)
 603            (setq mode-line-process '(": %s: input")))
 604           ((eq *haskell-status* 'busy)
 605            (setq mode-line-process '(": %s: busy")))
 606           ((eq *haskell-status* 'debug)
 607            (setq mode-line-process '(": %s: debug")))
 608           (t
 609            (haskell-mode-error "Confused about status of haskell process!")))
 610     ;; Yes, this is the officially sanctioned technique for forcing
 611     ;; a redisplay of the mode line.
 612     (set-buffer-modified-p (buffer-modified-p))))
 613
 614
 615 (defun haskell-send-to-process (string)
 616   (process-send-string "haskell" string)
 617   (process-send-string "haskell" "\n"))
 618
 619
 620 \f
 621 ;;; ==================================================================
 622 ;;; Handle input in haskell process buffer; history commands.
 623 ;;; ==================================================================
 624
 625 (defun haskell-get-old-input ()
 626   "Get old input text from Haskell process buffer."
 627   (save-excursion
 628     (if (re-search-forward haskell-prompt-pattern (point-max) 'move)
 629         (goto-char (match-beginning 0)))
 630     (cond ((re-search-backward haskell-prompt-pattern (point-min) t)
 631            (comint-skip-prompt)
 632            (let ((temp  (point)))
 633              (end-of-line)
 634              (buffer-substring temp (point)))))))
 635
 636
 637 (defun haskell-send-input ()
 638   "Send input to Haskell while in the process buffer"
 639   (interactive)
 640   (if (eq (get-haskell-status) 'debug)
 641       (comint-send-input)
 642       (haskell-send-input-aux)))
 643
 644 (defun haskell-send-input-aux ()
 645   ;; Note that the input string does not include its terminal newline.
 646   (let ((proc (get-buffer-process (current-buffer))))
 647     (if (not proc)
 648         (haskell-mode-error "Current buffer has no process!")
 649         (let* ((pmark (process-mark proc))
 650                (pmark-val (marker-position pmark))
 651                (input (if (>= (point) pmark-val)
 652                           (buffer-substring pmark (point))
 653                           (let ((copy (funcall comint-get-old-input)))
 654                             (goto-char pmark)
 655                             (insert copy)
 656                             copy))))
 657           (insert ?\n)
 658           (if (funcall comint-input-filter input)
 659               (ring-insert input-ring input))
 660           (funcall comint-input-sentinel input)
 661           (set-marker (process-mark proc) (point))
 662           (set-marker comint-last-input-end (point))
 663           (haskell-send-to-process input)))))
 664
 665
 666 \f
 667 ;;; ==================================================================
 668 ;;; Minibuffer input stuff
 669 ;;; ==================================================================
 670
 671 ;;; Haskell input history retrieval commands   (taken from comint.el)
 672 ;;; M-p -- previous input    M-n -- next input
 673
 674 (defvar haskell-minibuffer-local-map nil
 675   "Local map for minibuffer when in Haskell")
 676
 677 (if haskell-minibuffer-local-map
 678     nil
 679     (progn
 680       (setq haskell-minibuffer-local-map
 681             (copy-keymap minibuffer-local-map))
 682       ;; Haskell commands
 683       (define-key haskell-minibuffer-local-map "\ep"   'haskell-previous-input)
 684       (define-key haskell-minibuffer-local-map "\en"   'haskell-next-input)
 685       ))
 686
 687 (defun haskell-previous-input (arg)
 688   "Cycle backwards through input history."
 689   (interactive "*p")
 690   (let ((len (ring-length haskell-prompt-ring)))
 691     (cond ((<= len 0)
 692            (message "Empty input ring.")
 693            (ding))
 694           (t
 695            (cond ((eq last-command 'haskell-previous-input)
 696                   (delete-region (mark) (point))
 697                   (set-mark (point)))
 698                  (t
 699                   (setq input-ring-index
 700                         (if (> arg 0) -1
 701                             (if (< arg 0) 1 0)))
 702                   (push-mark (point))))
 703            (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
 704            (insert (ring-ref haskell-prompt-ring input-ring-index))
 705            (setq this-command 'haskell-previous-input))
 706           )))
 707
 708 (defun haskell-next-input (arg)
 709   "Cycle forwards through input history."
 710   (interactive "*p")
 711   (haskell-previous-input (- arg)))
 712
 713 (defvar haskell-last-input-match ""
 714   "Last string searched for by Haskell input history search, for defaulting.
 715 Buffer local variable.")
 716
 717 (defun haskell-previous-input-matching (str)
 718   "Searches backwards through input history for substring match"
 719   (interactive (let ((s (read-from-minibuffer
 720                          (format "Command substring (default %s): "
 721                                  haskell-last-input-match))))
 722                  (list (if (string= s "") haskell-last-input-match s))))
 723   (setq haskell-last-input-match str) ; update default
 724   (let ((str (regexp-quote str))
 725         (len (ring-length haskell-prompt-ring))
 726         (n 0))
 727     (while (and (<= n len)
 728                 (not (string-match str (ring-ref haskell-prompt-ring n))))
 729       (setq n (+ n 1)))
 730     (cond ((<= n len) (haskell-previous-input (+ n 1)))
 731           (t (haskell-mode-error "Not found.")))))
 732
 733
 734 ;;; Actually read an expression from the minibuffer using the new keymap.
 735
 736 (defun haskell-get-expression (prompt)
 737   (let ((exp  (read-from-minibuffer prompt nil haskell-minibuffer-local-map)))
 738     (ring-insert haskell-prompt-ring exp)
 739     exp))
 740
 741
 742 \f
 743 ;;; ==================================================================
 744 ;;; Handle output from Haskell process
 745 ;;; ==================================================================
 746
 747 ;;; The haskell process produces output with embedded control codes.
 748 ;;; These control codes are used to keep track of what kind of input
 749 ;;; the haskell process is expecting.  Ordinary output is just displayed.
 750 ;;;
 751 ;;; This is kind of complicated because control sequences can be broken
 752 ;;; across multiple batches of text received from the haskell process.
 753 ;;; If the string ends in the middle of a control sequence, save it up
 754 ;;; for the next call.
 755
 756 (defvar *haskell-saved-output* nil)
 757
 758 ;;; On the Next, there is some kind of race condition that causes stuff
 759 ;;; sent to the Haskell subprocess before it has really started to be lost.
 760 ;;; The point of this variable is to force the Emacs side to wait until
 761 ;;; Haskell has started and printed out its banner before sending it
 762 ;;; anything.  See start-haskell below.
 763
 764 (defvar *haskell-process-alive* nil)
 765
 766 (defun haskell-output-filter (process str)
 767   "Filter for output from Yale Haskell command interface"
 768   ;; *** debug
 769   ;;(let ((buffer  (get-buffer-create "haskell-output")))
 770   ;;  (save-excursion
 771   ;;    (set-buffer buffer)
 772   ;;    (insert str)))
 773   (setq *haskell-process-alive* t)
 774   (let ((next    0)
 775         (start   0)
 776         (data    (match-data)))
 777     (unwind-protect
 778         (progn
 779           ;; If there was saved output from last time, glue it in front of the
 780           ;; newly received input.
 781           (if *haskell-saved-output*
 782               (progn
 783                 (setq str (concat *haskell-saved-output* str))
 784                 (setq *haskell-saved-output* nil)))
 785           ;; Loop, looking for complete command sequences.
 786           ;; Set next to point to the first one.
 787           ;; start points to first character to be processed.
 788           (while (setq next
 789                        (string-match *haskell-message-match-regexp*
 790                                      str start))
 791             ;; Display any intervening ordinary text.
 792             (if (not (eq next start))
 793                 (haskell-display-output (substring str start next)))
 794             ;; Now dispatch on the particular command sequence found.
 795             ;; Handler functions are called with the string and start index
 796             ;; as arguments, and should return the index of the "next"
 797             ;; character.
 798             (let ((end  (match-end 0)))
 799               (haskell-handle-message str next)
 800               (setq start end)))
 801           ;; Look to see whether the string ends with an incomplete
 802           ;; command sequence.
 803           ;; If so, save the tail of the string for next time.
 804           (if (and (setq next
 805                      (string-match *haskell-message-prefix-regexp* str start))
 806                    (eq (match-end 0) (length str)))
 807               (setq *haskell-saved-output* (substring str next))
 808               (setq next (length str)))
 809           ;; Display any leftover ordinary text.
 810           (if (not (eq next start))
 811               (haskell-display-output (substring str start next))))
 812       (store-match-data data))))
 813
 814 (defvar *haskell-message-match-regexp*
 815   "EMACS:.*\n")
 816
 817 (defvar *haskell-message-prefix-regexp*
 818   "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?")
 819
 820 (defvar *haskell-message-dispatch*
 821   '(("EMACS:debug\n"         . haskell-got-debug)
 822     ("EMACS:busy\n"          . haskell-got-busy)
 823     ("EMACS:input\n"         . haskell-got-input)
 824     ("EMACS:ready\n"         . haskell-got-ready)
 825     ("EMACS:printers .*\n"   . haskell-got-printers)
 826     ("EMACS:optimizers .*\n" . haskell-got-optimizers)
 827     ("EMACS:message .*\n"    . haskell-got-message)
 828     ("EMACS:error\n"         . haskell-got-error)
 829     ))
 830
 831 (defun haskell-handle-message (str idx)
 832   (let ((list  *haskell-message-dispatch*)
 833         (fn    nil))
 834     (while (and list (null fn))
 835       (if (eq (string-match (car (car list)) str idx) idx)
 836           (setq fn (cdr (car list)))
 837           (setq list (cdr list))))
 838     (if (null fn)
 839         (haskell-mode-error "Garbled message from Haskell!")
 840         (let ((end  (match-end 0)))
 841           (funcall fn str idx end)
 842           end))))
 843
 844
 845 (defun haskell-message-data (string start end)
 846   (let ((real-start  (+ (string-match " " string start) 1))
 847         (real-end    (- end 1)))
 848     (substring string real-start real-end)))
 849
 850 (defun haskell-got-debug (string start end)
 851   (beep)
 852   (message "In the debugger!")
 853   (set-haskell-status 'debug))
 854
 855 (defun haskell-got-busy (string start end)
 856   (set-haskell-status 'busy))
 857
 858 (defun haskell-got-input (string start end)
 859   (if haskell-auto-switch-input
 860       (progn
 861         (haskell-switch)
 862         (beep)))
 863   (set-haskell-status 'input)
 864   (message "Waiting for input..."))
 865
 866 (defun haskell-got-ready (string start end)
 867   (set-haskell-status 'ready))
 868
 869 (defun haskell-got-printers (string start end)
 870   (haskell-printers-update (haskell-message-data string start end)))
 871
 872 (defun haskell-got-optimizers (string start end)
 873   (haskell-optimizers-update (haskell-message-data string start end)))
 874
 875 (defun haskell-got-message (string start end)
 876   (message "%s" (haskell-message-data string start end)))
 877
 878 (defun haskell-got-error (string start end)
 879 ; [[!chak! I found that annoying]]  (beep)
 880   (message "Haskell error."))
 881
 882
 883 ;;; Displays output at end of given buffer.
 884 ;;; This function only ensures that the output is visible, without
 885 ;;; selecting the buffer in which it is displayed.
 886 ;;; Note that just using display-buffer instead of all this rigamarole
 887 ;;; won't work; you need to temporarily select the window containing
 888 ;;; the *haskell-buffer*, or else the display won't be scrolled to show
 889 ;;; the new output.
 890 ;;; *** This should really position the window in the buffer so that
 891 ;;; *** the point is on the last line of the window.
 892
 893 (defun haskell-display-output (str)
 894   (let ((window  (selected-window)))
 895     (unwind-protect
 896         (progn
 897           (pop-to-buffer *haskell-buffer*)
 898           (haskell-display-output-aux str))
 899       (select-window window))))
 900
 901 (defun haskell-display-output-aux (str)
 902   (haskell-move-marker)
 903   (insert str)
 904   (haskell-move-marker))
 905
 906
 907 \f
 908 ;;; ==================================================================
 909 ;;; Interactive commands
 910 ;;; ==================================================================
 911
 912
 913 ;;; HASKELL
 914 ;;; -------
 915 ;;;
 916 ;;; This is the function that fires up the inferior haskell process.
 917
 918 (defun haskell ()
 919   "Run an inferior Haskell process with input and output via buffer *haskell*.
 920 Takes the program name from the variable haskell-program-name.
 921 Runs the hooks from inferior-haskell-mode-hook
 922 (after the comint-mode-hook is run).
 923 \(Type \\[describe-mode] in the process buffer for a list of commands.)"
 924   (interactive)
 925   (if (not (haskell-process-exists-p))
 926     (start-haskell)))
 927
 928 (defun start-haskell ()
 929   (message "Starting haskell subprocess...")
 930   ;; Kill old haskell process.  Normally this routine is only called
 931   ;; after checking haskell-process-exists-p, but things can get
 932   ;; screwed up if you rename the *haskell* buffer while leaving the
 933   ;; old process running.  This forces it to get rid of the old process
 934   ;; and start a new one.
 935   (if (get-process "haskell")
 936       (delete-process "haskell"))
 937   (let ((haskell-buffer
 938          (apply 'make-comint
 939                 "haskell"
 940                 (or haskell-program-name
 941                     (haskell-mode-error "Haskell-program-name undefined!"))
 942                 nil
 943                 nil)))
 944     (save-excursion
 945       (set-buffer haskell-buffer)
 946       (inferior-haskell-mode))
 947     (haskell-session-init)
 948     ;; Wait for process to get started before sending it anything
 949     ;; to avoid race condition on NeXT.
 950     (setq *haskell-process-alive* nil)
 951     (while (not *haskell-process-alive*)
 952       (sleep-for 1))
 953     (haskell-send-to-process ":(use-emacs-interface)")
 954     (haskell-printers-set haskell-initial-printers nil)
 955     (display-buffer haskell-buffer))
 956   (message "Starting haskell subprocess...  Done."))
 957
 958
 959 (defun haskell-process-exists-p ()
 960   (let ((haskell-buffer  (get-buffer *haskell-buffer*)))
 961     (and haskell-buffer (comint-check-proc haskell-buffer))))
 962
 963
 964
 965 ;;; Initialize things on the emacs side, and tell haskell that it's
 966 ;;; talking to emacs.
 967
 968 (defun haskell-session-init ()
 969   (set-haskell-status 'busy)
 970   (setq *last-loaded* nil)
 971   (setq *last-module* haskell-main-module)
 972   (setq *last-pad* haskell-main-pad)
 973   (setq *haskell-saved-output* nil)
 974   (haskell-create-main-pad)
 975   (set-process-filter (get-process "haskell") 'haskell-output-filter)
 976   )
 977
 978
 979 (defun haskell-create-main-pad ()
 980   (let ((buffer (get-buffer-create haskell-main-pad)))
 981     (save-excursion
 982       (set-buffer buffer)
 983       (haskell-mode))
 984     (haskell-record-pad-mapping
 985       haskell-main-pad haskell-main-module nil)
 986     buffer))
 987
 988
 989 ;;; Called from evaluation and compilation commands to start up a Haskell
 990 ;;; process if none is already in progress.
 991
 992 (defun haskell-maybe-create-process ()
 993   (cond ((haskell-process-exists-p)
 994          t)
 995         (haskell-auto-create-process
 996          (start-haskell))
 997         (t
 998          (haskell-mode-error "No Haskell process!"))))
 999
1000
1001
1002 ;;; HASKELL-GET-PAD
1003 ;;; ------------------------------------------------------------------
1004
1005 ;;; This always puts the pad buffer in the "other" window.
1006 ;;; Having it wipe out the .hs file window is clearly the wrong
1007 ;;; behavior.
1008
1009 (defun haskell-get-pad ()
1010   "Creates a new scratch pad for the current module.
1011 Signals an error if the current buffer is not a .hs file."
1012   (interactive)
1013   (let ((fname (buffer-file-name)))
1014     (if fname
1015         (do-get-pad fname (current-buffer))
1016         (haskell-mode-error "Not in a .hs buffer!"))))
1017
1018
1019 (defun do-get-pad (fname buff)
1020   (let* ((mname (or (haskell-get-modname buff)
1021                     (read-no-blanks-input "Scratch pad for module? " nil)))
1022          (pname (haskell-lookup-pad mname fname))
1023          (pbuff nil))
1024     ;; Generate the base name of the pad buffer, then create the
1025     ;; buffer.  The actual name of the pad buffer may be something
1026     ;; else because of name collisions.
1027     (if (not pname)
1028         (progn
1029           (setq pname (format "*%s-pad*" mname))
1030           (setq pbuff (generate-new-buffer pname))
1031           (setq pname (buffer-name pbuff))
1032           (haskell-record-pad-mapping pname mname fname)
1033           )
1034         (setq pbuff (get-buffer pname)))
1035     ;; Make sure the pad buffer is in haskell mode.
1036     (pop-to-buffer pbuff)
1037     (haskell-mode)))
1038
1039
1040
1041 ;;; HASKELL-SWITCH
1042 ;;; ------------------------------------------------------------------
1043
1044 (defun haskell-switch ()
1045   "Switches to \*haskell\* buffer."
1046   (interactive)
1047   (haskell-maybe-create-process)
1048   (pop-to-buffer *haskell-buffer*)
1049   (push-mark)
1050   (goto-char (point-max)))
1051
1052
1053
1054 ;;; HASKELL-KILL
1055 ;;; ------------------------------------------------------------------
1056
1057 (defun haskell-kill ()
1058   "Kill contents of *haskell* buffer.  \\[haskell-kill]"
1059   (interactive)
1060   (save-excursion
1061     (set-buffer *haskell-buffer*)
1062     (beginning-of-buffer)
1063     (let ((mark  (point)))
1064       (end-of-buffer)
1065       (kill-region mark (point)))))
1066
1067
1068
1069 ;;; HASKELL-COMMAND
1070 ;;; ------------------------------------------------------------------
1071
1072 (defun haskell-command (str)
1073   "Format STRING as a haskell command and send it to haskell process.  \\[haskell-command]"
1074   (interactive "sHaskell command: ")
1075   (haskell-send-to-process (format ":%s" str)))
1076
1077
1078 ;;; HASKELL-EVAL and HASKELL-RUN
1079 ;;; ------------------------------------------------------------------
1080
1081 (defun haskell-eval ()
1082   "Evaluate expression in current module. \\[haskell-eval]"
1083   (interactive)
1084   (haskell-maybe-create-process)
1085   (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
1086                     "emacs-eval"))
1087
1088 (defun haskell-run ()
1089   "Run Haskell Dialogue in current module"
1090   (interactive)
1091   (haskell-maybe-create-process)
1092   (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ")
1093                     "emacs-run"))
1094
1095 (defun haskell-run-main ()
1096   "Run Dialogue named main in current module"
1097   (interactive)
1098   (haskell-maybe-create-process)
1099   (haskell-eval-aux "main" "emacs-run"))
1100
1101 (defun haskell-report-type ()
1102   "Print the type of the expression."
1103   (interactive)
1104   (haskell-maybe-create-process)
1105   (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
1106                     "emacs-report-type"))
1107
1108 (defun haskell-eval-aux (exp fn)
1109   (cond ((equal *haskell-buffer* (buffer-name))
1110          ;; In the *haskell* buffer.
1111          (let* ((pname  *last-pad*)
1112                 (mname  *last-module*)
1113                 (fname  *last-loaded*))
1114            (haskell-eval-aux-aux exp pname mname fname fn)))
1115         ((buffer-file-name)
1116          ;; In a .hs file.
1117          (let* ((fname  (buffer-file-name))
1118                 (mname  (haskell-get-modname (current-buffer)))
1119                 (pname  (haskell-lookup-pad mname fname)))
1120            (haskell-eval-aux-aux exp pname mname fname fn)))
1121         (t
1122          ;; In a pad.
1123          (let* ((pname  (buffer-name (current-buffer)))
1124                 (mname  (haskell-get-module-from-pad pname))
1125                 (fname  (haskell-get-file-from-pad pname)))
1126            (haskell-eval-aux-aux exp pname mname fname fn)))
1127         ))
1128
1129 (defun haskell-eval-aux-aux (exp pname mname fname fn)
1130   (haskell-save-modified-source-files fname)
1131   (haskell-send-to-process (format ":(%s" fn))
1132   (haskell-send-to-process
1133     (prin1-to-string exp))
1134   (haskell-send-to-process
1135     (prin1-to-string (or pname fname "interactive")))
1136   (haskell-send-to-process
1137     (prin1-to-string
1138       (if (and pname (get-buffer pname))
1139           (save-excursion
1140             (set-buffer pname)
1141             (buffer-string))
1142           "")))
1143   (haskell-send-to-process
1144     (format "'|%s|" mname))
1145   (haskell-send-to-process
1146     (if fname
1147         (prin1-to-string (haskell-maybe-get-unit-file-name fname))
1148         "'#f"))
1149   (haskell-send-to-process ")")
1150   (setq *last-pad* pname)
1151   (setq *last-module* mname)
1152   (setq *last-loaded* fname))
1153
1154
1155
1156 ;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE
1157 ;;; ------------------------------------------------------------------
1158
1159 (defun haskell-run-file ()
1160   "Runs Dialogue named main in current file."
1161   (interactive)
1162   (haskell-maybe-create-process)
1163   (let ((fname  (haskell-get-file-to-operate-on)))
1164     (haskell-save-modified-source-files fname)
1165     (haskell-send-to-process ":(emacs-run-file")
1166     (haskell-send-to-process (prin1-to-string fname))
1167     (haskell-send-to-process ")")))
1168
1169 (defun haskell-load ()
1170   "Load current file."
1171   (interactive)
1172   (haskell-maybe-create-process)
1173   (let ((fname  (haskell-get-file-to-operate-on)))
1174     (haskell-save-modified-source-files fname)
1175     (haskell-send-to-process ":(emacs-load-file")
1176     (haskell-send-to-process (prin1-to-string fname))
1177     (haskell-send-to-process ")")))
1178
1179 (defun haskell-compile ()
1180   "Compile current file."
1181   (interactive)
1182   (haskell-maybe-create-process)
1183   (let ((fname  (haskell-get-file-to-operate-on)))
1184     (haskell-save-modified-source-files fname)
1185     (haskell-send-to-process ":(emacs-compile-file")
1186     (haskell-send-to-process (prin1-to-string fname))
1187     (haskell-send-to-process ")")))
1188
1189
1190 (defun haskell-get-file-to-operate-on ()
1191   (cond ((equal *haskell-buffer* (buffer-name))
1192          ;; When called from the haskell process buffer, prompt for a file.
1193          (call-interactively 'haskell-get-file/prompt))
1194         ((buffer-file-name)
1195          ;; When called from a .hs file buffer, use the unit file
1196          ;; associated with it, if there is one.
1197          (haskell-maybe-get-unit-file-name (buffer-file-name)))
1198         (t
1199          ;; When called from a pad, use the file that the module the
1200          ;; pad belongs to lives in.
1201          (haskell-maybe-get-unit-file-name
1202            (haskell-get-file-from-pad (buffer-name (current-buffer)))))))
1203
1204 (defun haskell-get-file/prompt (filename)
1205   (interactive "fHaskell file:  ")
1206   filename)
1207
1208
1209
1210 ;;; HASKELL-EXIT
1211 ;;; ------------------------------------------------------------------
1212
1213 (defun haskell-exit ()
1214   "Quit the haskell process."
1215   (interactive)
1216   (cond ((not (haskell-process-exists-p))
1217          (message "No process currently running."))
1218         ((y-or-n-p "Do you really want to quit Haskell? ")
1219          (haskell-send-to-process ":quit")
1220          ;; If we were running the tutorial, mark the temp buffer as unmodified
1221          ;; so we don't get asked about saving it later.
1222          (if (and *ht-temp-buffer*
1223                   (get-buffer *ht-temp-buffer*))
1224              (save-excursion
1225                (set-buffer *ht-temp-buffer*)
1226                (set-buffer-modified-p nil)))
1227          ;; Try to remove the haskell output buffer from the screen.
1228          (bury-buffer *haskell-buffer*)
1229          (replace-buffer-in-windows *haskell-buffer*))
1230         (t
1231          nil)))
1232
1233
1234 ;;; HASKELL-INTERRUPT
1235 ;;; ------------------------------------------------------------------
1236
1237 (defun haskell-interrupt ()
1238   "Interrupt the haskell process."
1239   (interactive)
1240   (if (haskell-process-exists-p)
1241       (haskell-send-to-process "\C-c")))
1242
1243
1244
1245 ;;; HASKELL-EDIT-UNIT
1246 ;;; ------------------------------------------------------------------
1247
1248 (defun haskell-edit-unit ()
1249   "Edit the .hu file."
1250   (interactive)
1251   (let ((fname       (buffer-file-name)))
1252     (if fname
1253         (let ((find-file-not-found-hooks  (list 'haskell-new-unit))
1254               (file-not-found             nil)
1255               (units-fname                (haskell-get-unit-file-name fname)))
1256           (find-file-other-window units-fname)
1257           ;; If creating a new file, initialize it to contain the name
1258           ;; of the haskell source file.
1259           (if file-not-found
1260               (save-excursion
1261                 (insert
1262                   (if (string= (file-name-directory fname)
1263                                (file-name-directory units-fname))
1264                       (file-name-nondirectory fname)
1265                       fname)
1266                   "\n"))))
1267         (haskell-mode-error "Not in a .hs buffer!"))))
1268
1269 (defun haskell-new-unit ()
1270   (setq file-not-found t))
1271
1272
1273 ;;; Look for a comment like "-- unit:" at top of file.
1274 ;;; If not found, assume unit file has same name as the buffer but
1275 ;;; a .hu extension.
1276
1277 (defun haskell-get-unit-file-name (fname)
1278   (or (haskell-get-unit-file-name-from-file fname)
1279       (concat (haskell-strip-file-extension fname) ".hu")))
1280
1281 (defun haskell-maybe-get-unit-file-name (fname)
1282   (or (haskell-get-unit-file-name-from-file fname)
1283       (haskell-strip-file-extension fname)))
1284
1285 (defun haskell-get-unit-file-name-from-file (fname)
1286   (let ((buffer  (get-file-buffer fname)))
1287     (if buffer
1288         (save-excursion
1289           (beginning-of-buffer)
1290           (if (re-search-forward "-- unit:[ \t]*" (point-max) t)
1291               (let ((beg  (match-end 0)))
1292                 (end-of-line)
1293                 (buffer-substring beg (point)))
1294               nil))
1295         nil)))
1296
1297
1298
1299 \f
1300 ;;; ==================================================================
1301 ;;; Support for printers/optimizers menus
1302 ;;; ==================================================================
1303
1304 ;;; This code was adapted from the standard buff-menu.el code.
1305
1306 (defvar haskell-menu-mode-map nil "")
1307
1308 (if (not haskell-menu-mode-map)
1309     (progn
1310       (setq haskell-menu-mode-map (make-keymap))
1311       (suppress-keymap haskell-menu-mode-map t)
1312       (define-key haskell-menu-mode-map "m" 'hm-mark)
1313       (define-key haskell-menu-mode-map "u" 'hm-unmark)
1314       (define-key haskell-menu-mode-map "x" 'hm-exit)
1315       (define-key haskell-menu-mode-map "q" 'hm-exit)
1316       (define-key haskell-menu-mode-map " " 'next-line)
1317       (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark)
1318       (define-key haskell-menu-mode-map "?" 'describe-mode)))
1319
1320 ;; Printers Menu mode is suitable only for specially formatted data.
1321
1322 (put 'haskell-menu-mode 'mode-class 'special)
1323
1324 (defun haskell-menu-mode ()
1325   "Major mode for editing Haskell flags.
1326 Each line describes a flag.
1327 Letters do not insert themselves; instead, they are commands.
1328 m -- mark flag (turn it on)
1329 u -- unmark flag (turn it off)
1330 x -- exit; tell the Haskell process to update the flags, then leave menu.
1331 q -- exit; same as x.
1332 Precisely,\\{haskell-menu-mode-map}"
1333   (kill-all-local-variables)
1334   (use-local-map haskell-menu-mode-map)
1335   (setq truncate-lines t)
1336   (setq buffer-read-only t)
1337   (setq major-mode 'haskell-menu-mode)
1338   (setq mode-name "Haskell Flags Menu")
1339   ;; These are all initialized elsewhere
1340   (make-local-variable 'hm-current-flags)
1341   (make-local-variable 'hm-request-fn)
1342   (make-local-variable 'hm-update-fn)
1343   (run-hooks 'haskell-menu-mode-hook))
1344
1345
1346 (defun haskell-menu (help-file buffer request-fn update-fn)
1347   (haskell-maybe-create-process)
1348   (if (get-buffer buffer)
1349       (progn
1350         (pop-to-buffer buffer)
1351         (goto-char (point-min)))
1352       (progn
1353         (pop-to-buffer buffer)
1354         (insert-file-contents help-file)
1355         (haskell-menu-mode)
1356         (setq hm-request-fn request-fn)
1357         (setq hm-update-fn update-fn)
1358         ))
1359   (hm-mark-current)
1360   (message "m = mark; u = unmark; x = execute; q = quit; ? = more help."))
1361
1362
1363
1364 ;;; A line that starts with *hm-marked* is a menu item turned on.
1365 ;;; A line that starts with *hm-unmarked* is turned off.
1366 ;;; A line that starts with anything else is just random text and is
1367 ;;; ignored by commands that deal with menu items.
1368
1369 (defvar *hm-marked*   " on")
1370 (defvar *hm-unmarked* "   ")
1371 (defvar *hm-marked-regexp*   " on   \\w")
1372 (defvar *hm-unmarked-regexp* "      \\w")
1373
1374 (defun hm-mark ()
1375   "Mark flag to be turned on."
1376   (interactive)
1377   (beginning-of-line)
1378   (cond ((looking-at *hm-marked-regexp*)
1379          (forward-line 1))
1380         ((looking-at *hm-unmarked-regexp*)
1381          (let ((buffer-read-only  nil))
1382            (delete-char (length *hm-unmarked*))
1383            (insert *hm-marked*)
1384            (forward-line 1)))
1385         (t
1386          (forward-line 1))))
1387
1388 (defun hm-unmark ()
1389   "Unmark flag."
1390   (interactive)
1391   (beginning-of-line)
1392   (cond ((looking-at *hm-unmarked-regexp*)
1393          (forward-line 1))
1394         ((looking-at *hm-marked-regexp*)
1395          (let ((buffer-read-only  nil))
1396            (delete-char (length *hm-marked*))
1397            (insert *hm-unmarked*)
1398            (forward-line 1)))
1399         (t
1400          (forward-line 1))))
1401
1402 (defun hm-backup-unmark ()
1403   "Move up and unmark."
1404   (interactive)
1405   (forward-line -1)
1406   (hm-unmark)
1407   (forward-line -1))
1408
1409
1410 ;;; Actually make the changes.
1411
1412 (defun hm-exit ()
1413   "Update flags, then leave menu."
1414   (interactive)
1415   (hm-execute)
1416   (hm-quit))
1417
1418 (defun hm-execute ()
1419   "Tell haskell process to tweak flags."
1420   (interactive)
1421   (save-excursion
1422     (goto-char (point-min))
1423     (let ((flags-on   nil)
1424           (flags-off  nil))
1425       (while (not (eq (point) (point-max)))
1426         (cond ((looking-at *hm-unmarked-regexp*)
1427                (setq flags-off (cons (hm-flag) flags-off)))
1428               ((looking-at *hm-marked-regexp*)
1429                (setq flags-on (cons (hm-flag) flags-on)))
1430               (t
1431                nil))
1432         (forward-line 1))
1433       (funcall hm-update-fn flags-on flags-off))))
1434
1435
1436 (defun hm-quit ()
1437   (interactive)
1438   "Make the menu go away."
1439   (bury-buffer (current-buffer))
1440   (replace-buffer-in-windows (current-buffer)))
1441
1442 (defun hm-flag ()
1443   (save-excursion
1444     (beginning-of-line)
1445     (forward-char 6)
1446     (let ((beg  (point)))
1447       ;; End of flag name marked by tab or two spaces.
1448       (re-search-forward "\t\\|  ")
1449       (buffer-substring beg (match-beginning 0)))))
1450
1451
1452 ;;; Update the menu to mark only those items currently turned on.
1453
1454 (defun hm-mark-current ()
1455   (funcall hm-request-fn)
1456   (save-excursion
1457     (goto-char (point-min))
1458     (while (not (eq (point) (point-max)))
1459       (cond ((and (looking-at *hm-unmarked-regexp*)
1460                   (hm-item-currently-on-p (hm-flag)))
1461              (hm-mark))
1462             ((and (looking-at *hm-marked-regexp*)
1463                   (not (hm-item-currently-on-p (hm-flag))))
1464              (hm-unmark))
1465             (t
1466              (forward-line 1))))))
1467
1468
1469 ;;; See if a menu item is turned on.
1470
1471 (defun hm-item-currently-on-p (item)
1472   (member-string= item hm-current-flags))
1473
1474 (defun member-string= (item list)
1475   (cond ((null list)
1476          nil)
1477         ((string= item (car list))
1478          list)
1479         (t
1480          (member-string= item (cdr list)))))
1481
1482
1483
1484 ;;; Make the menu for printers.
1485
1486 (defvar *haskell-printers-help*
1487   (concat (getenv "HASKELL") "/emacs-tools/printer-help.txt")
1488   "Help file for printers.")
1489
1490 (defvar *haskell-printers-buffer* "*Haskell printers*")
1491
1492 (defun haskell-printers ()
1493   "Set printers interactively."
1494   (interactive)
1495   (haskell-menu
1496     *haskell-printers-help*
1497     *haskell-printers-buffer*
1498     'haskell-printers-inquire
1499     'haskell-printers-set))
1500
1501 (defun haskell-printers-inquire ()
1502   (setq hm-current-flags t)
1503   (haskell-send-to-process ":(emacs-send-printers)")
1504   (while (eq hm-current-flags t)
1505     (sleep-for 1)))
1506
1507 (defun haskell-printers-update (data)
1508   (setq hm-current-flags (read data)))
1509
1510 (defun haskell-printers-set (flags-on flags-off)
1511   (haskell-send-to-process ":(emacs-set-printers '")
1512   (haskell-send-to-process (prin1-to-string flags-on))
1513   (haskell-send-to-process ")"))
1514
1515
1516 ;;; Equivalent stuff for the optimizers menu
1517
1518 (defvar *haskell-optimizers-help*
1519   (concat (getenv "HASKELL") "/emacs-tools/optimizer-help.txt")
1520   "Help file for optimizers.")
1521
1522 (defvar *haskell-optimizers-buffer* "*Haskell optimizers*")
1523
1524 (defun haskell-optimizers ()
1525   "Set optimizers interactively."
1526   (interactive)
1527   (haskell-menu
1528     *haskell-optimizers-help*
1529     *haskell-optimizers-buffer*
1530     'haskell-optimizers-inquire
1531     'haskell-optimizers-set))
1532
1533 (defun haskell-optimizers-inquire ()
1534   (setq hm-current-flags t)
1535   (haskell-send-to-process ":(emacs-send-optimizers)")
1536   (while (eq hm-current-flags t)
1537     (sleep-for 1)))
1538
1539 (defun haskell-optimizers-update (data)
1540   (setq hm-current-flags (read data)))
1541
1542 (defun haskell-optimizers-set (flags-on flags-off)
1543   (haskell-send-to-process ":(emacs-set-optimizers '")
1544   (haskell-send-to-process (prin1-to-string flags-on))
1545   (haskell-send-to-process ")"))
1546
1547
1548 \f
1549 ;;; ==================================================================
1550 ;;; Random utilities
1551 ;;; ==================================================================
1552
1553
1554 ;;; Keep track of the association between pads, modules, and files.
1555 ;;; The global variable is a list of (pad-buffer-name module-name file-name)
1556 ;;; lists.
1557
1558 (defvar *haskell-pad-mappings* ()
1559   "Associates pads with their corresponding module and file.")
1560
1561 (defun haskell-record-pad-mapping (pname mname fname)
1562   (setq *haskell-pad-mappings*
1563         (cons (list pname mname fname) *haskell-pad-mappings*)))
1564
1565 (defun haskell-get-module-from-pad (pname)
1566   (car (cdr (assoc pname *haskell-pad-mappings*))))
1567
1568 (defun haskell-get-file-from-pad (pname)
1569   (car (cdr (cdr (assoc pname *haskell-pad-mappings*)))))
1570
1571 (defun haskell-lookup-pad (mname fname)
1572   (let ((pname  (haskell-lookup-pad-aux mname fname *haskell-pad-mappings*)))
1573     (if (and pname (get-buffer pname))
1574         pname
1575         nil)))
1576
1577 (defun haskell-lookup-pad-aux (mname fname list)
1578   (cond ((null list)
1579          nil)
1580         ((and (equal mname (car (cdr (car list))))
1581               (equal fname (car (cdr (cdr (car list))))))
1582          (car (car list)))
1583         (t
1584          (haskell-lookup-pad-aux mname fname (cdr list)))))
1585
1586
1587
1588 ;;; Save any modified .hs and .hu files.
1589 ;;; Yes, the two set-buffer calls really seem to be necessary.  It seems
1590 ;;; that y-or-n-p makes emacs forget we had temporarily selected some
1591 ;;; other buffer, and if you just do save-buffer directly it will end
1592 ;;; up trying to save the current buffer instead.  The built-in
1593 ;;; save-some-buffers function has this problem....
1594
1595 (defun haskell-save-modified-source-files (filename)
1596   (let ((buffers   (buffer-list))
1597         (found-any nil))
1598     (while buffers
1599       (let ((buffer  (car buffers)))
1600         (if (and (buffer-modified-p buffer)
1601                  (save-excursion
1602                    (set-buffer buffer)
1603                    (and buffer-file-name
1604                         (haskell-source-file-p buffer-file-name)
1605                         (setq found-any t)
1606                         (or (null haskell-ask-before-saving)
1607                             (and filename (string= buffer-file-name filename))
1608                             (y-or-n-p
1609                                 (format "Save file %s? " buffer-file-name))))))
1610             (save-excursion
1611               (set-buffer buffer)
1612               (save-buffer))))
1613       (setq buffers (cdr buffers)))
1614     (if found-any
1615         (message "")
1616         (message "(No files need saving)"))))
1617
1618 (defun haskell-source-file-p (filename)
1619   (or (string-match "\\.hs$" filename)
1620       (string-match "\\.lhs$" filename)
1621       (string-match "\\.hi$" filename)
1622       (string-match "\\.hu$" filename)))
1623
1624
1625
1626 ;;; Buffer utilities
1627
1628 (defun haskell-move-marker ()
1629   "Moves the marker and point to the end of buffer"
1630   (set-marker comint-last-input-end (point-max))
1631   (set-marker (process-mark (get-process "haskell")) (point-max))
1632   (goto-char (point-max)))
1633
1634
1635
1636 ;;; Extract the name of the module the point is in, from the given buffer.
1637
1638 (defvar *haskell-re-module-hs*  "^module\\s *")
1639 (defvar *haskell-re-module-lhs* "^>\\s *module\\s *")
1640 (defvar *haskell-re-modname* "[A-Z]\\([a-z]\\|[A-Z]\\|[0-9]\\|'\\|_\\)*")
1641
1642 (defun haskell-get-modname (buff)
1643   "Get module name in BUFFER that point is in."
1644   (save-excursion
1645     (set-buffer buff)
1646     (let ((regexp  (if (haskell-lhs-filename-p (buffer-file-name))
1647                        *haskell-re-module-lhs*
1648                        *haskell-re-module-hs*)))
1649       (if (or (looking-at regexp)
1650               (re-search-backward regexp (point-min) t)
1651               (re-search-forward regexp (point-max) t))
1652           (progn
1653             (goto-char (match-end 0))
1654             (if (looking-at *haskell-re-modname*)
1655                 (buffer-substring (match-beginning 0) (match-end 0))
1656                 (haskell-mode-error "Module name not found!!")))
1657           "Main"))))
1658
1659
1660 ;;; Strip file extensions.
1661 ;;; Only strip off extensions we know about; e.g.
1662 ;;; "foo.hs" -> "foo" but "foo.bar" -> "foo.bar".
1663
1664 (defvar *haskell-filename-regexp* "\\(.*\\)\\.\\(hs\\|lhs\\)$")
1665
1666 (defun haskell-strip-file-extension (filename)
1667   "Strip off the extension from a filename."
1668   (if (string-match *haskell-filename-regexp* filename)
1669       (substring filename (match-beginning 1) (match-end 1))
1670       filename))
1671
1672
1673 ;;; Is this a .lhs filename?
1674
1675 (defun haskell-lhs-filename-p (filename)
1676   (string-match ".*\\.lhs$" filename))
1677
1678
1679 ;;; Haskell mode error
1680
1681 (defun haskell-mode-error (msg)
1682   "Show MSG in message line as an error from the haskell mode."
1683   (error (concat "Haskell mode:  " msg)))
1684
1685
1686 \f
1687 ;;; ==================================================================
1688 ;;; User customization
1689 ;;; ==================================================================
1690
1691 (defvar haskell-load-hook nil
1692   "This hook is run when haskell is loaded in.
1693 This is a good place to put key bindings."
1694   )
1695
1696 (run-hooks 'haskell-load-hook)
1697
1698
1699
1700 \f
1701 ;;;======================================================================
1702 ;;; Tutorial mode setup
1703 ;;;======================================================================
1704
1705 ;;; Set up additional key bindings for tutorial mode.
1706
1707 (defvar ht-mode-map (make-sparse-keymap))
1708
1709 (haskell-establish-key-bindings ht-mode-map)
1710 (define-key ht-mode-map "\C-c\C-f" 'ht-next-page)
1711 (define-key ht-mode-map "\C-c\C-b" 'ht-prev-page)
1712 (define-key ht-mode-map "\C-c\C-l" 'ht-restore-page)
1713 (define-key ht-mode-map "\C-c?"    'describe-mode)
1714
1715 (defun haskell-tutorial-mode ()
1716   "Major mode for running the Haskell tutorial.
1717 You can use these commands:
1718 \\{ht-mode-map}"
1719   (interactive)
1720   (kill-all-local-variables)
1721   (use-local-map ht-mode-map)
1722   (setq major-mode 'haskell-tutorial-mode)
1723   (setq mode-name "Haskell Tutorial")
1724   (set-syntax-table haskell-mode-syntax-table)
1725   (run-hooks 'haskell-mode-hook))
1726
1727
1728 (defun haskell-tutorial ()
1729   "Run the haskell tutorial."
1730   (interactive)
1731   (ht-load-tutorial)
1732   (ht-make-buffer)
1733   (ht-display-page)
1734   (haskell-maybe-create-process)
1735   (haskell-send-to-process ":(emacs-set-printers '(interactive))")
1736   )
1737
1738
1739 ;;; Load the tutorial file into a read-only buffer.  Do not display this
1740 ;;; buffer.
1741
1742 (defun ht-load-tutorial ()
1743   (let ((buffer  (get-buffer *ht-file-buffer*)))
1744     (if buffer
1745         (save-excursion
1746           (set-buffer buffer)
1747           (beginning-of-buffer))
1748         (save-excursion
1749           (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*)))
1750           (let ((fname (substitute-in-file-name *ht-source-file*)))
1751             (if (file-readable-p fname)
1752                 (ht-load-tutorial-aux fname)
1753                 (call-interactively 'ht-load-tutorial-aux)))))))
1754
1755 (defun ht-load-tutorial-aux (filename)
1756   (interactive "fTutorial file: ")
1757   (insert-file filename)
1758   (set-buffer-modified-p nil)
1759   (setq buffer-read-only t)
1760   (beginning-of-buffer))
1761
1762
1763 ;;; Create a buffer to use for messing about with each page of the tutorial.
1764 ;;; Put the buffer into haskell-tutorial-mode.
1765
1766 (defun ht-make-buffer ()
1767   (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs"))
1768   (setq *ht-temp-buffer* (buffer-name))
1769   (haskell-tutorial-mode))
1770
1771
1772 ;;; Commands for loading text into the tutorial pad buffer
1773
1774 (defun ht-next-page ()
1775   "Go to the next tutorial page."
1776   (interactive)
1777   (if (ht-goto-next-page)
1778       (ht-display-page)
1779       (beep)))
1780
1781 (defun ht-goto-next-page ()
1782   (let ((buff  (current-buffer)))
1783     (unwind-protect
1784         (progn
1785           (set-buffer *ht-file-buffer*)
1786           (search-forward "\C-l" nil t))
1787       (set-buffer buff))))
1788
1789 (defun ht-prev-page ()
1790   "Go to the previous tutorial page."
1791   (interactive)
1792   (if (ht-goto-prev-page)
1793       (ht-display-page)
1794       (beep)))
1795
1796 (defun ht-goto-prev-page ()
1797   (let ((buff  (current-buffer)))
1798     (unwind-protect
1799         (progn
1800           (set-buffer *ht-file-buffer*)
1801           (search-backward "\C-l" nil t))
1802       (set-buffer buff))))
1803
1804 (defun ht-goto-page (arg)
1805   "Go to the tutorial page specified as the argument."
1806   (interactive "sGo to page: ")
1807   (if (ht-searchfor-page (format "Page: %s " arg))
1808       (ht-display-page)
1809       (beep)))
1810
1811 (defun ht-goto-section (arg)
1812   "Go to the tutorial section specified as the argument."
1813   (interactive "sGo to section: ")
1814   (if (ht-searchfor-page (format "Section: %s " arg))
1815       (ht-display-page)
1816       (beep)))
1817
1818 (defun ht-searchfor-page (search-string)
1819   (let ((buff           (current-buffer)))
1820     (unwind-protect
1821         (progn
1822           (set-buffer *ht-file-buffer*)
1823           (let ((point  (point)))
1824             (beginning-of-buffer)
1825             (if (search-forward search-string nil t)
1826                 t
1827                 (progn
1828                   (goto-char point)
1829                   nil))))
1830       (set-buffer buff))))
1831
1832 (defun ht-restore-page ()
1833   (interactive)
1834   (let ((old-point  (point)))
1835     (ht-display-page)
1836     (goto-char old-point)))
1837
1838 (defun ht-display-page ()
1839   (set-buffer *ht-file-buffer*)
1840   (let* ((beg   (progn
1841                  (if (search-backward "\C-l" nil t)
1842                      (forward-line 1)
1843                      (beginning-of-buffer))
1844                  (point)))
1845          (end   (progn
1846                   (if (search-forward "\C-l" nil t)
1847                       (beginning-of-line)
1848                       (end-of-buffer))
1849                   (point)))
1850          (text  (buffer-substring beg end)))
1851     (set-buffer *ht-temp-buffer*)
1852     (erase-buffer)
1853     (insert text)
1854     (beginning-of-buffer)))
1855
1856
1857 \f
1858 ;;;======================================================================
1859 ;;; Menu bar stuff
1860 ;;;======================================================================
1861
1862 ;;; This only works in Emacs version 19, so it's in a separate file for now.
1863
1864 (if (featurep 'menu-bar)
1865     (load-library "haskell-menu"))
1866