;;	$Id: cwb.el,v 1.30 1997/09/30 20:01:44 pxs Exp pxs $
;; Copyright (C) 1997 LFCS Edinburgh. 	
;; cwb.el. Major modes for using the Edinburgh Concurrency Workbench.
;; Hacked by Perdita Stevens from ml.el, which has a complicated history...
;; Bug reporting code originates from c++-mode.el by Barry Warsaw and others.

;; Thanks:
;; to Matthew Morley (who has contributed more stuff not yet integrated, too)
;; to Thomas Kleymann and the Lego team 
;; for help and code.
;;
;; Introduction
;; ============
;; Do a "C-h m" in a cwb-mode buffer for more information on
;; customizing cwb-mode.  To submit bug reports hit "C-c C-b" in a
;; cwb-mode buffer.  This runs the command cwb-submit-bug-report and
;; automatically sets up the mail buffer with some of the necessary
;; information.  If you have any questions or suggestions, please
;; contact me: Perdita.Stevens@dcs.ed.ac.uk.
;;
;; Your .emacs file
;; ========================================================================
;; Some suggestions for your .emacs file.
;;
;; ; If cwb.el lives in some non-standard directory, you must tell emacs
;; ; where to get it. This may or may not be necessary.
;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
;;
;; ; Autoload cwb from file cwb.el
;; (autoload 'cwb "cwb" "Run a CWB process." t)
;;
;; ; The binary has an odd name or location:
;; (setq cwb-program-name "/usr/local/beta-test/cwb")
;;
;; NB If you want to run the CWB on a fast machine (which is a very
;; good idea) you can do this by making cwb-program-name be the name
;; of a script which runs the cwb on that fast machine. E.g.
;; rsh fastmachine "(cd myfavouritedirectory; cwb)"
;; 
;; ; Define C-c t to run my favorite command in CWB mode:
;; (setq cwb-load-hook
;;       '((lambda () (define-key cwb-mode-map "\C-ct"
;;                                'favorite-cmd))))
;; EMACS VERSIONS:
;; ==============
;; I'm running XEmacs 19.15. This mode will definitely not work with any
;; Emacs version 18 (or earlier!). It is intended not to break with FSF
;; Emacs version 19: but it may not be fully functional. Please do send me
;; fixes to make it more so, though! Currently:
;; o RMSmacs does not seem to support pop-up menus (?) so they are only
;;   available for XEmacs
;; Some things covered by defs in Miscellaneous below:
;; o RMSmacs only understands ring-p, which XEmacs thinks is obsolete
;; o RMSmacs doesn't understand the optional argument to erase-buffer
;; o same for buffer-string
;;
;; KNOWN BUGS AND TO DO
;; 1) That &^$%@!
;; (error/warning) Error in process filter: (args-out-of-range 0 0)
;; It doesn't tell you *which* process filter, and I can't get it to happen
;; repeatedly enough to debug...
;; 
;; 2) Aliasing problem still, e.g. if user types \{b}, since CWB will print
;; \b. Can I fix this? Surely.
;; 
;; 3) Turned off pointing at nodes because can't handle \{b}
;;
;; Toggles should be on a menu
;;
;; Lots of variables should be buffer local, and things may be buggy at the
;; moment because they're not. Similarly, things may assume they're in a CWB
;; buffer when they're not...
;;
(require 'comint)
(require 'ring) ;actually comint requires this anyway, but we do need it here
(require 'easymenu)

;;; Constants controlling the mode.
;;  =======================================================================
;;  These are the constants you might want to change

(defvar cwb-program-name "cwb"		;v7.1beta or later
  "*Program to run as CWB.")

(defvar cwb-init-file-name (expand-file-name "~/.cwbrc")
  "*File to load into any CWB we start")

;; Why not change this to local support, save me from mistaken bugreports? :-)
(defvar cwb-help-address "Perdita.Stevens@dcs.ed.ac.uk"
  "*Address accepting submission of bug reports.")

;; Users shouldn't change these directly in a running CWB, it won't have any
;; effect. Use the functions cwb-abbrev-use and cwb-abbbrevs-grab to toggle
;; them.
;; In a running, set-up CWB, the variable should be non-nil exactly when
;; the corresponding filter is in comint-output-filter-functions.
(defvar cwb-abbrevs-grab nil
  "Non-nil means parse CWB definitions for use as abbreviations. E.g.
if you issue the CWB command agent Foo = a.0 then if this variable is
non-nil this command will be parsed to allow the possibility of
replacing a.0 by Foo in future CWB output. Whether this replacement is
actually done depends on the value of cwb-abbrevs-use.")

(defvar cwb-abbrevs-use nil
  "Non-nil means use available abbreviations on CWB output.")

(defvar cwb-graph-display-program-name "daVinci -pipe" ;v2.0 or later
  "*Program to use to display the CWB's graphs.")

(defvar cwb-graph-translator "cwb2daVinci" ;v1.12 or later
  "*Program to use to turn CWB output into something that can be
displayed by the current cwb-graph-display-program-name.")

;;;  You probably don't want to change these
;;  =======================================================================

(defconst cwb-mode-version "$Id: cwb.el,v 1.30 1997/09/30 20:01:44 pxs Exp pxs $"
  "cwb-mode version number.")

(defconst cwb-www-home-page "http://www.dcs.ed.ac.uk/home/cwb/")

(defconst cwb-www-doc-page "http://www.dcs.ed.ac.uk/home/cwb/doc/")

(defconst cwb-load-command "input \"%s\";"
  "*Template for loading a file into the CWB.")

(defconst cwb-transitions-command "transitions %s;"
  "*Template for listing the transitions of an agent in the CWB.")

(defconst cwb-graph-command "graph %s;"
  "*Template for listing the graph of an agent in the CWB.")

(defconst cwb-top-level-prompt-regexp "Command:")

;; O for Perl regexps. This is not foolproof.
(defconst cwb-prompt-regexp 
"\\(Command:\\|Sim:\\|Which move\\|Hit return to continue:\\|\n.*(y or n)\\)"
  "*Regexp used to recognise prompts in the CWB process.")

;(defvar cwb-game-name "top.pl"
;  "*Program to play interactive games using the CWB.")

(defvar cwb-temp-threshold 0
  "*Controls when emacs uses temporary files to communicate with CWB. 
If not a number (e.g., NIL), then emacs always sends text directly to the
subprocess.  If an integer N, then emacs uses a temporary file whenever the
text is longer than N chars. The variable `cwb-temp-file' contains the name
of the temporary file for communicating. See `cwb-load-command' and function
`cwb-send-region'.

Sending regions directly through the pty (not using temp files)
doesn't work very well. Some operating systems have small pty buffers,
and large regions will overflow. Some operating systems (e.g., MIPS')
initialise pty's with # as the tty erase character, so that #'s in
source text will disappear, along with the preceding character."
)

(defvar cwb-temp-file (make-temp-name "/tmp/cwb")
  "*Temp file that emacs uses to communicate with the CWB process.
See `cwb-temp-threshold'. Defaults to (make-temp-name \"/tmp/cwb\").")

(defconst cwb-output-eaten-buffer "*CWB output eaten*")
(defconst cwb-graph-display-buffer "*CWB graph display*")
(defconst cwb-temporary-output-buffer "*CWB temporary output*")
(defconst cwb-help-buffer "*CWB help*")

(defvar cwb-file-mode-abbrev-table nil
  "Abbrev table in use in cwb-file-mode buffers.")
(define-abbrev-table 'cwb-file-mode-abbrev-table ())

(defvar cwb-synonym-alist nil)
(defvar cwb-synonym-names nil)
(defvar cwb-abbrevs-used-mark 1
  "A mark which indicates the beginning of a section to which we may want to
apply abbreviations")
(defvar cwb-abbrevs-grabbed-mark 1
  "A mark which indicates the beginning of a section from which we may want to
grab abbreviations")

(defvar cwb-graph-last-char-seen 1
  "A mark which indicates the beginning of a section from which we may want to
extract gaph commands")

(defvar cwb-agent-ring-size 32
  "Size of agent ring.")
(defvar cwb-agent-ring-index nil
  "Index of last matched agent.")
(defvar cwb-agent-ring (make-ring cwb-agent-ring-size)
  "Ring of agents previously referred to.")

(defvar cwb-graph-selection-regexp ;There are some things Perl does better
				   ;than elisp! 
"node_selections_labels(\\[\"\\(.*\\)\"\\])"
  "What parts of the grapher's output to save on the CWB agent ring.")
(defvar cwb-graph-command-regexp 
"menu_selection(\"\\(.*\\)\")\\|\\(node_double_click\\)"
  "What parts of the grapher's output are commands for the CWB.")
(defvar cwb-dummy-node-regexp "DUMMY\\(.*\\)->\\(.*\\)->\\(.*\\)"
"part of a selection matching dummy node, i.e. transitions, in daVinci")

(defconst cwb-running-XEmacs (string-match "XEmacs" emacs-version))


;;; Derived modes
;; =======================================================================

(define-derived-mode cwb-file-mode fundamental-mode
  "CWB" "Major mode for editing CWB code.
Doesn't do much yet! 

For information on running an CWB process, see the documentation
for cwb-mode.

Customisation: Entry to this mode runs the hooks on cwb-file-mode-hook.

Mode map
========
\\{cwb-file-mode-map}"
  (install-cwb-keybindings cwb-file-mode-map)
  (define-key cwb-file-mode-map "\C-m" 'newline-and-indent)
  (define-key cwb-file-mode-map "\C-c\C-s" 'switch-to-cwb)
  (define-key cwb-file-mode-map "\C-c\C-r" 'cwb-send-region)
  (if cwb-running-XEmacs 
      (define-key cwb-file-mode-map 'button3 'cwb-popup-file-mode-menu))
  (easy-menu-add cwb-file-mode-menu cwb-file-mode-map))

(define-derived-mode cwb-mode comint-mode
  "CWB" "Major mode for interacting with a CWB process.

The following commands are available:
\\{cwb-mode-map}

A CWB process can be fired up with \\[cwb].

Customisation: Entry to this mode runs the hooks on comint-mode-hook and
cwb-mode-hook (in that order).

You can send text to the CWB process from other buffers containing
CWB source.  
    switch-to-cwb switches the current buffer to the CWB process buffer.
    cwb-send-region sends the current region to the CWB process.

    Prefixing the cwb-send-region command with a \\[universal-argument]
    causes a switch to the CWB process buffer after sending the text.

For information on running multiple processes in multiple buffers, see
documentation for variable cwb-buffer.

Commands:
Return after the end of the process' output sends the text from the 
end of process to point.
Return before the end of the process' output copies the current line
to the end of the process' output, and sends it.
Delete converts tabs to spaces as it moves back.
Paragraphs are separated only by blank lines.  Semicolons start comments.
If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it."
  (install-cwb-keybindings cwb-mode-map)
;; stuff that's only relevant to an interactive cwb buffer
  (define-key cwb-mode-map "\C-c\C-l" 'cwb-load-file)
  (define-key cwb-mode-map "\C-c\C-x" 'cwb-graph-display)
  (define-key cwb-mode-map "\C-i"     'cwb-complete-command)
  (define-key cwb-mode-map "\M-\C-i"  'cwb-complete-agent)
  (if cwb-running-XEmacs (define-key cwb-mode-map 'button3 'cwb-popup-menu))
  (easy-menu-add cwb-mode-menu cwb-mode-map)
  (setq comint-prompt-regexp cwb-prompt-regexp)
  (setq cwb-synonym-alist nil)
  (setq cwb-synonym-names nil)
  (setq comint-input-sentinel 'ignore)
  (if cwb-abbrevs-use 
      (add-hook 'comint-output-filter-functions 'cwb-abbrevs-use-filter nil t))
  (if cwb-abbrevs-grab
      (add-hook 'comint-output-filter-functions 'cwb-abbrevs-grab-filter nil t))
  (add-hook 'kill-emacs-hook 'cwb-tidy))

;;; Key bindings
;; =======================================================================

;; stuff that's relevant to any cwb buffer, interactive or not
(defun install-cwb-keybindings (map)
  (define-key map "\C-c\C-b" 'cwb-submit-bug-report)
  (define-key map "\C-c\C-u" 'cwb-abbrevs-use)
  (define-key map "\C-c\C-v" 'cwb-mode-version))

;;; Menus
;; =======================================================================

(defvar cwb-shared-menu
  '(("Help and docs"
     ["The CWB's WWW documentation"     (w3-fetch cwb-www-doc-page)  t]
     ["The CWB's WWW home page"     (w3-fetch cwb-www-home-page)  t]
     ["Help on Emacs CWB-mode" describe-mode  t])
    ["Submit bug report"     (cwb-submit-bug-report)  t]))

(defvar cwb-grapher-menu
  '(("Graph display"
     ["Start daVinci" cwb-graph-display t]
     ["Show graph..." cwb-graph-graph (cwb-grapher-is-live)]
     ["Show transitions..." cwb-graph-transitions (cwb-grapher-is-live)]
     ["Add graph..." cwb-graph-add-graph (cwb-grapher-is-live)]
     ["Add transitions..." cwb-graph-add-transitions (cwb-grapher-is-live)])))

(defvar cwb-mode-menu 
  (append
   '(["Display context" (cwb-show-as-help "print;") t])
   '(["Load file..." cwb-load-file t])
   cwb-grapher-menu
   '(("Abbreviations"
      ["Use"     (cwb-abbrevs-use)  
      :style toggle
      :selected cwb-abbrevs-use]
      ["Grab"     (cwb-abbrevs-grab)  
      :style toggle
      :selected cwb-abbrevs-grab]
      ["Add..." cwb-abbrevs-make t]
      ["Show all" (cwb-abbrevs-show) t]
      ["Forget all" (cwb-abbrevs-forget) t]))
   '(("Help from CWB"
      ["General" (cwb-show-as-help "help;") t]
      ["On agent syntax" (cwb-show-as-help "help syntax;") t]
      ["On logic" (cwb-show-as-help "help logic;") t]
      ["On commands" (cwb-show-as-help "help commands;") t]))
   cwb-shared-menu)
  "The menu for the interactive CWB")

(defvar cwb-file-mode-menu cwb-shared-menu
  "The menu for editing CWB files")

(defun cwb-popup-menu (event)
  "Display the cwb-mode menu"
  (interactive "@e")
  (if cwb-running-XEmacs		; shouldn't have bound to this else
    (let ((history (comint-make-history-menu))
          (agent-history (cwb-make-agent-menu)))
      (popup-menu (append cwb-mode-menu
                          (if history
                              (list (cons "Command History" history)))
                          (if agent-history
                              (list (cons "Agent History" agent-history)))
			  (list (cons "Comint stuff" comint-popup-menu)))))
    (error "CWB menu code works only with XEmacs, not FSF emacs. Sorry!")))

(defun cwb-popup-file-mode-menu (event)
  "Display the cwb-file-mode menu"
  (interactive "@e")
  (if cwb-running-XEmacs		; shouldn't have bound to this else
      (popup-menu cwb-file-mode-menu)
    (error "CWB menu code works only with XEmacs, not FSF emacs. Sorry!")))

(easy-menu-define cwb-mode-menu
		  cwb-mode-map
		  "Menu used in cwb-mode."
		  (append '("CWB") cwb-mode-menu))

(easy-menu-define cwb-file-mode-menu  
		  cwb-file-mode-map
		  "Menu used in cwb-file-mode."
		  (append '("CWB") cwb-file-mode-menu))

(defvar cwb-agent-menu-max 40
  "*Maximum number of entries to display on the CWB agent-history menu.")

(defun cwb-make-agent-menu ()
  (if (or (not (ringp cwb-agent-ring))
	  (ring-empty-p cwb-agent-ring))
      nil
    (let ((menu nil)
	  hist
	  (index (1- (ring-length cwb-agent-ring)))
	  (count 0))
      ;; We have to build up a list ourselves from the ring vector.
      (while (and (>= index 0)
		  (and cwb-agent-menu-max
		       (< count cwb-agent-menu-max)))
	(setq hist (ring-ref cwb-agent-ring index)
	      menu (cons (vector hist (list 'cwb-agent-history hist) t)
			 menu)
	      count (1+ count)
	      index (1- index)))
      menu)))

(defun cwb-agent-history (string)
  (goto-char (point-max))
;; The command equivalent deletes the whole line before inserting
;; string. Of course we don't want to do that! For now, delete nothing.
  (insert string))

;;; Interactive CWBs: starting them, switching between them.
;; =======================================================================

(defvar cwb-buffer nil "*The current CWB process buffer.)

MULTIPLE PROCESS SUPPORT
===========================================================================
Cwb.el supports, in a fairly simple fashion, running multiple CWB
processes. To run multiple CWB processes, you start the first up with
\\[cwb]. It will be in a buffer named *cwb*. Rename this buffer
with \\[rename-buffer]. You may now start up a new process with another
\\[cwb]. It will be in a new buffer, named *cwb*. You can
switch between the different process buffers with \\[switch-to-buffer].

However, if you are using the CWB graph drawing facilities, multiple
process support is not good (yet). In this case it would be best to
stick to one CWB buffer.

Commands that send text from source buffers to CWB processes -- like
cwb-send-region -- have to choose a process to send to, when you have
more than one CWB process around. This is determined by the global
variable cwb-buffer. Suppose you have three CWBs running:
    Buffer	Process
    foo		cwb
    bar		cwb<2>
    *cwb*        cwb<3>
If you do a \\[cwb-send-region] command on some CWB source code,
what process do you send it to?

- If you're in a process buffer (foo, bar, or *cwb*), 
  you send it to that process.
- If you're in some other buffer (e.g., a source file), you
  send it to the process attached to buffer cwb-buffer.
This process selection is performed by function cwb-proc.

Whenever \\[cwb] fires up a new process, it resets cwb-buffer
to be the new process's buffer. If you only run one process, this will
do the right thing. If you run multiple processes, you can change
cwb-buffer to another process buffer with \\[set-variable].

More sophisticated approaches are, of course, possible. If you find youself
needing to switch back and forth between multiple processes frequently, you
may wish to consider writing something like ilisp.el, a larger, more
sophisticated package for running inferior Lisp and Scheme processes. The
approach taken here is for a minimal, simple implementation. Feel free to
extend it.")

(defun cwb-proc-buffer ()
  "Returns the current CWB process buffer. See variable cwb-buffer."
  (if (eq major-mode 'cwb-mode) (current-buffer) cwb-buffer))

(defun cwb-proc ()
  "Returns the current CWB process. See variable cwb-buffer."
  (let ((proc (get-buffer-process (cwb-proc-buffer))))
    (or proc 
	(error "No current process. See variable cwb-buffer"))))

(defun cwb (&optional cmd)
 "Run an CWB process, input and output via buffer *cwb*.
If there is a process already running in *cwb*, just switch to that buffer.
With argument, allows you to edit the command line (default is value
of cwb-program-name).  Runs the hooks from cwb-mode-hook (after the
comint-mode-hook is run). Loads file cwb-init-file-name into the CWB.

\(Type \\[describe-mode] in the process buffer for a list of commands.)" 
  (interactive (list (and current-prefix-arg
			  (read-string "Run CWB: " cwb-program-name))))
  (let ((cmd (or cmd cwb-program-name)))
    (if (not (comint-check-proc "*cwb*"))
	(let ((cmdlist (cwb-args-to-list cmd)))
	  (set-buffer (apply 'make-comint "cwb" (car cmdlist)
			     nil (cdr cmdlist)))
	  (cwb-mode)
	  (if (file-readable-p cwb-init-file-name)
	      (cwb-load-file cwb-init-file-name)))))
  (setq cwb-buffer "*cwb*")
  (switch-to-buffer "*cwb*"))

;;; Miscellaneous utility functions
;; =======================================================================

;; A few defns to cover the RMSmacs-XEmacs gap: XEmacs is primary to me.
(if cwb-running-XEmacs () (defalias 'ringp 'ring-p))

(if cwb-running-XEmacs (defalias 'cwb-buffer-string 'buffer-string)
;; I happen not to need the middle 2 args
  (defun cwb-buffer-string (&optional foo bar buffer)
    (save-excursion
      (if buffer (set-buffer buffer))
      (buffer-string))))

(if cwb-running-XEmacs (defalias 'cwb-erase-buffer 'erase-buffer)
  (defun cwb-erase-buffer (&optional buffer)
    (if buffer
	(save-excursion
	  (set-buffer buffer)
	  (erase-buffer))
      (erase-buffer))))

(defun cwb-here ()
"Move to the nearest CWB buffer, without saving excursion."
  (set-buffer (cwb-proc-buffer)))

(defun cwb-args-to-list (string)
  (let ((where (string-match "[ \t]" string)))
    (cond ((null where) (list string))
	  ((not (= where 0))
	   (cons (substring string 0 where)
		 (cwb-args-to-list (substring string (+ 1 where)
					     (length string)))))
	  (t (let ((pos (string-match "[^ \t]" string)))
	       (if (null pos)
		   nil
		   (cwb-args-to-list (substring string pos
					       (length string)))))))))

(defun cwb-tidy ()
  "Something to add to `kill-emacs-hook' to tidy up tmp files on exit."
  (if (file-readable-p cwb-temp-file)
      (delete-file cwb-temp-file)))

;; I feel there ought to be a built-in to do this, but I can't find it.
(defun cwb-empty-buffer (name)
  (save-excursion
    (set-buffer (get-buffer-create name))
    (cwb-erase-buffer)))

(defun cwb-beginning-of-last-prompt (&optional prompt-regexp)
  (save-excursion
    (set-buffer cwb-buffer)
    (goto-char (point-max))
    (search-backward-regexp (or prompt-regexp comint-prompt-regexp) nil t)))

;; A fn to be used in filters to see whether we've got to the next
;; match for regexp yet (regexp is probably a prompt pattern).
;; Return nil if we haven't, or the beginning of the next match.
(defun cwb-reached-match-after (p regexp)
  (save-excursion
    (set-buffer cwb-buffer)
    (goto-char p)
    (let ((m (search-forward-regexp regexp nil t)))
      (if m (match-beginning 0) nil))))

;; From pmark to the end of the buffer, call fn for each match of regexp
(defun cwb-do-from-mark (pmark regexp fn)
  (goto-char pmark)
  (while (search-forward-regexp regexp nil t) (eval fn)))

(defun cwb-strip-whitespace (string)
  "Return STRING stripped of all whitespace."
  (while (string-match "[\r\n\t ]+" string)
    (setq string (replace-match "" t t string)))
  string)

;;; Stuff to let us ask the CWB things and catch its output. A bit flaky!
;; =======================================================================

(defvar cwb-delete-from-here 1)
(defvar cwb-eating-output nil)

(defun cwb-start-eating ()
  (cwb-here)
  (setq cwb-eating-output t)
  (setq cwb-delete-from-here (point-max))
;; I know RMS has done some good to the community, but this is a pain.
  (if cwb-running-XEmacs
      (cwb-erase-buffer (get-buffer-create cwb-output-eaten-buffer))
    (save-excursion 
      (set-buffer (get-buffer-create cwb-output-eaten-buffer))
      (cwb-erase-buffer)))
  (add-hook 'comint-output-filter-functions 'cwb-eat-output nil t))

(defun cwb-stop-eating ()
  (cwb-here)
  (setq cwb-eating-output nil)
  (remove-hook 'comint-output-filter-functions 'cwb-eat-output))

;; Add whatever's not the next top level prompt to cwb-output-eaten-buffer
;; see whether we need to keep going, delete whatever we should.
(defun cwb-eat-output (string)
  (if cwb-eating-output
      (let* ((here (cwb-reached-match-after cwb-delete-from-here
					    cwb-top-level-prompt-regexp))
	     (eaten (if here (buffer-substring cwb-delete-from-here here)
		      string)))
	(if here (cwb-stop-eating))
	(save-excursion (set-buffer cwb-output-eaten-buffer) (insert eaten))
	(delete-region cwb-delete-from-here (point-max)))))

;; Returns the result of the command, which is the content of 
;; cwb-output-eaten-buffer -- can also use that directly if more convenient
(defun cwb-ask-silently (command) ; command should finish with Command: prompt!
  (cwb-here)
  (cwb-start-eating)
  (cwb-input command)
  (while cwb-eating-output (sleep-for 1))
  (goto-char (point-max))
  (if cwb-running-XEmacs
      (cwb-buffer-string nil nil cwb-output-eaten-buffer)
    (save-excursion
      (set-buffer cwb-output-eaten-buffer)
      (cwb-buffer-string))))

(defun cwb-show-as-help (command)
  "Show the output from command in a help window.
Command should not need input later!"
  (interactive)
  (cwb-here)
  (let ((buffer (get-buffer-create cwb-help-buffer)))
    (cwb-ask-silently command)
    ;; Clear the output buffer, show this stuff there
    (set-buffer buffer)
    (if buffer-read-only (toggle-read-only))
    (cwb-erase-buffer)
    (insert-buffer cwb-output-eaten-buffer)
    (goto-char 1)
    (help-mode)
    (switch-to-buffer-other-window buffer)))

;; thing to turn off all filters for speed.

;;; Things useful in cwb-file-mode
;; =======================================================================

;; Fakes it with a temp-file if necessary.

(defun cwb-send-region (start end &optional and-go)
  "Send the current region to the CWB process.
Prefix argument means switch-to-cwb afterwards.
If the region is short, it is sent directly, via comint-send-region.
Otherwise, it is written to a temp file and an appropriate
command is sent to the process. See variables cwb-temp-threshold, 
cwb-temp-file and cwb-load-command."

  (interactive "r\nP")
  (cond ((and (numberp cwb-temp-threshold)
	      (< cwb-temp-threshold (- end start)))
	 ;; Just in case someone is still reading from
	 ;; cwb-temp-file:
	 (if (file-exists-p cwb-temp-file)
	     (delete-file cwb-temp-file))
	 (write-region start end cwb-temp-file nil 'silently)
	 (comint-send-string (cwb-proc)
		 (concat (format cwb-load-command cwb-temp-file) "\n")))
	(t
	 (comint-send-region (cwb-proc) start end)
	 (comint-send-string (cwb-proc) "\n")))
  (if and-go (switch-to-cwb t)))

(defun switch-to-cwb (eob-p)
  "Switch to the CWB process buffer, starting the CWB if there isn't one.
With argument, positions cursor at end of buffer."
  (interactive "P")
  (if (cwb-proc-buffer)
      (pop-to-buffer (cwb-proc-buffer))
      (error "No current process buffer. See variable cwb-buffer."))
  (cond (eob-p
	 (push-mark)
	 (goto-char (point-max)))))

;;; Interacting with a graph-displayer, currently daVinci
;; =======================================================================

;;; (a) Stuff that's _definitely_ daVinci specific:
;; =======================================================================

(defvar cwb-daVinci-menu-items '(
("transitions"    "Transitions"     "T" "shift" "t")
("addtransitions" "Add transitions" "t" "none"  "")
("graph"          "Graph"           "G" "shift" "g")
("addgraph"       "Add graph"       "g" "none"  "")
) "*CWB-specific things to appear in daVinci's edit menu")


(defun cwb-setup-grapher ()
  "Configure the graph displayer (here, daVinci) for using with CWB"
  (let* ((m-format "menu_entry_mne(\"%s\",\"%s\",\"%s\",%s,\"%s\")")
	 (entries (mapconcat (lambda (x) (apply 'format m-format x)) 
			     cwb-daVinci-menu-items ","))
	 (a-format "\"%s\"")
	 (activations (mapconcat (lambda (x) (apply 'format a-format x)) 
				 cwb-daVinci-menu-items ",")))
    (concat "app_menu(create_menus([" entries "]))\n"
	    "app_menu(activate_menus([" activations "]))\n"
	    "window(title(\"Edinburgh Concurrency Workbench\"))\n"
	    "window(show_status(\"CWB commands are under Edit!\"))\n")))

;; I can't get it to display things like \{a} without this error:
;; Tcl/Tk Error: extra characters after close-brace
;; so for the time being it's turned off. Can MJM do it right??
(defun cwb-graph-message (message)
;  (cwb-graph-say (cwb-quote-grapher-input 
;		  (format "window(show_message(\"%s\"))\n" message))))
  (message message))

;; Oddly, daVinci sometimes quotes ' in its output, but doesn't require '
;; quoted in its input.
(defun cwb-unquote-grapher-output (pmark)
  (cwb-do-from-mark pmark (regexp-quote "\\'") '(replace-match "'" nil t))
  (cwb-do-from-mark pmark (regexp-quote "\\\\") '(replace-match "\\" nil t)))

;; There has to be an easier way to do this -- doesn't there?
(defun cwb-quote-grapher-input (str)
  "Double up \\ in STRING."
  (let* ((string (cwb-strip-whitespace str))
	 (pos (string-match "\\\\" string 0)))
    (while pos
      (if (eq pos (string-match "\\\\n" string pos))
          (setq pos (string-match "\\\\" string (1+ pos)))
        (string-match "\\\\" string pos)
        (setq string (replace-match "\\\\\\\\" nil nil string))
        (setq pos (string-match "\\\\" string (+ 2 pos)))))
    string))

;; filters for the output from the grapher. Problem is that it doesn't
;; necessarily arrive in sensible chunks; we might get half of the
;; cwb-filter-regexp stuff in each of two chunks. I need to think more
;; about the communication options -- e.g. I'm assuming we'll only get
;; one command in a chunk, is this OK?
(defun cwb-graph-filter (string)
  (if (not (= (point-max) cwb-graph-last-char-seen)) ;really something
						     ;new
;; we're interested in the whole of the first newly-completed line
      (let ((pmark (progn (goto-char cwb-graph-last-char-seen)
			  (beginning-of-line);assume regexp just one line
			  (point-marker))))
	(setq cwb-graph-last-char-seen (point-max))
	(cwb-unquote-grapher-output pmark)
;; Deal with selections:
;; if the user selects a thing, we'll show what it was, in case the text
;; is too small to read. We'll also remember selected agents.
	(cwb-do-from-mark 
	 pmark cwb-graph-selection-regexp
	 '(if (match-beginning 1)
	      (let ((thing (match-string 1)))
		(if (string-match cwb-dummy-node-regexp thing)
;; don't try to show agents as well as actions, they're too often huge
		    (cwb-graph-message (concat "--" (match-string 2 thing)
					       "-->"))
		  (cwb-maybe-insert-agent thing)
		  ;; again, echo the state's name.
		  (cwb-graph-message thing)))))
;; Deal with commands
	(cwb-do-from-mark 
	 pmark cwb-graph-command-regexp
	 '(let ((command 
		 (if (match-beginning 1)
		     (buffer-substring (match-beginning 1) (match-end 1))
                   (if (match-beginning 2)
                       (buffer-substring (match-beginning 2) (match-end 2))
                     (match-string 3))))
		(agent (cwb-prev-agent)))
;; neater to write this higher order, I know...(but try edebug on HO stuff!)
	    (cond ((string-equal command "transitions")
		   (cwb-graph-transitions agent))
		  ((string-equal command "graph")
		   (cwb-graph-graph agent))
		  ((or (string-equal command "addtransitions") 
		       (string-equal command "node_double_click"))
		   (cwb-graph-add-transitions agent))
		  ((string-equal command "addgraph")
		   (cwb-graph-add-graph agent))
                  (t (error "This shouldn't happen!"))))))))

;;; (b) Stuff that could _conceivably_ work for another graph viewer
;; =======================================================================

;; It would really be more friendly to check whether there's one already
;; before we ask the user to enter one! But how, given interactive?
(defun cwb-graph-display (&optional cmd)
  "Run an inferior process to display graphs for the CWB, input and
output via buffer cwb-graph-display-buffer.  
If there is a process already running in cwb-graph-display-buffer, do nothing.
With argument, allows you to edit the command line (default is value
of cwb-graph-display-program-name)."
  (interactive (list 
		(and current-prefix-arg
		     (read-string "Run cwb-graph-display: " 
				  cwb-graph-display-program-name))))
  (let* ((cmd (or cmd cwb-graph-display-program-name))
	 (process-connection-type nil)  ; Use a pipe.
	 (cmdlist (cwb-args-to-list cmd)))
    (if (comint-check-proc cwb-graph-display-buffer)
	(message 
	 (concat "There is already a CWB graph display process running."))
      (set-buffer (apply 'make-comint "CWB graph display" (car cmdlist)
			 nil (cdr cmdlist)))
      (cwb-erase-buffer)
      (setq cwb-graph-last-char-seen 1)
      (add-hook 'comint-output-filter-functions 'cwb-graph-filter nil t)
      (cwb-graph-say (cwb-setup-grapher)))))

(defun cwb-graph-say (string)
  (process-send-string (cwb-graph-display-proc)
		       (concat string "\n"))) 

(defun cwb-graph-display-proc ()
  "Returns the current CWB graph display process."
  (let ((proc (get-buffer-process cwb-graph-display-buffer)))
    (or proc
	(error "No current CWB grapher. See function cwb-graph-display"))))

(defun cwb-grapher-is-live ()
  (comint-check-proc cwb-graph-display-buffer))

(defun cwb-grapher-check-live ()
  (if (not (cwb-grapher-is-live))
      (error "No current CWB grapher. See function cwb-graph-display")))

(defun cwb-graph-display-buffer (&optional add agent delete)
  "Translate the contents of the CWB eaten buffer into something the graph
display program can understand, and feed it to the graph display program.
With prefix argument, add to whatever's currently displayed, rather than 
replacing it."
  (interactive "r\nP")
  (cwb-grapher-check-live)
  (cwb-maybe-insert-agent agent) 
  (set-buffer cwb-output-eaten-buffer) 
  (cwb-empty-buffer cwb-temporary-output-buffer)     
  (apply 'call-process-region (point-min) (point-max) cwb-graph-translator
	 delete cwb-temporary-output-buffer nil 
	 "-t" (or agent "lookinregion")
	 (if add '("-a") nil))
  (cwb-graph-say (cwb-buffer-string nil nil cwb-temporary-output-buffer)))

;; why does the compiler think cwb-agent-history isn't used? It is...??
(defun cwb-get-user-to-choose-agent (prompt)
  (let ((cwb-agent-history (cwb-list-from-ring cwb-agent-ring)))
    (list(read-from-minibuffer prompt nil nil nil 
			       'cwb-agent-history))))

(defun cwb-graph-it (agent command &optional add)
  (cwb-ask-silently (format command agent))
  (cwb-graph-display-buffer add agent))

(defun cwb-graph-transitions (agent &optional add)
"Show the transitions (nextsteps) of agent. Agents which have been
referred to before are remembered\; use M-p and M-n to move through
the list of them. Prefix argument means add this information to the 
existing display." 
  (interactive (cwb-get-user-to-choose-agent "Transitions from agent: "))
  (cwb-graph-it agent cwb-transitions-command add))

(defun cwb-graph-graph (agent &optional add)
"Show the graph of agent. Agents which have been referred to before are 
remembered\; use M-p and M-n to move through the list of them. Prefix
argument means add this information to the existing display."
  (interactive (cwb-get-user-to-choose-agent "Graph of agent: "))
  (cwb-graph-it agent cwb-graph-command add))

;; This is still silly! Can I fill in add and still get user to choose agent?
(defun cwb-graph-add-transitions (agent)
"Show the transitions (nextsteps) of agent. Agents which have been
referred to before are remembered\; use M-p and M-n to move through
the list of them."
  (interactive (cwb-get-user-to-choose-agent "Transitions from agent: "))
  (cwb-graph-it agent cwb-transitions-command t))

(defun cwb-graph-add-graph (agent)
"Show the graph of agent. Agents which have been referred to before are 
remembered\; use M-p and M-n to move through the list of them."
  (interactive (cwb-get-user-to-choose-agent "Graph of agent: "))
  (cwb-graph-it agent cwb-graph-command t))

;;; Stuff for managing the agent ring
;; =======================================================================

(defun cwb-maybe-insert-agent (agent)
"Insert agent into the agent ring, except that we don't allow
consecutive duplicates"
  (if (and agent
	   (or (ring-empty-p cwb-agent-ring)
	       (not (string-equal (ring-ref cwb-agent-ring 0) agent))))
      (ring-insert cwb-agent-ring agent)))
  
(defun cwb-list-from-ring (ring)
  (if (or (not (ringp ring))
	  (ring-empty-p ring))
      nil
    (let ((history nil)
	  (index (1- (ring-length ring))))
      ;; We have to build up a list ourselves from the ring vector.
	  (while (>= index 0)
	    (setq history (cons (ring-ref ring index) history)
		  index (1- index)))
	  history)))

(defun cwb-prev-agent ()
  (cond ((or (not (ringp cwb-agent-ring))
	     (ring-empty-p cwb-agent-ring))
	 (message "Select an agent first, or use Emacs to enter one")
	 nil)
	(t (ring-ref cwb-agent-ring 0))))

(defun cwb-dynamic-list-agent-ring ()
  "List in help buffer the buffer's agent history."
  (interactive)
  (if (or (not (ringp cwb-agent-ring))
	  (ring-empty-p cwb-agent-ring))
      (message "No agent history")
    (let ((history nil)
	  (history-buffer " *Agent History*")
	  (index (1- (ring-length cwb-agent-ring)))
	  (conf (current-window-configuration)))
      ;; We have to build up a list ourselves from the ring vector.
      (while (>= index 0)
	(setq history (cons (ring-ref cwb-agent-ring index) history)
	      index (1- index)))
      ;; Change "completion" to "agent history reference"
      ;; to make the display accurate.
      (with-output-to-temp-buffer history-buffer
	(display-completion-list history)
	(set-buffer history-buffer)
	(forward-line 3)
	(while (search-backward "completion" nil 'move)
	  (replace-match "agent history reference")))
      (comint-restore-window-config conf))))

(defun cwb-complete-agent (stub)
  (interactive (list (buffer-substring (point) 
				 (save-excursion (forward-word -1)
						 (point)))))
  (comint-dynamic-simple-complete stub (cwb-list-from-ring cwb-agent-ring)))

;;; Interaction with the graphical user interface (not in use)
;; ==========================================================================
(defun cwb-print-filter (string)
  (append-to-file string nil "/tmp/cwb2tkperl"))

(defun cwb-input (string)
  (comint-send-string (cwb-proc) (concat string "\n")))

;;; User abbreviations
;; ===========================================================================
;; Tried using abbrev-mode to help here, but really it seems to be no help: 
;; it's too attached to "words".

(defun cwb-abbrevs-make (name expansion)
  "Add an abbreviation to be automatically used on CWB output"
  (interactive "sReplace: \nswith: ")
  (setq cwb-synonym-alist (cons (cons name expansion) cwb-synonym-alist))
  (if (not (member name cwb-synonym-names))
    (setq cwb-synonym-names (cons name cwb-synonym-names))))

(defun cwb-abbrevs-forget ()
  "Forget all abbreviations"
  (interactive)
  (setq cwb-synonym-alist nil)
  (setq cwb-synonym-names nil)
  (message "Forgot all abbreviations"))

(defun cwb-abbrevs-show ()
  "Show all abbreviations in a new buffer"
  (interactive)
  (let ((buffer (get-buffer-create "*CWB abbreviations*")))
    (set-buffer buffer)
    (cwb-erase-buffer)
    (cwb-abbrevs-show-these (sort cwb-synonym-names 'string-lessp))
    (switch-to-buffer-other-window buffer)
    (goto-char (point-min))))

(defun cwb-abbrevs-show-these (these)
  (if (null these) ()
      (cwb-abbrev-show (car these))
      (cwb-abbrevs-show-these (cdr these))))

(defun cwb-abbrev-show (name)
  (let ((expansion (cdr (assoc name cwb-synonym-alist))))
    (insert (format "Replacing %s with %s\n\n" expansion name))))

;; redundancy here: too many primitives!
;; string is completely irrelevant: point is that this fn gets called
;; when there is new input.
;; We want to filter in chunks that end at the beginnings of prompts, to
;; avoid missing matches when they're split between successive chunks.
(defun cwb-abbrevs-use-filter (string)
  (if (cwb-reached-match-after cwb-abbrevs-used-mark cwb-prompt-regexp)
;;we've got at least one sensible chunk to deal with
      (progn (cwb-maybe-expand-abbrevs cwb-abbrevs-used-mark 
				       cwb-synonym-names)
	     ;;Now set cwb-abbrevs-used-mark to something later than it was!
	     (setq cwb-abbrevs-used-mark (cwb-beginning-of-last-prompt)))))

(defun cwb-abbrevs-grab-filter (string)
  (let ((here (cwb-beginning-of-last-prompt)))
    (if (> here cwb-abbrevs-grabbed-mark)
;;we've got at least one sensible chunk to deal with
	(progn (cwb-grab-abbrev 
		(buffer-substring cwb-abbrevs-grabbed-mark here))
	       (setq cwb-abbrevs-grabbed-mark here)))))

(defun cwb-grab-abbrev (string)
  "If there's a CWB definition in string, grab it as an abbreviation.
If there's an agent definition, also add it to the agent ring." 
  (cond ((string-match 
	  "\\(agent\\|prop\\|set\\|relabel\\) \\(\\w*\\) = \\([^;]*\\);" 
	  string)
	 (let ((body (substring string (match-beginning 3) (match-end 3)))
	       (identifier (substring string (match-beginning 2)
				      (match-end 2)))
	       (type (substring string (match-beginning 1) (match-end 1))))
	 (cwb-abbrevs-make body identifier)
	 (if (equal type "agent") (cwb-maybe-insert-agent identifier))))))

(defun cwb-maybe-expand-abbrevs (start names)
  "From start, try to expand all the abbrevs given by names"
  (if (null names) 
      ()
    (cwb-maybe-expand-abbrev start (car names))
    (cwb-maybe-expand-abbrevs start (cdr names))))


(defun cwb-maybe-expand-abbrev (start name)
  "Replace one abbreviation by its expansion, wherever it occurs"
  (let ((expansion (cdr (assoc name cwb-synonym-alist))))
    (save-excursion
      (goto-char start)
      (while (search-forward name nil t)
	(replace-match expansion nil t)))))

(defun cwb-abbrevs-use ()
  "Toggle whether available abbreviations are applied to CWB output"
  (interactive)
  (if cwb-abbrevs-use 
      (progn 
	(setq cwb-abbrevs-use nil)
	(remove-hook 'comint-output-filter-functions 'cwb-abbrevs-use-filter)
	(setq mode-name "CWB")
	(message "Using abbreviations is off"))
    (setq cwb-abbrevs-use t)
    (add-hook 'comint-output-filter-functions 'cwb-abbrevs-use-filter nil t)
    (setq mode-name "CWB using abbrevs")
    (setq cwb-abbrevs-used-mark (point-max))
    (message "Will use abbreviations for future CWB output"))
  (if cwb-running-XEmacs (redraw-modeline)
    (force-mode-line-update)))		; obsolete fn required by RMSmacs

;; don't show status of this in the modeline; because it gets too cramped,
;; and this doesn't affect correctness of CWB output whereas using abbrevs can
(defun cwb-abbrevs-grab ()
  "Toggle whether to try to grab abbreviations from CWB future input"
  (interactive)
  (if cwb-abbrevs-grab 
      (progn 
	(setq cwb-abbrevs-grab nil)
	(remove-hook 'comint-output-filter-functions 'cwb-abbrevs-grab-filter)
	(message "Grabbing abbreviations is off"))
    (setq cwb-abbrevs-grab t)
    (add-hook 'comint-output-filter-functions 'cwb-abbrevs-grab-filter nil t)
    (setq cwb-abbrevs-grabbed-mark (point-max))
    (message "Will grab abbreviations from future CWB output")))

;;; Loading source files:
;;; ===========================================================================

(defvar cwb-source-modes '(cwb-file-mode) 
"*Used to determine if a buffer contains CWB source code.  If it's
  loaded into a buffer that is in one of these major modes, it's
  considered a CWB source file by cwb-load-file. Used by this
  command to determine defaults.")

(defvar cwb-prev-l/c-dir/file nil
  "Caches the (directory . file) pair used in the last cwb-load-file
  command. Used for determining the default in the next one.")

(defun cwb-load-file (file-name)
  "Load a CWB file into the CWB process."
  (interactive (comint-get-source "Load CWB file: " cwb-prev-l/c-dir/file
				  cwb-source-modes nil))
  (comint-check-source file-name) ; Check to see if buffer needs saved.
  (setq cwb-prev-l/c-dir/file (cons (file-name-directory    file-name)
				   (file-name-nondirectory file-name)))

  (comint-send-string (cwb-proc)
		      (concat (format cwb-load-command file-name) "\n"))
  (switch-to-cwb t))

;; Submitting a bug report
;; ======================================================================
;; Thanks to c++-mode.el by Barry Warsaw for the original of this code:

(defun cwb-mode-version ()
  "Echo the current version of cwb-mode."
  (interactive)
  (message "Using cwb-mode.el %s" cwb-mode-version))

(defun cwb-submit-bug-report ()
  "Submit via mail a bug report on the CWB, or on cwb-mode."
  (interactive)
  (require 'reporter)
  (and
   (y-or-n-p "Do you want to submit a report on either the CWB or cwb-mode? ")
   (reporter-submit-bug-report
    cwb-help-address
    (concat "cwb-mode.el " cwb-mode-version " ")
    (list
     'cwb-prompt-regexp
     'cwb-program-name) 
    nil 
    nil
    "Thank you for submitting a bug report. \nPlease include as much information as possible about the bug. \nFor example, it might be a good idea to insert the contents of your CWB \nbuffer here, using\nM-x insert-buffer RET *cwb* RET"

    )))

;; Command completion
;; ======================================================================
(defun cwb-complete-command (stub)
  (interactive (list (buffer-substring (point) 
				 (save-excursion (forward-word -1)
						 (comint-skip-prompt)
						 (point)))))
  (comint-dynamic-simple-complete 
   stub 
   '(
"agent"
"branchingeq"
"checkprop"
"checkpropold"
"clear"
"closure"
"cong"
"contraction"
"cwb"
"deadlocks" 
"deadlocksobs"
"derivatives"
"dfstrong"
"dftrace"
"dfweak"
"diveq"
"diverges"
"echo"
"eq"
"findinit"
"freevars"
"game"
"globalmc"
"graph"
"help"
"init"
"input"
"localmc"
"mayeq"
"maypre"
"min"
"musteq"
"mustpre"
"obs"
"output"
"pb"
"play"
"pre"
"precong"
"prefixform"
"print"
"prop"
"quit"
"random"
"relabel"
"save"
"set"
"sim"
"size"
"sort"
"stable"
"states"
"statesexp"
"statesobs"
"strongeq"
"strongpre"
"testeq"
"testpre"
"transitions"
"toggle"
"twothirdseq"
"twothirdspre"
"vs"
)))

(defun cwb-input-with-semicolon ()
"Like comint-input-send, but sends an additional semi-colon at the
end. NB doesn't interact properly with abbreviations, at the moment!"
  (interactive)
  (comint-send-input)
  (comint-simple-send (cwb-proc) ";"))

;;; Lastly, hooks:
;; =======================================================================

(defvar cwb-load-hook nil
  "*This hook is run when CWB is loaded in.
This is a good place to put keybindings.")
	
(run-hooks 'cwb-load-hook)

(provide 'cwb)