(require 'compile)
(defvar *fcsh-compile-old-compilation-start* nil
"Reference to actual compilation-start function that fcsh overrides")
(defvar *fcsh-path* "c:\\anihome\\scripts\\fcsh.bat"
"Path to run fcsh. This is usually sdks/bin/fcsh.")
(defvar *fcsh-compile-active* nil
"true if `fcsh-compile' has been called.
`fcsh-compile' calls `fcsh-restore-compile' if this is true.")
(defvar *fcsh-mxmlc-command* "mxmlc"
"The command to run first when fcsh is started.")
(defvar *fcsh-mxmlc-subsequent-command* "compile 1"
"The command to run when compile is called after the first time.")
(defvar *fcsh-mxmlc-output-path* "..\\bin-debug\\"
"Output path to the swf. This is passed as an argument to `*fcsh-mxmlc-command*'.
The swf's name is `*fcsh-mxml-file*' with mxml extension stripped off
and swf extension added.")
(defvar *fcsh-mxml-file* ""
"The name of the mxml file to pass to the first and only mxmlc command.")
(add-to-list 'compilation-error-regexp-alist 'flex)
(add-to-list 'compilation-error-regexp-alist-alist
'(flex "^\\(.*\\)(\\(.*\\)):.* \\(Error\\|Warnin\\(g\\)\\): .*$" 1 2 nil (4)))
(defun fcsh-compile ()
"Call this function from a buffer visiting the MXML file you
want to compile.
It is best to have a mxmlfilename-config.xml to
pass arguments to mxmlc.
Once this function is called, compile
will invoke fcsh and not kill it until the compilation buffer is
manually killed. Subsequent compile and recompile will use the
same fcsh instance and pass compile 1 to it.
Use `fcsh-restore-compile' to restore compile's old behaviour.
See `*fcsh-compile-active*'."
(interactive)
(setq compile-command *fcsh-path*)
(setq *fcsh-mxml-file* (buffer-name))
(if (not *fcsh-compile-active*)
(progn
(setq *fcsh-compile-active* t)
(fset '*fcsh-compile-old-compilation-start* (symbol-function 'compilation-start))
(fset 'compilation-start 'fcsh-compilation-start)
)
)
)
(defun fcsh-restore-compile ()
"See `fcsh-compile', `*fcsh-compile-active*' for more info."
(interactive)
(if *fcsh-compile-active*
(progn
(setq *fcsh-compile-active* nil)
(fset 'compilation-start '*fcsh-compile-old-compilation-start*)
)
))
(defun fcsh-compilation-filter (proc string)
"Process filter for compilation buffers.
Inserts the text, but uses `insert-before-markers'.
Also checks for (fcsh) string to see if the compilation has ended."
(if (buffer-name (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t))
(save-excursion
(goto-char (process-mark proc))
(insert-before-markers string)
(if (and (>= (length string) (length "(fcsh) "))
(string= (substring string (- (length string) (length "(fcsh) "))) "(fcsh) "))
(progn
(compilation-handle-exit (process-status proc)
(process-exit-status proc)
"finished")
(setq compilation-in-progress (delq proc compilation-in-progress))
))
(run-hooks 'compilation-filter-hook))))))
(defun fcsh-compilation-start (command &optional mode name-function highlight-regexp)
"Same as compilation-start but instead of spawning a different
process each time, keeps on passing command to the existing fcsh
shell."
(or mode (setq mode 'compilation-mode))
(let* ((name-of-mode
(if (eq mode t)
(prog1 "compilation" (require 'comint))
(replace-regexp-in-string "-mode$" "" (symbol-name mode))))
(thisdir default-directory)
outwin outbuf)
(with-current-buffer
(setq outbuf
(get-buffer-create
(compilation-buffer-name name-of-mode mode name-function)))
(let ((comp-proc (get-buffer-process (current-buffer)))) (if comp-proc (if (eq (process-status comp-proc) 'run) (setq mode t) )))
(if (not (eq mode t))
(progn
(buffer-disable-undo (current-buffer))
(setq default-directory thisdir)
)
)
(if (not (eq mode t))
(let ((inhibit-read-only t)
(default-directory thisdir))
(cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
(if (match-end 1)
(substitute-env-vars (match-string 1 command))
"~")
default-directory))
(erase-buffer)
(if (not (eq mode t))
(funcall mode)
(setq buffer-read-only nil)
(with-no-warnings (comint-mode))
(compilation-shell-minor-mode))
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(insert "-*- mode: " name-of-mode
"; default-directory: " (prin1-to-string default-directory)
" -*-\n"
(format "%s started at %s\n\n"
mode-name
(substring (current-time-string) 0 19))
command "\n")
(setq thisdir default-directory))
)
(set-buffer-modified-p nil))
(if (eq outbuf (current-buffer))
(goto-char (point-max)))
(setq outwin (display-buffer outbuf nil t))
(with-current-buffer outbuf
(let ((process-environment
(append
compilation-environment
(if (if (boundp 'system-uses-terminfo) if system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
(unless (getenv "EMACS")
(list "EMACS=t"))
(list "INSIDE_EMACS=t")
(copy-sequence process-environment)))
fcsh-initial-contents
)
(if (not (eq mode t))
(progn
(set (make-local-variable 'compilation-arguments)
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(set-window-start outwin (point-min))
(or (eq outwin (selected-window))
(set-window-point outwin (if compilation-scroll-output
(point)
(point-min))))
)
)
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
(compilation-set-window-height outwin)
(pop-to-buffer (current-buffer) t t)
(goto-char (point-min))
(next-line 2)
(setq fcsh-initial-contents (buffer-substring (point-min) (point)))
(setq buffer-read-only nil)
(erase-buffer)
(insert fcsh-initial-contents)
(insert "\n(fcsh) ")
(goto-char (point-max))
(setq buffer-read-only t)
(if (fboundp 'start-process)
(let ((proc (if (eq mode t)
(get-buffer-process (current-buffer))
(start-process-shell-command (downcase mode-name)
outbuf command))))
(setq mode-line-process '(":%s"))
(if (not (eq mode t))
(progn
(set-process-sentinel proc 'compilation-sentinel)
(set-process-filter proc 'fcsh-compilation-filter)))
(if (not (eq mode t) )
(progn
(goto-char (point-max))
(setq buffer-read-only nil)
(insert (concat "\n" (concat *fcsh-mxmlc-command* " "
*fcsh-mxml-file* " -o "
*fcsh-mxmlc-output-path*
(file-name-sans-extension *fcsh-mxml-file*)
".swf\n" )))
(setq buffer-read-only t)
(comint-send-string proc (concat *fcsh-mxmlc-command* " "
*fcsh-mxml-file* " -o "
*fcsh-mxmlc-output-path*
(file-name-sans-extension *fcsh-mxml-file*)
".swf\n" ))
)
)
(if (eq mode t)
(progn
(goto-char (point-max))
(setq buffer-read-only nil)
(insert (concat "\n" *fcsh-mxmlc-subsequent-command* "\n"))
(goto-char (point-max))
(setq buffer-read-only t)
(comint-send-string proc (concat *fcsh-mxmlc-subsequent-command* "\n"))
))
(set-marker (process-mark proc) (point) outbuf)
(when compilation-disable-input
(condition-case nil
(process-send-eof proc)
(error nil)))
(setq compilation-in-progress
(cons proc compilation-in-progress)))
))
(setq default-directory thisdir))
(if (buffer-local-value 'compilation-scroll-output outbuf)
(save-selected-window
(select-window outwin)
(goto-char (point-max))))
(other-window 1)
(setq next-error-last-buffer outbuf)))