layout.
This commit is contained in:
parent
d0a10277bf
commit
92f4b72a12
@ -14,18 +14,35 @@
|
|||||||
|
|
||||||
(require 'ghc-func)
|
(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-running nil)
|
||||||
(defvar-local ghc-check-process-name nil)
|
(defvar-local ghc-check-process-name nil)
|
||||||
(defvar-local ghc-check-original-buffer nil)
|
(defvar-local ghc-check-original-buffer nil)
|
||||||
(defvar-local ghc-check-original-file nil)
|
(defvar-local ghc-check-original-file nil)
|
||||||
|
|
||||||
(defun ghc-check-get-process-name ()
|
(ghc-defstruct hilit-info file line col msg)
|
||||||
(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-syntax ()
|
(defun ghc-check-syntax ()
|
||||||
(unless ghc-check-process-name
|
(unless ghc-check-process-name
|
||||||
@ -46,6 +63,14 @@
|
|||||||
(let ((pro (ghc-check-get-process cpro name buf)))
|
(let ((pro (ghc-check-get-process cpro name buf)))
|
||||||
(process-send-string pro (concat file "\n"))))))))
|
(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)
|
(defun ghc-check-get-process (cpro name buf)
|
||||||
(cond
|
(cond
|
||||||
((not cpro)
|
((not cpro)
|
||||||
@ -62,8 +87,6 @@
|
|||||||
(set-process-query-on-exit-flag pro nil)
|
(set-process-query-on-exit-flag pro nil)
|
||||||
pro))
|
pro))
|
||||||
|
|
||||||
(ghc-defstruct hilit-info file line col msg)
|
|
||||||
|
|
||||||
(defun ghc-check-process-filter (process string)
|
(defun ghc-check-process-filter (process string)
|
||||||
(with-current-buffer (process-buffer process)
|
(with-current-buffer (process-buffer process)
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
@ -94,6 +117,8 @@
|
|||||||
(defun ghc-check-process-sentinel (process event)
|
(defun ghc-check-process-sentinel (process event)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defun ghc-check-highlight-original-buffer (ofile buf infos)
|
(defun ghc-check-highlight-original-buffer (ofile buf infos)
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(remove-overlays (point-min) (point-max) 'ghc-check t)
|
(remove-overlays (point-min) (point-max) 'ghc-check t)
|
||||||
@ -127,23 +152,6 @@
|
|||||||
'ghc-face-warn)))
|
'ghc-face-warn)))
|
||||||
(overlay-put ovl 'face face)))))))
|
(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 ()
|
(defun ghc-display-errors ()
|
||||||
@ -162,6 +170,8 @@
|
|||||||
(let ((ovls (overlays-at p)))
|
(let ((ovls (overlays-at p)))
|
||||||
(ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
|
(ghc-filter (lambda (ovl) (overlay-get ovl 'ghc-check)) ovls)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defun ghc-goto-prev-error ()
|
(defun ghc-goto-prev-error ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((here (point))
|
(let* ((here (point))
|
||||||
@ -182,4 +192,6 @@
|
|||||||
(pnts (mapcar 'overlay-start ovls2)))
|
(pnts (mapcar 'overlay-start ovls2)))
|
||||||
(if pnts (goto-char (apply 'min pnts)))))
|
(if pnts (goto-char (apply 'min pnts)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(provide 'ghc-check)
|
(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-shallower-key 'ghc-make-indent-shallower)
|
||||||
(define-key haskell-mode-map ghc-deeper-key 'ghc-make-indent-deeper)
|
(define-key haskell-mode-map ghc-deeper-key 'ghc-make-indent-deeper)
|
||||||
(ghc-comp-init)
|
(ghc-comp-init)
|
||||||
(setq ghc-initialized t)))
|
(setq ghc-initialized t))
|
||||||
|
(ghc-check-syntax))
|
||||||
|
|
||||||
(defun ghc-abbrev-init ()
|
(defun ghc-abbrev-init ()
|
||||||
(set (make-local-variable 'dabbrev-case-fold-search) nil))
|
(set (make-local-variable 'dabbrev-case-fold-search) nil))
|
||||||
|
Loading…
Reference in New Issue
Block a user