Permalink
Browse files

Handling compile messages from Cabal build with collapsible messages.

  • Loading branch information...
1 parent f7369dc commit 957a6ae2f50f24081f9bcf08f4283590095f6fe5 @chrisdone chrisdone committed Mar 25, 2012
Showing with 129 additions and 28 deletions.
  1. +70 −1 haskell-interactive-mode.el
  2. +56 −24 haskell-process.el
  3. +3 −3 haskell-site-file.el
@@ -58,6 +58,16 @@
"Face for the prompt."
:group 'haskell)
+(defface haskell-interactive-face-compile-error
+ '((t :inherit 'compilation-error))
+ "Face for compile errors."
+ :group 'haskell)
+
+(defface haskell-interactive-face-compile-warning
+ '((t :inherit 'compilation-warning))
+ "Face for compiler warnings."
+ :group 'haskell)
+
(defface haskell-interactive-face-result
'((t :inherit 'font-lock-string-face))
"Face for the result."
@@ -74,6 +84,7 @@
'(lambda () (interactive) (haskell-interactive-mode-history-toggle 1)))
(define-key map (kbd "M-n")
'(lambda () (interactive) (haskell-interactive-mode-history-toggle -1)))
+ (define-key map [tab] 'haskell-interactive-mode-tab)
map)
"Interactive Haskell mode map.")
@@ -121,7 +132,7 @@
nil
(lambda (state response)
(when (not (string= "" response))
- (haskell-interactive-mode-eval-result (car state) response))
+ (haskell-interactive-mode-eval-result (car state) response))
(haskell-interactive-mode-prompt (car state))))))))
(defun haskell-interactive-mode-beginning ()
@@ -183,6 +194,41 @@
'read-only t
'rear-nonsticky t)))))
+(defun haskell-interactive-mode-compile-error (session message)
+ "Echo an error."
+ (haskell-interactive-mode-compile-message
+ session message 'haskell-interactive-face-compile-error))
+
+(defun haskell-interactive-mode-compile-warning (session message)
+ "Warning message."
+ (haskell-interactive-mode-compile-message
+ session message 'haskell-interactive-face-compile-warning))
+
+(defun haskell-interactive-mode-compile-message (session message type)
+ "Echo a compiler warning."
+ (with-current-buffer (haskell-session-interactive-buffer session)
+ (save-excursion
+ (haskell-interactive-mode-goto-end-point)
+ (let ((lines (string-match "^\\(.*\\)\n\\([[:unibyte:][:nonascii:]]+\\)" message)))
+ (when lines
+ (insert (propertize (concat (match-string 1 message) "\n")
+ 'face type
+ 'read-only t
+ 'rear-nonsticky t
+ 'expandable t))
+ (insert (propertize (concat (match-string 2 message) "\n")
+ 'face type
+ 'read-only t
+ 'rear-nonsticky t
+ 'collapsible t
+ 'invisible t
+ 'message-length (length (match-string 2 message)))))
+ (unless lines
+ (insert (propertize (concat message "\n")
+ 'face type
+ 'read-only t
+ 'rear-nonsticky t)))))))
+
(defun haskell-interactive-mode-insert (session message)
"Echo a read only piece of text before the prompt."
(with-current-buffer (haskell-session-interactive-buffer session)
@@ -242,3 +288,26 @@
(haskell-mode-message-line msg)
(when echo
(haskell-interactive-mode-echo session msg))))
+
+(defun haskell-interactive-mode-tab ()
+ "The tab command."
+ (interactive)
+ (cond
+ ((get-text-property (point) 'collapsible)
+ (let ((column (current-column)))
+ (search-backward-regexp "^[^ ]")
+ (haskell-interactive-mode-tab-expand)
+ (goto-char (+ column (line-beginning-position)))))
+ (t (haskell-interactive-mode-tab-expand))))
+
+(defun haskell-interactive-mode-tab-expand ()
+ "Expand the rest of the message."
+ (cond ((get-text-property (point) 'expandable)
+ (let* ((pos (1+ (line-end-position)))
+ (visibility (get-text-property pos 'invisible))
+ (length (1+ (get-text-property pos 'message-length))))
+ (let ((inhibit-read-only t))
+ (put-text-property pos
+ (+ pos length)
+ 'invisible
+ (not visibility)))))))
View
@@ -100,8 +100,7 @@
(haskell-process-send-string (cadr state)
(format ":load %s" (caddr state))))
(lambda (state buffer)
- (or (haskell-process-live-load-file (cadr state) buffer)
- (haskell-process-live-load-packages (cadr state) buffer)))
+ (haskell-process-live-build (cadr state) buffer nil))
(lambda (state response)
(haskell-process-load-complete (car state) response))))))
@@ -137,17 +136,36 @@
('cabal-dev "cabal-dev"))
(caddr state)))))
(lambda (state buffer)
- (haskell-interactive-mode-insert
- (haskell-process-session (cadr state))
- (replace-regexp-in-string
- haskell-process-prompt-regex
- ""
- (substring buffer (cadddr state))))
- (setf (cdddr state) (list (length buffer)))
- nil)
+ (cond ((or (string= (caddr state) "build")
+ (string= (caddr state) "install"))
+ (haskell-process-live-build (cadr state) buffer t))
+ (t
+ (haskell-process-cabal-live state buffer))))
(lambda (state _)
- (haskell-interactive-mode-echo (haskell-process-session (cadr state))
- (format "Complete: cabal %s" (caddr state))))))))
+ (let* ((process (cadr state))
+ (session (haskell-process-session process))
+ (message-count 0)
+ (cursor (haskell-process-response-cursor process)))
+ (haskell-process-set-response-cursor process 0)
+ (while (haskell-process-errors-warnings session process)
+ (setq message-count (1+ message-count)))
+ (haskell-process-set-response-cursor process cursor)
+ (let ((msg (format "Complete: cabal %s (%s compiler messages)"
+ (caddr state)
+ message-count)))
+ (haskell-interactive-mode-echo session msg)
+ (haskell-mode-message-line msg))))))))
+
+(defun haskell-process-cabal-live (state buffer)
+ "Do live updates for Cabal processes."
+ (haskell-interactive-mode-insert
+ (haskell-process-session (cadr state))
+ (replace-regexp-in-string
+ haskell-process-prompt-regex
+ ""
+ (substring buffer (cadddr state))))
+ (setf (cdddr state) (list (length buffer)))
+ nil)
(defun haskell-process-load-complete (session response)
"Handle the complete loading response."
@@ -164,30 +182,41 @@
(haskell-process-set-response-cursor process 0)
(while (haskell-process-errors-warnings session process))
(haskell-process-set-response-cursor process cursor)
- (haskell-mode-message-line "Compilation failed.")
- (haskell-interactive-mode-echo session "Compilation failed.")))))
+ (haskell-interactive-mode-compile-error session "Compilation failed.")))))
-(defun haskell-process-live-load-file (process buffer)
+(defun haskell-process-live-build (process buffer echo-in-repl)
"Show live updates for loading files."
(cond ((haskell-process-consume
process
- (concat "\\[\\([0-9]+\\) of \\([0-9]+\\)\\]"
+ (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
" Compiling \\([^ ]+\\)[ ]+"
"( \\([^ ]+\\), \\([^ ]+\\) )[\r\n]+"))
(haskell-interactive-show-load-message
(haskell-process-session process)
'compiling
(match-string 3 buffer)
(match-string 4 buffer)
- nil)
- t)))
-
-(defun haskell-process-live-load-packages (process buffer)
- "Show live package loading updates."
- (cond ((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n")
+ echo-in-repl)
+ t)
+ ((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n")
(haskell-mode-message-line
(format "Loading: %s"
- (match-string 1 buffer))))))
+ (match-string 1 buffer)))
+ t)
+ ((haskell-process-consume
+ process
+ "^Preprocessing executables for \\(.+?\\)\\.\\.\\.")
+ (let ((msg (format "Preprocessing: %s" (match-string 1 buffer))))
+ (haskell-interactive-mode-echo
+ (haskell-process-session process)
+ msg)
+ (haskell-mode-message-line msg)))
+ ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.")
+ (let ((msg (format "Building: %s" (match-string 1 buffer))))
+ (haskell-interactive-mode-echo
+ (haskell-process-session process)
+ msg)
+ (haskell-mode-message-line msg)))))
(defun haskell-process-errors-warnings (session buffer)
"Trigger handling type errors or warnings."
@@ -209,7 +238,10 @@
line
col
error-msg)))
- (haskell-interactive-mode-echo session final-msg)
+ (funcall (if warning
+ 'haskell-interactive-mode-compile-warning
+ 'haskell-interactive-mode-compile-error)
+ session final-msg)
(unless warning
(haskell-mode-message-line final-msg)))
t)))
View
@@ -181,7 +181,7 @@ autofill-mode.
;;;### (autoloads (haskell-interactive-mode-echo haskell-interactive-switch
;;;;;; haskell-interactive-bring haskell-interactive-mode) "haskell-interactive-mode"
-;;;;;; "haskell-interactive-mode.el" (20334 64030))
+;;;;;; "haskell-interactive-mode.el" (20335 8730))
;;; Generated autoloads from haskell-interactive-mode.el
(autoload 'haskell-interactive-mode "haskell-interactive-mode" "\
@@ -311,7 +311,7 @@ Return to the non-import point we were at before going to the module list.
;;;### (autoloads (haskell-process haskell-process-start haskell-process-cabal
;;;;;; haskell-process-cabal-build haskell-process-load-file) "haskell-process"
-;;;;;; "haskell-process.el" (20334 65375))
+;;;;;; "haskell-process.el" (20335 8867))
;;; Generated autoloads from haskell-process.el
(autoload 'haskell-process-load-file "haskell-process" "\
@@ -433,7 +433,7 @@ we load it.
;;;### (autoloads nil nil ("haskell-checkers.el" "haskell-font-lock.el"
;;;;;; "haskell-ghci.el" "haskell-hugs.el" "haskell-package.el"
;;;;;; "haskell-simple-indent.el" "haskell-string.el" "init.el")
-;;;;;; (20334 65379 994401))
+;;;;;; (20335 8929 659887))
;;;***

0 comments on commit 957a6ae

Please sign in to comment.