@@ -251,34 +251,65 @@ COMMAND, ARG and IGNORED correspond to the standard company backend API."
251251 (psc-ide-send-sync psc-ide-command-quit))
252252
253253(defun psc-ide--server-start-globs ()
254- " Detects bower and psc-package projects and determines sensible source globs."
254+ " Detects bower, psc-package and spago projects and determines sensible source globs."
255255
256- (when (and (file-exists-p " psc-package.json" ) (file-exists-p " bower.json" ))
257- (message " Detected both a \" psc-package.json\" and a \" bower.json\" file. " ))
256+ (let* ((project-globs [" psc-package.json" " bower.json" " spago.dhall" ])
257+ (found-package-files (seq-filter 'file-exists-p project-globs)))
258+ (when (> (length found-package-files) 1 )
259+ (message
260+ (concat " Detected multiple project files: "
261+ (mapconcat 'identity found-package-files " , " )))))
258262
259263 (let ((server-globs psc-ide-source-globs))
260- (if (file-exists-p " psc-package.json" )
261- (let ((results " *PSC-PACKAGE SOURCES*" )
262- (err-file (make-temp-file " psc-package-errs" )))
263- (unwind-protect
264- (if (zerop (call-process " psc-package" nil (list results err-file) nil " sources" ))
265- (progn
266- (with-current-buffer (get-buffer results)
267- (let ((globs (split-string (buffer-string ) " [\r\n ]+" t )))
268- (setq server-globs (append server-globs globs))
269- (delete-windows-on results)
270- (kill-buffer results)))
271- (message " Set source globs from psc-package. Starting server... " ))
272- (with-current-buffer (get-buffer-create " *PSC-PACKAGE ERRORS*" )
273- (let ((inhibit-read-only t ))
274- (insert-file-contents err-file nil nil nil t ))
275- (special-mode )
276- (display-buffer (current-buffer ))
277- (error " Error executing psc-package " )))
278- (delete-file err-file)))
279- (if (file-exists-p " bower.json" )
280- (setq server-globs (append server-globs '(" bower_components/purescript-*/src/**/*.purs" )))
281- (message " Couldn't find psc-package.json nor bower.json files, using just the user specified globs. " )))
264+ (cond ((file-exists-p " psc-package.json" ) (add-psc-package-globs))
265+ ((file-exists-p " bower.json" ) (add-bower-globs))
266+ ((file-exists-p " spago.dhall" ) (add-spago-globs))
267+ (t (message " Couldn't find psc-package.json, bower.json nor spago.dhall files, using just the user specified globs. " )))))
268+
269+ (defun add-psc-package-globs ()
270+ (add-globs
271+ " *PSC-PACKAGE SOURCES*"
272+ " *PSC-PACKAGE ERRORS*"
273+ " psc-package-errs"
274+ '((" cmd" . " psc-package" )
275+ (" args" . (" sources" )))))
276+
277+ (defun add-spago-globs ()
278+ (add-globs
279+ " *SPAGO SOURCES*"
280+ " *SPAGO ERRORS*"
281+ " spago-errs"
282+ '((" cmd" . " spago" )
283+ (" args" . (" sources" )))))
284+
285+ (defun add-bower-globs ()
286+ (append psc-ide-source-globs '(" bower_components/purescript-*/src/**/*.purs" )))
287+
288+ (defun add-globs (results errors err-file cmd-alist )
289+ " Takes
290+ - a result buffer name
291+ - an error buffer name
292+ - an error file name
293+ - a command name and its arguments as an alist, e.g. ((\" cmd\" . \" psc-package\" ) (\" args\" . (\" sources\" )))"
294+ (let ((server-globs psc-ide-source-globs)
295+ (cmd (cdr (assoc " cmd" cmd-alist)))
296+ (cmd-args (cdr (assoc " args" cmd-alist))))
297+ (unwind-protect
298+ (if (zerop (apply 'call-process cmd nil (list results err-file) nil cmd-args))
299+ (progn
300+ (with-current-buffer (get-buffer results)
301+ (let ((globs (split-string (buffer-string ) " [\r\n ]+" t )))
302+ (setq server-globs (append server-globs globs))
303+ (delete-windows-on results)
304+ (kill-buffer results)))
305+ (message (format " Set source globs from %s . Starting server... " cmd)))
306+ (with-current-buffer (get-buffer-create errors)
307+ (let ((inhibit-read-only t ))
308+ (insert-file-contents err-file nil nil nil t ))
309+ (special-mode )
310+ (display-buffer (current-buffer ))
311+ (error (format " Error executing %s " cmd))))
312+ (delete-file err-file))
282313 server-globs))
283314
284315(defun psc-ide-load-module (module-name )
0 commit comments