;;; @ tex-mma.el  Minor mode for interaction with Mathematica from TeX buffer
;;; Written 2/12/1991 by Dan Dill dan@chem.bu.edu

;;; $Modified: Sun Feb  6 18:40:22 EST 1994 by dan $

(defconst tex-mma-version-string
  "TeX/Mathematica Version 1.4 <Mon, 11 Oct 1993> Copyright 1993 Dan Dill"
  "String describing this version of TeX/Mathematica.")

(defconst tex-mma-herald
  "This is TeX/Mathematica 1.4 Copyright 1993 Dan Dill.  "
  "Startup message.")


;;; @@ Copyright
;;;
;;; Copyright (C) 1991, 1993 Dan Dill (dan@chem.bu.edu)
;;; This is part of TeX/Mathematica
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


;;; @@ Change log moved to end of file


;;; @@ Environment

(require 'min-bind)
(require 'kill-fix)
(require 'math)

;; Note, it is important *not* to `(require 'tex-mode)', so that
;; TeX/Mathematica can be used with either tex-mode or with AUC-TeX.


;;(defconst emacs-version-19 (string= (substring emacs-version 0 3) "19.")
;;"t if version 19 of emacs, else nil")


;;; @@ Constants

(defvar tex-mma-mode-syntax-table nil
  "Syntax table used while in Mathematica minor mode.")

(defvar tex-mma-process-name
  "math"
  "The name of the inferior Mathematica process.
make-shell names the buffer the process name surrounded by `*'s.")

(defvar tex-mma-process-buffer
  "*math*"
  "The name of the shell buffer running Mathematica with tex-mma-mode")


(defvar tex-mma-info-file
  "/soft/gnu/info/tex-mma.info"
  "*Fully specified location of the tex-mma.info file.")

(defvar tex-mma-temp-dir
  "/tmp/"
  "*Directory for temporary files.
Specify \"\" to use the directory of the TeX/Mathematica document buffer.")

(defvar tex-mma-output-marker "."
  "*Contents of line separating input and output portion of cell.")

(defvar tex-mma-abbreviations-allowed nil
  "*If non-nil, then `...' abbreviations are allowed in cell labels and references.
Note that enabling this options will slow cell and package assembly.")

(defvar tex-mma-max-references 5
  "*Number of references in a cell below which cell references are fetched
as needed, scanning the entire document for each reference.  At or above this
number, all cells in a document for the given filename are precollated in a
single scan of the document.")


;;; @@ Help

(autoload 'Info-goto-node "info")

(defun tex-mma-info ()
  (interactive)
  (Info-goto-node (concat "(" tex-mma-info-file ")" "Top")))


;;; @@ Startup

(defvar mma-window-height nil
  "*Number of lines in a mma window.  If nil, use Emacs default.")

;; Set the height of WINDOW according to mma-window-height.
(defun mma-set-window-height (window)
  (and mma-window-height
       (= (window-width window) (frame-width (window-frame window)))
       ;; If window is alone in its frame, aside from a minibuffer,
       ;; don't change its height.
       (not (eq window (frame-root-window (window-frame window))))
       ;; This save-excursion prevents us from changing the current buffer,
       ;; which might not be the same as the selected window's buffer.
       (save-excursion
	 (let ((w (selected-window)))
	   (unwind-protect
	       (progn
		 (select-window window)
		 (enlarge-window (- mma-window-height
				    (window-height))))
	     (select-window w))))))


(defun tex-mathematica ()
  "Set up tex-mma-mode and the generic interface.
Entering tex-mma mode calls the value of tex-mma-minor-mode-hook,
and then the value of plain-tex-mma-minor-mode-hook."
  (interactive)
  (tex-mma-startup 'tex-mode))

(defun latex-mathematica ()
  "Set up latex-mma-mode and the generic interface.
Entering latex-mma mode calls the value of latex-mma-minor-mode-hook,
and then the value of plain-tex-mma-minor-mode-hook."
  (interactive)
  (tex-mma-startup 'LaTeX-mode))

(defun latex-mathematica-mode ()
  "Set up latex-mma-mode and the generic interface.
Entering latex-mma mode calls the value of latex-mma-minor-mode-hook,
and then the value of plain-tex-mma-minor-mode-hook."
  (interactive)
  (tex-mma-startup 'latex-mode))

(defun plain-tex-mathematica ()
  "Set up plain-tex-mma-mode and the generic interface.
Entering plain-tex-mma-mode mode calls the value of latex-mma-minor-mode-hook,
and then the value of plain-tex-mma-minor-mode-hook."
  (interactive)
  (tex-mma-startup 'plain-tex-mode))

(defun tex-mma-startup (mode)
  "Set up tex-mma-mode."
  (tex-mma-setup)
  (funcall mode); major mode
  (tex-mma-mode); minor mode
  ; We don't enter math-mode in TeX buffer so we must make this variable here
  (make-local-variable 'doing-math-complete-symbol)
  (setq doing-math-complete-symbol nil); Placate byte compiler
  (message (substitute-command-keys
	    (concat tex-mma-herald "Use \\[tex-mma-info] for help."))))


;;; @@ Data structures

; Not defvar, since the code depends on the values defined here.

(defconst tex-mma-cell-alist-default
  '(("mathematica" .
     (
      ("buffer-go" . tex-mma-math-buffer-go)
      ("recenter" . tex-mma-math-recenter)
      ("replace" . tex-mma-math-replace)
      ("send" . tex-mma-math-send)
      ("send-cell" . tex-mma-math-send-cell)
      ("show" . tex-mma-math-show)
      ("update" . tex-mma-math-update)
      )))
  "Alist of functions for `mathematica' cells.  Used by tex-mma-get-cell-alist to
initialize tex-mma-cell-alist so we can be sure to start fresh.")

(defvar tex-mma-cell-alist ()
  "Alist of defined cells.  The entry for each cell is the alist of command names
and corresponding functions.  This is filled in by tex-mma-get-cell-alist from
variables `type'-tex-mma-cell-alist.")

(defvar tex-mma-defined-cells ()
  "List of defined cells.
This is filled in by tex-mma-get-defined-cells.")

(defconst tex-mma-cell-default "mathematica"
  "Default cell-type for generic operations.")

(defvar tex-mma-dereference-path nil
  "List of buffers referenced in cell assembly.
Used by `tex-mma-dereference-buffer' to detect self-reference.")

(defvar tex-mma-zap-file-prefix nil
  "Global variable used as prefix to make unique buffer names for cell and package
assembly.")

(defvar tex-mma-error-point nil
  "Buffer position where error detected.")

(defvar tex-mma-buffer-alist nil
  "Alist of temporary buffers associate with cells `file:part'.
The buffers are used in package and cell assembly.")

(defvar tex-mma-source-buffer nil
  "Buffer from which tex-mma-collate-cells works.")

(defconst tex-mma-temp-suffix 0
  "Temporary filename suffix.  Incremented by 1 for each filename.")

(defun tex-mma-make-temp-name ()
  "Return a unique filename."
  (setq tex-mma-temp-suffix (+ tex-mma-temp-suffix 1))
  (concat (concat (make-temp-name "#mz") "-")
	  tex-mma-temp-suffix
	  ".m")
  )


;;; @@ Initialization

(defun tex-mma-version ()
  "Display string indentifying each component of this TeX/Mathematica."
  (interactive)
  (with-output-to-temp-buffer "*Help*" (print-help-return-message))
  (let ((home-buffer (current-buffer))
	list
	type)
    (pop-to-buffer "*Help*")
    (insert tex-mma-version-string)
    (insert "\n")
    (setq list tex-mma-defined-cells)
    (while (setq type (car list))
      (setq list (cdr list))
      (if (equal type "mathematica")
	  nil ; We have already displayed this
	(insert (eval (intern (concat type "-tex-mma-version-string")))))
      (insert "\n"))
    (pop-to-buffer home-buffer))
  (bury-buffer "*Help*"))

(defvar tex-mma-new-types ()
  "*List of cell types to be added to TeX/Mathematica.")

(defun tex-mma-setup ()
  "Run hooks for new cell types and setup TeX/Mathematica data structures."
  (tex-mma-run-hooks)
  (tex-mma-get-cell-alist)
  (tex-mma-get-defined-cells)
  )

(defun tex-mma-run-hooks ()
  "Run hooks for new cell types."
  (let ((types tex-mma-new-types)
	type)
    (while (setq type (car types))
      (setq types (cdr types))
      (funcall (intern (concat type "-tex-mma-hook"))) ; Force functions to load
      )))

(defun tex-mma-replace-assoc (alist key val)
  "Replace ALIST KEY VALUE, if KEY present, else add KEY VALUE.
Return modified alist."
  (if (assoc key alist)
      (setcdr (assoc key alist) val)
    (setcdr alist (cons (cons key val) (cdr alist))))
  alist)

(defun tex-mma-get-cell-alist ()
  "Create tex-mma-cell-alist."
  (setq tex-mma-cell-alist tex-mma-cell-alist-default)
  (if tex-mma-new-types
      (let ((types tex-mma-new-types)
	    type)
	(while (setq type (car types))
	  (setq types (cdr types))
	  (if (equal "mathematica" type)
	      (error "You can't add cell type `%s' to TeX/Mathematica" type)
            ; Add functions for a new type
	    (message "Adding cell type `%s' ..." type)
	    (sleep-for 1)
	    (tex-mma-replace-assoc
	     tex-mma-cell-alist
	     type
	     (eval (intern (concat type "-tex-mma-cell-alist")))))))))


(defun tex-mma-get-defined-cells ()
  "Fill in list of defined cells."
  (setq tex-mma-defined-cells (mapcar 'car tex-mma-cell-alist)))


;;; @@ TeX/Mathematica functions for generic cells

(defun tex-mma-dispatch (cell command)
  "Run function for CELL specified by COMMAND."
  (let ((name-function (assoc command (cdr (assoc cell tex-mma-cell-alist)))))
    (if (not name-function)
	(error "Command `%s' not defined for cell type `%s'" command cell)
      (funcall (cdr name-function)))))

(defun tex-mma-cell-type ()
  "Returns cell type if contained in tex-mma-defined-cells,
else returns nil."
  (let ((list tex-mma-defined-cells)
	type)
    (catch 'done
      (while (setq type (car list))
	(if (tex-mma-cell-p type)
	    (throw 'done t))
	(setq list (cdr list))))
    type))

(defun tex-mma-buffer-go ()
  "Go to process buffer.
Process is that of cell containing point, else prompt for process."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-buffer-go)
    (let (cell)
      (if (setq cell (tex-mma-cell-type))
	  t
	(setq cell (completing-read
		    (concat "Buffer (default " tex-mma-cell-default "): ")
	 tex-mma-cell-alist nil t nil))
	(if (string-equal cell "")
	    (setq cell tex-mma-cell-default)))
      (setq tex-mma-cell-default cell)
      (tex-mma-dispatch cell "buffer-go"))))

(defun tex-mma-send ()
  "Send statements constaining point to process.
Statements are delimited by blank lines."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-send)
    (let ((cell (completing-read
		 (concat "Buffer (default " tex-mma-cell-default "): ")
		 tex-mma-cell-alist nil t nil)))
      (if (string-equal cell "")
	  (setq cell tex-mma-cell-default))
      (setq tex-mma-cell-default cell)
      (tex-mma-dispatch cell "send"))))

(defun tex-mma-send-cell ()
  "Send input to process.
Point must be in a cell."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-send-cell)
    (let ((cell (tex-mma-cell-type)))
      (if cell
	  (tex-mma-dispatch cell "send-cell")
	(error "Not in a cell")))))

(defun tex-mma-replace ()
  "Replace output (if any) with last process result.
Point must be in process cell.
Output (if any) assumed to follow input, separated by tex-mma-output-marker line."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-replace)
    (let ((cell (tex-mma-cell-type)))
      (if cell
	  (tex-mma-dispatch cell "replace")
	(error "Not in a cell")))))

(defun tex-mma-update ()
  "Send input to process and optionally replace output with result.
Point must be in process cell.
Output (if any) assumed to follow input, separated by tex-mma-output-marker line."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-update)
    (let ((cell (tex-mma-cell-type)))
      (if cell
	  (tex-mma-dispatch cell "update")
	(error "Not in a cell")))))

(defun tex-mma-recenter ()
  "Place process buffer input prompt at top of screen.
Process is that of cell containing point, else prompt for process."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-recenter)
    (let (cell)
      (if (setq cell (tex-mma-cell-type))
	  t
	(setq cell (completing-read
                    (concat "Buffer (default " tex-mma-cell-default "): ")
		    tex-mma-cell-alist nil t nil))
	(if (string-equal cell "")
            (setq cell tex-mma-cell-default)))
      (setq tex-mma-cell-default cell)
      (tex-mma-dispatch cell "recenter"))))

(defun tex-mma-show ()
  "Make last process output visible.
Process is that of cell containing point, else prompt for process."
  (interactive)
  (if (not tex-mma-new-types)
      (tex-mma-math-show)
    (let (cell)
      (if (setq cell (tex-mma-cell-type))
	  t
        (setq cell (completing-read
                    (concat "Buffer (default " tex-mma-cell-default "): ")
		    tex-mma-cell-alist nil t nil))
        (if (string-equal cell "")
            (setq cell tex-mma-cell-default)))
      (setq tex-mma-cell-default cell)
      (tex-mma-dispatch cell "show"))))

(defun tex-mma-toggle-init ()
  "Toggle the initialization mark of cell."
  (interactive)
  (let ((type (tex-mma-cell-type)))
    (if type
	(tex-mma-toggle-init-type type)
      (error "Not in a cell"))))

(defun tex-mma-toggle-init-type (type)
  "Toggle initialization marker of TYPE cell containing point."
  (save-excursion
    (re-search-backward (concat "^\\\\begin\{" type "\}"))
    (goto-char (match-end 0))
    (if (looking-at "\\[\\* Initialization Cell \\*\\]")
	(delete-region (match-beginning 0) (match-end 0))
      (insert "[* Initialization Cell *]")
      )))

(defun tex-mma-eval-all (arg)
  "Optionally evaluate all cells.
With C-u prefix, evaluate without confirmation at each cell."
  (interactive "P")
  (if arg
      (tex-mma-eval nil nil)
    (tex-mma-eval nil t)))

(defun tex-mma-eval-init (arg)
  "Optionally evaluate all initialization cells.
With C-u prefix, evaluate without confirmation at each cell."
  (interactive "P")
  (if arg
      (tex-mma-eval "\\[\\* Initialization Cell \\*\\]" nil)
    (tex-mma-eval "\\[\\* Initialization Cell \\*\\]" t)))

(defun tex-mma-create-cell ()
  "Insert a cell."
  (interactive)
  (let (type)
    (if (not tex-mma-new-types)
	(setq type "mathematica")
      (setq type (completing-read
		  (concat "Cell type (default " tex-mma-cell-default "): ")
		  tex-mma-cell-alist nil t nil))
      (if (string-equal type "")
	  (setq type tex-mma-cell-default)))
    (setq tex-mma-cell-default type)
    (tex-mma-create-cell-type type)))

(defun tex-mma-create-cell-type (type)
  "Insert TYPE cell in buffer."
  (if (tex-mma-cell-p type)
      (error "Cell already exists")
    (if (not (bolp))
	(progn
	  (open-line 1)
	  (forward-line 1)))
    (insert (concat "\\begin{" type "}\n\n\\end{" type "}\n"))
    (beginning-of-line)
    (previous-line 2)))

(defun tex-mma-forward-cell ()
  "Move to next cell.
Return type of cell, else return nil."
  (interactive)
    (let ((cur-pos (point))
	  (list tex-mma-defined-cells)
	  (cell-pos (point-max))
	  new-pos
	  cell-type
	  type)
      (while (setq type (car list))
	(setq list (cdr list))
	(setq new-pos (tex-mma-next-cell-start type))
	(if (not (equal new-pos cur-pos))
	    (if (> new-pos cell-pos)
		nil
	      (setq cell-pos new-pos)
	      (setq cell-type type))))
      (if (equal cell-pos (point-max))
	  nil; No more cells
	(goto-char cell-pos)
	cell-type)))

(defun tex-mma-backward-cell ()
  "Move to previous cell.
Return type of cell found, else return nil."
  (interactive)
    (let ((cur-pos (point))
	  (list tex-mma-defined-cells)
	  (cell-pos (point-min))
	  new-pos
	  cell-type
	  type)
      (while (setq type (car list))
	(setq list (cdr list))
	(setq new-pos (tex-mma-previous-cell-start type))
	(if (not (equal new-pos cur-pos))
	    (if (< new-pos cell-pos)
		nil
	      (setq cell-pos new-pos)
	      (setq cell-type type))))
      (if (equal cell-pos (point-min))
	  nil ; No more cells
	(goto-char cell-pos)
	cell-type)))

(defun tex-mma-eval (kind ask)
  "Optionally evaluate all KIND cells.
If ASK is non-nil, then ask whether each KIND cell is to be evaluated,
else evaluate each KIND cell.  If KIND is nil, evaluate all cells."
  (let (type bypass display-start display-end cur-pos)
    (save-excursion
      (goto-char (point-min))
      (while (setq type (tex-mma-forward-cell))
	(forward-line -1)
	(if (not (looking-at (concat "^\\\\begin\{" type "\}" kind)))
	    (progn
	      (forward-line 1) ; Don't want the same cell next time
	      nil) ; Wrong kind of cell
	  ;; We have a cell of the right kind
	  (setq display-start (point))
	  (goto-char (tex-mma-cell-end type))
	  (forward-line 1) ; We need to include cell trailer in narrowed region
	  (end-of-line)    ; ..
	  (setq display-end (point))
	  (forward-line 0)
	  (unwind-protect
	      (progn
		(tex-mma-recenter)
		(narrow-to-region display-start display-end)
		(goto-char (point-min))
		(recenter 1) ; force display, just in case...
		(forward-line 1)
		(if (and ask (not (y-or-n-p "Evaluate this cell? ")))
		    t
		  (tex-mma-update)
		  (tex-mma-show)))
	    (widen) ; If user aborts evaluation at prompt
	    ) ; unwind-protect
	  ) ; if in a valid cell
	) ; while still types to check
      ) ; save-excursion
    (widen)
    (beep)
    (message "Evaluation of cells finished")
    ) ; let
  )

(defun tex-mma-do-completion ()
  (interactive)
  (let ((type (tex-mma-cell-type)))
    (if (and type (tex-mma-insert-complete-name type))
	t ; Cell filename or partname completion
      ; Mathematica completion
      (tex-mma-math-start-process)
      (math-complete-symbol))))

(defun tex-mma-cell-start (type)
  "Return position of start of cell of TYPE containing point."
  (let ((begin-re (concat "^\\\\begin\{" type "\}")))
  (save-excursion
    (if (not (looking-at begin-re))
	(re-search-backward begin-re))
    (forward-line 1)
    (point))))

(defun tex-mma-cell-end (type)
  "Return position of end of cell of TYPE containing point."
  (let ((end-re (concat "^\\\\end\{" type "\}")))
    (save-excursion
      (re-search-forward end-re)
      (forward-line -1)
      (end-of-line)
      (point))))

(defun tex-mma-previous-cell-start (type)
  "Get start of preceding cell of TYPE.  If none, return current position."
  (let ((cur-pos (point))
	(start nil)
	(begin-re (concat "^\\\\begin\{" type "\}"))
	(end-re (concat "^\\\\end\{" type "\}")))
    (save-excursion
      (if (not (re-search-backward end-re (point-min) t))
	  cur-pos
	(if (tex-mma-cell-p type)
	    (progn
	      (re-search-backward begin-re)
	      (forward-line 1)
	      (point))
	  cur-pos)))))


(defun tex-mma-next-cell-start (type)
  "Get start of next cell of TYPE.  If none, return current position."
  (let ((cur-pos (point))
	(start nil)
        (begin-re (concat "^\\\\begin\{" type "\}"))
        (end-re (concat "^\\\\end\{" type "\}")))
    (save-excursion
      (if (re-search-forward begin-re (point-max) t)
	  (progn
	    (if (not (tex-mma-cell-p type))
		cur-pos)
	    (forward-line 1)
	    (point))
	cur-pos))))

(defun tex-mma-cell-p (type)
  "Returns t if point is in a TeX/Mathematica cell of type, else returns nil."
  (let ((begin-re (concat "^\\\\begin\{" type "\}"))
	(end-re (concat "^\\\\end\{" type "\}"))
	found)
    (catch 'done
      (save-excursion
	(if (re-search-backward begin-re (point-min) t)
	    (setq found (point))
	  (throw 'done nil))) ; No \begin{...}
      (save-excursion
	(if (re-search-backward end-re found t)
	    (throw 'done nil))) ; Intervening \end{...}
      (save-excursion
	(if (re-search-forward end-re (point-max) t)
	    (setq found (point))
	  (throw 'done nil))) ; No \end{...}
      (save-excursion
	(if (re-search-forward begin-re found t)
	    (throw 'done nil) ; Intervening \begin{...}
	  (throw 'done t)))))) ; In a cell


(defun tex-mma-delete-output (type)
  "Delete current TYPE output (if any).  Assumes point in TYPE cell.
Output assumed to follow input, separated by a tex-mma-output-marker line.
Input *may* contain blank lines."
  (let ((out-start (tex-mma-output-p type)))
    (if out-start
	(delete-region out-start (tex-mma-cell-end type))
      t)))

(defun tex-mma-output-p (type)
  "Return start of TYPE output text if present, else return nil.  Assumes
point in TYPE cell.  Output assumed to follow input, separated by a
tex-mma-output-marker line."
  (save-excursion
    (goto-char (tex-mma-cell-start type))
    (if (re-search-forward
	 (concat "^"
		 (regexp-quote tex-mma-output-marker)
		 "\n")
	 (tex-mma-cell-end type) t)
	(progn
	  (forward-line -2)
	  (end-of-line)
	  (point))
      nil)))

(defun tex-mma-convert-output-marker (old-marker new-marker)

  "Convert output marker line, prompting for current and new output markers,
OLD-MARKER and NEW-MARKER.  Set (buffer-local) tex-mma-output-marker to
NEW-MARKER.

Note that if OLD-MARKER is the null string (blank line), this function assumes
that output follows the first blank line in a cell, that is, that the input
portion of the cell contains no blank lines.  This is always the case *except*
for cells that are to be part of a package, and so that can contain blank
lines.  If there are such cells in your document that do have blank lines in
their input portion, then after you use this function, you must hand edit the
first whitespace line in the input part of the cell, which will have been
converted to the new output marker, back to a blank line."

  (interactive "sCurrent output marker: \nsNew output marker: ")
  (let (type
	(count 0)
	(old-marker-line (concat "\n" old-marker "\n"))
	(new-marker-line (concat "\n" new-marker "\n"))
	)
    (save-excursion
      (goto-char (point-min))
      (while (setq type (tex-mma-forward-cell))
	(if (search-forward new-marker-line (tex-mma-cell-end type) t)
	    nil ; Cell is in new format
	  (if (not (search-forward old-marker-line (tex-mma-cell-end type) t))
	      nil ; Cell contains no output
	    (forward-line -1)
	    (if (not (looking-at "\n"))
		(progn
		  (kill-line 1)
		  (open-line 1)
		  ))
	    (insert new-marker)
	    (setq count (+ count 1))
	    )))
      ) ; save-excusion
    (beep)
    (if (> count 0)
	(message  "Cells converted to new output marker: %d" count)
      (message "No cells needing conversion were found")
      )
    ); let
  (setq tex-mma-output-marker new-marker)
  )


;;; @@ TeX/Mathematica functions for package assembly

(defun tex-mma-assemble (arg)
 "Assemble package (see tex-mma-assemble-package), or, with C-u prefix,
assemble references within a cell (see tex-mma-assemble-cell)."
  (interactive "P")
  (if arg
      (tex-mma-assemble-cell)
    (tex-mma-assemble-package)))

(defun tex-mma-assemble-cell (&optional delete)
  "Assemble references in cell to file with unique name.  The buffer used to
write the file is not deleted, unless optional DELETE is non-nil.
Return the filename."

  ;; Here is how this function works:

  ;; The text of the cell is written to a buffer with key `file:part'.  Then
  ;; the number of references in the cell is counted.  If the number of
  ;; references in the cell is less than tex-mma-max-references, then the cell
  ;; references are resolved by successive calls to tex-mma-dereference-buffer
  ;; which collates the text for cell references as needed, using
  ;; tex-mma-collate-cells.  If the number of references is equal to or
  ;; greater than tex-mma-max-references, then all cells in the document
  ;; correpsonding to the current cell type and filename are collated into
  ;; buffers, using tex-mma-collate-cells, and then the all cell references
  ;; are are resolved by successive calls to tex-mma-dereference-buffer.

  ;; The global `tex-mma-buffer-alist' associates buffer names with keys.
  ;; Buffer names are unique.  The names of all buffers are constructed with
  ;; `tex-mma-make-temp-name' and are unique.  All buffers except possibly the
  ;; cell-buffer are deleted on exit.

  (interactive)
  (let ((type (tex-mma-cell-type))
	(home-buffer (current-buffer))
	files parts file part
	ref-count
	cell-key cell-buffer tmp-alist tmp-buffer)
    (if (not type) (error "Not in a cell"))
    (if (not (tex-mma-reference-p type)) (error "Cell contains no references"))
    (save-excursion
      (goto-char (tex-mma-cell-start type))
      (forward-line -1)
      (if (not (looking-at (concat "^\\\\begin{" type "}.*<.*:.*>")))
	  (error "Cell is not marked"))

      (setq tex-mma-error-point (point))
      (if tex-mma-abbreviations-allowed
	  (unwind-protect ; In case filename errors
	      ;; This can take some seconds
	      (progn
		(message "Getting filenames...")
		(setq files (tex-mma-get-filenames type))
		(message "")
		)
	    (goto-char tex-mma-error-point)))

      (setq file (tex-mma-get-filename files))
      (if (not file) (error "Ambiguous filename"))

      (if tex-mma-abbreviations-allowed
	  ;; This can take several seconds for a document with many cells
	  (progn
	    (message "Getting partnames")
	    (setq parts (tex-mma-get-partnames type file files))
	    (message "")
	    ))

      (setq part (tex-mma-get-partname parts))
      (if  (not part) (error "Ambiguous partname"))

      ) ; save-excursion

    (setq cell-key (concat file ":"))
    (if (not (equal part "")) (setq cell-key (concat cell-key part)))
    (message "Assembling `%s' ..." cell-key) ; (sleep-for 1)
    (setq cell-buffer (tex-mma-make-temp-name))
    (setq tex-mma-buffer-alist (list (cons cell-key cell-buffer)))
    (unwind-protect
	(save-excursion
	  (tex-mma-append-cell-to-buffer type cell-buffer)
	  (setq tex-mma-source-buffer (current-buffer)) ; Collate from here

	  (if (< (tex-mma-reference-count cell-buffer) tex-mma-max-references)
	      ;; Build reference buffers as needed
		(while (tex-mma-dereference-buffer cell-key files parts nil type))
	    ;; Prebuild all reference buffers
	    (tex-mma-collate-cells type file part files parts nil)
	    (while (tex-mma-dereference-buffer cell-key files parts nil nil))
	    )
	  (set-buffer cell-buffer)
	  (write-file (concat tex-mma-temp-dir cell-buffer))
	  (set-buffer home-buffer)
	  )
      ;; unwind-protect forms: deleted cell buffers
      (setq tmp-alist tex-mma-buffer-alist)
      (while (setq tmp-buffer (cdr (car tmp-alist)))
	(setq tmp-alist (cdr tmp-alist))
	(condition-case nil ; In case buffer not actually created
	    (if (and (not delete) (equal tmp-buffer cell-buffer))
		nil ; Don't delete the assembly buffer
	      (kill-buffer tmp-buffer))
	  (error nil)))
      ) ; unwind-protect
    (message "`%s' assembled in file `%s%s'" cell-key tex-mma-temp-dir cell-buffer)
    (concat tex-mma-temp-dir cell-buffer)
    ) ; let
  ) ; done

(defun tex-mma-assemble-package (&optional type file overwrite)
  "Assemble text into a package buffer and write that buffer to a file.
The buffer is *not* deleted.  Return the filename.

Optional arguments (useful for batch processing):

TYPE cells;
FILE package filename;
OVERWRITE, if not nil package filename buffer will be overwritten without asking."

  ;; Here is how this function works:

  ;; The entire buffer is scanned for marked cells matching TYPE and FILE and
  ;; these are collated by `file' and `part' into buffers with keys
  ;; `file:part' and, for `part' = "" (a package cell), into a buffer with key
  ;; `FILE'.

  ;; Once the cell buffers have been created, then all cell references in the
  ;; package buffer, with key `FILE', are replaced by the contents of the
  ;; corresponding buffers with keys `file:part', by successive calls to
  ;; tex-mma-dereference-buffer.

  ;; The global `tex-mma-buffer-alist' associates buffer names with keys.
  ;; Buffer names are unique.  The names of all buffers are constructed with
  ;; `tex-mma-make-temp-name' and are unique.    All buffers
  ;; except the package buffer `FILE' are deleted on exit.

  (interactive)
  (let ((home-buffer (current-buffer))
	(this-type (tex-mma-cell-type))
	files parts prompt
	tmp-buffer tmp-alist file-buffer
	)

    (if (not type)
	;; If type has not been specified, prompt
	(if (not tex-mma-new-types)
	    (setq type "mathematica")
	  (setq type (read-from-minibuffer
		      "Package type: " (or this-type tex-mma-cell-default)))
	  (if (equal type "") (error "No type specified"))
	  (setq tex-mma-cell-default type)
	  ) ; if type not specifed in fucntion call
      ) ; if on type

    (if (not file)
	;; If file has not been specifed, prompt
	(progn
	  (if this-type
	      ;; Get default file from cell label, if any
	      (save-excursion
		(goto-char (tex-mma-cell-start type))
		(forward-line -1)
		(if (looking-at (concat "^\\\\begin{" type "}.*<.*:.*>"))
		    (progn
		      (setq tex-mma-error-point (point))
		      (unwind-protect ; In case filename errors
			  (if tex-mma-abbreviations-allowed
			      ;; This can take some seconds
			      (progn
				(message "Getting filenames...")
				(if (not (setq files (tex-mma-get-filenames type)))
				    (error "No complete package filenames found"))
				(message "")
				))
			(goto-char tex-mma-error-point))
		      (setq file (tex-mma-get-filename files))))))
	  (setq file (read-from-minibuffer "Package file: " file))
          (if (or (not file) (equal file "")) (error "No file specified"))
	  ) ; if file not specified in function call
      ) ; if on file

    (if (not overwrite)
	(if (file-exists-p file)
	    (progn
	      (setq prompt (concat
			    "Package file `"
			    file
			    "' exists. Overwrite it ? "))
	      (if (not (y-or-n-p prompt))
		  (error "Package assembly cancelled")))))

    (if (get-buffer file) (kill-buffer file))

    (if tex-mma-abbreviations-allowed
	;; This can take several seconds for a document with many cells
	(progn
	  (message "Getting partnames...")
	  (setq parts (tex-mma-get-partnames type file files))
	  (message "")
	  ))

    (message "Assembling package `%s' ..." file) ;(sleep-for 1)

    ;; Set where assembly will occur
    (setq file-buffer (tex-mma-make-temp-name))
    (setq tex-mma-buffer-alist (list (cons file file-buffer)))

    (unwind-protect ; So buffer can be deleted even if errors or abort
	(progn
	  (setq tex-mma-source-buffer (current-buffer)) ; Collate from here
	  (tex-mma-collate-cells type file nil files parts nil)
	  (or (get-buffer (cdr (assoc file tex-mma-buffer-alist)))
	      (error "No `%s' cell `%s:' found" type file))

	  ;; OK, here we go:  Recursively dereference the cell buffer:
	  (while (tex-mma-dereference-buffer file files parts))

	  (set-buffer file-buffer)
	  (write-file file)
	  (set-buffer home-buffer)
	  )
      ;; unwind-protect tail:  Delete part files
      (setq tmp-alist tex-mma-buffer-alist)
      (while (setq tmp-buffer (cdr (car tmp-alist)))
	(setq tmp-alist (cdr tmp-alist))
	(condition-case nil ; In case buffer not actually created
	    (if (equal tmp-buffer file-buffer)
		nil ; Don't delete the package buffer
	      (kill-buffer tmp-buffer))
	  (error nil)))
      ) ; unwind-protect
    (message "Package `%s' assembled" file)
;    file
    (switch-to-buffer-other-window file)
    ) ; let
  ) ; done

(defun tex-mma-reference-count (buffer)
  "Return the number of references in BUFFER."
  (let ((count 0)
	(home-buffer (current-buffer)))
    (save-excursion
	  (set-buffer buffer)
	  (goto-char (point-min))
	  (while (re-search-forward "^ *\t*<[^:].*:[^>].*>$" (point-max) t)
	    (setq count (+ count 1)))
	  (set-buffer home-buffer)
	  )
    count
    ))

(defun tex-mma-append-cell-to-buffer (type buffer)
  "Append text of TYPE cell containing point to BUFFER.
Create BUFFER if it does not exist."
  (if (not (tex-mma-cell-p type))
      (error "Not in a cell.")
    (let ((home-buffer (current-buffer))
	  (start (tex-mma-cell-start type))
	  end)
      (if (not (setq end (tex-mma-output-p type)))
	  (setq end (tex-mma-cell-end type)))
      (save-excursion
	(set-buffer (get-buffer-create buffer))
	(goto-char (point-max))
	(insert-buffer-substring home-buffer start end)
	(insert "\n")
	))))

(defun tex-mma-collate-cells (type file part files parts &optional single)

  "Assemble TYPE cells marked with filename FILE in buffers with keys
`file:part' or, for part = null string (package cells), with key `file'.  The
names of all buffers are constructed with `tex-mma-make-temp-name' and are
unique.  If PART is non-nil then do not collate cells with keys `FILE:PART'
and `FILE' (package cells).  Use FILES and PARTS for name completion \(see
`tex-mma-get-filename' and `tex-mma-get-partname'\).  If optional SINGLE is
non-nil, then collate just cells `FILE:PART' (PART must be non-nil).

The global `tex-mma-buffer-alist' associates buffer names with keys.  It must
be initialized, typically with the buffer for key `FILE' or `FILE:PART',
according to whether PART is nil or not."

  (let ((home-buffer (current-buffer))
	this-part this-file key this-type
	)
    (unwind-protect ; For error location
	(setq tex-mma-error-point (point)) ; Go here if no error
	(progn

	  ;; Scan buffer to construct buffers for all `file:part'
	  (save-excursion
	    (set-buffer tex-mma-source-buffer) ; Collate from here
	    (goto-char (point-min))
	    (while (setq this-type (tex-mma-forward-cell))
	      (if (not (equal type this-type))
		  nil

		;; We have a cell of the right type
		(forward-line -1) ; Move to \begin{...
		(if (not (looking-at (concat "^\\\\begin{" type "}.*<.*:.*>")))
		    (forward-line 1) ; So we go to next cell next time through

		  ;; We have a marked cell
		  (setq this-file (tex-mma-get-filename files))
		  (cond
		   ((not this-file)
		    (setq tex-mma-error-point (point))
		    (error "Ambiguous filename"))
		   ((not (equal file this-file))
		    (forward-line 1)) ; So we go to next cell next time through
		   (t

		    ;; We have a cell of the right package filename
		    (setq this-part (tex-mma-get-partname parts))
		    (cond
		     ((not this-part)
		      (setq tex-mma-error-point (point))
		      (error "Ambiguous partname"))
		     ((and single (not (equal this-part part)))
		      (forward-line 1)) ; Do only `file:part' for SINGLE non-nil
		     ((and part (equal this-part ""))
		      (forward-line 1)) ; Cell assembly, ignore package cell `FILE:'
		     ((and (not single) (equal this-part part))
		      (forward-line 1)) ; Cell assembly, ignore cell `FILE:PART'
		     (t

		      ;; We have a cell with a valid partname
		      (forward-line 1) ; Move into cell
		      (if (equal this-part "")
			  (setq key file)
			(setq key (concat file ":" this-part)))
		      (or
		       (assoc key tex-mma-buffer-alist) ; buffer already created
		       (tex-mma-replace-assoc
			tex-mma-buffer-alist
			key (tex-mma-make-temp-name)))

		      ;; Append cell contents to its buffer
		      (tex-mma-append-cell-to-buffer
		       type
		       (cdr (assoc key tex-mma-buffer-alist)))

		      ) ; t on valid partname
		     ) ; cond on partname
		    ) ; t on right filename (package)
		   ) ; cond on filename
		  ) ; if a marked cell
		) ; if a cell of type TYPE
	      ) ; while still cells to process
	    (set-buffer home-buffer)
	    ) ; save excursion
	  ) ; progn of unwind-protect body

      ;; unwind-protect tail:  Delete part files
      (goto-char tex-mma-error-point)
      ) ; unwind-protect
    ) ; let
  ) ; done

(defun tex-mma-dereference-buffer (key files parts &optional noinit type)
  "Resolve all references in buffer corresponding to KEY in alist
tex-mma-buffer-alist, using FILES and PARTS for name completion.  If optional
NOINIT is nil, initialize global variable `tex-mma-dereference-path' with KEY.
If NOINIT is non-nil, add KEY to `tex-mma-dereference-path'.  If optional TYPE
is nil, then references must exist in tex-mma-buffer-alist.  If TYPE is non-nil,
then references are collated in buffers and added to tex-mma-buffer-alist if
necessary.  Use `tex-mma-dereference-path' to check for self-reference and
report error if detected,"
  (let ((ref-found nil)
	(home-buffer (current-buffer))
	path-to-here
	ref-indent ref-key ref-buffer
	(key-buffer (cdr (assoc key tex-mma-buffer-alist)))
	file part
	re-found
	)
    (or key-buffer (error "No cell `%s'" key))
    (set-buffer key-buffer)
    (goto-char (point-min))
    (if noinit
	t
      (setq noinit t)
      (setq tex-mma-dereference-path (list key))
      )
    (setq path-to-here tex-mma-dereference-path)
    (while (re-search-forward "^ *\t*<[^:].*:[^>].*>$" (point-max) t)
      (setq re-found 1)
      (beginning-of-line)
      (setq ref-indent (tex-mma-get-reference-indentation))
      (setq file (tex-mma-get-filename files))
      (setq part (tex-mma-get-partname parts))
      (setq ref-key (concat file ":" part))
      (if (tex-mma-string-mem ref-key path-to-here)
	    (tex-mma-dereference-error (cons ref-key path-to-here)))
      (setq tex-mma-dereference-path (cons ref-key path-to-here))
      (if (and type (not (assoc ref-key tex-mma-buffer-alist)))
      	  ;; Construct buffer on the fly
	  (progn
	    (setq ref-buffer (tex-mma-make-temp-name))
	    (tex-mma-replace-assoc tex-mma-buffer-alist ref-key ref-buffer)
	    (tex-mma-collate-cells type file part files parts t)
	    )
	(setq ref-buffer (cdr (assoc ref-key tex-mma-buffer-alist)))
	)
      (while (tex-mma-dereference-buffer ref-key files parts noinit type))
      (kill-line 1) ; Remove reference line
      (insert-buffer ref-buffer)

;;      (let ((zmacs-regions nil))
;;	;; Lucid Emacs 19 compatibility
;;	(if ref-indent (indent-rigidly (point) (mark) ref-indent)))

      ;; Emacs 19 transient-mark-mode compatibility
      (let ((indent-start (point))
	    indent-end)
	(exchange-point-and-mark)
	(setq indent-end (point))
	(exchange-point-and-mark)
	(if ref-indent (indent-rigidly indent-start indent-end ref-indent))
	)

      )
    (setq tex-mma-dereference-path path-to-here)
    (set-buffer home-buffer)
    ref-found
    ) ; let
  ) ; done

(defun tex-mma-dereference-error (path)
  "Report package self-reference error, in PATH"
  (let ((cell (car path))
	(home-buffer (current-buffer))
	to-cell from-cell)
    (setq to-cell cell)
    (with-output-to-temp-buffer "*Help*" (message ""))
    (pop-to-buffer "*Help*")
    (insert "Self-reference detected assembling TeX/Mathematica cell\n\n")
    (insert (concat "\t\t" to-cell "\n\n"))
    (insert "Here is how the self-reference happened:\n\n")
    (setq path (reverse path))
    (setq from-cell (car path))
    (insert (concat "\t" from-cell "\n"))
    (while (setq path (cdr path))
      (setq to-cell (car path))
      (if (equal cell to-cell)
	  (insert (concat " !!! ->\t   -->\t" to-cell "\n"))
	(insert (concat "\t   -->\t" to-cell "\n")))
      (setq from-cell to-cell)
      )
    (pop-to-buffer home-buffer)
    (error "Self-reference detected")
    ))

(defun tex-mma-get-reference-indentation ()
  "Return indentation of reference on current line.
Line assumed tabified."
  (let (start end)
    (save-excursion
      (beginning-of-line)
      (setq start (point))
      (search-forward "<")
      (untabify start (point))
      (setq end (point))
      (beginning-of-line)
      (tabify (point) end)
      (- end start 1) ; -1 since search places point after `>'
      )))

(defun tex-mma-insert-complete-name (type)
  "Insert complete name in buffer, for cell of type TYPE.
Return t if successful, else nil."
  (interactive)
  (let ((here (point))
	start end name text files parts
	)
    (save-excursion
      (beginning-of-line)
      (cond
       ((and ; partname
	 (or
	  (re-search-forward (concat "^\\\\begin{" type "}<.*:[^\t]*") here t)
	  (re-search-forward (concat "^[ \t]*<.*:[^\t]*") here t))
	 (equal here (point)))

	;; This can take a second or two
	(message "Getting filenames...")
	(if (not (setq files (tex-mma-get-filenames type)))
            (error "No package filenames in document"))
	(message "")

	(search-backward "<")
        (forward-char 1)
        (setq start (point))
	(search-forward ":")
	(forward-char -1)
        (setq text (buffer-substring start (point)))
	(if (not (setq name (tex-mma-complete-name text files)))
            (error "No matching package filename found"))

	;; This can take several seconds for a document with many cells
	(message "Getting partnames")
	(setq parts (tex-mma-get-partnames type name files))
	(message "")

	(forward-char 1)
        (setq start (point)) ; New start, for partname deletion
	(setq text (buffer-substring (point) here))
	(if (not (setq name (tex-mma-complete-name
			     (concat text "...")
			     parts)))
            (error "No matching package partname found"))
        (cond
         ((equal t name) ; Text is complete
          (setq name text)
          )
         ((equal t (try-completion name parts)) ; Completion is exact
          )
         (t ; Else, get completion
          (setq name
                (completing-read
                 "Partname (<space> to see partnames): "
                 parts nil t name))
          )
         ) ; cond: what kind of partname completion was done
        (delete-region start here)
        (insert (concat name ">"))
	) ; End of partname completion
       ((and ; filename
	 (or (re-search-forward (concat "^\\\\begin{" type "}<[^ \t]*") here t)
	     (re-search-forward "^[ \t]*<[^ \t]*" here t))
	 (equal here (point)))

	;; This can take a second or two
	(message "Getting filenames...")
	(if (not (setq files (tex-mma-get-filenames type)))
	    (error "No package filenames in document"))
	(message "")

	(re-search-backward "<")
	(forward-char 1)
	(setq start (point))
	(setq text (buffer-substring start here))
	(if (not (setq name (tex-mma-complete-name
			     (concat text "...") ; completion form
			     files)))
	    (error "No matching package filename found"))
	(cond
	 ((equal t name) ; Text is complete
	  (setq name text)
	  )
	 ((equal t (try-completion name files)) ; Completion is exact
	  )
	 (t ; Else, get completion
	  (setq name
		(completing-read
		 "Filename (<space> to see filenames): "
		 files nil t name))
	  (if (equal "" name) (error "")) ; No response means no completion
	  )
	 ) ; cond: what kind of filename completion was done
	(delete-region start here)
	(insert (concat name ":"))
	) ; End of filename completion
       (t
	;;(error "Nothing to complete")
	nil ; No error; pass to Mathematica for symbol completion
	)
       ) ; cond: what kind of completion to do
      ) ; save-excursion
    (if (not name)
	nil
      (goto-char (+ (point) (length name) 1))
      t)))

(defun tex-mma-get-filenames (type)
  "Return alist of package filenames for cells of type TYPE."
  (let (cell-type file files)
    (save-excursion
      (goto-char (point-min))
      (while (setq cell-type (tex-mma-forward-cell))
	(if (not (equal type cell-type))
	    nil
	  (forward-line -1)
	  (if (not (looking-at (concat "^\\\\begin{" type "}.*<.*>")))
	      (forward-line 1) ; Cell not marked.  Get set for next one
	    (if (setq file (tex-mma-get-filename)) ; Only unabbreviated names
		(if files
		    (if (assoc file files)
			nil ; already only
		      (setq files (cons (list file) files))) ; Add to alist
		  (setq files (list (list file))))) ; Start alist
	    (forward-line 1)
	    ) ; if a marked cell
	  ) ; if cell of type TYPE
	) ; while cell to look at
      ) ; save-excursion
    files
    )) ; let and done

(defun tex-mma-complete-name (text alist &optional exact)
  "Get full name corresponding to TEXT.
If text is a string ending in `...',
then the substring preceding the `...' is used with try-completion on ALIST.
An exact match is required if optional EXACT is t.
If text is just `...' and alist is length 1, then the car of its single element
is returned.
Oherwise nil is returned."
  (let (name try-name)
    (if (not (string-match "\\(\\.\\.\\.$\\)" text))
	(setq name text) ; don't do completion on full names
      (if (and
	   (eq 0 (match-beginning 1)) ; just "..."
	   (eq 1 (length alist))) ; a single package filename
	  (setq name (car (car alist)))
	(setq try-name (substring text 0 (match-beginning 1)))
	(setq name (try-completion try-name alist)))
      (cond
       ((equal t name)
	(setq name try-name))
       ((and
	 exact
	 (not (equal t (try-completion name alist))))
	(setq name nil)))) ; Not an exact match, so error
    name))

(defun tex-mma-get-partnames (type file files)
  "Return alist of partnames for TYPE package FILE, using FILES for
filename completion."
  (let (cell-end cell-type cell-file part parts)
    (setq tex-mma-error-point (point))
    (unwind-protect
	(save-excursion
	  (goto-char (point-min))
	  (while (setq cell-type (tex-mma-forward-cell))
	    (if (not (equal type cell-type))
		nil ; Wrong type
	      (setq cell-end (tex-mma-cell-end type))
	      (forward-line -1)
	      (if (not (looking-at
                       "^\\\\begin{.+}.*<[^:].*:.*>"))
		  (forward-line 1) ; Not a marked cell
		(setq cell-file (tex-mma-get-filename files))
		(if (not (equal file cell-file))
		    (forward-line 1) ; Wrong file
		  (while (and
			  (<= (point) cell-end)
			  (or
			   (re-search-forward
			    "^\\\\begin{.+}.*<[^:].*:.*>" cell-end t)
			   (re-search-forward
			    "^ *\t*<[^:].*:.*>" cell-end t)))
		    (beginning-of-line) ; We have a filename-partname reference
		    (if (not (setq file (tex-mma-get-filename files)))
 			(progn
			  (setq tex-mma-error-point (point))
			  (error "Ambiguous filename")))
		    (if (not (equal cell-file file))
			(progn
			  (setq tex-mma-error-point (point))
			  (error "Reference must match cell filename: `%s'"
				 cell-file)))
		    (setq part (tex-mma-get-partname))
		    (if (not part)
			nil ; Need full (unabbreviated) parts only, for alist
		      (if parts ; Update alist
			  (if (or
			       (equal part "")
			       (tex-mma-string-mem part parts))
			      nil; already on list
			    (setq parts (append (list part) parts))) ; Add to alist
			(if (not (equal part ""))
			    (setq parts (list part)))) ; Create alist
		      ) ; if an unabbreviated part
		    (forward-line 1)
		    ) ; while references to process in this cell
		  ) ; if a marked cell of this FILE
		) ; if a marked cell
	      ) ; if a TYPE cell
	    ) ; while cells to process
	  ); save-excursion
      (goto-char tex-mma-error-point) ; unwind-protect form
      ) ; unwind-protect
    (setq parts (mapcar 'list parts)) ; Make list into an alist
    parts
    ) ; let
  ) ; done

(defun tex-mma-get-filename (&optional alist)
  "Get filename in package reference on current line.
If optional ALIST is supplied, use it for name completion.
Return nil if no name or error in name."
  (let ((match-re "\\(<\\)[^:]*\\(:\\)")
	(abbrev-re "\\.\\.\\.")
	beg text)
    (save-excursion
      (beginning-of-line)
      (setq beg (point))
      (end-of-line)
      (setq text (buffer-substring beg (point)))
      (string-match match-re text)
      (setq text (substring text (+ 1 (match-beginning 1)) (+ -1 (match-end 2))))
      ) ; save excursion
    (if alist
	(tex-mma-complete-name text alist t)
      (if (string-match abbrev-re text)
	  (if tex-mma-abbreviations-allowed
	      nil
	    (setq tex-mma-error-point (point))
 (error "Set tex-mma-abbreviations-allowed (M-x set-variable) to use abbreviations")
	    )
	text))))

(defun tex-mma-get-partname (&optional alist)
  "Get partname in package reference on current line.
If optional ALIST is supplied, use it for name completion.
Return nil if no name or error in name."
  (let ((match-re "\\(:\\)\\([^>]*\\)")
	(abbrev-re "\\.\\.\\.")
	beg text)
    (save-excursion
      (beginning-of-line)
      (setq beg (point))
      (end-of-line)
      (setq text (buffer-substring beg (point)))
      (string-match match-re text)
      (setq text (substring text (+ 1 (match-beginning 1)) (match-end 2)))
      ) ; save excursion
    (if alist
	(tex-mma-complete-name text alist t)
      (if (string-match abbrev-re text)
	  (if tex-mma-abbreviations-allowed
	      nil
	    (setq tex-mma-error-point (point))
 (error "Set tex-mma-abbreviations-allowed (M-x set-variable) to use abbreviations")
            )
	text))))

(defun tex-mma-string-mem (element list) ; memq doesn't work for strings
  "Returns t if string ELEMENT is in LIST of strings, else returns nil."
  (let (try)
    (catch 'done
      (while (setq try (car list))
	(setq list (cdr list))
	(if (equal element try)
	    (throw 'done t)))
      nil)))

(defun tex-mma-reference-p (type)
  "Return t if TYPE cell contains a cell reference, else retrun nil."
  (save-excursion
    (goto-char (tex-mma-cell-start type))
    (if (re-search-forward "^ *\t*<[^:].*:[^>].*>$" (tex-mma-cell-end type) t)
	t
      nil)))


;;; @@ TeX/Mathematica functions for "mathematica" cells

(defun tex-mma-math-start-process ()
  "Start up Mathematica in math mode, if necessary."
  (if (tex-mma-math-start-process-p)
      nil
    (let ((home-buffer (current-buffer)))
      (math)
      ; Wait until Mathematica startup is done
      (while (not (looking-at "^In\\[[0-9]+\\]:=\\s *$"))
	(sit-for 1)
	(goto-char (point-max))
	(beginning-of-line))
      (goto-char (point-max))
      (pop-to-buffer home-buffer)))
  (message ""))

(defun tex-mma-math-start-process-p ()
  (if (get-buffer-process tex-mma-process-buffer)
      t
    nil))

(defun tex-mma-math-buffer-go ()
  "Go to Mathematica buffer."
  (interactive)
  (tex-mma-math-start-process)
  (tex-mma-math-pop-to-buffer))

(defun tex-mma-math-send ()
  "Send Mathematica statements containing point to Mathematica subshell.
Statements are delimited by blank lines."
  (interactive)
  (tex-mma-math-start-process)
  (let ((start (tex-mma-math-start))
	(end (tex-mma-math-end))
	(home-buffer (current-buffer)))
    (tex-mma-math-pop-to-buffer)
    (goto-char (point-max))
    (insert-buffer-substring home-buffer start end)))

(defun tex-mma-math-interrupt
 ()
  "Interrupt evaluation of current Mathematica cell."
  (interactive)
  (if (not math-send-filter-active)
      (error "No Mathematica evaluation to quit")
    (tex-mma-math-start-process)
    (tex-mma-math-pop-to-buffer)
    (goto-char (point-max))
    (interrupt-process nil t)))

(defun tex-mma-math-send-cell ()
  "Send input to Mathematica, using tex-mma-math-send-cell-do.
Point must be in a cell.  Use C-g to return to TeX/Mathematica buffer
before Mathematica finishes executing the cell, or to interrupt execution
of the cell."
  (interactive)
  (condition-case nil
      ;; Protected form.
      (tex-mma-math-send-cell-do)
    ;; The handler.
    (quit
     (if (and math-send-filter-active (y-or-n-p "Interrupt Mathematica? "))
	 (tex-mma-math-interrupt)))))

(defun tex-mma-math-send-cell-do ()
  "Send input to Mathematica.  Point must be in a cell.
Input is scaned for syntax errors, using check-math-syntax."
  (if (not (tex-mma-cell-p "mathematica"))
      (error "Not in Mathematica cell"))
  (tex-mma-math-start-process)
  (let ((home-buffer (current-buffer))
	assembled-file start end)
    (if (tex-mma-reference-p "mathematica")
	(progn
	  (widen) ; So cell references will be found
	  (setq assembled-file (tex-mma-assemble-cell t)))
      (save-excursion
	(goto-char (tex-mma-cell-start "mathematica"))
	(setq start (point))
	(if (not (setq end (tex-mma-output-p "mathematica")))
	    (setq end (tex-mma-cell-end "mathematica"))))
      (set-syntax-table math-mode-syntax-table) ; Run math-mode syntax checks
      (check-math-syntax start end)             ; ..
      (set-syntax-table tex-mma-mode-syntax-table)  ; ..
      )
    (tex-mma-math-pop-to-buffer)
    (goto-char (point-max))
    (if assembled-file
	(insert (concat "<<\"" assembled-file "\""))
      (insert-buffer-substring home-buffer start end))
    (setq math-send-filter-active t)
    (unwind-protect
	(unwind-protect
	    (progn
	      (math-send-input)
	      (while math-send-filter-active
		(sit-for 0.1) ; Let Mathematica process filter work
		))
	  ;; math-send-input unwind-protect tail
	  (save-excursion
	    (if (not (memq math-send-filter-status
			   '(normal blank-line-added)))
		(error "Problem in math-send..."))))
      ;; unwind-protect tail
      (if (memq math-send-filter-status
		'(normal blank-line-added premature-output))
	  (pop-to-buffer home-buffer) ; Return to TeX buffer
	)                             ; .. else stay in Mma buffer
				      ; .. to fix error
	)))

(defun tex-mma-math-replace ()
  "Replace output (if any) with last Mathematica result. Point must be in a cell.
Output assumed to follow input, separated by a tex-mma-output-marker line."
  (interactive)
  (if (not (tex-mma-cell-p "mathematica"))
      (error "Not in Mathematica cell"))
  (tex-mma-math-start-process)
  (save-excursion
    (tex-mma-delete-output "mathematica")
    (tex-mma-math-get-output)
    ))

(defun tex-mma-math-update ()
  "Send input to Mathematica and optionally replace output with result.
Point must be in cell.  Output assumed to follow input,
separated by a tex-mma-output-marker line."
  (interactive)
  (if (not (tex-mma-cell-p "mathematica"))
      (error "Not in Mathematica cell"))
  (tex-mma-math-send-cell)
  (tex-mma-math-replace))
;;;  ; We need to wait for Mathematica's output anyhow, so we might as well ask
;;;  (if (y-or-n-p "Replace output? ")
;;;      (tex-mma-math-replace)
;;;    t))

(defun tex-mma-math-show ()
  "Make last Mathematica output visible."
  (interactive)
  (tex-mma-math-start-process)
  (let ((home-buffer (current-buffer)))

 (pop-to-buffer (process-buffer (get-process tex-mma-process-name)))
;;TCH    (tex-mma-math-pop-to-buffer)

    (goto-char (point-max))
    (recenter)
    (pop-to-buffer home-buffer)))

(defun tex-mma-math-find-error ()
  "Go to error in .m file reported in Mathematica buffer."
  (interactive)
  (tex-mma-math-buffer-go)
  (find-math-error))

(defun tex-mma-math-recenter ()
  "Place shell-mma-buffer input prompt at top of screen."
  (interactive)
  (tex-mma-math-start-process)
  (let ((home-buffer (current-buffer)))
    (tex-mma-math-pop-to-buffer)
    (goto-char (point-max))
    (recenter 0)
    (pop-to-buffer home-buffer)))

(defun tex-mma-math-pop-to-buffer ()
;;(TCH)  (pop-to-buffer (process-buffer (get-process tex-mma-process-name))))
  (let ((tex-mma-buffer (process-buffer (get-process tex-mma-process-name))))
    (setq outwin (get-buffer-window tex-mma-buffer))
    (if outwin
	(progn
	  (pop-to-buffer tex-mma-buffer)
	  (mma-set-window-height outwin))
      (set-buffer tex-mma-buffer))))


(defun tex-mma-math-get-output ()
  "Insert last output from Mathematica.
Assumes point in cell.  Output inserted at end of cell."
  (tex-mma-math-start-process)
  (let ((tex-mma-process (get-process tex-mma-process-name)))
    (let ((tex-mma-buffer (process-buffer tex-mma-process))
	  (home-buffer (current-buffer))
	  out-start out-end)

      (set-buffer tex-mma-buffer)
;;(TCH)      (pop-to-buffer tex-mma-buffer)

      (goto-char math-last-input-end) ; First line of Mathematica output
      (beginning-of-line)	 ; ..
      (forward-line 1)		 ; ..
      (setq out-start (point))	 ; ..
      (goto-char (point-max))	 ; Last line
      (beginning-of-line)	 ; .. exclude next In[..]:= prompt
      (setq out-end (point))
      (goto-char (point-max))	 ; Leave point at next In[..]:= prompt
      (pop-to-buffer home-buffer)
      (if (= out-start out-end)
	  nil ; no output
	;; Insert output before \end{mathematica}
	(goto-char (tex-mma-cell-end "mathematica"))
	(forward-line 1)		 ; Insert marker before output
	(open-line 2)		 ; ..
	(insert tex-mma-output-marker)
	(forward-line 1)		 ; ..
	(insert-buffer-substring tex-mma-buffer out-start out-end)
	(beginning-of-line)	 ; Delete blank lines at end of output
	(previous-line 1)	 ; ..
	(kill-line 2)		 ; ..
	)
      )))

(defun tex-mma-math-start ()
  "Return position of start of text containing point.
Statement is delimited by blank lines (or start/end of buffer)."
  (save-excursion
    (beginning-of-line)
    (while (and
	    (not (looking-at "\n"))
	    (not (equal (point-min) (point))))
      (forward-line -1))
    (if (looking-at "\n")
	(forward-line 1)
      t)
    (point)))

(defun tex-mma-math-end ()
  "Return position of end of text containing point.
Statement is delimited by blank lines (or start/end of buffer)."
  (save-excursion
    (beginning-of-line)
    (while (and
	    (not (looking-at "\n"))
	    (not (equal (point-max) (point))))
      (forward-line 1))
    (if (looking-at "\n")
	(forward-line -1)
      (progn
	(forward-char -1)
	(if (looking-at "\n")
	    t
	  (forward-char 1))))
    (end-of-line)
    (point)))

;;; tjc graphics extension :-)

(defun tex-mma-tjc-do (s)
  (interactive "sDo what: ")
  (save-window-excursion
  (save-excursion
    (tex-mma-math-pop-to-buffer)
    (goto-char (point-max))
    (insert s)
    (setq math-send-filter-active t)
    (unwind-protect
	(unwind-protect
	    (progn
	      (math-send-input)
	      (while math-send-filter-active
		(sit-for 0.1) ; Let Mathematica process filter work
		))
	  ;; math-send-input unwind-protect tail
	  (save-excursion
	    (if (not (memq math-send-filter-status
			   '(normal blank-line-added)))
		(error "Problem in math-send..."))))
      ;; unwind-protect tail
      (if (memq math-send-filter-status
		'(normal blank-line-added premature-output))
	t ; Return to TeX buffer
      )                             ; .. else stay in Mma buffer
					; .. to fix error
    ))))


(defun tex-mma-tjc-insert-graphics ()
  (interactive)
  (tex-mma-tjc-do "Display[\"/tmp/t.gif\", %, \"GIF\", ImageSize->{300,200}]")
  (let ((s (with-temp-buffer
	     (insert-file-contents-literally "/tmp/t.gif")
	     (buffer-string))))
    (if s
	(let ((image (make-image-instance
		      (vector 'gif :data s) nil nil 'no-error)))
	  (if image
	      (let ((glyph (make-glyph image))
		    (end))
		(set-extent-begin-glyph (make-extent (point) (point)) glyph)
		))))))



;;; @@ The mode

(defconst tex-mma-keymap nil "Keymap for tex-mathematica mode")

(defun tex-mma-make-keymap ()
  "Define keymap for Mathematica minor mode"
  (if tex-mma-keymap ; create TeX/Mathematica keymap, if necessary
      ()
    (setq tex-mma-keymap (make-sparse-keymap))
    (define-key tex-mma-keymap "\C-c\C-[" 'tex-mma-backward-cell)
    (define-key tex-mma-keymap "\C-c\C-]" 'tex-mma-forward-cell)
    (define-key tex-mma-keymap "\C-c\r" 'tex-mma-send)
    (define-key tex-mma-keymap "\C-ca" 'tex-mma-eval-all)
    (define-key tex-mma-keymap "\C-cc" 'tex-mma-create-cell)
    (define-key tex-mma-keymap "\C-ch" 'tex-mma-info)
    (define-key tex-mma-keymap "\C-ci" 'tex-mma-eval-init)
    (define-key tex-mma-keymap "\C-cl" 'tex-mma-recenter)
    (define-key tex-mma-keymap "\C-cm" 'tex-mma-assemble)
    (define-key tex-mma-keymap "\C-cr" 'tex-mma-replace)
    (define-key tex-mma-keymap "\C-cs" 'tex-mma-show)
    (define-key tex-mma-keymap "\C-cu" 'tex-mma-update)
    (define-key tex-mma-keymap "\C-cv" 'tex-mma-version)

;;;TCH
;;;    (define-key tex-mma-keymap "\C-hE" 'math-extra-help)
;;;    (define-key tex-mma-keymap "\C-he" 'math-help)
    (define-key help-map "E" 'math-extra-help)
    (define-key help-map "e" 'math-help)

    (define-key tex-mma-keymap "\C-c\C-c" 'tex-mma-math-interrupt)
    (define-key tex-mma-keymap "\C-c\C-e" 'tex-mma-math-find-error)
    (define-key tex-mma-keymap "\C-c\t" 'tex-mma-toggle-init)
;;    (define-key tex-mma-keymap "\C-u\C-c\C-c" 'tex-mma-math-interrupt)
;;    (define-key tex-mma-keymap "\C-u\C-c\C-e" 'tex-mma-math-find-error)
;;    (define-key tex-mma-keymap "\C-u\C-c\t" 'tex-mma-toggle-init)
    (define-key tex-mma-keymap "\e\r" 'tex-mma-send-cell)
    (define-key tex-mma-keymap "\e\t" 'tex-mma-do-completion)
    (define-key tex-mma-keymap "\eo" 'tex-mma-buffer-go)
;;; tjc
    (define-key tex-mma-keymap "\C-cg" 'tex-mma-tjc-insert-graphics)

    ))

(minor-mode-define
 tex-mma-mode; minor mode variable
 "Math"; name used in mode line
 (); No cleanup (except minor-unbind) needed at exit
 "Toggle Mathematica minor mode,
for editing TeX/LaTeX files of input for Mathematica

Special commands:
\\{tex-mma-keymap}"

 (make-local-variable 'tex-mma-output-marker)
 (make-local-variable 'tex-mma-abbreviations-allowed)
 (tex-mma-make-keymap)

 ;; Emacs 19 tex-mode.el uses tex-mode-syntax table.
 ;; Emacs 18 tex-mode.el and AUC-TeX both use TeX-mode-syntax-table.
 ;; So make a copy of whichever table here.
 (setq tex-mma-mode-syntax-table (copy-syntax-table))
 ;; Run hooks before setting keymap, so additions can be made
 (run-hooks 'tex-mma-minor-mode-hook 'plain-tex-minor-mma-mode-hook)
 (minor-add-to-keymap 'tex-mma-mode tex-mma-keymap)
 )



;;;


;;;(minor-non-local 'tex-mma-mode)

;;; @@ Change log

;;; 2/17/1991
;;;   Version 1 -> 1.1:  Replace shell-mma-mode with David Jacobson's math-mode

;;; 2/20/1991
;;;   Fix syntax table misassignment in tex-mma-send-cell, caught by
;;;   Weiqi Gao gao@ucrmath.ucr.edu

;;; 2/21/1991
;;;   Change (defconst ...) to (defvar ...) so user (setq ...) preserved,
;;;   Dave Gillespie daveg@csvax.cs.caltech.edu

;;; 2/28/1991 Version 1.1 -> 1.2:
;;;   TeX-Mathematica-help -> Texinfo tex-mma.info
;;;   mma -> mathematica for user-visible functions
;;;   Fix logic in tex-mma-eval-init so bogus cells bypassed

;;; 3/5/1991
;;;   Add latex-mathematica and plain-tex-mathematica

;;; 3/6/1991
;;;   Add tex-mma-eval-all-ask/noask (C-c a/C-u C-c a)

;;; 4/9/1991 Version 1.2 -> 1.3
;;;   Don't start Mathematica until needed.
;;;   Bind tex-mma-recenter to C-c l.
;;;   Adapt/add code for generic TeX/Mathematica interface.
;;;   Add tex-mma-assemble-package (C-c m) to assemble packages from cells;
;;;     related changes.
;;;   Renamed many functions; general cleanup

;;; 4/26/1991
;;;   Rework package interface
;;;   Rename tex-mma-assemble-cell to tex-mma-create-cell (C-c c)
;;;   Add tex-mma-assemble-cell (C-u C-c m) to assemble a cell
;;;   tex-mma-eval-all/init bypass cells containing cell references

;;; 5/8/1991
;;;   Change tex-mma-math-send-cell to use double unwind-protect, to work
;;;   with revised math.el.
;;;   Make tex-mma-new-types user setable.
;;;   Fix (let...) bug in tex-mma-dispatch

;;; 6/24/1991 Version 1.3 -> 1.31

;;;   Modify tex-mma-append-cell-to-buffer to not copy output portion of cell,
;;;   so that package components can be tested as they are developed.  This in
;;;   turn requires either that the input portion of package cells contain no
;;;   blank lines or that the output marker be changed from a blank line to a
;;;   non-blank line (tex-mma-output-marker).  Because blank lines are useful
;;;   for vertical formatting of cell references, you may want to change the
;;;   output marker to a non-blank line if you use the package feature.
;;;   Because this change *INTRODUCES AN INCOMPATIBILITY*, it is made optional
;;;   but enabled by default, by making tex-mma-output-marker buffer local but
;;;   with the global default ".".  The new function
;;;   tex-mma-convert-output-marker is provided to convert from one output
;;;   marker to another.  See the Texinfo document for further details.

;;;   Rewrite tex-mma-assemble-package-type to use unique buffer names.

;;;   Correct error that collated all cells in cell assembly instead of just
;;;   assembling the cell containing point.

;;;   Rewrite tex-mma-assemble-cell to assemble cell references on the fly,
;;;   for efficiency.

;;;   Write assembled cell buffer to file in directory tex-mma-temp-dir.

;;;   Do *not* delete cell buffer (C-u C-c m).

;;;   Automatically assemble a cell containing references on ESC RET
;;;   (tex-mma-math-send-cell), write the assembled cell to a file and then
;;;   transmit to Mathematica using <<"file".  Delete the assembly buffer (C-u
;;;   C-c m does *not* delete the assembly buffer).  Change tex-mma-eval to
;;;   *not* bypass cells containing cell references (see 4/26/1991).

;;;   Stay in TeX/LaTeX buffer on package or cell assembly, and leave the
;;;   assembled buffers in text mode.

;;;   Control abbreviation processing with buffer-local
;;;   tex-mma-abbreviations-allowed, disabled (nil) by default.

;;;   Control cell-assembly logic with tex-mma-max-references.

;;;   Eliminate name completion (too slow) in package assembly.  Take defaults
;;;   from current cell, if any.

;;; 7/2/1991
;;;   Remove tex-mma-process-string (dregs from when tex-mma.el made a shell)
;;;   Found by Keiji Kanazawa <kgk@cs.brown.edu>

;;; 7/31/1991
;;;   Replace error with nil in tex-mma-complete-name, so Mathematica
;;;   symbol completion will get called if no package name completion

;;;   Clear "Getting filenames..." and "Getting partnames..." when done.

;;; 12/16/1991
;;;   Correct error in use of tex-mma-output-marker in tex-mma-output-p:
;;;   Protect with (regexp-quote tex-mma-output-marker).

;;; 6/23/1993 Version 1.31 -> 1.4
;;;   Move change log to end of file

;;;   Adopt standard GNU copyright

;;;   Remove query "Replace output?" from tex-mma-math-update, since
;;;   synchronization now handled by math-send-filter-active.  A
;;;   consequence is that execution of initialization cells proceeds
;;;   without user intervention.

;;;   Make a minor mode, using min-bind.el functions.
;;;   This means that TeX/Mathematica works with Emacs 18, Emacs 19,
;;;   and Lucid Emacs 19, and with either GNU tex-mode.el or AUC-TeX.
;;;   Thanks to
;;;     Christian Lynbech (lynbech@daimi.aau.dk) for the original nudge,
;;;     Per Abrahamsen (abraham@research.att.com) for suggesting the
;;;       minor-mode approach, and
;;;     Inge Frick (inge@nada.kth.se) for providing min-bind.el.

;;;   To avoid conflict with tex-mode and AUC-TeX bindings, rebind
;;;       C-c TAB to C-u C-c TAB     tex-mma-toggle-init
;;;       C-c C-e to C-u C-c C-e     tex-mma-math-find-error

;;;   Fixed use of (mark) in tex-mma-dereference-buffer for
;;;   Lucid Emacs 19 compatibility (Christian Lynbech, lynbech@daimi.aau.dk)

;;;   Add tex-mma-math-interrupt to interrupt current evaluation of current
;;;   cell.  Bind to C-u C-c C-c, to avoid conflict with AUC-TeX bindings.

;;;   Modify tex-mma-math-send-cell to optionally interrupt Mathematica
;;;   when C-g (keyboard-quit) is executed (yeah!)

;;;   TeX-mma-mode-map changed to tex-mma-keymap.  Now contains just the
;;;   tex-mma-specific bindings.  These bindings can be augmented or changed
;;;   using startup hooks.

;;;   Startup hooks changed from
;;;
;;;       text-mode-hook, TeX-mma-mode-hook, plain-TeX-mode-hook
;;;
;;;   to
;;;
;;;       tex-mma-minor-mode-hook, plain-tex-mma-minor-mode-hook
;;;
;;;   The hooks <type>-tex-mma-hook, used to setup new cell types,
;;;   are left unchnaged.

;;; 9/27/1993
;;;   Move tex-mma-keymap setup code into tex-mma-mode, via
;;;   tex-mma-make-keymap

;;; 10/6/1993
;;;   tex-mma-dereference-buffer:  Fix mark problem with Emacs 19
;;;   transient-mark-mode.  This replaces the Lucid Emacs 19 fix above.

;;;   tex-mma-assemble-package:  Make package visible in other window.

;;; 10/8/1993
;;;   Fix conflict with C-u as universal argument.
;;;       tex-mma-eval-all replaces tex-mma-eval-all-ask/noask
;;;       tex-mma-eval-init replaces tex-mma-eval-init-ask/noask
;;;       tex-mma-assemble dispatches to tex-mma-assemble-package
;;;         and tex-mma-assemble-cell

;;; 10/11/1993
;;;   Restore original bindings, so we don't force AUC-TeX conventions,
;;;   and until we come up with a better alternative.  In particular, C-u
;;;   prefix is *not* a good idea (see above)
;;;       tex-mma-math-interrupt: C-u C-c C-c --> C-c C-c
;;;       tex-mma-math-find-error: C-u C-c e --> C-c e
;;;       tex-mma-toggle-init: C-u C-c TAB --> C-c TAB

;;; @@ Emacs

;;; Local Variables:
;;; mode: emacs-lisp
;;; mode: outline-minor
;;; outline-regexp: ";;; @+\\|(......"
;;; End:

;;; tex-mma.el ends here