diff --git a/haskell-cabal.el b/haskell-cabal.el index f7a214c6b..f8dd89968 100644 --- a/haskell-cabal.el +++ b/haskell-cabal.el @@ -1069,6 +1069,55 @@ source-section." ;; unwind (haskell-mode-toggle-interactive-prompt-state t))) -(provide 'haskell-cabal) +(defun haskell-cabal--find-tags-dir () + "Return a directory where TAGS file will be generated. +Tries to find cabal file first and if succeeds uses its location. +If cabal file not found uses current file directory. If current +buffer not visiting a file returns nil." + (or (haskell-cabal-find-dir) + (when buffer-file-name + (file-name-directory buffer-file-name)))) + +(defun haskell-cabal--compose-hasktags-command (dir) + "Prepare command to execute `hasktags` command in DIR folder. +By default following parameters are passed to Hasktags +executable: +-e - generate ETAGS file +-x - generate additional information in CTAGS file. + +This function takes into account user's operation system: in case +of Windows it generates simple command, relying on Hasktags +itself to find source files: + +hasktags --output=DIR\TAGS -x -e DIR + +In other cases it uses `find` command to find all source files +recursively avoiding visiting unnecessary heavy directories like +.git, .svn, _darcs and build directories created by +cabal-install, stack, etc and passes list of found files to Hasktags." + (if (eq system-type 'windows-nt) + (format "hasktags --output=\"%s\\TAGS\" -x -e \"%s\"" dir dir) + (format "cd %s && %s | %s" + dir + (concat "find . " + "-type d \\( " + "-path ./.git " + "-o -path ./.svn " + "-o -path ./_darcs " + "-o -path ./.stack-work " + "-o -path ./dist " + "-o -path ./.cabal-sandbox " + "\\) -prune " + "-o -type f \\( " + "-name '*.hs' " + "-or -name '*.lhs' " + "-or -name '*.hsc' " + "\\) -not \\( " + "-name '#*' " + "-or -name '.*' " + "\\) -print0") + "xargs -0 hasktags -e -x"))) + +(provide 'haskell-cabal) ;;; haskell-cabal.el ends here diff --git a/haskell-commands.el b/haskell-commands.el index 1e9e9534f..9ce5733ca 100644 --- a/haskell-commands.el +++ b/haskell-commands.el @@ -35,6 +35,7 @@ (require 'haskell-presentation-mode) (require 'haskell-utils) (require 'highlight-uses-mode) +(require 'haskell-cabal) ;;;###autoload (defun haskell-process-restart () @@ -689,7 +690,9 @@ happened since function invocation)." (haskell-utils-async-stop-watching-changes init-buffer)))))))) -;;;###autoload +(make-obsolete 'haskell-process-generate-tags + 'haskell-mode-generate-tags + "2016-03-14") (defun haskell-process-generate-tags (&optional and-then-find-this-tag) "Regenerate the TAGS table. If optional AND-THEN-FIND-THIS-TAG argument is present it is used with @@ -700,20 +703,13 @@ function `xref-find-definitions' after new table was generated." process (make-haskell-command :state (cons process and-then-find-this-tag) - :go (lambda (state) - (if (eq system-type 'windows-nt) - (haskell-process-send-string - (car state) - (format ":!hasktags --output=\"%s\\TAGS\" -x -e \"%s\"" - (haskell-session-cabal-dir (haskell-process-session (car state))) - (haskell-session-cabal-dir (haskell-process-session (car state))))) - (haskell-process-send-string - (car state) - (format ":!cd %s && %s | %s" - (haskell-session-cabal-dir - (haskell-process-session (car state))) - "find . -type d \\( -path ./.stack-work -o -path ./dist -o -path ./.cabal-sandbox \\) -prune -o -type f \\( -name '*.hs' -or -name '*.lhs' -or -name '*.hsc' \\) -not \\( -name '#*' -or -name '.*' \\) -print0" - "xargs -0 hasktags -e -x")))) + :go + (lambda (state) + (let* ((process (car state)) + (cabal-dir (haskell-session-cabal-dir + (haskell-process-session process))) + (command (haskell-cabal--compose-hasktags-command cabal-dir))) + (haskell-process-send-string process command))) :complete (lambda (state _response) (when (cdr state) (let ((tags-file-name diff --git a/haskell-interactive-mode.el b/haskell-interactive-mode.el index 98037843a..34f01e072 100644 --- a/haskell-interactive-mode.el +++ b/haskell-interactive-mode.el @@ -425,18 +425,6 @@ SESSION, otherwise operate on the current buffer." (setq haskell-interactive-mode-history-index 0)) -(defun haskell-mode-message-line (str) - "Message only one line, multiple lines just disturbs the programmer." - (message (haskell-mode-one-line str (frame-width)))) - -(defun haskell-mode-one-line (str width) - "Try to fit as much as possible on one line." - (let* - ((long-line (replace-regexp-in-string "\n" " " str)) - (condensed (replace-regexp-in-string " +" " " - (haskell-string-trim long-line)))) - (truncate-string-to-width condensed width nil nil "…"))) - (defun haskell-interactive-mode-tab () "Do completion if at prompt or else try collapse/expand." (interactive) diff --git a/haskell-load.el b/haskell-load.el index fc3a14bcf..3dd70c506 100644 --- a/haskell-load.el +++ b/haskell-load.el @@ -21,6 +21,7 @@ ;;; Code: (require 'cl-lib) +(require 'haskell-mode) (require 'haskell-process) (require 'haskell-interactive-mode) (require 'haskell-modules) diff --git a/haskell-mode.el b/haskell-mode.el index 8e927c65e..924f8fe42 100644 --- a/haskell-mode.el +++ b/haskell-mode.el @@ -144,6 +144,7 @@ (require 'haskell-string) (require 'haskell-indentation) (require 'haskell-font-lock) +(require 'haskell-cabal) ;; All functions/variables start with `(literate-)haskell-'. @@ -1069,8 +1070,36 @@ successful, nil otherwise." (goto-char (point-min)) (end-of-line))) -;; Provide ourselves: +;;;###autoload +(defun haskell-mode-generate-tags (&optional and-then-find-this-tag) + "Generate tags using Hasktags. This is synchronous function. + +If optional AND-THEN-FIND-THIS-TAG argument is present it is used +with function `xref-find-definitions' after new table was +generated." + (let* ((dir (haskell-cabal--find-tags-dir)) + (command (haskell-cabal--compose-hasktags-command dir))) + (if (not command) + (error "Unable to compose hasktags command") + (shell-command command) + (haskell-mode-message-line "Tags generated.") + (when and-then-find-this-tag + (let ((tags-file-name dir)) + (xref-find-definitions and-then-find-this-tag)))))) + +(defun haskell-mode-message-line (str) + "Echo STR in mini-buffer. +Given string is shrinken to single line, multiple lines just +disturbs the programmer." + (message (haskell-mode-one-line str (frame-width)))) + +(defun haskell-mode-one-line (str width) + "Try to fit STR as much as possible on one line according to given WIDTH." + (let* ((long-line (replace-regexp-in-string "\n" " " str)) + (condensed (replace-regexp-in-string + " +" " " (haskell-string-trim long-line)))) + (truncate-string-to-width condensed width nil nil "…"))) +;; Provide ourselves: (provide 'haskell-mode) - ;;; haskell-mode.el ends here diff --git a/haskell.el b/haskell.el index 9f20cdd96..a3dc618b2 100644 --- a/haskell.el +++ b/haskell.el @@ -339,23 +339,27 @@ If `haskell-process-load-or-reload-prompt' is nil, accept `default'." ;;;###autoload (defun haskell-mode-jump-to-tag (&optional next-p) - "Jump to the tag of the given identifier." + "Jump to the tag of the given identifier. + +Give optional NEXT-P parameter to override value of +`xref-prompt-for-identifier' during definition search." (interactive "P") (let ((ident (haskell-ident-at-point)) - (tags-file-name (haskell-session-tags-filename (haskell-session))) + (tags-file-dir (haskell-cabal--find-tags-dir)) (tags-revert-without-query t)) - (when (and ident (not (string= "" (haskell-string-trim ident)))) - (cond ((file-exists-p tags-file-name) - (let ((xref-prompt-for-identifier next-p)) - (xref-find-definitions ident))) - (t (haskell-process-generate-tags ident)))))) + (when (and ident + (not (string= "" (haskell-string-trim ident))) + tags-file-dir) + (let ((tags-file-name (concat tags-file-dir "TAGS"))) + (cond ((file-exists-p tags-file-name) + (let ((xref-prompt-for-identifier next-p)) + (xref-find-definitions ident))) + (t (haskell-mode-generate-tags ident))))))) ;;;###autoload (defun haskell-mode-after-save-handler () "Function that will be called after buffer's saving." - (when haskell-tags-on-save - (ignore-errors (when (and (boundp 'haskell-session) haskell-session) - (haskell-process-generate-tags)))) + (when haskell-tags-on-save (ignore-errors (haskell-mode-generate-tags))) (when haskell-stylish-on-save (ignore-errors (haskell-mode-stylish-buffer)) (let ((before-save-hook '())