layout.
This commit is contained in:
parent
d0a10277bf
commit
92f4b72a12
@ -14,18 +14,35 @@
|
||||
|
||||
(require 'ghc-func)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; stolen from flymake.el
|
||||
(defface ghc-face-error
|
||||
'((((supports :underline (:style wave)))
|
||||
:underline (:style wave :color "Red1"))
|
||||
(t
|
||||
:inherit error))
|
||||
"Face used for marking error lines."
|
||||
:group 'ghc)
|
||||
|
||||
(defface ghc-face-warn
|
||||
'((((supports :underline (:style wave)))
|
||||
:underline (:style wave :color "DarkOrange"))
|
||||
(t
|
||||
:inherit warning))
|
||||
"Face used for marking warning lines."
|
||||
:group 'ghc)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar-local ghc-check-running nil)
|
||||
(defvar-local ghc-check-process-name nil)
|
||||
(defvar-local ghc-check-original-buffer nil)
|
||||
(defvar-local ghc-check-original-file nil)
|
||||
|
||||
(defun ghc-check-get-process-name ()
|
||||
(let ((file (buffer-file-name)))
|
||||
(with-temp-buffer
|
||||
(ghc-call-process ghc-module-command nil t nil "root" file)
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "^\\(.*\\)$")
|
||||
(match-string-no-properties 1)))))
|
||||
(ghc-defstruct hilit-info file line col msg)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ghc-check-syntax ()
|
||||
(unless ghc-check-process-name
|
||||
@ -46,6 +63,14 @@
|
||||
(let ((pro (ghc-check-get-process cpro name buf)))
|
||||
(process-send-string pro (concat file "\n"))))))))
|
||||
|
||||
(defun ghc-check-get-process-name ()
|
||||
(let ((file (buffer-file-name)))
|
||||
(with-temp-buffer
|
||||
(ghc-call-process ghc-module-command nil t nil "root" file)
|
||||
(goto-char (point-min))
|
||||
(when (looking-at "^\\(.*\\)$")
|
||||
(match-string-no-properties 1)))))
|
||||
|
||||
(defun ghc-check-get-process (cpro name buf)
|
||||
(cond
|
||||
((not cpro)
|
||||
@ -62,8 +87,6 @@
|
||||
(set-process-query-on-exit-flag pro nil)
|
||||
pro))
|
||||
|
||||
(ghc-defstruct hilit-info file line col msg)
|
||||
|
||||
(defun ghc-check-process-filter (process string)
|
||||
(with-current-buffer (process-buffer process)
|
||||
(goto-char (point-max))
|
||||
@ -94,6 +117,8 @@
|
||||
(defun ghc-check-process-sentinel (process event)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ghc-check-highlight-original-buffer (ofile buf infos)
|
||||
(with-current-buffer buf
|
||||
(remove-overlays (point-min) (point-max) 'ghc-check t)
|
||||
@ -127,23 +152,6 @@
|
||||
'ghc-face-warn)))
|
||||
(overlay-put ovl 'face face)))))))
|
||||
|
||||
;; stolen from flymake.el
|
||||
(defface ghc-face-error
|
||||
'((((supports :underline (:style wave)))
|
||||
:underline (:style wave :color "Red1"))
|
||||
(t
|
||||
:inherit error))
|
||||
"Face used for marking error lines."
|
||||
:group 'ghc)
|
||||
|
||||
(defface ghc-face-warn
|
||||
'((((supports :underline (:style wave)))
|
||||
:underline (:style wave :color "DarkOrange"))
|
||||
(t
|
||||
:inherit warning))
|
||||
"Face used for marking warning lines."
|
||||
:group 'ghc)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ghc-display-errors ()
|
||||
@ -162,6 +170,8 @@
|
||||
(let ((ovls (overlays-at p)))
|
||||
(ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ghc-goto-prev-error ()
|
||||
(interactive)
|
||||
(let* ((here (point))
|
||||
@ -182,4 +192,6 @@
|
||||
(pnts (mapcar 'overlay-start ovls2)))
|
||||
(if pnts (goto-char (apply 'min pnts)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(provide 'ghc-check)
|
||||
|
@ -86,7 +86,8 @@
|
||||
(define-key haskell-mode-map ghc-shallower-key 'ghc-make-indent-shallower)
|
||||
(define-key haskell-mode-map ghc-deeper-key 'ghc-make-indent-deeper)
|
||||
(ghc-comp-init)
|
||||
(setq ghc-initialized t)))
|
||||
(setq ghc-initialized t))
|
||||
(ghc-check-syntax))
|
||||
|
||||
(defun ghc-abbrev-init ()
|
||||
(set (make-local-variable 'dabbrev-case-fold-search) nil))
|
||||
|
Loading…
Reference in New Issue
Block a user