Klimi's new dotfiles with stow.
Não pode escolher mais do que 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

266 linhas
10 KiB

há 4 anos
  1. ;;; inf-haskell.el --- Interaction with an inferior Haskell process -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  3. ;; Copyright (C) 2017 Vasantha Ganesh Kanniappan <vasanthaganesh.k@tuta.io>
  4. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
  5. ;; Keywords: Haskell
  6. ;; This file is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 3, or (at your option)
  9. ;; any later version.
  10. ;; This file is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; A major mode for the buffer that holds the inferior process
  18. ;; Todo:
  19. ;; - Check out Shim for ideas.
  20. ;; - i-h-load-buffer and i-h-send-region.
  21. ;;; Code:
  22. (require 'comint)
  23. (require 'shell) ; For directory tracking.
  24. (require 'etags)
  25. (require 'haskell-compat)
  26. (require 'compile)
  27. (require 'haskell-decl-scan)
  28. (require 'haskell-cabal)
  29. (require 'haskell-customize)
  30. (require 'cl-lib)
  31. (require 'haskell-string)
  32. ;;;###autoload
  33. (defgroup inferior-haskell nil
  34. "Settings for REPL interaction via `inferior-haskell-mode'"
  35. :link '(custom-manual "(haskell-mode)inferior-haskell-mode")
  36. :prefix "inferior-haskell-"
  37. :prefix "haskell-"
  38. :group 'haskell)
  39. (defcustom inferior-haskell-hook nil
  40. "The hook that is called after starting inf-haskell."
  41. :type 'hook)
  42. (defun haskell-program-name-with-args ()
  43. "Return the command with the arguments to start the repl based on the
  44. directory structure."
  45. (cl-ecase (haskell-process-type)
  46. ('ghci (cond ((eq system-type 'cygwin) (nconc "ghcii.sh"
  47. haskell-process-args-ghci))
  48. (t (append
  49. (if (listp haskell-process-path-ghci)
  50. haskell-process-path-ghci
  51. (list haskell-process-path-ghci))
  52. haskell-process-args-ghci))))
  53. ('cabal-repl (nconc `(,haskell-process-path-cabal
  54. "repl")
  55. haskell-process-args-cabal-repl))
  56. ('stack-ghci (nconc `(,haskell-process-path-stack
  57. "ghci")
  58. haskell-process-args-stack-ghci))))
  59. (defconst inferior-haskell-info-xref-re
  60. "-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?$")
  61. (defconst inferior-haskell-module-re
  62. "-- Defined in \\(.+\\)$"
  63. "Regular expression for matching module names in :info.")
  64. (defvar inferior-haskell-multiline-prompt-re
  65. "^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*| "
  66. "Regular expression for matching multiline prompt (the one inside :{ ... :} blocks).")
  67. (defconst inferior-haskell-error-regexp-alist
  68. `(;; Format of error messages used by GHCi.
  69. ("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n *\\)\\([Ww]arning\\)?"
  70. 1 2 4 ,@(if (fboundp 'compilation-fake-loc)
  71. '((6) nil (5 '(face nil font-lock-multiline t)))))
  72. ;; Runtime exceptions, from ghci.
  73. ("^\\*\\*\\* Exception: \\(.+?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\)): .*"
  74. 1 ,@(if (fboundp 'compilation-fake-loc) '((2 . 4) (3 . 5)) '(2 3)))
  75. ;; GHCi uses two different forms for line/col ranges, depending on
  76. ;; whether it's all on the same line or not :-( In Emacs-23, I could use
  77. ;; explicitly numbered subgroups to merge the two patterns.
  78. ("^\\*\\*\\* Exception: \\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): .*"
  79. 1 2 ,(if (fboundp 'compilation-fake-loc) '(3 . 4) 3))
  80. ;; Info messages. Not errors per se.
  81. ,@(when (fboundp 'compilation-fake-loc)
  82. `(;; Other GHCi patterns used in type errors.
  83. ("^[ \t]+at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
  84. 1 2 (3 . 4) 0)
  85. ;; Foo.hs:318:80:
  86. ;; Ambiguous occurrence `Bar'
  87. ;; It could refer to either `Bar', defined at Zork.hs:311:5
  88. ;; or `Bar', imported from Bars at Frob.hs:32:0-16
  89. ;; (defined at Location.hs:97:5)
  90. ("[ (]defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\))?$" 1 2 3 0)
  91. ("imported from .* at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$"
  92. 1 2 (3 . 4) 0)
  93. ;; Info xrefs.
  94. (,inferior-haskell-info-xref-re 1 2 (3 . 4) 0))))
  95. "Regexps for error messages generated by inferior Haskell processes.
  96. The format should be the same as for `compilation-error-regexp-alist'.")
  97. (defconst haskell-prompt-regexp
  98. ;; Why the backslash in [\\._[:alnum:]]?
  99. "^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*\\( λ\\)?> \\|^λ?> $")
  100. ;;; TODO
  101. ;;; -> Make font lock work for strings, directories, hyperlinks
  102. ;;; -> Make font lock work for key words???
  103. (defvaralias 'inferior-haskell-mode-map 'inf-haskell-map)
  104. (defvar inf-haskell-map
  105. (let ((map (make-sparse-keymap)))
  106. (define-key map "\C-c\C-d" 'comint-kill-subjob)
  107. map))
  108. (define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell"
  109. "Major mode for interacting with an inferior Haskell process."
  110. :group 'inferior-haskell
  111. (setq-local comint-prompt-regexp haskell-prompt-regexp)
  112. (setq-local paragraph-start haskell-prompt-regexp)
  113. (setq-local comint-input-autoexpand nil)
  114. (setq-local comint-prompt-read-only t)
  115. ;; Setup directory tracking.
  116. (setq-local shell-cd-regexp ":cd")
  117. (condition-case nil
  118. (shell-dirtrack-mode 1)
  119. (error ;The minor mode function may not exist or not accept an arg.
  120. (setq-local shell-dirtrackp t)
  121. (add-hook 'comint-input-filter-functions 'shell-directory-tracker
  122. nil 'local)))
  123. ;; Setup `compile' support so you can just use C-x ` and friends.
  124. (setq-local compilation-error-regexp-alist inferior-haskell-error-regexp-alist)
  125. (setq-local compilation-first-column 0) ;GHCI counts from 0.
  126. (if (and (not (boundp 'minor-mode-overriding-map-alist))
  127. (fboundp 'compilation-shell-minor-mode))
  128. ;; If we can't remove compilation-minor-mode bindings, at least try to
  129. ;; use compilation-shell-minor-mode, so there are fewer
  130. ;; annoying bindings.
  131. (compilation-shell-minor-mode 1)
  132. ;; Else just use compilation-minor-mode but without its bindings because
  133. ;; things like mouse-2 are simply too annoying.
  134. (compilation-minor-mode 1)
  135. (let ((map (make-sparse-keymap)))
  136. (dolist (keys '([menu-bar] [follow-link]))
  137. ;; Preserve some of the bindings.
  138. (define-key map keys (lookup-key compilation-minor-mode-map keys)))
  139. (add-to-list 'minor-mode-overriding-map-alist
  140. (cons 'compilation-minor-mode map))))
  141. (add-hook 'inferior-haskell-hook 'inferior-haskell-init))
  142. (defvar inferior-haskell-buffer nil
  143. "The buffer in which the inferior process is running.")
  144. (defun inferior-haskell-start-process ()
  145. "Start an inferior haskell process.
  146. With universal prefix \\[universal-argument], prompts for a COMMAND,
  147. otherwise uses `haskell-program-name-with-args'.
  148. It runs the hook `inferior-haskell-hook' after starting the process and
  149. setting up the inferior-haskell buffer."
  150. (let ((command (haskell-program-name-with-args)))
  151. (when inferior-haskell-root-dir
  152. (setq default-directory inferior-haskell-root-dir))
  153. (setq inferior-haskell-buffer
  154. (apply 'make-comint "haskell" (car command) nil (cdr command)))
  155. (with-current-buffer inferior-haskell-buffer
  156. (inferior-haskell-mode)
  157. (run-hooks 'inferior-haskell-hook))))
  158. (defun inferior-haskell-process ()
  159. "Restart if not present."
  160. (cond ((and (buffer-live-p inferior-haskell-buffer)
  161. (comint-check-proc inferior-haskell-buffer))
  162. (get-buffer-process inferior-haskell-buffer))
  163. (t (inferior-haskell-start-process)
  164. (inferior-haskell-process))))
  165. ;;;###autoload
  166. (defalias 'run-haskell 'switch-to-haskell)
  167. ;;;###autoload
  168. (defun switch-to-haskell ()
  169. "Show the inferior-haskell buffer. Start the process if needed."
  170. (interactive)
  171. (let ((proc (inferior-haskell-process)))
  172. (pop-to-buffer-same-window (process-buffer proc))))
  173. (defvar inferior-haskell-result-history nil)
  174. (defvar haskell-next-input ""
  175. "This is a temporary variable to store the intermediate results while
  176. `accecpt-process-output' with `haskell-extract-exp'")
  177. (defun haskell-extract-exp (str)
  178. (setq haskell-next-input (concat haskell-next-input str))
  179. (if (with-temp-buffer
  180. (insert haskell-next-input)
  181. (re-search-backward haskell-prompt-regexp nil t 1))
  182. (progn
  183. (push (substring haskell-next-input
  184. 0
  185. (1- (with-temp-buffer
  186. (insert haskell-next-input)
  187. (re-search-backward haskell-prompt-regexp nil t 1))))
  188. inferior-haskell-result-history)
  189. (setq haskell-next-input ""))
  190. ""))
  191. (defun inferior-haskell-no-result-return (strg)
  192. (let ((proc (inferior-haskell-process)))
  193. (with-local-quit
  194. (progn
  195. (add-to-list 'comint-preoutput-filter-functions
  196. (lambda (output)
  197. (haskell-extract-exp output)))
  198. (process-send-string proc strg)
  199. (accept-process-output proc)
  200. (sit-for 0.1)
  201. (setq comint-preoutput-filter-functions nil)))))
  202. (defun inferior-haskell-get-result (inf-expr)
  203. "Submit the expression `inf-expr' to ghci and read the result."
  204. (let* ((times 5))
  205. (inferior-haskell-no-result-return (concat inf-expr "\n"))
  206. (while (and (> times 0)
  207. (not (stringp (car inferior-haskell-result-history))))
  208. (setq times (1- times))
  209. (inferior-haskell-no-result-return (concat inf-expr "\n")))
  210. (haskell-string-chomp (car inferior-haskell-result-history))))
  211. (defun inferior-haskell-init ()
  212. "The first thing run while initalizing inferior-haskell-buffer"
  213. (with-local-quit
  214. (with-current-buffer inferior-haskell-buffer
  215. (process-send-string (inferior-haskell-process) "\n")
  216. (accept-process-output (inferior-haskell-process))
  217. (sit-for 0.1))))
  218. (defvar haskell-set+c-p nil
  219. "t if `:set +c` else nil")
  220. (defun haskell-set+c ()
  221. "set `:set +c` is not already set"
  222. (if (not haskell-set+c-p)
  223. (inferior-haskell-get-result ":set +c")))
  224. (provide 'inf-haskell)
  225. ;;; inf-haskell.el ends here