M-t inserts module or undefine.

This commit is contained in:
Kazu Yamamoto 2014-03-25 14:58:20 +09:00
parent dc6424454e
commit 97b3de7328
3 changed files with 37 additions and 17 deletions

View File

@ -157,12 +157,15 @@
(forward-line) (forward-line)
(if (not (bolp)) (insert "\n"))) (if (not (bolp)) (insert "\n")))
(insert (match-string 1) " = undefined\n"))) (insert (match-string 1) " = undefined\n")))
((string-match "Not in scope: `\\([^']+\\)'" data) ;; GHC 7.8 uses Unicode for single-quotes.
(save-match-data ((string-match "Not in scope: `\\([^'\n\0]+\\)'" data)
(unless (re-search-forward "^$" nil t) (let ((sym (match-string 1 data)))
(goto-char (point-max)) (if (y-or-n-p (format "Import module for %s?" sym))
(insert "\n"))) (ghc-ins-mod sym)
(insert "\n" (match-string 1 data) " = undefined\n")) (unless (re-search-forward "^$" nil t)
(goto-char (point-max))
(insert "\n"))
(insert "\n" (ghc-enclose sym) " = undefined\n"))))
((string-match "Pattern match(es) are non-exhaustive" data) ((string-match "Pattern match(es) are non-exhaustive" data)
(let* ((fn (ghc-get-function-name)) (let* ((fn (ghc-get-function-name))
(arity (ghc-get-function-arity fn))) (arity (ghc-get-function-arity fn)))
@ -175,7 +178,9 @@
(let ((end (point))) (let ((end (point)))
(search-backward old nil t) (search-backward old nil t)
(delete-region (point) end)) (delete-region (point) end))
(insert new)))))))) (insert new))))
(t
(message "Nothing is done"))))))
(defun ghc-extract-type (str) (defun ghc-extract-type (str)
(with-temp-buffer (with-temp-buffer

View File

@ -197,4 +197,11 @@
(insert (format "%% %s %s\n" cmd (mapconcat 'identity args " "))) (insert (format "%% %s %s\n" cmd (mapconcat 'identity args " ")))
(insert-buffer-substring cbuf))))) (insert-buffer-substring cbuf)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-enclose (expr)
(if (string-match "^[a-zA-Z0-9_]$" expr)
expr
(concat "(" expr ")")))
(provide 'ghc-func) (provide 'ghc-func)

View File

@ -6,6 +6,8 @@
;; Author: Kazu Yamamoto <Kazu@Mew.org> ;; Author: Kazu Yamamoto <Kazu@Mew.org>
;; Created: Dec 27, 2011 ;; Created: Dec 27, 2011
(require 'ghc-process)
;;; Code: ;;; Code:
(defvar ghc-ins-mod-rendezvous nil) (defvar ghc-ins-mod-rendezvous nil)
@ -14,15 +16,16 @@
(interactive) (interactive)
(let* ((expr0 (ghc-things-at-point)) (let* ((expr0 (ghc-things-at-point))
(expr (ghc-read-expression expr0))) (expr (ghc-read-expression expr0)))
(let ((mods (ghc-function-to-modules expr))) (ghc-ins-mod expr)))
(if (null mods)
(message "No module guessed") (defun ghc-ins-mod (expr)
(let ((mod (ghc-completing-read "Module name (%s): " mods))) (let ((mods (ghc-function-to-modules expr)))
(save-excursion (if (null mods)
(ghc-goto-module-position) (message "No module guessed")
(if (string-match "^[a-zA-Z0-9_]$" expr) (let ((mod (ghc-completing-read "Module name (%s): " mods)))
(insert "import " mod " (" expr ")\n") (save-excursion
(insert "import " mod " ((" expr "))\n")))))))) (ghc-goto-module-position)
(insert "import " mod " (" (ghc-enclose expr) ")\n"))))))
(defun ghc-completing-read (fmt lst) (defun ghc-completing-read (fmt lst)
(let* ((def (car lst)) (let* ((def (car lst))
@ -35,7 +38,12 @@
(if (re-search-backward "^import" nil t) (if (re-search-backward "^import" nil t)
(ghc-goto-empty-line) (ghc-goto-empty-line)
(if (re-search-backward "^module" nil t) (if (re-search-backward "^module" nil t)
(ghc-goto-empty-line) (progn
(ghc-goto-empty-line)
(forward-line)
(unless (eolp)
(save-excursion
(insert "\n"))))
(goto-char (point-min))))) (goto-char (point-min)))))
(defun ghc-goto-empty-line () (defun ghc-goto-empty-line ()