Move sml-compile to prog-proc.

2 files changed, 95 insertions, 85 deletions

diff --git a/prog-proc.el b/prog-proc.el
index 0a643bca77b..a2b4fa9c0e3 100644
--- a/prog-proc.el
+++ b/prog-proc.el
@@ -63,20 +63,19 @@
   (name :read-only t)
   (run :read-only t)
   (load-cmd :read-only t)
-  (chdir-cmd :read-only t))
+  (chdir-cmd :read-only t)
+  (compile-commands-alist :read-only t))
 
 (defvar prog-proc-functions nil
   "Struct containing the various functions to create a new process, ...")
 
-(defmacro prog-proc--call (method &rest args)
-  `(prog-proc--funcall
-    #',(intern (format "prog-proc-functions-%s" method))
-    ,@args))
-(defun prog-proc--funcall (selector &rest args)
-  (if (not prog-proc-functions)
+(defmacro prog-proc--prop (prop)
+  `(,(intern (format "prog-proc-functions-%s" prop))
+    (or prog-proc-functions
       ;; FIXME: Look for available ones and pick one.
-      (error "Not an `prog-proc' buffer")
-    (apply (funcall selector prog-proc-functions) args)))
+        (error "Not an `prog-proc' buffer"))))
+(defmacro prog-proc--call (method &rest args)
+  `(funcall (prog-proc--prop ,method) ,@args))
 
 ;; The inferior process and his buffer are basically interchangeable.
 ;; Currently the code takes prog-proc--buffer as the main reference,
@@ -196,5 +195,79 @@ AND-GO if non-nil indicate to additionally switch to the process's buffer."
   (add-hook 'comint-input-filter-functions
             #'prog-proc-comint-input-filter-function nil t))
 
+(defvar prog-proc-compile-command nil
+  "The command used by default by `prog-proc-compile'.
+See also `prog-proc-compile-commands-alist'.")
+
+(defvar prog-proc-compile-commands-alist nil
+  "Commands used by default by `prog-proc-compile'.
+Each command is associated with its \"main\" file.
+It is perfectly OK to associate several files with a command or several
+commands with the same file.")
+
+(defun prog-proc-compile (command &optional and-go)
+  "Pass COMMAND to the read-eval-loop process to compile the current file.
+
+You can then use the command \\[next-error] to find the next error message
+and move to the source code that caused it.
+
+Interactively, prompts for the command if `compilation-read-command' is
+non-nil.  With prefix arg, always prompts.
+
+Prefix arg AND-GO also means to switch to the read-eval-loop buffer afterwards."
+  (interactive
+   (let* ((dir default-directory)
+	  (cmd "cd \"."))
+     ;; Look for files to determine the default command.
+     (while (and (stringp dir)
+                 (progn
+                   (dolist (cf (prog-proc--prop compile-commands-alist))
+                     (when (file-exists-p (expand-file-name (cdr cf) dir))
+                       (setq cmd (concat cmd "\"; " (car cf)))
+                       (return nil)))
+                   (not cmd)))
+       (let ((newdir (file-name-directory (directory-file-name dir))))
+	 (setq dir (unless (equal newdir dir) newdir))
+	 (setq cmd (concat cmd "/.."))))
+     (setq cmd
+	   (cond
+	    ((local-variable-p 'prog-proc-compile-command)
+             prog-proc-compile-command)
+	    ((string-match "^\\s-*cd\\s-+\"\\.\"\\s-*;\\s-*" cmd)
+	     (substring cmd (match-end 0)))
+	    ((string-match "^\\s-*cd\\s-+\"\\(\\./\\)" cmd)
+	     (replace-match "" t t cmd 1))
+	    ((string-match ";" cmd) cmd)
+	    (t prog-proc-compile-command)))
+     ;; code taken from compile.el
+     (list (if (or compilation-read-command current-prefix-arg)
+               (read-from-minibuffer "Compile command: "
+				     cmd nil nil '(compile-history . 1))
+             cmd))))
+     ;; ;; now look for command's file to determine the directory
+     ;; (setq dir default-directory)
+     ;; (while (and (stringp dir)
+     ;; 	    (dolist (cf (prog-proc--prop compile-commands-alist) t)
+     ;; 	      (when (and (equal cmd (car cf))
+     ;; 			 (file-exists-p (expand-file-name (cdr cf) dir)))
+     ;; 		(return nil))))
+     ;;   (let ((newdir (file-name-directory (directory-file-name dir))))
+     ;;     (setq dir (unless (equal newdir dir) newdir))))
+     ;; (setq dir (or dir default-directory))
+     ;; (list cmd dir)))
+  (set (make-local-variable 'prog-proc-compile-command) command)
+  (save-some-buffers (not compilation-ask-about-save) nil)
+  (let ((dir default-directory))
+    (when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
+      (setq dir (match-string 1 command))
+      (setq command (replace-match "" t t command)))
+    (setq dir (expand-file-name dir))
+    (let ((proc (prog-proc-proc)))
+      (with-current-buffer (process-buffer proc)
+        (setq default-directory dir)
+        (prog-proc-send-string
+         proc (concat (prog-proc--call chdir-cmd dir) "\n" command))
+        (when and-go (pop-to-buffer (process-buffer proc)))))))
+
 (provide 'prog-proc)
 ;;; prog-proc.el ends here
diff --git a/sml-mode.el b/sml-mode.el
index 83cba3ddbe0..10cb5e37178 100644
--- a/sml-mode.el
+++ b/sml-mode.el
@@ -683,6 +683,16 @@ Assumes point is right before the | symbol."
   "Regexp used to recognise prompts in the inferior ML process."
   :type 'regexp)
 
+(defcustom sml-compile-commands-alist
+  '(("CMB.make();" . "all-files.cm")
+    ("CMB.make();" . "pathconfig")
+    ("CM.make();" . "sources.cm")
+    ("use \"load-all\";" . "load-all"))
+  "Commands used by default by `sml-prog-proc-compile'.
+Each command is associated with its \"main\" file.
+It is perfectly OK to associate several files with a command or several
+commands with the same file.")
+
 ;; FIXME: Try to auto-detect the process and set those vars accordingly.
 
 (defvar sml-use-command "use \"%s\""
@@ -722,7 +732,9 @@ See `compilation-error-regexp-alist' for a description of the format.")
                   :chdir-cmd (lambda (dir)
                                ;; `sml-cd-command' was defined a long time
                                ;; ago not to include a final semi-colon.
-                               (concat (format sml-cd-command dir) ";"))))
+                               (concat (format sml-cd-command dir) ";"))
+                  :compile-commands-alist sml-compile-commands-alist
+                  ))
 
 ;; font-lock support
 (defconst inferior-sml-font-lock-keywords
@@ -926,81 +938,6 @@ TAB file name completion, as in shell-mode, etc.."
 
   (setq mode-line-process '(": %s")))
 
-(defcustom sml-compile-command "CM.make()"
-  "The command used by default by `sml-compile'.
-See also `sml-compile-commands-alist'.")
-
-(defcustom sml-compile-commands-alist
-  '(("CMB.make()" . "all-files.cm")
-    ("CMB.make()" . "pathconfig")
-    ("CM.make()" . "sources.cm")
-    ("use \"load-all\"" . "load-all"))
-  "Commands used by default by `sml-compile'.
-Each command is associated with its \"main\" file.
-It is perfectly OK to associate several files with a command or several
-commands with the same file.")
-
-(defun sml-compile (command &optional and-go)
-  "Pass a COMMAND to the SML process to compile the current program.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil.  With prefix arg, always prompts.
-
-Prefix arg AND-GO also means to `switch-to-sml' afterwards."
-  (interactive
-   (let* ((dir default-directory)
-	  (cmd "cd \"."))
-     ;; Look for files to determine the default command.
-     (while (and (stringp dir)
-                 (progn
-                   (dolist (cf sml-compile-commands-alist)
-                     (when (file-exists-p (expand-file-name (cdr cf) dir))
-                       (setq cmd (concat cmd "\"; " (car cf)))
-                       (return nil)))
-                   (not cmd)))
-       (let ((newdir (file-name-directory (directory-file-name dir))))
-	 (setq dir (unless (equal newdir dir) newdir))
-	 (setq cmd (concat cmd "/.."))))
-     (setq cmd
-	   (cond
-	    ((local-variable-p 'sml-compile-command) sml-compile-command)
-	    ((string-match "^\\s-*cd\\s-+\"\\.\"\\s-*;\\s-*" cmd)
-	     (substring cmd (match-end 0)))
-	    ((string-match "^\\s-*cd\\s-+\"\\(\\./\\)" cmd)
-	     (replace-match "" t t cmd 1))
-	    ((string-match ";" cmd) cmd)
-	    (t sml-compile-command)))
-     ;; code taken from compile.el
-     (if (or compilation-read-command current-prefix-arg)
-	 (list (read-from-minibuffer "Compile command: "
-				     cmd nil nil '(compile-history . 1)))
-       (list cmd))))
-     ;; ;; now look for command's file to determine the directory
-     ;; (setq dir default-directory)
-     ;; (while (and (stringp dir)
-     ;; 	    (dolist (cf sml-compile-commands-alist t)
-     ;; 	      (when (and (equal cmd (car cf))
-     ;; 			 (file-exists-p (expand-file-name (cdr cf) dir)))
-     ;; 		(return nil))))
-     ;;   (let ((newdir (file-name-directory (directory-file-name dir))))
-     ;;     (setq dir (unless (equal newdir dir) newdir))))
-     ;; (setq dir (or dir default-directory))
-     ;; (list cmd dir)))
-  (set (make-local-variable 'sml-compile-command) command)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (let ((dir default-directory))
-    (when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
-      (setq dir (match-string 1 command))
-      (setq command (replace-match "" t t command)))
-    (setq dir (expand-file-name dir))
-    (with-current-buffer (sml-proc-buffer)
-      (setq default-directory dir)
-      (sml-send-string (concat (format sml-cd-command dir) "; " command)
-                       t and-go))))
-
 ;;; MORE CODE FOR SML-MODE
 
 ;;;###autoload