Browse Source

Changes to emacs config

master
Taylor Bockman 9 years ago
parent
commit
f34dc39ef3
  1. 20
      .gitignore
  2. 14
      dotfiles/awesome/rc.lua
  3. 122
      dotfiles/emacs.d/elpa/ag-20150814.1655/ag-autoloads.el
  4. 1
      dotfiles/emacs.d/elpa/ag-20150814.1655/ag-pkg.el
  5. 617
      dotfiles/emacs.d/elpa/ag-20150814.1655/ag.el
  6. 2
      dotfiles/emacs.d/elpa/archives/melpa/archive-contents
  7. 130
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-apropos.el
  8. 230
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-autoloads.el
  9. 150
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-browse-ns.el
  10. 106
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-classpath.el
  11. 849
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-client.el
  12. 225
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-common.el
  13. 157
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-compat.el
  14. 533
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-debug.el
  15. 454
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-doc.el
  16. 164
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-eldoc.el
  17. 112
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-grimoire.el
  18. 309
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-inspector.el
  19. 1603
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-interaction.el
  20. 208
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-macroexpansion.el
  21. 454
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-mode.el
  22. 210
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-overlays.el
  23. 12
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-pkg.el
  24. 122
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-popup.el
  25. 1198
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-repl.el
  26. 129
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-resolve.el
  27. 71
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-scratch.el
  28. 154
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-selector.el
  29. 610
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-stacktrace.el
  30. 499
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-test.el
  31. 383
      dotfiles/emacs.d/elpa/cider-20151022.28/cider-util.el
  32. 524
      dotfiles/emacs.d/elpa/cider-20151022.28/cider.el
  33. 1265
      dotfiles/emacs.d/elpa/cider-20151022.28/nrepl-client.el
  34. 55
      dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode-autoloads.el
  35. 1
      dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode-pkg.el
  36. 1220
      dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode.el
  37. 32
      dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode-autoloads.el
  38. 1
      dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode-pkg.el
  39. 1259
      dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode.el
  40. 15
      dotfiles/emacs.d/elpa/dash-20151021.113/dash-autoloads.el
  41. 1
      dotfiles/emacs.d/elpa/dash-20151021.113/dash-pkg.el
  42. 2435
      dotfiles/emacs.d/elpa/dash-20151021.113/dash.el
  43. 15
      dotfiles/emacs.d/elpa/epl-20150517.433/epl-autoloads.el
  44. 1
      dotfiles/emacs.d/elpa/epl-20150517.433/epl-pkg.el
  45. 695
      dotfiles/emacs.d/elpa/epl-20150517.433/epl.el
  46. 18
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/dir
  47. 484
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/fdl-1.3.info
  48. 230
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-autoloads.el
  49. 469
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-ert.el
  50. 11
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-pkg.el
  51. 8088
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck.el
  52. 3018
      dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck.info
  53. 29
      dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure-autoloads.el
  54. 1
      dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure-pkg.el
  55. 205
      dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure.el
  56. 34
      dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell-autoloads.el
  57. 11
      dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell-pkg.el
  58. 299
      dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell.el
  59. 209
      dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/get-cabal-configuration.hs
  60. 48
      dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/get-flags.hs
  61. 26
      dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip-autoloads.el
  62. 1
      dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip-pkg.el
  63. 61
      dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip.el
  64. 25
      dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust-autoloads.el
  65. 1
      dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust-pkg.el
  66. 121
      dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust.el
  67. 24
      dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode-autoloads.el
  68. 1
      dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode-pkg.el
  69. 61
      dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode.el
  70. BIN
      dotfiles/emacs.d/elpa/gnupg/pubring.kbx~
  71. 438
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/NEWS
  72. 18
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/dir
  73. 125
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/ghc-core.el
  74. 68
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/ghci-script-mode.el
  75. 231
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-align-imports.el
  76. 181
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-bot.el
  77. 974
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-cabal.el
  78. 184
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-checkers.el
  79. 65
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-collapse.el
  80. 944
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-commands.el
  81. 70
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-compat.el
  82. 163
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-compile.el
  83. 133
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-complete-module.el
  84. 266
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-completions.el
  85. 429
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-customize.el
  86. 744
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-debug.el
  87. 619
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-decl-scan.el
  88. 1914
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-doc.el
  89. 589
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-font-lock.el
  90. 1598
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-indent.el
  91. 1174
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-indentation.el
  92. 1117
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-interactive-mode.el
  93. 223
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-lexeme.el
  94. 529
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-load.el
  95. 159
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-menu.el
  96. 1727
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode-autoloads.el
  97. 5
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode-pkg.el
  98. 1076
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode.el
  99. 658
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode.info
  100. 114
      dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-modules.el
  101. Some files were not shown because too many files have changed in this diff Show More

20
.gitignore vendored

@ -1,2 +1,22 @@
*.swp
*.swo
*~
\#*\#
/.emacs.desktop
/.emacs.desktop.lock
*.elc
auto-save-list
tramp
.\#*
# Org-mode
.org-id-locations
*_archive
*_flymake.*
/eshell/history
/eshell/lastdir
/elpa/
*.rel
/auto/
.cask/
*.last
/elpa/*

14
dotfiles/awesome/rc.lua

@ -429,18 +429,6 @@ globalkeys = awful.util.table.join(
awful.key({ altkey }, "Left", function () lain.util.tag_view_nonempty(-1) end),
awful.key({ altkey }, "Right", function () lain.util.tag_view_nonempty(1) end),
-- Default client focus
awful.key({ altkey }, "k",
function ()
awful.client.focus.byidx( 1)
if client.focus then client.focus:raise() end
end),
awful.key({ altkey }, "j",
function ()
awful.client.focus.byidx(-1)
if client.focus then client.focus:raise() end
end),
-- By direction client focus
awful.key({ modkey }, "j",
function()
@ -508,7 +496,7 @@ globalkeys = awful.util.table.join(
-- Widgets popups
awful.key({ altkey, }, "c", function () lain.widgets.calendar:show(7) end),
awful.key({ altkey, }, "h", function () fswidget.show(7) end),
awful.key({ altkey, "Control" }, "h", function () fswidget.show(7) end),
awful.key({ altkey, }, "w", function () myweather.show(7) end),
-- ALSA volume control

122
dotfiles/emacs.d/elpa/ag-20150814.1655/ag-autoloads.el

@ -0,0 +1,122 @@
;;; ag-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "ag" "ag.el" (22059 7730 733350 776000))
;;; Generated autoloads from ag.el
(autoload 'ag "ag" "\
Search using ag in a given DIRECTORY for a given search STRING,
with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING DIRECTORY)" t nil)
(autoload 'ag-files "ag" "\
Search using ag in a given DIRECTORY for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to
the symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-TYPE DIRECTORY)" t nil)
(autoload 'ag-regexp "ag" "\
Search using ag in a given directory for a given regexp.
The regexp should be in PCRE syntax, not Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING DIRECTORY)" t nil)
(autoload 'ag-project "ag" "\
Guess the root of the current project and search it with ag
for the given string.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING)" t nil)
(autoload 'ag-project-files "ag" "\
Search using ag for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to the
symbol under point.
If called with a prefix, prompts for flags to pass to ag.
\(fn STRING FILE-TYPE)" t nil)
(autoload 'ag-project-regexp "ag" "\
Guess the root of the current project and search it with ag
for the given regexp. The regexp should be in PCRE syntax, not
Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag.
\(fn REGEXP)" t nil)
(defalias 'ag-project-at-point 'ag-project)
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
(autoload 'ag-dired "ag" "\
Recursively find files in DIR matching PATTERN.
The PATTERN is matched against the full path to the file, not
only against the file name.
The results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `ag-dired-regexp'.
\(fn DIR PATTERN)" t nil)
(autoload 'ag-dired-regexp "ag" "\
Recursively find files in DIR matching REGEXP.
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
The REGEXP is matched against the full path to the file, not
only against the file name.
Results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `find-dired'.
\(fn DIR REGEXP)" t nil)
(autoload 'ag-project-dired "ag" "\
Recursively find files in current project matching PATTERN.
See also `ag-dired'.
\(fn PATTERN)" t nil)
(autoload 'ag-project-dired-regexp "ag" "\
Recursively find files in current project matching REGEXP.
See also `ag-dired-regexp'.
\(fn REGEXP)" t nil)
(autoload 'ag-kill-buffers "ag" "\
Kill all `ag-mode' buffers.
\(fn)" t nil)
(autoload 'ag-kill-other-buffers "ag" "\
Kill all `ag-mode' buffers other than the current buffer.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; ag-autoloads.el ends here

1
dotfiles/emacs.d/elpa/ag-20150814.1655/ag-pkg.el

@ -0,0 +1 @@
(define-package "ag" "20150814.1655" "A front-end for ag ('the silver searcher'), the C ack replacement." '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")))

617
dotfiles/emacs.d/elpa/ag-20150814.1655/ag.el

@ -0,0 +1,617 @@
;;; ag.el --- A front-end for ag ('the silver searcher'), the C ack replacement.
;; Copyright (C) 2013-2014 Wilfred Hughes <me@wilfred.me.uk>
;;
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Created: 11 January 2013
;; Version: 0.47
;; Package-Version: 20150814.1655
;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
;;; Commentary:
;; Please see README.md for documentation, or read it online at
;; https://github.com/Wilfred/ag.el/#agel
;;; License:
;; This file is not part of GNU Emacs.
;; However, it is distributed under the same license.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(eval-when-compile (require 'cl)) ;; dolist, defun*, flet
(require 'cl-lib) ;; cl-letf
(require 'dired) ;; dired-sort-inhibit
(require 'dash)
(require 's)
(require 'find-dired) ;; find-dired-filter
(defcustom ag-executable
"ag"
"Name of the ag executable to use."
:type 'string
:group 'ag)
(defcustom ag-arguments
(list "--line-number" "--smart-case" "--nogroup" "--column" "--stats" "--")
"Default arguments passed to ag.
Ag.el requires --nogroup and --column, so we recommend you add any
additional arguments to the start of this list.
--line-number is required on Window, as otherwise ag will not
print line numbers when the input is a stream."
:type '(repeat (string))
:group 'ag)
(defcustom ag-highlight-search nil
"Non-nil means we highlight the current search term in results.
This requires the ag command to support --color-match, which is only in v0.14+"
:type 'boolean
:group 'ag)
(defcustom ag-reuse-buffers nil
"Non-nil means we reuse the existing search results buffer or
dired results buffer, rather than creating one buffer per unique
search."
:type 'boolean
:group 'ag)
(defcustom ag-reuse-window nil
"Non-nil means we open search results in the same window,
hiding the results buffer."
:type 'boolean
:group 'ag)
(defcustom ag-project-root-function nil
"A function to determine the project root for `ag-project'.
If set to a function, call this function with the name of the
file or directory for which to determine the project root
directory.
If set to nil, fall back to finding VCS root directories."
:type '(choice (const :tag "Default (VCS root)" nil)
(function :tag "Function"))
:group 'ag)
(defcustom ag-ignore-list nil
"A list of patterns to ignore when searching."
:type '(repeat (string))
:group 'ag)
(require 'compile)
;; Although ag results aren't exactly errors, we treat them as errors
;; so `next-error' and `previous-error' work. However, we ensure our
;; face inherits from `compilation-info-face' so the results are
;; styled appropriately.
(defface ag-hit-face '((t :inherit compilation-info))
"Face name to use for ag matches."
:group 'ag)
(defface ag-match-face '((t :inherit match))
"Face name to use for ag matches."
:group 'ag)
(defvar ag-search-finished-hook nil
"Hook run when ag completes a search in a buffer.")
(defun ag/run-finished-hook (buffer how-finished)
"Run the ag hook to signal that the search has completed."
(with-current-buffer buffer
(run-hooks 'ag-search-finished-hook)))
(defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body)
"Temporarily override the definition of FUN-NAME whilst BODY is executed.
Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)."
`(cl-letf (((symbol-function ,fun-name)
(lambda ,fun-args ,fun-body)))
,@body))
(defun ag/next-error-function (n &optional reset)
"Open the search result at point in the current window or a
different window, according to `ag-reuse-window'."
(if ag-reuse-window
;; prevent changing the window
(ag/with-patch-function
'pop-to-buffer (buffer &rest args) (switch-to-buffer buffer)
(compilation-next-error-function n reset))
;; just navigate to the results as normal
(compilation-next-error-function n reset)))
;; Note that we want to use as tight a regexp as we can to try and
;; handle weird file names (with colons in them) as well as possible.
;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
;; in file names.
(defvar ag/file-column-pattern
"^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):"
"A regexp pattern that groups output into filename, line number and column number.")
(define-compilation-mode ag-mode "Ag"
"Ag results compilation mode"
(set (make-local-variable 'compilation-error-regexp-alist)
(list 'compilation-ag-nogroup))
(set (make-local-variable 'compilation-error-regexp-alist-alist)
(list (cons 'compilation-ag-nogroup (list ag/file-column-pattern 1 2 3))))
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
(set (make-local-variable 'next-error-function) #'ag/next-error-function)
(set (make-local-variable 'compilation-finish-functions)
#'ag/run-finished-hook)
(add-hook 'compilation-filter-hook 'ag-filter nil t))
(define-key ag-mode-map (kbd "p") #'compilation-previous-error)
(define-key ag-mode-map (kbd "n") #'compilation-next-error)
(define-key ag-mode-map (kbd "k") '(lambda () (interactive)
(let (kill-buffer-query-functions) (kill-buffer))))
(defun ag/buffer-name (search-string directory regexp)
"Return a buffer name formatted according to ag.el conventions."
(cond
(ag-reuse-buffers "*ag search*")
(regexp (format "*ag search regexp:%s dir:%s*" search-string directory))
(:else (format "*ag search text:%s dir:%s*" search-string directory))))
(defun ag/format-ignore (ignores)
"Prepend '--ignore' to every item in IGNORES."
(apply #'append
(mapcar (lambda (item) (list "--ignore" item)) ignores)))
(defun* ag/search (string directory
&key (regexp nil) (file-regex nil) (file-type nil))
"Run ag searching for the STRING given in DIRECTORY.
If REGEXP is non-nil, treat STRING as a regular expression."
(let ((default-directory (file-name-as-directory directory))
(arguments ag-arguments)
(shell-command-switch "-c"))
(unless regexp
(setq arguments (cons "--literal" arguments)))
(if ag-highlight-search
(setq arguments (append '("--color" "--color-match" "30;43") arguments))
(setq arguments (append '("--nocolor") arguments)))
(when (char-or-string-p file-regex)
(setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
(when file-type
(setq arguments (cons (format "--%s" file-type) arguments)))
(when ag-ignore-list
(setq arguments (append (ag/format-ignore ag-ignore-list) arguments)))
(unless (file-exists-p default-directory)
(error "No such directory %s" default-directory))
(let ((command-string
(mapconcat #'shell-quote-argument
(append (list ag-executable) arguments (list string "."))
" ")))
;; If we're called with a prefix, let the user modify the command before
;; running it. Typically this means they want to pass additional arguments.
(when current-prefix-arg
;; Make a space in the command-string for the user to enter more arguments.
(setq command-string (ag/replace-first command-string " -- " " -- "))
;; Prompt for the command.
(let ((adjusted-point (- (length command-string) (length string) 5)))
(setq command-string
(read-from-minibuffer "ag command: "
(cons command-string adjusted-point)))))
;; Call ag.
(compilation-start
command-string
#'ag-mode
`(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
(defun ag/dwim-at-point ()
"If there's an active selection, return that.
Otherwise, get the symbol at point, as a string."
(cond ((use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end)))
((symbol-at-point)
(substring-no-properties
(symbol-name (symbol-at-point))))))
(defun ag/buffer-extension-regex ()
"If the current buffer has an extension, return
a PCRE pattern that matches files with that extension.
Returns an empty string otherwise."
(let ((file-name (buffer-file-name)))
(if (stringp file-name)
(format "\\.%s$" (ag/escape-pcre (file-name-extension file-name)))
"")))
(defun ag/longest-string (&rest strings)
"Given a list of strings and nils, return the longest string."
(let ((longest-string nil))
(dolist (string strings)
(cond ((null longest-string)
(setq longest-string string))
((stringp string)
(when (< (length longest-string)
(length string))
(setq longest-string string)))))
longest-string))
(defun ag/replace-first (string before after)
"Replace the first occurrence of BEFORE in STRING with AFTER."
(replace-regexp-in-string
(concat "\\(" (regexp-quote before) "\\)" ".*\\'")
after string
nil nil 1))
(autoload 'vc-git-root "vc-git")
(require 'vc-svn)
;; Emacs 23.4 doesn't provide vc-svn-root.
(unless (functionp 'vc-svn-root)
(defun vc-svn-root (file)
(vc-find-root file vc-svn-admin-directory)))
(autoload 'vc-hg-root "vc-hg")
(defun ag/project-root (file-path)
"Guess the project root of the given FILE-PATH.
Use `ag-project-root-function' if set, or fall back to VCS
roots."
(if ag-project-root-function
(funcall ag-project-root-function file-path)
(or (ag/longest-string
(vc-git-root file-path)
(vc-svn-root file-path)
(vc-hg-root file-path))
file-path)))
(defun ag/dired-align-size-column ()
(beginning-of-line)
(when (looking-at "^ ")
(forward-char 2)
(search-forward " " nil t 4)
(let* ((size-start (point))
(size-end (search-forward " " nil t))
(width (and size-end (- size-end size-start))))
(when (and size-end
(< width 12)
(> width 1))
(goto-char size-start)
(insert (make-string (- 12 width) ? ))))))
(defun ag/dired-filter (proc string)
"Filter the output of ag to make it suitable for `dired-mode'."
(let ((buf (process-buffer proc))
(inhibit-read-only t))
(if (buffer-name buf)
(with-current-buffer buf
(save-excursion
(save-restriction
(widen)
(let ((beg (point-max)))
(goto-char beg)
(insert string)
(goto-char beg)
(or (looking-at "^")
(progn
(ag/dired-align-size-column)
(forward-line 1)))
(while (looking-at "^")
(insert " ")
(ag/dired-align-size-column)
(forward-line 1))
(goto-char beg)
(beginning-of-line)
;; Remove occurrences of default-directory.
(while (search-forward (concat " " default-directory) nil t)
(replace-match " " nil t))
(goto-char (point-max))
(if (search-backward "\n" (process-mark proc) t)
(progn
(dired-insert-set-properties (process-mark proc)
(1+ (point)))
(move-marker (process-mark proc) (1+ (point)))))))))
(delete-process proc))))
(defun ag/dired-sentinel (proc state)
"Update the status/modeline after the process finishes."
(let ((buf (process-buffer proc))
(inhibit-read-only t))
(if (buffer-name buf)
(with-current-buffer buf
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(insert "\n ag " state)
(forward-char -1) ;Back up before \n at end of STATE.
(insert " at " (substring (current-time-string) 0 19))
(forward-char 1)
(setq mode-line-process
(concat ":" (symbol-name (process-status proc))))
;; Since the buffer and mode line will show that the
;; process is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc)
(force-mode-line-update)))
(run-hooks 'dired-after-readin-hook)
(message "%s finished." (current-buffer))))))
(defun ag/kill-process ()
"Kill the `ag' process running in the current buffer."
(interactive)
(let ((ag (get-buffer-process (current-buffer))))
(and ag (eq (process-status ag) 'run)
(eq (process-filter ag) (function find-dired-filter))
(condition-case nil
(delete-process ag)
(error nil)))))
(defun ag/escape-pcre (regexp)
"Escape the PCRE-special characters in REGEXP so that it is
matched literally."
(let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
(apply #'concat
(mapcar
(lambda (c)
(cond
((not (string-match-p (regexp-quote c) alphanum))
(concat "\\" c))
(t c)))
(mapcar #'char-to-string (string-to-list regexp))))))
;;;###autoload
(defun ag (string directory)
"Search using ag in a given DIRECTORY for a given search STRING,
with STRING defaulting to the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (ag/read-from-minibuffer "Search string")
(read-directory-name "Directory: ")))
(ag/search string directory))
;;;###autoload
(defun ag-files (string file-type directory)
"Search using ag in a given DIRECTORY for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to
the symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (ag/read-from-minibuffer "Search string")
(ag/read-file-type)
(read-directory-name "Directory: ")))
(apply #'ag/search string directory file-type))
;;;###autoload
(defun ag-regexp (string directory)
"Search using ag in a given directory for a given regexp.
The regexp should be in PCRE syntax, not Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag."
(interactive "sSearch regexp: \nDDirectory: ")
(ag/search string directory :regexp t))
;;;###autoload
(defun ag-project (string)
"Guess the root of the current project and search it with ag
for the given string.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (ag/read-from-minibuffer "Search string")))
(ag/search string (ag/project-root default-directory)))
;;;###autoload
(defun ag-project-files (string file-type)
"Search using ag for a given search STRING,
limited to files that match FILE-TYPE. STRING defaults to the
symbol under point.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (ag/read-from-minibuffer "Search string")
(ag/read-file-type)))
(apply 'ag/search string (ag/project-root default-directory) file-type))
(defun ag/read-from-minibuffer (prompt)
"Read a value from the minibuffer with PROMPT.
If there's a string at point, offer that as a default."
(let* ((suggested (ag/dwim-at-point))
(final-prompt
(if suggested
(format "%s (default %s): " prompt suggested)
(format "%s: " prompt)))
;; Ask the user for input, but add `suggested' to the history
;; so they can use M-n if they want to modify it.
(user-input (read-from-minibuffer
final-prompt
nil nil nil nil suggested)))
;; Return the input provided by the user, or use `suggested' if
;; the input was empty.
(if (> (length user-input) 0)
user-input
suggested)))
;;;###autoload
(defun ag-project-regexp (regexp)
"Guess the root of the current project and search it with ag
for the given regexp. The regexp should be in PCRE syntax, not
Emacs regexp syntax.
If called with a prefix, prompts for flags to pass to ag."
(interactive (list (ag/read-from-minibuffer "Search regexp")))
(ag/search regexp (ag/project-root default-directory) :regexp t))
(autoload 'symbol-at-point "thingatpt")
;;;###autoload
(defalias 'ag-project-at-point 'ag-project)
(make-obsolete 'ag-project-at-point 'ag-project "0.19")
;;;###autoload
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
(make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46")
;;;###autoload
(defun ag-dired (dir pattern)
"Recursively find files in DIR matching PATTERN.
The PATTERN is matched against the full path to the file, not
only against the file name.
The results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `ag-dired-regexp'."
(interactive "DDirectory: \nsFile pattern: ")
(ag-dired-regexp dir (ag/escape-pcre pattern)))
;;;###autoload
(defun ag-dired-regexp (dir regexp)
"Recursively find files in DIR matching REGEXP.
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
The REGEXP is matched against the full path to the file, not
only against the file name.
Results are presented as a `dired-mode' buffer with
`default-directory' being DIR.
See also `find-dired'."
(interactive "DDirectory: \nsFile regexp: ")
(let* ((dired-buffers dired-buffers) ;; do not mess with regular dired buffers
(orig-dir dir)
(dir (file-name-as-directory (expand-file-name dir)))
(buffer-name (if ag-reuse-buffers
"*ag dired*"
(format "*ag dired pattern:%s dir:%s*" regexp dir)))
(cmd (concat ag-executable " --nocolor -g '" regexp "' "
(shell-quote-argument dir)
" | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/ | xargs -I '{}' ls "
dired-listing-switches " '{}' &")))
(with-current-buffer (get-buffer-create buffer-name)
(switch-to-buffer (current-buffer))
(widen)
(kill-all-local-variables)
(if (fboundp 'read-only-mode)
(read-only-mode -1)
(setq buffer-read-only nil))
(let ((inhibit-read-only t)) (erase-buffer))
(setq default-directory dir)
(run-hooks 'dired-before-readin-hook)
(shell-command cmd (current-buffer))
(insert " " dir ":\n")
(insert " " cmd "\n")
(dired-mode dir)
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(define-key map "\C-c\C-k" 'ag/kill-process)
(use-local-map map))
(set (make-local-variable 'dired-sort-inhibit) t)
(set (make-local-variable 'revert-buffer-function)
`(lambda (ignore-auto noconfirm)
(ag-dired-regexp ,orig-dir ,regexp)))
(if (fboundp 'dired-simple-subdir-alist)
(dired-simple-subdir-alist)
(set (make-local-variable 'dired-subdir-alist)
(list (cons default-directory (point-min-marker)))))
(let ((proc (get-buffer-process (current-buffer))))
(set-process-filter proc #'ag/dired-filter)
(set-process-sentinel proc #'ag/dired-sentinel)
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) 1 (current-buffer)))
(setq mode-line-process '(":%s")))))
;;;###autoload
(defun ag-project-dired (pattern)
"Recursively find files in current project matching PATTERN.
See also `ag-dired'."
(interactive "sFile pattern: ")
(ag-dired-regexp (ag/project-root default-directory) (ag/escape-pcre pattern)))
;;;###autoload
(defun ag-project-dired-regexp (regexp)
"Recursively find files in current project matching REGEXP.
See also `ag-dired-regexp'."
(interactive "sFile regexp: ")
(ag-dired-regexp (ag/project-root default-directory) regexp))
;;;###autoload
(defun ag-kill-buffers ()
"Kill all `ag-mode' buffers."
(interactive)
(dolist (buffer (buffer-list))
(when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
(kill-buffer buffer))))
;;;###autoload
(defun ag-kill-other-buffers ()
"Kill all `ag-mode' buffers other than the current buffer."
(interactive)
(let ((current-buffer (current-buffer)))
(dolist (buffer (buffer-list))
(when (and
(eq (buffer-local-value 'major-mode buffer) 'ag-mode)
(not (eq buffer current-buffer)))
(kill-buffer buffer)))))
;; Taken from grep-filter, just changed the color regex.
(defun ag-filter ()
"Handle match highlighting escape sequences inserted by the ag process.
This function is called from `compilation-filter-hook'."
(when ag-highlight-search
(save-excursion
(forward-line 0)
(let ((end (point)) beg)
(goto-char compilation-filter-start)
(forward-line 0)
(setq beg (point))
;; Only operate on whole lines so we don't get caught with part of an
;; escape sequence in one chunk and the rest in another.
(when (< (point) end)
(setq end (copy-marker end))
;; Highlight ag matches and delete marking sequences.
(while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[[0-9]*m" end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face 'ag-match-face)
t t))
;; Delete all remaining escape sequences
(goto-char beg)
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
(replace-match "" t t)))))))
(defun ag/get-supported-types ()
"Query the ag executable for which file types it recognises."
(let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable)))
(lines (-map #'s-trim (s-lines ag-output)))
(types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines))
(extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines))))
(-zip types extensions)))
(defun ag/read-file-type ()
"Prompt the user for a known file type, or let them specify a PCRE regex."
(let* ((all-types-with-extensions (ag/get-supported-types))
(all-types (mapcar 'car all-types-with-extensions))
(file-type
(completing-read "Select file type: "
(append '("custom (provide a PCRE regex)") all-types)))
(file-type-extensions
(cdr (assoc file-type all-types-with-extensions))))
(if file-type-extensions
(list :file-type file-type)
(list :file-regex
(read-from-minibuffer "Filenames which match PCRE: "
(ag/buffer-extension-regex))))))
(provide 'ag)
;;; ag.el ends here

2
dotfiles/emacs.d/elpa/archives/melpa/archive-contents

File diff suppressed because one or more lines are too long

130
dotfiles/emacs.d/elpa/cider-20151022.28/cider-apropos.el

@ -0,0 +1,130 @@
;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Jeff Valk, Bozhidar Batsov
;;
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Apropos functionality for Clojure.
;;; Code:
(require 'cider-doc)
(require 'cider-util)
(require 'cider-compat)
(require 'cider-client)
(require 'cider-popup)
(require 'nrepl-client)
(require 'clojure-mode)
(require 'apropos)
(require 'button)
(defconst cider-apropos-buffer "*cider-apropos*")
(push cider-apropos-buffer cider-ancillary-buffers)
(defun cider-apropos-doc (button)
"Display documentation for the symbol represented at BUTTON."
(cider-doc-lookup (button-get button 'apropos-symbol)))
(defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p)
"Return a short description for the performed apropos search."
(concat (if case-sensitive-p "Case-sensitive " "")
(if docs-p "Documentation " "")
(format "Apropos for %S" query)
(if ns (format " in namespace %S" ns) "")
(if include-private-p
" (public and private symbols)"
" (public symbols only)")))
(defun cider-apropos-highlight (doc query)
"Return the DOC string propertized to highlight QUERY matches."
(let ((pos 0))
(while (string-match query doc pos)
(setq pos (match-end 0))
(put-text-property (match-beginning 0)
(match-end 0)
'font-lock-face apropos-match-face doc)))
doc)
(defun cider-apropos-result (result query docs-p)
"Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P."
(nrepl-dbind-response result (name type doc)
(let* ((label (capitalize (if (string= type "variable") "var" type)))
(help (concat "Display doc for this " (downcase label))))
(cider-propertize-region (list 'apropos-symbol name
'action 'cider-apropos-doc
'help-echo help)
(insert-text-button name 'type 'apropos-symbol)
(insert "\n ")
(insert-text-button label 'type (intern (concat "apropos-" type)))
(insert ": ")
(let ((beg (point)))
(if docs-p
(insert (cider-apropos-highlight doc query) "\n")
(insert doc)
(fill-region beg (point))))
(insert "\n")))))
(declare-function cider-mode "cider-mode")
(defun cider-show-apropos (summary results query docs-p)
"Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P."
(with-current-buffer (cider-popup-buffer cider-apropos-buffer t)
(let ((inhibit-read-only t))
(set-syntax-table clojure-mode-syntax-table)
(apropos-mode)
(cider-mode)
(if (boundp 'header-line-format)
(setq-local header-line-format summary)
(insert summary "\n\n"))
(dolist (result results)
(cider-apropos-result result query docs-p))
(goto-char (point-min)))))
;;;###autoload
(defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p)
"Show all symbols whose names match QUERY, a regular expression.
The search may be limited to the namespace NS, and may optionally search doc
strings, include private vars, and be case sensitive."
(interactive
(if current-prefix-arg
(list (read-string "Clojure Apropos: ")
(let ((ns (read-string "Namespace: ")))
(if (string= ns "") nil ns))
(y-or-n-p "Search doc strings? ")
(y-or-n-p "Include private symbols? ")
(y-or-n-p "Case-sensitive? "))
(list (read-string "Clojure Apropos: "))))
(cider-ensure-op-supported "apropos")
(if-let ((summary (cider-apropos-summary
query ns docs-p privates-p case-sensitive-p))
(results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))
(cider-show-apropos summary results query docs-p)
(message "No apropos matches for %S" query)))
;;;###autoload
(defun cider-apropos-documentation ()
"Shortcut for (cider-apropos <query> nil t)."
(interactive)
(cider-apropos (read-string "Clojure documentation Apropos: ") nil t))
(provide 'cider-apropos)

230
dotfiles/emacs.d/elpa/cider-20151022.28/cider-autoloads.el

@ -0,0 +1,230 @@
;;; cider-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "cider" "cider.el" (22059 18180 9650 974000))
;;; Generated autoloads from cider.el
(autoload 'cider-version "cider" "\
Display CIDER's version.
\(fn)" t nil)
(autoload 'cider-jack-in "cider" "\
Start a nREPL server for the current project and connect to it.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its
own buffer.
\(fn &optional PROMPT-PROJECT CLJS-TOO)" t nil)
(autoload 'cider-jack-in-clojurescript "cider" "\
Start a nREPL server and connect to it both Clojure and ClojureScript REPLs.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
\(fn &optional PROMPT-PROJECT)" t nil)
(autoload 'cider-connect "cider" "\
Connect to an nREPL server identified by HOST and PORT.
Create REPL buffer and start an nREPL client connection.
When the optional param PROJECT-DIR is present, the connection
gets associated with it.
\(fn HOST PORT &optional PROJECT-DIR)" t nil)
(eval-after-load 'clojure-mode '(progn (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect)))
;;;***
;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (22059 18179
;;;;;; 579650 971000))
;;; Generated autoloads from cider-apropos.el
(autoload 'cider-apropos "cider-apropos" "\
Show all symbols whose names match QUERY, a regular expression.
The search may be limited to the namespace NS, and may optionally search doc
strings, include private vars, and be case sensitive.
\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil)
(autoload 'cider-apropos-documentation "cider-apropos" "\
Shortcut for (cider-apropos <query> nil t).
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (22059
;;;;;; 18179 522984 304000))
;;; Generated autoloads from cider-browse-ns.el
(autoload 'cider-browse-ns "cider-browse-ns" "\
List all NAMESPACE's vars in BUFFER.
\(fn NAMESPACE)" t nil)
(autoload 'cider-browse-ns-all "cider-browse-ns" "\
List all loaded namespaces in BUFFER.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (22059
;;;;;; 18180 62984 307000))
;;; Generated autoloads from cider-classpath.el
(autoload 'cider-classpath "cider-classpath" "\
List all classpath entries.
\(fn)" t nil)
(autoload 'cider-open-classpath-entry "cider-classpath" "\
Open a classpath entry.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-debug" "cider-debug.el" (22059 18179
;;;;;; 556317 638000))
;;; Generated autoloads from cider-debug.el
(autoload 'cider-debug-defun-at-point "cider-debug" "\
Instrument the top-level expression at point.
If it is a defn, dispatch the instrumented definition. Otherwise,
immediately evaluate the instrumented expression.
While debugged code is being evaluated, the user is taken through the
source code and displayed the value of various expressions. At each step,
a number of keys will be prompted to the user.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (22059
;;;;;; 18179 832984 306000))
;;; Generated autoloads from cider-grimoire.el
(autoload 'cider-grimoire-web "cider-grimoire" "\
Open grimoire documentation in the default web browser.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates.
\(fn &optional ARG)" t nil)
(autoload 'cider-grimoire "cider-grimoire" "\
Open grimoire documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (22059
;;;;;; 18179 782984 305000))
;;; Generated autoloads from cider-inspector.el
(autoload 'cider-inspect "cider-inspector" "\
Eval the string EXPRESSION and inspect the result.
\(fn EXPRESSION)" t nil)
;;;***
;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el"
;;;;;; (22059 18179 959650 973000))
;;; Generated autoloads from cider-macroexpansion.el
(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\
Invoke 'macroexpand-1' on the expression preceding point.
If invoked with a PREFIX argument, use 'macroexpand' instead of
'macroexpand-1'.
\(fn &optional PREFIX)" t nil)
(autoload 'cider-macroexpand-all "cider-macroexpansion" "\
Invoke 'clojure.walk/macroexpand-all' on the expression preceding point.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-mode" "cider-mode.el" (22059 18179 656317
;;;;;; 637000))
;;; Generated autoloads from cider-mode.el
(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\
Mode line lighter for `cider-mode'.
The value of this variable is a mode line template as in
`mode-line-format'. See Info Node `(elisp)Mode Line Format' for
details about mode line templates.
Customize this variable to change how `cider-mode' displays its
status in the mode line. The default value displays the current connection.
Set this variable to nil to disable the mode line
entirely.")
(custom-autoload 'cider-mode-line "cider-mode" t)
(autoload 'cider-mode "cider-mode" "\
Minor mode for REPL interaction from a Clojure buffer.
\\{cider-mode-map}
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (22059 18179
;;;;;; 706317 637000))
;;; Generated autoloads from cider-scratch.el
(autoload 'cider-scratch "cider-scratch" "\
Create a scratch buffer.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-selector" "cider-selector.el" (22059
;;;;;; 18180 36317 640000))
;;; Generated autoloads from cider-selector.el
(autoload 'cider-selector "cider-selector" "\
Select a new buffer by type, indicated by a single character.
The user is prompted for a single character indicating the method by
which to choose a new buffer. The `?' character describes then
available methods. OTHER-WINDOW provides an optional target.
See `def-cider-selector-method' for defining new methods.
\(fn &optional OTHER-WINDOW)" t nil)
;;;***
;;;### (autoloads nil nil ("cider-client.el" "cider-common.el" "cider-compat.el"
;;;;;; "cider-doc.el" "cider-eldoc.el" "cider-interaction.el" "cider-overlays.el"
;;;;;; "cider-pkg.el" "cider-popup.el" "cider-repl.el" "cider-resolve.el"
;;;;;; "cider-stacktrace.el" "cider-test.el" "cider-util.el" "nrepl-client.el")
;;;;;; (22059 18180 158485 22000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; cider-autoloads.el ends here

150
dotfiles/emacs.d/elpa/cider-20151022.28/cider-browse-ns.el

@ -0,0 +1,150 @@
;;; cider-browse-ns.el --- CIDER namespace browser
;; Copyright © 2014-2015 John Andrews
;; Author: John Andrews <john.m.andrews@gmail.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; (cider-browse-ns)
;; Display a list of all vars in a namespace.
;; Pressing <enter> will take you to the cider-doc buffer for that var.
;; Pressing ^ will take you to a list of all namespaces (akin to dired mode)
;; (cider-browse-ns-all)
;; Explore clojure namespaces by browsing a list of all namespaces.
;; Pressing enter expands into a list of that namespace's vars as if by
;; executing the command (cider-browse-ns "my.ns")
;;; Code:
(require 'cider-repl)
(require 'cider-client)
(require 'cider-compat)
(defconst cider-browse-ns-buffer "*Browse NS*")
(defvar-local cider-browse-ns-current-ns nil)
;; Mode Definition
(defvar cider-browse-ns-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map "d" #'cider-browse-ns--doc-at-point)
(define-key map "s" #'cider-browse-ns--find-at-point)
(define-key map [return] #'cider-browse-ns--doc-at-point)
(define-key map "^" #'cider-browse-ns-all)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
map))
(defvar cider-browse-ns-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] #'cider-browse-ns--handle-mouse)
map))
(define-derived-mode cider-browse-ns-mode special-mode "browse-ns"
"Major mode for browsing Clojure namespaces.
\\{cider-browse-ns-mode-map}"
(set-syntax-table clojure-mode-syntax-table)
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t)
(setq-local cider-browse-ns-current-ns nil))
(defun cider-browse-ns--properties (text)
"Decorate TEXT with a clickable keymap and function face."
(propertize text
'font-lock-face 'font-lock-function-name-face
'mouse-face 'highlight
'keymap cider-browse-ns-mouse-map))
(defun cider-browse-ns--list (buffer title items &optional ns noerase)
"Reset contents of BUFFER. Then display TITLE at the top and ITEMS are indented underneath.
If NS is non-nil, it is added to each item as the
`cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the
contents of the buffer are not reset before inserting TITLE and ITEMS."
(with-current-buffer buffer
(cider-browse-ns-mode)
(let ((inhibit-read-only t))
(unless noerase (erase-buffer))
(goto-char (point-max))
(insert (propertize title 'font-lock-face 'font-lock-type-face)
"\n")
(dolist (item items)
(insert (propertize (concat " " item "\n")
'cider-browse-ns-current-ns ns)))
(goto-char (point-min)))))
;; Interactive Functions
;;;###autoload
(defun cider-browse-ns (namespace)
"List all NAMESPACE's vars in BUFFER."
(interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list))))
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(let ((vars (cider-sync-request:ns-vars namespace)))
(cider-browse-ns--list (current-buffer)
namespace
(mapcar (lambda (var)
(format "%s"
(cider-browse-ns--properties var)))
vars))
(setq-local cider-browse-ns-current-ns namespace))))
;;;###autoload
(defun cider-browse-ns-all ()
"List all loaded namespaces in BUFFER."
(interactive)
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(let ((names (cider-sync-request:ns-list)))
(cider-browse-ns--list (current-buffer)
"All loaded namespaces"
(mapcar (lambda (name)
(cider-browse-ns--properties name))
names))
(setq-local cider-browse-ns-current-ns nil))))
(defun cider-browse-ns--var-at-point ()
(let ((line (thing-at-point 'line)))
(when (string-match " +\\(.+\\)\n?" line)
(format "%s/%s"
(or (get-text-property (point) 'cider-browse-ns-current-ns)
cider-browse-ns-current-ns)
(match-string 1 line)))))
(defun cider-browse-ns--doc-at-point ()
"Expand browser according to thing at current point."
(interactive)
(when-let ((var (cider-browse-ns--var-at-point)))
(cider-doc-lookup var)))
(defun cider-browse-ns--find-at-point ()
(interactive)
(when-let ((var (cider-browse-ns--var-at-point)))
(cider-find-var current-prefix-arg var)))
(defun cider-browse-ns--handle-mouse (event)
"Handle mouse click EVENT."
(interactive "e")
(cider-browse-ns--doc-at-point))
(provide 'cider-browse-ns)
;;; cider-browse-ns.el ends here

106
dotfiles/emacs.d/elpa/cider-20151022.28/cider-classpath.el

@ -0,0 +1,106 @@
;;; cider-classpath.el --- Basic Java classpath browser
;; Copyright © 2014-2015 Bozhidar Batsov
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Basic Java classpath browser for CIDER.
;;; Code:
(require 'cider-client)
(require 'cider-popup)
(require 'cider-compat)
(defvar cider-classpath-buffer "*Classpath*")
(defvar cider-classpath-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map [return] #'cider-classpath-operate-on-point)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
map))
(defvar cider-classpath-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] #'cider-classpath-handle-mouse)
map))
(define-derived-mode cider-classpath-mode special-mode "classpath"
"Major mode for browsing the entries in Java's classpath.
\\{cider-classpath-mode-map}"
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t))
(defun cider-classpath-list (buffer items)
"Populate BUFFER with ITEMS."
(with-current-buffer buffer
(cider-classpath-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(dolist (item items)
(insert item "\n"))
(goto-char (point-min)))))
(defun cider-classpath-properties (text)
"Decorate TEXT with a clickable keymap and function face."
(let ((face (cond
((not (file-exists-p text)) 'font-lock-warning-face)
((file-directory-p text) 'dired-directory)
(t 'default))))
(propertize text
'font-lock-face face
'mouse-face 'highlight
'keymap cider-classpath-mouse-map)))
(defun cider-classpath-operate-on-point ()
"Expand browser according to thing at current point."
(interactive)
(let* ((bol (line-beginning-position))
(eol (line-end-position))
(line (buffer-substring-no-properties bol eol)))
(find-file-other-window line)))
(defun cider-classpath-handle-mouse (event)
"Handle mouse click EVENT."
(interactive "e")
(cider-classpath-operate-on-point))
;;;###autoload
(defun cider-classpath ()
"List all classpath entries."
(interactive)
(with-current-buffer (cider-popup-buffer cider-classpath-buffer t)
(cider-classpath-list (current-buffer)
(mapcar (lambda (name)
(cider-classpath-properties name))
(cider-sync-request:classpath)))))
;;;###autoload
(defun cider-open-classpath-entry ()
"Open a classpath entry."
(interactive)
(when-let ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath))))
(find-file-other-window entry)))
(provide 'cider-classpath)
;;; cider-classpath.el ends here

849
dotfiles/emacs.d/elpa/cider-20151022.28/cider-client.el

@ -0,0 +1,849 @@
;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*-
;; Copyright © 2013-2015 Bozhidar Batsov
;;
;; Author: Bozhidar Batsov <bozhidar@batsov.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; A layer of abstraction above the actual client code.
;;; Code:
(require 'spinner)
(require 'nrepl-client)
(require 'cider-common)
(require 'cider-compat)
(require 'seq)
;;; Connection Buffer Management
(defvar cider-connections nil
"A list of connections.")
(defun cider-connected-p ()
"Return t if CIDER is currently connected, nil otherwise."
(not (null (cider-connections))))
(defun cider-ensure-connected ()
"Ensure there is a cider connection present.
An error is signaled in the absence of a connection."
(unless (cider-connected-p)
(error "No active nREPL connections")))
(defsubst cider--in-connection-buffer-p ()
"Return non-nil if current buffer is connected to a server."
(and (derived-mode-p 'cider-repl-mode)
(process-live-p
(get-buffer-process (current-buffer)))))
(defun cider-default-connection (&optional no-error)
"The default (fallback) connection to use for nREPL interaction.
When NO-ERROR is non-nil, don't throw an error when no connection has been
found."
(or (car (cider-connections))
(unless no-error
(error "No nREPL connection buffer"))))
(define-obsolete-function-alias 'nrepl-current-connection-buffer 'cider-default-connection "0.10")
(defun cider-connections ()
"Return the list of connection buffers.
If the list is empty and buffer-local, return the global value."
(or (setq cider-connections
(seq-filter #'buffer-live-p cider-connections))
(when (local-variable-p 'cider-connect)
(kill-local-variable 'cider-connections)
(seq-filter #'buffer-live-p cider-connections))))
(defun cider-repl-buffers ()
"Return the list of REPL buffers."
(seq-filter
(lambda (buffer)
(with-current-buffer buffer (derived-mode-p 'cider-repl-mode)))
(buffer-list)))
(defun cider-make-connection-default (connection-buffer)
"Make the nREPL CONNECTION-BUFFER the default connection.
Moves CONNECTION-BUFFER to the front of `cider-connections'."
(interactive (list (if (cider--in-connection-buffer-p)
(current-buffer)
(user-error "Not in a REPL buffer"))))
;; maintain the connection list in most recently used order
(let ((buf (get-buffer connection-buffer)))
(setq cider-connections
(cons buf (delq buf cider-connections))))
(cider--connections-refresh))
(declare-function cider--close-buffer "cider-interaction")
(defun cider--close-connection-buffer (conn-buffer)
"Close CONN-BUFFER, removing it from `cider-connections'.
Also close associated REPL and server buffers."
(let ((buffer (get-buffer conn-buffer)))
(setq cider-connections
(delq buffer cider-connections))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when nrepl-tunnel-buffer
(cider--close-buffer nrepl-tunnel-buffer)))
;; If this is the only (or last) REPL connected to its server, the
;; kill-process hook will kill the server.
(cider--close-buffer buffer))))
;;; Current connection logic
(defvar-local cider-repl-type nil
"The type of this REPL buffer, usually either \"clj\" or \"cljs\".")
(defun cider-find-connection-buffer-for-project-directory (project-directory &optional all-connections)
"Return the most appropriate connection-buffer for the given PROJECT-DIRECTORY.
By order of preference, this is any connection whose directory matches
PROJECT-DIRECTORY, followed by any connection whose directory is nil,
followed by any connection at all.
Only return nil if `cider-connections' is empty (there are no connections).
If more than one connection satisfy a given level of preference, return the
connection buffer closer to the start of `cider-connections'. This is
usally the connection that was more recently created, but the order can be
changed. For instance, the function `cider-make-connection-default' can be
used to move a connection to the head of the list, so that it will take
precedence over other connections associated with the same project.
If ALL-CONNECTIONS is non-nil, the return value is a list and all matching
connections are returned, instead of just the most recent."
(let ((fn (if all-connections #'seq-filter #'seq-find)))
(or (funcall fn (lambda (conn)
(when-let ((conn-proj-dir (with-current-buffer conn
nrepl-project-dir)))
(equal (file-truename project-directory)
(file-truename conn-proj-dir))))
cider-connections)
(funcall fn (lambda (conn)
(with-current-buffer conn
(not nrepl-project-dir)))
cider-connections)
(if all-connections
cider-connections
(car cider-connections)))))
(defun cider-read-connection (prompt)
"Completing read for connections using PROMPT."
(get-buffer (completing-read prompt (mapcar #'buffer-name (cider-connections)))))
(defun cider-assoc-project-with-connection (&optional project connection)
"Associate a Clojure PROJECT with an nREPL CONNECTION.
Useful for connections created using `cider-connect', as for them
such a link cannot be established automatically."
(interactive)
(cider-ensure-connected)
(let ((conn-buf (or connection (cider-read-connection "Connection: ")))
(project-dir (or project (read-directory-name "Project directory: " nil (clojure-project-dir) nil (clojure-project-dir)))))
(when conn-buf
(with-current-buffer conn-buf
(setq nrepl-project-dir project-dir)))))
(defun cider-assoc-buffer-with-connection ()
"Associate the current buffer with a connection.
Useful for connections created using `cider-connect', as for them
such a link cannot be established automatically."
(interactive)
(cider-ensure-connected)
(let ((conn (cider-read-connection "Connection: ")))
(when conn
(setq-local cider-connections (list conn)))))
(defun cider-clear-buffer-local-connection ()
"Remove association between the current buffer and a connection."
(interactive)
(cider-ensure-connected)
(kill-local-variable 'cider-connections))
(defun cider-current-connection (&optional type)
"Return the REPL buffer relevant for the current Clojure source buffer.
A REPL is relevant if its `nrepl-project-dir' is compatible with the
current directory (see `cider-find-connection-buffer-for-project-directory').
If there is ambiguity, it is resolved by matching TYPE with the REPL
type (Clojure or ClojureScript). If TYPE is nil, it is derived from the
file extension."
;; Cleanup the connections list.
(cider-connections)
(cond
((cider--in-connection-buffer-p) (current-buffer))
((= 1 (length cider-connections)) (car cider-connections))
(t (let* ((project-directory (clojure-project-dir (cider-current-dir)))
(repls (and project-directory
(cider-find-connection-buffer-for-project-directory project-directory 'all))))
(if (= 1 (length repls))
;; Only one match, just return it.
(car repls)
;; OW, find one matching the extension of current file.
(let ((type (or type (file-name-extension (or (buffer-file-name) "")))))
(or (seq-find (lambda (conn)
(equal (with-current-buffer conn
(or cider-repl-type "clj"))
type))
(append repls cider-connections))
(car repls)
(car cider-connections))))))))
;;; Connection Browser
(defvar cider-connections-buffer-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "d" #'cider-connections-make-default)
(define-key map "g" #'cider-connection-browser)
(define-key map "k" #'cider-connections-close-connection)
(define-key map (kbd "RET") #'cider-connections-goto-connection)
(define-key map "?" #'describe-mode)
(define-key map "h" #'describe-mode)
map))
(declare-function cider-popup-buffer-mode "cider-popup")
(define-derived-mode cider-connections-buffer-mode cider-popup-buffer-mode
"CIDER Connections"
"CIDER Connections Buffer Mode.
\\{cider-connections-buffer-mode-map}
\\{cider-popup-buffer-mode-map}"
(setq-local truncate-lines t))
(defvar cider--connection-ewoc)
(defconst cider--connection-browser-buffer-name "*cider-connections*")
(defun cider-connection-browser ()
"Open a browser buffer for nREPL connections."
(interactive)
(if-let ((buffer (get-buffer cider--connection-browser-buffer-name)))
(progn
(cider--connections-refresh-buffer buffer)
(unless (get-buffer-window buffer)
(select-window (display-buffer buffer))))
(cider--setup-connection-browser)))
(define-obsolete-function-alias 'nrepl-connection-browser 'cider-connection-browser "0.10")
(defun cider--connections-refresh ()
"Refresh the connections buffer, if the buffer exists.
The connections buffer is determined by
`cider--connection-browser-buffer-name'"
(when-let ((buffer (get-buffer cider--connection-browser-buffer-name)))
(cider--connections-refresh-buffer buffer)))
(add-hook 'nrepl-disconnected-hook #'cider--connections-refresh)
(defun cider--connections-refresh-buffer (buffer)
"Refresh the connections BUFFER."
(cider--update-connections-display
(buffer-local-value 'cider--connection-ewoc buffer)
cider-connections))
(defun cider--setup-connection-browser ()
"Create a browser buffer for nREPL connections."
(with-current-buffer (get-buffer-create cider--connection-browser-buffer-name)
(let ((ewoc (ewoc-create
'cider--connection-pp
" REPL Host Port Project\n")))
(setq-local cider--connection-ewoc ewoc)
(cider--update-connections-display ewoc cider-connections)
(setq buffer-read-only t)
(cider-connections-buffer-mode)
(display-buffer (current-buffer)))))
(defun cider--connection-pp (connection)
"Print an nREPL CONNECTION to the current buffer."
(let* ((buffer-read-only nil)
(buffer (get-buffer connection))
(endpoint (buffer-local-value 'nrepl-endpoint buffer)))
(insert
(format "%s %-30s %-16s %5s %s%s"
(if (equal connection (car cider-connections)) "*" " ")
(buffer-name connection)
(car endpoint)
(prin1-to-string (cadr endpoint))
(or (cider--project-name
(buffer-local-value 'nrepl-project-dir buffer))
"")
(with-current-buffer buffer
(if cider-repl-type
(concat " " cider-repl-type)
""))))))
(defun cider--update-connections-display (ewoc connections)
"Update the connections EWOC to show CONNECTIONS."
(ewoc-filter ewoc (lambda (n) (member n connections)))
(let ((existing))
(ewoc-map (lambda (n) (setq existing (cons n existing))) ewoc)
(let ((added (seq-difference connections existing)))
(mapc (apply-partially 'ewoc-enter-last ewoc) added)
(save-excursion (ewoc-refresh ewoc)))))
(defun cider--ewoc-apply-at-point (f)
"Apply function F to the ewoc node at point.
F is a function of two arguments, the ewoc and the data at point."
(let* ((ewoc cider--connection-ewoc)
(node (and ewoc (ewoc-locate ewoc))))
(when node
(funcall f ewoc (ewoc-data node)))))
(defun cider-connections-make-default ()
"Make default the connection at point in the connection browser."
(interactive)
(save-excursion
(cider--ewoc-apply-at-point #'cider--connections-make-default)))
(defun cider--connections-make-default (ewoc data)
"Make the connection in EWOC specified by DATA default.
Refreshes EWOC."
(interactive)
(cider-make-connection-default data)
(ewoc-refresh ewoc))
(defun cider-connections-close-connection ()
"Close connection at point in the connection browser."
(interactive)
(cider--ewoc-apply-at-point #'cider--connections-close-connection))
(defun cider--connections-close-connection (ewoc data)
"Close the connection in EWOC specified by DATA."
(cider--close-connection-buffer (get-buffer data))
(cider--update-connections-display ewoc cider-connections))
(defun cider-connections-goto-connection ()
"Goto connection at point in the connection browser."
(interactive)
(cider--ewoc-apply-at-point #'cider--connections-goto-connection))
(defun cider--connections-goto-connection (_ewoc data)
"Goto the REPL for the connection in _EWOC specified by DATA."
(when (buffer-live-p data)
(select-window (display-buffer data))))
(defun cider-display-connected-message ()
"Message displayed on successful connection."
(message "Connected. %s" (cider-random-words-of-inspiration)))
;; TODO: Replace direct usage of such hooks with CIDER hooks,
;; that are connection type independent
(add-hook 'nrepl-connected-hook 'cider-display-connected-message)
;;; Evaluation helpers
(defun cider-ns-form-p (form)
"Check if FORM is an ns form."
(string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form))
(defvar-local cider-buffer-ns nil
"Current Clojure namespace of some buffer.
Useful for special buffers (e.g. REPL, doc buffers) that have to
keep track of a namespace.
This should never be set in Clojure buffers, as there the namespace
should be extracted from the buffer's ns form.")
(defun cider-current-ns ()
"Return the current ns.
The ns is extracted from the ns form for Clojure buffers and from
`cider-buffer-ns' for all other buffers. If it's missing, use the current
REPL's ns, otherwise fall back to \"user\"."
(or cider-buffer-ns
(clojure-find-ns)
(when-let ((repl-buf (cider-current-connection)))
(buffer-local-value 'cider-buffer-ns repl-buf))
"user"))
(define-obsolete-function-alias 'cider-eval 'nrepl-request:eval "0.9")
(defun cider-nrepl-op-supported-p (op)
"Check whether the current connection supports the nREPL middleware OP."
(nrepl-op-supported-p op (cider-current-connection)))
(defvar cider-version)
(defun cider-ensure-op-supported (op)
"Check for support of middleware op OP.
Signal an error if it is not supported."
(unless (cider-nrepl-op-supported-p op)
(error "Can't find nREPL middleware providing op \"%s\". Please, install (or update) cider-nrepl %s and restart CIDER" op (upcase cider-version))))
(defun cider-nrepl-send-request (request callback)
"Send REQUEST and register response handler CALLBACK.
REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
\"par1\" ... ).
Return the id of the sent message."
(nrepl-send-request request callback (cider-current-connection)))
(defun cider-nrepl-send-sync-request (request &optional abort-on-input)
"Send REQUEST to the nREPL server synchronously.
Hold till final \"done\" message has arrived and join all response messages
of the same \"op\" that came along and return the accumulated response.
If ABORT-ON-INPUT is non-nil, the function will return nil
at the first sign of user input, so as not to hang the
interface."
(nrepl-send-sync-request request (cider-current-connection) abort-on-input))
(defun cider-nrepl-send-unhandled-request (request)
"Send REQUEST to the nREPL server and ignore any responses.
Immediately mark the REQUEST as done.
Return the id of the sent message."
(let* ((conn (cider-current-connection))
(id (nrepl-send-request request #'ignore conn)))
(with-current-buffer conn
(nrepl--mark-id-completed id))
id))
(defun cider-nrepl-request:eval (input callback &optional ns point)
"Send the request INPUT and register the CALLBACK as the response handler.
If NS is non-nil, include it in the request. POINT, if non-nil, is the
position of INPUT in its buffer."
(nrepl-request:eval input
callback
(cider-current-connection)
(cider-current-session)
ns
point))
(defun cider-nrepl-sync-request:eval (input &optional ns)
"Send the INPUT to the nREPL server synchronously.
If NS is non-nil, include it in the request."
(nrepl-sync-request:eval
input
(cider-current-connection)
(cider-current-session)
ns))
(defun cider--nrepl-pprint-eval-request (input session &optional ns right-margin)
"Prepare :pprint-eval request message for INPUT.
SESSION and NS are used for the context of the evaluation.
RIGHT-MARGIN specifies the maximum column-width of the pretty-printed
result, and is included in the request if non-nil."
(append (list "pprint" "true")
(and right-margin (list "right-margin" right-margin))
(nrepl--eval-request input session ns)))
(defun cider-nrepl-request:pprint-eval (input callback &optional ns right-margin)
"Send the request INPUT and register the CALLBACK as the response handler.
The request is dispatched via CONNECTION and SESSION.
If NS is non-nil, include it in the request.
RIGHT-MARGIN specifies the maximum column width of the
pretty-printed result, and is included in the request if non-nil."
(cider-nrepl-send-request
(cider--nrepl-pprint-eval-request input (cider-current-session) ns right-margin)
callback))
(defun cider-tooling-eval (input callback &optional ns)
"Send the request INPUT and register the CALLBACK as the response handler.
NS specifies the namespace in which to evaluate the request."
;; namespace forms are always evaluated in the "user" namespace
(nrepl-request:eval input
callback
(cider-current-connection)
(cider-current-tooling-session)
ns))
(defalias 'cider-current-repl-buffer #'cider-current-connection
"The current REPL buffer.
Return the REPL buffer given by `cider-current-connection'.")
(declare-function cider-interrupt-handler "cider-interaction")
(defun cider-interrupt ()
"Interrupt any pending evaluations."
(interactive)
(with-current-buffer (cider-current-connection)
(let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests)))
(dolist (request-id pending-request-ids)
(nrepl-request:interrupt
request-id
(cider-interrupt-handler (current-buffer))
(cider-current-connection)
(cider-current-session))))))
(defun cider-current-session ()
"The REPL session to use for this buffer."
(with-current-buffer (cider-current-connection)
nrepl-session))
(define-obsolete-function-alias 'nrepl-current-session 'cider-current-session "0.10")
(defun cider-current-tooling-session ()
"Return the current tooling session."
(with-current-buffer (cider-current-connection)
nrepl-tooling-session))
(define-obsolete-function-alias 'nrepl-current-tooling-session 'cider-current-tooling-session "0.10")
(defun cider--var-choice (var-info)
"Prompt to choose from among multiple VAR-INFO candidates, if required.
This is needed only when the symbol queried is an unqualified host platform
method, and multiple classes have a so-named member. If VAR-INFO does not
contain a `candidates' key, it is returned as is."
(let ((candidates (nrepl-dict-get var-info "candidates")))
(if candidates
(let* ((classes (nrepl-dict-keys candidates))
(choice (completing-read "Member in class: " classes nil t))
(info (nrepl-dict-get candidates choice)))
info)
var-info)))
(defun cider-var-info (var &optional all)
"Return VAR's info as an alist with list cdrs.
When multiple matching vars are returned you'll be prompted to select one,
unless ALL is truthy."
(when (and var (not (string= var "")))
(let ((var-info (cider-sync-request:info var)))
(if all var-info (cider--var-choice var-info)))))
(defun cider-member-info (class member)
"Return the CLASS MEMBER's info as an alist with list cdrs."
(when (and class member)
(cider-sync-request:info nil class member)))
(defun cider--find-var-other-window (var &optional line)
"Find the definition of VAR, optionally at a specific LINE.
Display the results in a different window."
(if-let ((info (cider-var-info var)))
(progn
(if line (setq info (nrepl-dict-put info "line" line)))
(cider--jump-to-loc-from-info info t))
(user-error "Symbol %s not resolved" var)))
(defun cider--find-var (var &optional line)
"Find the definition of VAR, optionally at a specific LINE."
(if-let ((info (cider-var-info var)))
(progn
(if line (setq info (nrepl-dict-put info "line" line)))
(cider--jump-to-loc-from-info info))
(user-error "Symbol %s not resolved" var)))
(defun cider-find-var (&optional arg var line)
"Find definition for VAR at LINE.
Prompt according to prefix ARG and `cider-prompt-for-symbol'.
A single or double prefix argument inverts the meaning of
`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes
the results to be displayed in a different window. The default value is
thing at point."
(interactive "P")
(cider-ensure-op-supported "info")
(if var
(cider--find-var var line)
(funcall (cider-prompt-for-symbol-function arg)
"Symbol"
(if (cider--open-other-window-p arg)
#'cider--find-var-other-window
#'cider--find-var))))
;;; Requests
(declare-function cider-load-file-handler "cider-interaction")
(defun cider-request:load-file (file-contents file-path file-name &optional callback)
"Perform the nREPL \"load-file\" op.
FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be
loaded. If CALLBACK is nil, use `cider-load-file-handler'."
(cider-nrepl-send-request (list "op" "load-file"
"session" (cider-current-session)
"file" file-contents
"file-path" file-path
"file-name" file-name)
(or callback
(cider-load-file-handler (current-buffer)))))
;;; Sync Requests
(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p)
"Send \"apropos\" op with args SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P."
(thread-first `("op" "apropos"
"ns" ,(cider-current-ns)
"query" ,query
,@(when search-ns `("search-ns" ,search-ns))
,@(when docs-p '("docs?" "t"))
,@(when privates-p '("privates?" "t"))
,@(when case-sensitive-p '("case-sensitive?" "t")))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "apropos-matches")))
(defun cider-sync-request:classpath ()
"Return a list of classpath entries."
(cider-ensure-op-supported "classpath")
(thread-first (list "op" "classpath"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "classpath")))
(defun cider-sync-request:complete (str context)
"Return a list of completions for STR using nREPL's \"complete\" op."
(when-let ((dict (thread-first (list "op" "complete"
"session" (cider-current-session)
"ns" (cider-current-ns)
"symbol" str
"context" context)
(cider-nrepl-send-sync-request 'abort-on-input))))
(nrepl-dict-get dict "completions")))
(defun cider-sync-request:info (symbol &optional class member)
"Send \"info\" op with parameters SYMBOL or CLASS and MEMBER."
(let ((var-info (thread-first `("op" "info"
"session" ,(cider-current-session)
"ns" ,(cider-current-ns)
,@(when symbol (list "symbol" symbol))
,@(when class (list "class" class))
,@(when member (list "member" member)))
(cider-nrepl-send-sync-request))))
(if (member "no-info" (nrepl-dict-get var-info "status"))
nil
var-info)))
(defun cider-sync-request:eldoc (symbol &optional class member)
"Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER."
(when-let ((eldoc (thread-first `("op" "eldoc"
"session" ,(cider-current-session)
"ns" ,(cider-current-ns)
,@(when symbol (list "symbol" symbol))
,@(when class (list "class" class))
,@(when member (list "member" member)))
(cider-nrepl-send-sync-request 'abort-on-input))))
(if (member "no-eldoc" (nrepl-dict-get eldoc "status"))
nil
eldoc)))
(defun cider-sync-request:ns-list ()
"Get a list of the available namespaces."
(thread-first (list "op" "ns-list"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "ns-list")))
(defun cider-sync-request:ns-vars (ns)
"Get a list of the vars in NS."
(thread-first (list "op" "ns-vars"
"session" (cider-current-session)
"ns" ns)
(cider-nrepl-send-sync-request)
(nrepl-dict-get "ns-vars")))
(defun cider-sync-request:resource (name)
"Perform nREPL \"resource\" op with resource name NAME."
(thread-first (list "op" "resource"
"name" name)
(cider-nrepl-send-sync-request)
(nrepl-dict-get "resource-path")))
(defun cider-sync-request:resources-list ()
"Perform nREPL \"resource\" op with resource name NAME."
(thread-first (list "op" "resources-list")
(cider-nrepl-send-sync-request)
(nrepl-dict-get "resources-list")))
(defun cider-sync-request:format-code (code)
"Perform nREPL \"format-code\" op with CODE."
(thread-first (list "op" "format-code"
"code" code)
(cider-nrepl-send-sync-request)
(nrepl-dict-get "formatted-code")))
(defun cider-sync-request:format-edn (edn &optional right-margin)
"Perform \"format-edn\" op with EDN and RIGHT-MARGIN."
(let* ((response (thread-first (list "op" "format-edn"
"edn" edn)
(append (and right-margin (list "right-margin" right-margin)))
(cider-nrepl-send-sync-request)))
(err (nrepl-dict-get response "err")))
(when err
;; err will be a stacktrace with a first line that looks like:
;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]"
(error (car (split-string err "\n"))))
(nrepl-dict-get response "formatted-edn")))
;;; Eval spinner
(defcustom cider-eval-spinner-type 'progress-bar
"Appearance of the evaluation spinner.
Value is a symbol. The possible values are the symbols in the
`spinner-types' variable."
:type 'symbol
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-show-eval-spinner t
"When true, show the evaluation spinner in the mode line."
:type 'boolean
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-eval-spinner-delay 1
"Amount of time, in seconds, after which the evaluation spinner will be shown."
:type 'integer
:group 'cider
:package-version '(cider . "0.10.0"))
(defun cider-spinner-start ()
"Start the evaluation spinner.
Do nothing if `cider-show-eval-spinner' is nil."
(when cider-show-eval-spinner
(spinner-start cider-eval-spinner-type nil
cider-eval-spinner-delay)))
(defun cider-eval-spinner-handler (eval-buffer original-callback)
"Return a response handler that stops the spinner and calls ORIGINAL-CALLBACK.
EVAL-BUFFER is the buffer where the spinner was started."
(lambda (response)
;; buffer still exists and
;; we've got status "done" from nrepl
;; stop the spinner
(when (and (buffer-live-p eval-buffer)
(let ((status (nrepl-dict-get response "status")))
(or (member "done" status)
(member "eval-error" status)
(member "error" status))))
(with-current-buffer eval-buffer
(spinner-stop)))
(funcall original-callback response)))
;;; Connection info
(defun cider--java-version ()
"Retrieve the underlying connection's Java version."
(with-current-buffer (cider-current-connection "clj")
(when nrepl-versions
(thread-first nrepl-versions
(nrepl-dict-get "java")
(nrepl-dict-get "version-string")))))
(defun cider--clojure-version ()
"Retrieve the underlying connection's Clojure version."
(with-current-buffer (cider-current-connection "clj")
(when nrepl-versions
(thread-first nrepl-versions
(nrepl-dict-get "clojure")
(nrepl-dict-get "version-string")))))
(defun cider--nrepl-version ()
"Retrieve the underlying connection's nREPL version."
(with-current-buffer (cider-current-connection "clj")
(when nrepl-versions
(thread-first nrepl-versions
(nrepl-dict-get "nrepl")
(nrepl-dict-get "version-string")))))
(defun cider--connection-info (connection-buffer)
"Return info about CONNECTION-BUFFER.
Info contains project name, current REPL namespace, host:port
endpoint and Clojure version."
(with-current-buffer connection-buffer
(format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)"
(if cider-repl-type
(upcase (concat cider-repl-type " "))
"")
(or (cider--project-name nrepl-project-dir) "<no project>")
(car nrepl-endpoint)
(cadr nrepl-endpoint)
(cider--java-version)
(cider--clojure-version)
(cider--nrepl-version))))
(defun cider--connection-properties (conn-buffer)
"Extract the essential properties of CONN-BUFFER."
(with-current-buffer conn-buffer
(list
:host (car nrepl-endpoint)
:port (cadr nrepl-endpoint)
:project-dir nrepl-project-dir)))
(defun cider--connection-host (conn-buffer)
"Get CONN-BUFFER's host."
(plist-get (cider--connection-properties conn-buffer) :host))
(defun cider--connection-port (conn-buffer)
"Get CONN-BUFFER's port."
(plist-get (cider--connection-properties conn-buffer) :port))
(defun cider--connection-project-dir (conn-buffer)
"Get CONN-BUFFER's project dir."
(plist-get (cider--connection-properties conn-buffer) :project-dir))
(defun cider-display-connection-info (&optional show-default)
"Display information about the current connection.
With a prefix argument SHOW-DEFAULT it will display info about the
default connection."
(interactive "P")
(message "%s" (cider--connection-info (if show-default
(cider-default-connection)
(cider-current-connection)))))
(define-obsolete-function-alias 'cider-display-current-connection-info 'cider-display-connection-info "0.10")
(defun cider-rotate-default-connection ()
"Rotate and display the default nREPL connection."
(interactive)
(cider-ensure-connected)
(setq cider-connections
(append (cdr cider-connections)
(list (car cider-connections))))
(message "Default nREPL connection: %s"
(cider--connection-info (car cider-connections))))
(defun cider-replicate-connection (&optional conn)
"Establish a new connection based on an existing connection.
The new connection will use the same host and port.
If CONN is not provided the user will be prompted to select a connection."
(interactive)
(let* ((conn (or conn (cider-read-connection "Select connection to replicate: ")))
(host (cider--connection-host conn))
(port (cider--connection-port conn))
(project-dir (cider--connection-project-dir conn)))
(cider-connect host port project-dir)))
(define-obsolete-function-alias 'cider-rotate-connection 'cider-rotate-default-connection "0.10")
(defun cider-extract-designation-from-current-repl-buffer ()
"Extract the designation from the cider repl buffer name."
(let ((repl-buffer-name (buffer-name (cider-current-repl-buffer)))
(template (split-string nrepl-repl-buffer-name-template "%s")))
(string-match (format "^%s\\(.*\\)%s"
(regexp-quote (concat (car template) nrepl-buffer-name-separator))
(regexp-quote (cadr template)))
repl-buffer-name)
(or (match-string 1 repl-buffer-name) "<no designation>")))
(defun cider-change-buffers-designation ()
"Change the designation in cider buffer names.
Buffer names changed are cider-repl and nrepl-server."
(interactive)
(cider-ensure-connected)
(let* ((designation (read-string (format "Change CIDER buffer designation from '%s': "
(cider-extract-designation-from-current-repl-buffer))))
(new-repl-buffer-name (nrepl-format-buffer-name-template
nrepl-repl-buffer-name-template designation)))
(with-current-buffer (cider-current-repl-buffer)
(rename-buffer new-repl-buffer-name)
(when nrepl-server-buffer
(let ((new-server-buffer-name (nrepl-format-buffer-name-template
nrepl-server-buffer-name-template designation)))
(with-current-buffer nrepl-server-buffer
(rename-buffer new-server-buffer-name)))))
(message "CIDER buffer designation changed to: %s" designation)))
(provide 'cider-client)
;;; cider-client.el ends here

225
dotfiles/emacs.d/elpa/cider-20151022.28/cider-common.el

@ -0,0 +1,225 @@
;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Common functions that are useful in both Clojure buffers and REPL
;; buffers.
;;; Code:
(require 'cider-compat)
(require 'nrepl-client)
(require 'cider-util)
(defcustom cider-prompt-for-symbol t
"Controls when to prompt for symbol when a command requires one.
When non-nil, always prompt, and use the symbol at point as the default
value at the prompt.
When nil, attempt to use the symbol at point for the command, and only
prompt if that throws an error."
:type '(choice (const :tag "always" t)
(const :tag "dwim" nil))
:group 'cider
:package-version '(cider . "0.9.0"))
(defun cider--should-prompt-for-symbol (&optional invert)
(if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol))
(defun cider-prompt-for-symbol-function (&optional invert)
(if (cider--should-prompt-for-symbol invert)
#'cider-read-symbol-name
#'cider-try-symbol-at-point))
(defun cider--kw-to-symbol (kw)
"Convert the keyword KW to a symbol."
(when kw
(replace-regexp-in-string "\\`:+" "" kw)))
(declare-function cider-read-from-minibuffer "cider-interaction")
(defun cider-read-symbol-name (prompt callback)
"Read a symbol name using PROMPT with a default of the one at point.
Use CALLBACK as the completing read var callback."
(funcall callback (cider-read-from-minibuffer
prompt
;; if the thing at point is a keyword we treat it as symbol
(cider--kw-to-symbol (cider-symbol-at-point)))))
(defun cider-try-symbol-at-point (prompt callback)
"Call CALLBACK with symbol at point.
On failure, read a symbol name using PROMPT and call CALLBACK with that."
(condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point)))
('error (funcall callback (cider-read-from-minibuffer prompt)))))
(declare-function cider-jump-to "cider-interaction")
(defun cider--jump-to-loc-from-info (info &optional other-window)
"Jump to location give by INFO.
INFO object is returned by `cider-var-info' or `cider-member-info'.
OTHER-WINDOW is passed to `cider-jamp-to'."
(let* ((line (nrepl-dict-get info "line"))
(file (nrepl-dict-get info "file"))
(name (nrepl-dict-get info "name"))
(buffer (and file
(not (cider--tooling-file-p file))
(cider-find-file file))))
(if buffer
(cider-jump-to buffer (if line (cons line nil) name) other-window)
(error "No source location"))))
(declare-function url-filename "url-parse" (cl-x) t)
(defun cider--url-to-file (url)
"Return the filename from the resource URL.
Uses `url-generic-parse-url' to parse the url. The filename is extracted and
then url decoded. If the decoded filename has a Windows device letter followed
by a colon immediately after the leading '/' then the leading '/' is dropped to
create a valid path."
(let ((filename (url-unhex-string (url-filename (url-generic-parse-url url)))))
(if (string-match "^/\\([a-zA-Z]:/.*\\)" filename)
(match-string 1 filename)
filename)))
(defun cider-tramp-prefix (&optional buffer)
"Use the filename for BUFFER to determine a tramp prefix.
Defaults to the current buffer.
Return the tramp prefix, or nil if BUFFER is local."
(let* ((buffer (or buffer (current-buffer)))
(name (or (buffer-file-name buffer)
(with-current-buffer buffer
default-directory))))
(when (tramp-tramp-file-p name)
(let ((vec (tramp-dissect-file-name name)))
(tramp-make-tramp-file-name (tramp-file-name-method vec)
(tramp-file-name-user vec)
(tramp-file-name-host vec)
nil)))))
(defun cider--client-tramp-filename (name &optional buffer)
"Return the tramp filename for path NAME relative to BUFFER.
If BUFFER has a tramp prefix, it will be added as a prefix to NAME.
If the resulting path is an existing tramp file, it returns the path,
otherwise, nil."
(let* ((buffer (or buffer (current-buffer)))
(name (concat (cider-tramp-prefix buffer) name)))
(if (tramp-handle-file-exists-p name)
name)))
(defun cider--server-filename (name)
"Return the nREPL server-relative filename for NAME."
(if (tramp-tramp-file-p name)
(with-parsed-tramp-file-name name nil
localname)
name))
(defvar cider-from-nrepl-filename-function
(with-no-warnings
(if (eq system-type 'cygwin)
#'cygwin-convert-file-name-from-windows
#'identity))
"Function to translate nREPL namestrings to Emacs filenames.")
(defcustom cider-prefer-local-resources nil
"Prefer local resources to remote (tramp) ones when both are available."
:type 'boolean
:group 'cider)
(defun cider--file-path (path)
"Return PATH's local or tramp path using `cider-prefer-local-resources'.
If no local or remote file exists, return nil."
(let* ((local-path (funcall cider-from-nrepl-filename-function path))
(tramp-path (and local-path (cider--client-tramp-filename local-path))))
(cond ((equal local-path "") "")
((and cider-prefer-local-resources (file-exists-p local-path))
local-path)
((and tramp-path (file-exists-p tramp-path))
tramp-path)
((and local-path (file-exists-p local-path))
local-path))))
(declare-function archive-extract "arc-mode")
(declare-function archive-zip-extract "arc-mode")
(defun cider-find-file (url)
"Return a buffer visiting the file URL if it exists, or nil otherwise.
If URL has a scheme prefix, it must represent a fully-qualified file path
or an entry within a zip/jar archive. If URL doesn't contain a scheme
prefix and is an absolute path, it is treated as such. Finally, if URL is
relative, it is expanded within each of the open Clojure buffers till an
existing file ending with URL has been found."
(require 'arc-mode)
(cond ((string-match "^file:\\(.+\\)" url)
(when-let ((file (cider--url-to-file (match-string 1 url)))
(path (cider--file-path file)))
(find-file-noselect path)))
((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url)
(when-let ((entry (match-string 3 url))
(file (cider--url-to-file (match-string 2 url)))
(path (cider--file-path file))
(name (format "%s:%s" path entry)))
(or (find-buffer-visiting name)
(if (tramp-tramp-file-p path)
(progn
;; Use emacs built in archiving
(find-file path)
(goto-char (point-min))
;; Make sure the file path is followed by a newline to
;; prevent eg. clj matching cljs.
(search-forward (concat entry "\n"))
;; moves up to matching line
(forward-line -1)
(archive-extract)
(current-buffer))
;; Use external zip program to just extract the single file
(with-current-buffer (generate-new-buffer
(file-name-nondirectory entry))
(archive-zip-extract path entry)
(set-visited-file-name name)
(setq-local default-directory (file-name-directory path))
(setq-local buffer-read-only t)
(set-buffer-modified-p nil)
(set-auto-mode)
(current-buffer))))))
(t (if-let ((path (cider--file-path url)))
(find-file-noselect path)
(unless (file-name-absolute-p url)
(let ((cider-buffers (cider-util--clojure-buffers))
(url (file-name-nondirectory url)))
(or (cl-loop for bf in cider-buffers
for path = (with-current-buffer bf
(expand-file-name url))
if (and path (file-exists-p path))
return (find-file-noselect path))
(cl-loop for bf in cider-buffers
if (string= (buffer-name bf) url)
return bf))))))))
(defun cider--open-other-window-p (arg)
"Test prefix value ARG to see if it indicates displaying results in other window."
(let ((narg (prefix-numeric-value arg)))
(pcase narg
(-1 t) ; -
(16 t) ; empty empty
(_ nil))))
(provide 'cider-common)
;;; cider-common.el ends here

157
dotfiles/emacs.d/elpa/cider-20151022.28/cider-compat.el

@ -0,0 +1,157 @@
;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Pretty much everything here's copied from subr-x for compatibility with
;; Emacs 24.3 and 24.4.
;;; Code:
(eval-and-compile
(unless (fboundp 'thread-first )
(defmacro internal--thread-argument (first? &rest forms)
"Internal implementation for `thread-first' and `thread-last'.
When Argument FIRST? is non-nil argument is threaded first, else
last. FORMS are the expressions to be threaded."
(pcase forms
(`(,x (,f . ,args) . ,rest)
`(internal--thread-argument
,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
(`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
(_ (car forms))))
(defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
`(internal--thread-argument t ,@forms)))
(unless (fboundp 'thread-last )
(defmacro thread-last (&rest forms)
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
(declare (indent 1) (debug thread-first))
`(internal--thread-argument nil ,@forms))))
(eval-and-compile
(unless (fboundp 'internal--listify)
(defsubst internal--listify (elt)
"Wrap ELT in a list if it is not one."
(if (not (listp elt))
(list elt)
elt)))
(unless (fboundp 'internal--check-binding)
(defsubst internal--check-binding (binding)
"Check BINDING is properly formed."
(when (> (length binding) 2)
(signal
'error
(cons "`let' bindings can have only one value-form" binding)))
binding))
(unless (fboundp 'internal--build-binding-value-form)
(defsubst internal--build-binding-value-form (binding prev-var)
"Build the conditional value form for BINDING using PREV-VAR."
`(,(car binding) (and ,prev-var ,(cadr binding)))))
(unless (fboundp ' internal--build-binding)
(defun internal--build-binding (binding prev-var)
"Check and build a single BINDING with PREV-VAR."
(thread-first
binding
internal--listify
internal--check-binding
(internal--build-binding-value-form prev-var))))
(unless (fboundp ' internal--build-bindings)
(defun internal--build-bindings (bindings)
"Check and build conditional value forms for BINDINGS."
(let ((prev-var t))
(mapcar (lambda (binding)
(let ((binding (internal--build-binding binding prev-var)))
(setq prev-var (car binding))
binding))
bindings)))))
(eval-and-compile
(unless (fboundp 'if-let)
(defmacro if-let (bindings then &rest else)
"Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in THEN, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 2)
(debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
(when (and (<= (length bindings) 2)
(not (listp (car bindings))))
;; Adjust the single binding case
(setq bindings (list bindings)))
`(let* ,(internal--build-bindings bindings)
(if ,(car (internal--listify (car (last bindings))))
,then
,@else)))
(defmacro when-let (bindings &rest body)
"Process BINDINGS and if all values are non-nil eval BODY.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in BODY, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 1) (debug if-let))
(list 'if-let bindings (macroexp-progn body)))))
(provide 'cider-compat)
;;; cider-compat.el ends here

533
dotfiles/emacs.d/elpa/cider-20151022.28/cider-debug.el

@ -0,0 +1,533 @@
;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*-
;; Copyright © 2015 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Instrument code with `cider-debug-defun-at-point', and when the code is
;; executed cider-debug will kick in. See this function's doc for more
;; information.
;;; Code:
(require 'nrepl-client)
(require 'cider-interaction)
(require 'cider-client)
(require 'cider-util)
(require 'cider-inspector)
(require 'cider-browse-ns)
(require 'cider-common)
(require 'cider-compat)
(require 'seq)
(require 'spinner)
;;; Customization
(defgroup cider-debug nil
"Presentation and behaviour of the cider debugger."
:prefix "cider-debug-"
:group 'cider
:package-version '(cider . "0.10.0"))
(defface cider-debug-code-overlay-face
'((((class color) (background light)) :background "grey80")
(((class color) (background dark)) :background "grey30"))
"Face used to mark code being debugged."
:group 'cider-debug
:package-version '(cider . "0.9.1"))
(defface cider-debug-prompt-face
'((t :underline t :inherit font-lock-builtin-face))
"Face used to highlight keys in the debug prompt."
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defface cider-instrumented-face
'((t :box (:color "red" :line-width -1)))
"Face used to mark code being debugged."
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defcustom cider-debug-prompt 'overlay
"If and where to show the keys while debugging.
If `minibuffer', show it in the minibuffer along with the return value.
If `overlay', show it in an overlay above the current function.
If t, do both.
If nil, don't list available keys at all."
:type '(choice (const :tag "Show in minibuffer" minibuffer)
(const :tag "Show above function" overlay)
(const :tag "Show in both places" t)
(const :tag "Don't list keys" nil))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defcustom cider-debug-use-overlays t
"Whether to higlight debugging information with overlays.
Takes the same possible values as `cider-use-overlays', but only applies to
values displayed during debugging sessions.
To control the overlay that lists possible keys above the current function,
configure `cider-debug-prompt' instead."
:type '(choice (const :tag "End of line" t)
(const :tag "Bottom of screen" nil)
(const :tag "Both" both))
:group 'cider-debug
:package-version '(cider . "0.9.1"))
(defcustom cider-debug-print-level 10
"print-level for values displayed by the debugger.
This variable must be set before starting the repl connection."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max depth" 10))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defcustom cider-debug-print-length 10
"print-length for values displayed by the debugger.
This variable must be set before starting the repl connection."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max depth" 10))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
;;; Implementation
(defun cider-browse-instrumented-defs ()
"List all instrumented definitions."
(interactive)
(if-let ((all (thread-first (cider-nrepl-send-sync-request (list "op" "debug-instrumented-defs"))
(nrepl-dict-get "list"))))
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(let ((inhibit-read-only t))
(erase-buffer)
(dolist (list all)
(let ((ns (car list)))
(cider-browse-ns--list (current-buffer) ns
(mapcar #'cider-browse-ns--properties (cdr list))
ns 'noerase)
(goto-char (point-max))
(insert "\n"))))
(goto-char (point-min)))
(message "No currently instrumented definitions")))
(defun cider--debug-response-handler (response)
"Handle responses from the cider.debug middleware."
(nrepl-dbind-response response (status id causes)
(when (member "eval-error" status)
(cider--render-stacktrace-causes causes))
(when (member "need-debug-input" status)
(cider--handle-debug response))
(when (member "done" status)
(nrepl--mark-id-completed id))))
(defun cider--debug-init-connection ()
"Initialize a connection with the cider.debug middleware."
(cider-nrepl-send-request
(append '("op" "init-debugger")
(when cider-debug-print-level
(list "print-level" cider-debug-print-level))
(when cider-debug-print-length
(list "print-length" cider-debug-print-length)))
#'cider--debug-response-handler))
;;; Debugging overlays
(defconst cider--fringe-arrow-string
#("." 0 1 (display (left-fringe right-triangle)))
"Used as an overlay's before-string prop to place a fringe arrow.")
(defun cider--debug-display-result-overlay (value)
"Place an overlay at point displaying VALUE."
(when cider-debug-use-overlays
;; This is cosmetic, let's ensure it doesn't break the session no matter what.
(ignore-errors
;; Result
(cider--make-result-overlay (cider-font-lock-as-clojure value)
:where (point-marker)
:type 'debug-result
'before-string cider--fringe-arrow-string)
;; Code
(cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point))
(point) 'debug-code
'face 'cider-debug-code-overlay-face
;; Higher priority than `show-paren'.
'priority 2000))))
;;; Minor mode
(defvar-local cider--debug-mode-commands-alist nil
"Alist from keys to debug commands.
Autogenerated by `cider--turn-on-debug-mode'.")
(defvar-local cider--debug-mode-response nil
"Response that triggered current debug session.
Set by `cider--turn-on-debug-mode'.")
(defcustom cider-debug-display-locals nil
"If non-nil, local variables are displayed while debugging.
Can be toggled at any time with `\\[cider-debug-toggle-locals]'."
:type 'boolean
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defun cider--debug-format-locals-list (locals)
"Return a string description of list LOCALS.
Each element of LOCALS should be a list of at least two elements."
(if locals
(let ((left-col-width
;; To right-indent the variable names.
(apply #'max (mapcar (lambda (l) (string-width (car l))) locals))))
;; A format string to build a format string. :-P
(mapconcat (lambda (l) (format (format " %%%ds: %%s\n" left-col-width)
(propertize (car l) 'face 'font-lock-variable-name-face)
(cider-font-lock-as-clojure (cadr l))))
locals ""))
""))
(defun cider--debug-prompt (command-list)
"Return prompt to display for COMMAND-LIST."
(concat
(mapconcat (lambda (x) (put-text-property 0 1 'face 'cider-debug-prompt-face x) x)
;; `eval' is now integrated with things like `C-x C-e' and `C-c M-:'
;; so we don't advertise this key to reduce clutter.
;; `inspect' would conflict with `inject'.
(seq-difference command-list '("eval" "inspect")) " ")
"\n"))
(defvar-local cider--debug-prompt-overlay nil)
(defun cider--debug-mode-redisplay ()
"Display the input prompt to the user."
(nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals)
(when (or (eq cider-debug-prompt t)
(eq cider-debug-prompt 'overlay))
(if (overlayp cider--debug-prompt-overlay)
(overlay-put cider--debug-prompt-overlay
'before-string (cider--debug-prompt input-type))
(setq cider--debug-prompt-overlay
(cider--make-overlay
(max (cider-defun-at-point-start-pos)
(window-start))
nil 'debug-prompt
'before-string (cider--debug-prompt input-type)))))
(let* ((value (concat " " cider-eval-result-prefix
(cider-font-lock-as-clojure
(or debug-value "#unknown#"))))
(to-display
(concat (when cider-debug-display-locals
(cider--debug-format-locals-list locals))
(when (or (eq cider-debug-prompt t)
(eq cider-debug-prompt 'minibuffer))
(cider--debug-prompt input-type))
(when (or (not cider-debug-use-overlays)
(eq cider-debug-use-overlays 'both))
value))))
(if (> (string-width to-display) 0)
(message "%s" to-display)
;; If there's nothing to display in the minibuffer. Just send the value
;; to the Messages buffer.
(message "%s" value)
(message nil)))))
(defun cider-debug-toggle-locals ()
"Toggle display of local variables."
(interactive)
(setq cider-debug-display-locals (not cider-debug-display-locals))
(cider--debug-mode-redisplay))
(defun cider--debug-lexical-eval (key form &optional callback _point)
"Eval FORM in the lexical context of debug session given by KEY.
Do nothing if CALLBACK is provided.
Designed to be used as `cider-interactive-eval-override' and called instead
of `cider-interactive-eval' in debug sessions."
;; The debugger uses its own callback, so if the caller is passing a callback
;; we return nil and let `cider-interactive-eval' do its thing.
(unless callback
(cider-debug-mode-send-reply (format "{:response :eval, :code %s}" form)
key)
t))
(defvar cider--debug-mode-tool-bar-map
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "right-arrow" #'cider-debug-mode-send-reply :next :label "Next step")
(tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue non-stop")
(tool-bar-add-item "jump-to" #'cider-debug-mode-send-reply :out :label "Out of sexp")
(tool-bar-add-item "exit" #'cider-debug-mode-send-reply :quit :label "Quit")
tool-bar-map))
(defvar cider--debug-mode-map)
(define-minor-mode cider--debug-mode
"Mode active during debug sessions.
In order to work properly, this mode must be activated by
`cider--turn-on-debug-mode'."
nil " DEBUG" '()
(if cider--debug-mode
(if cider--debug-mode-response
(nrepl-dbind-response cider--debug-mode-response (input-type)
;; A debug session is an ongoing eval, but it's annoying to have the
;; spinner spinning while you debug.
(when spinner-current (spinner-stop))
(setq-local tool-bar-map cider--debug-mode-tool-bar-map)
(add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local)
(add-hook 'before-revert-hook #'cider--debug-quit nil 'local)
(unless (consp input-type)
(error "debug-mode activated on a message not asking for commands: %s" cider--debug-mode-response))
;; Integrate with eval commands.
(setq cider-interactive-eval-override
(apply-partially #'cider--debug-lexical-eval
(nrepl-dict-get cider--debug-mode-response "key")))
;; Set the keymap.
(let ((alist (mapcar (lambda (k) (cons (string-to-char k) (concat ":" k)))
(seq-difference input-type '("inspect")))))
(setq cider--debug-mode-commands-alist alist)
(dolist (it alist)
(define-key cider--debug-mode-map (vector (car it)) #'cider-debug-mode-send-reply)))
;; Show the prompt.
(cider--debug-mode-redisplay)
;; If a sync request is ongoing, the user can't act normally to
;; provide input, so we enter `recursive-edit'.
(when nrepl-ongoing-sync-request
(recursive-edit)))
(cider--debug-mode -1)
(if (called-interactively-p 'any)
(user-error (substitute-command-keys "Don't call this mode manually, use `\\[universal-argument] \\[cider-eval-defun-at-point]' instead"))
(error "Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first")))
(setq cider-interactive-eval-override nil)
(setq cider--debug-mode-commands-alist nil)
(setq cider--debug-mode-response nil)
;; We wait a moment before clearing overlays and the read-onlyness, so that
;; cider-nrepl has a chance to send the next message, and so that the user
;; doesn't accidentally hit `n' between two messages (thus editing the code).
(when-let ((proc (unless nrepl-ongoing-sync-request
(get-buffer-process (cider-current-connection)))))
(accept-process-output proc 0.5))
(unless cider--debug-mode
(setq buffer-read-only nil)
(cider--debug-remove-overlays (current-buffer)))
(when nrepl-ongoing-sync-request
(ignore-errors (exit-recursive-edit)))))
(defun cider--debug-remove-overlays (&optional buffer)
"Remove CIDER debug overlays from BUFFER if `cider--debug-mode' is nil."
(when (or (not buffer) (buffer-live-p buffer))
(with-current-buffer (or buffer (current-buffer))
(unless cider--debug-mode
(kill-local-variable 'tool-bar-map)
(remove-overlays nil nil 'cider-type 'debug-result)
(remove-overlays nil nil 'cider-type 'debug-code)
(setq cider--debug-prompt-overlay nil)
(remove-overlays nil nil 'cider-type 'debug-prompt)))))
(defun cider--debug-set-prompt (value)
"Set `cider-debug-prompt' to VALUE, then redisplay."
(setq cider-debug-prompt value)
(cider--debug-mode-redisplay))
(easy-menu-define cider-debug-mode-menu cider--debug-mode-map
"Menu for CIDER debug mode"
`("CIDER DEBUGGER"
["Next step" (cider-debug-mode-send-reply ":next") :keys "n"]
["Continue non-stop" (cider-debug-mode-send-reply ":continue") :keys "c"]
["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"]
["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"]
"--"
["Evaluate in current scope" (cider-debug-mode-send-reply ":eval") :keys "e"]
["Inject value" (cider-debug-mode-send-reply ":inject") :keys "i"]
["Inspect value" (cider-debug-mode-send-reply ":inspect")]
["Inspect local variables" (cider-debug-mode-send-reply ":locals") :keys "l"]
"--"
("Configure keys prompt"
["Don't show keys" (cider--debug-set-prompt nil) :style toggle :selected (eq cider-debug-prompt nil)]
["Show in minibuffer" (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)]
["Show above function" (cider--debug-set-prompt 'overlay) :style toggle :selected (eq cider-debug-prompt 'overlay)]
["Show in both places" (cider--debug-set-prompt t) :style toggle :selected (eq cider-debug-prompt t)]
"--"
["List locals" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals])
["Customize" (customize-group 'cider-debug)]))
(defun cider-debug-mode-send-reply (command &optional key)
"Reply to the message that started current bufer's debugging session.
COMMAND is sent as the input option. KEY can be provided to reply to a
specific message."
(interactive (list
(if (symbolp last-command-event)
(symbol-name last-command-event)
(cdr (assq last-command-event cider--debug-mode-commands-alist)))
nil))
(cider-nrepl-send-unhandled-request
(list "op" "debug-input" "input" (or command ":quit")
"key" (or key (nrepl-dict-get cider--debug-mode-response "key"))))
(ignore-errors (cider--debug-mode -1)))
(defun cider--debug-quit ()
"Send a :quit reply to the debugger. Used in hooks."
(when cider--debug-mode
(cider-debug-mode-send-reply ":quit")
(message "Quitting debug session")))
;;; Movement logic
(defconst cider--debug-buffer-format "*cider-debug %s*")
(defun cider--debug-trim-code (code)
(replace-regexp-in-string "\\`#\\(dbg\\|break\\) ?" "" code))
(defun cider--initialize-debug-buffer (code ns id)
"Create a new debugging buffer with CODE and namespace NS.
ID is the id of the message that instrumented CODE."
(let ((buffer-name (format cider--debug-buffer-format id)))
(if-let ((buffer (get-buffer buffer-name)))
(cider-popup-buffer-display buffer 'select)
(with-current-buffer (cider-popup-buffer buffer-name 'select
#'clojure-mode 'ancillary)
(setq cider-buffer-ns ns)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
(buffer-undo-list t))
(erase-buffer)
(insert
(format "%s" (cider--debug-trim-code code)))
(cider--font-lock-ensure)
(set-buffer-modified-p nil))))
(switch-to-buffer buffer-name)
(goto-char (point-min))))
(defun cider--debug-goto-keyval (key)
"Find KEY in current sexp or return nil."
(when-let ((limit (ignore-errors (save-excursion (up-list) (point)))))
(search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>")
limit 'noerror)))
(defun cider--debug-move-point (coordinates)
"Place point on POS in FILE, then navigate into the next sexp.
COORDINATES is a list of integers that specify how to navigate into the
sexp."
(condition-case-unless-debug nil
;; Navigate through sexps inside the sexp.
(let ((in-syntax-quote nil))
(while coordinates
(down-list)
;; Are we entering a syntax-quote?
(when (looking-back "`\\(#{\\|[{[(]\\)" (line-beginning-position))
;; If we are, this affects all nested structures until the next `~',
;; so we set this variable for all following steps in the loop.
(setq in-syntax-quote t))
(when in-syntax-quote
;; A `(. .) is read as (seq (concat (list .) (list .))). This pops
;; the `seq', since the real coordinates are inside the `concat'.
(pop coordinates)
;; Non-list seqs like `[] and `{} are read with
;; an extra (apply vector ...), so pop it too.
(unless (eq ?\( (char-before))
(pop coordinates)))
;; #(...) is read as (fn* ([] ...)), so we patch that here.
(when (looking-back "#(" (line-beginning-position))
(pop coordinates))
(if coordinates
(let ((next (pop coordinates)))
(when in-syntax-quote
;; We're inside the `concat' form, but we need to discard the
;; actual `concat' symbol from the coordinate.
(setq next (1- next)))
;; String coordinates are map keys.
(if (stringp next)
(cider--debug-goto-keyval next)
(clojure-forward-logical-sexp next)
(when in-syntax-quote
(clojure-forward-logical-sexp 1)
(forward-sexp -1)
;; Here a syntax-quote is ending.
(let ((match (when (looking-at "~@?")
(match-string 0))))
(when match
(setq in-syntax-quote nil))
;; A `~@' is read as the object itself, so we don't pop
;; anything.
(unless (equal "~@" match)
;; Anything else (including a `~') is read as a `list'
;; form inside the `concat', so we need to pop the list
;; from the coordinates.
(pop coordinates))))))
;; If that extra pop was the last coordinate, this represents the
;; entire #(...), so we should move back out.
(backward-up-list)))
;; Place point at the end of instrumented sexp.
(clojure-forward-logical-sexp 1))
;; Avoid throwing actual errors, since this happens on every breakpoint.
(error (message "Can't find instrumented sexp, did you edit the source?"))))
(defun cider--handle-debug (response)
"Handle debugging notification.
RESPONSE is a message received from the nrepl describing the input
needed. It is expected to contain at least \"key\", \"input-type\", and
\"prompt\", and possibly other entries depending on the input-type."
(nrepl-dbind-response response (debug-value key coor code file point ns original-id
input-type prompt inspect)
(condition-case-unless-debug e
(progn
(pcase input-type
("expression" (cider-debug-mode-send-reply (cider-read-from-minibuffer
(or prompt "Expression: "))
key))
((pred sequencep)
(when (or code (and file point))
;; We prefer in-source debugging.
(when (and file point)
(if-let ((buf (find-buffer-visiting file)))
(if-let ((win (get-buffer-window buf)))
(select-window win)
(pop-to-buffer buf))
(find-file file))
(goto-char point))
;; But we can create a temp buffer if that fails.
(unless (or (looking-at-p (regexp-quote code))
(looking-at-p (regexp-quote (cider--debug-trim-code code))))
(cider--initialize-debug-buffer code ns original-id))
(cider--debug-move-point coor))
;; The overlay code relies on window boundaries, but point could have been
;; moved outside the window by some other code. Redisplay here to ensure the
;; visible window includes point.
(redisplay)
(cider--debug-remove-overlays)
(when cider-debug-use-overlays
(cider--debug-display-result-overlay debug-value))
(setq cider--debug-mode-response response)
(cider--debug-mode 1)))
(when inspect
(cider-inspector--value-handler nil inspect)
(cider-inspector--done-handler (current-buffer))))
;; If something goes wrong, we send a "quit" or the session hangs.
(error (cider-debug-mode-send-reply ":quit" key)
(message "Error encountered while handling the debug message: %S" e)))))
;;; User commands
;;;###autoload
(defun cider-debug-defun-at-point ()
"Instrument the top-level expression at point.
If it is a defn, dispatch the instrumented definition. Otherwise,
immediately evaluate the instrumented expression.
While debugged code is being evaluated, the user is taken through the
source code and displayed the value of various expressions. At each step,
a number of keys will be prompted to the user."
(interactive)
(cider-eval-defun-at-point 'debug-it))
(provide 'cider-debug)
;;; cider-debug.el ends here

454
dotfiles/emacs.d/elpa/cider-20151022.28/cider-doc.el

@ -0,0 +1,454 @@
;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Jeff Valk
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Mode for formatting and presenting documentation
;;; Code:
(require 'cider-common)
(require 'cider-compat)
(require 'cider-util)
(require 'cider-popup)
(require 'cider-client)
(require 'cider-grimoire)
(require 'nrepl-client)
(require 'org-table)
(require 'button)
(require 'easymenu)
;;; Variables
(defgroup cider-doc nil
"Documentation for CIDER."
:prefix "cider-doc-"
:group 'cider)
(defvar cider-doc-map
(let (cider-doc-map)
(define-prefix-command 'cider-doc-map)
(define-key cider-doc-map (kbd "a") #'cider-apropos)
(define-key cider-doc-map (kbd "C-a") #'cider-apropos)
(define-key cider-doc-map (kbd "A") #'cider-apropos-documentation)
(define-key cider-doc-map (kbd "d") #'cider-doc)
(define-key cider-doc-map (kbd "C-d") #'cider-doc)
(define-key cider-doc-map (kbd "r") #'cider-grimoire)
(define-key cider-doc-map (kbd "C-r") #'cider-grimoire)
(define-key cider-doc-map (kbd "h") #'cider-grimoire-web)
(define-key cider-doc-map (kbd "j") #'cider-javadoc)
(define-key cider-doc-map (kbd "C-j") #'cider-javadoc)
cider-doc-map)
"CIDER documentation keymap.")
(defvar cider-doc-menu
'("Documentation ..."
["CiderDoc" cider-doc]
["JavaDoc in browser" cider-javadoc]
["Grimoire" cider-grimoire]
["Grimoire in browser" cider-grimoire-web]
["Search functions/vars" cider-apropos]
["Search documentation" cider-apropos-documentation])
"CIDER documentation submenu.")
;;; cider-docview-mode
(defgroup cider-docview-mode nil
"Formatting/fontifying documentation viewer."
:prefix "cider-docview-"
:group 'cider)
(defcustom cider-docview-fill-column fill-column
"Fill column for docstrings in doc buffer."
:type 'list
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
;; Faces
(defface cider-docview-emphasis-face
'((t (:inherit default :underline t)))
"Face for emphasized text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-strong-face
'((t (:inherit default :underline t :weight bold)))
"Face for strongly emphasized text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-literal-face
'((t (:inherit font-lock-string-face)))
"Face for literal text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-table-border-face
'((t (:inherit shadow)))
"Face for table borders"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
;; Colors & Theme Support
(defvar cider-docview-code-background-color
(cider-scale-background-color)
"Background color for code blocks.")
(defadvice enable-theme (after cider-docview-adapt-to-theme activate)
"When theme is changed, update `cider-docview-code-background-color'."
(setq cider-docview-code-background-color (cider-scale-background-color)))
;; Mode & key bindings
(defvar cider-docview-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" #'cider-popup-buffer-quit-function)
(define-key map "g" #'cider-docview-grimoire)
(define-key map "G" #'cider-docview-grimoire-web)
(define-key map "j" #'cider-docview-javadoc)
(define-key map "s" #'cider-docview-source)
(define-key map (kbd "<backtab>") #'backward-button)
(define-key map (kbd "TAB") #'forward-button)
(easy-menu-define cider-docview-mode-menu map
"Menu for CIDER's doc mode"
`("CiderDoc"
["Look up in Grimoire" cider-docview-grimoire]
["Look up in Grimoire (browser)" cider-docview-grimoire-web]
["JavaDoc in browser" cider-docview-javadoc]
["Jump to source" cider-docview-source]
"--"
["Quit" cider-popup-buffer-quit-function]
))
map))
(defvar cider-docview-symbol)
(defvar cider-docview-javadoc-url)
(defvar cider-docview-file)
(defvar cider-docview-line)
(define-derived-mode cider-docview-mode special-mode "Doc"
"Major mode for displaying CIDER documentation
\\{cider-docview-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil)
(setq-local cider-docview-symbol nil)
(setq-local cider-docview-javadoc-url nil)
(setq-local cider-docview-file nil)
(setq-local cider-docview-line nil))
;;; Interactive functions
(defun cider-docview-javadoc ()
"Open the Javadoc for the current class, if available."
(interactive)
(if cider-docview-javadoc-url
(browse-url cider-docview-javadoc-url)
(error "No Javadoc available for %s" cider-docview-symbol)))
(defun cider-javadoc-handler (symbol-name)
"Invoke the nREPL \"info\" op on SYMBOL-NAME if available."
(when symbol-name
(cider-ensure-op-supported "info")
(let* ((info (cider-var-info symbol-name))
(url (nrepl-dict-get info "javadoc")))
(if url
(browse-url url)
(user-error "No Javadoc available for %s" symbol-name)))))
(defun cider-javadoc (arg)
"Open Javadoc documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(funcall (cider-prompt-for-symbol-function arg)
"Javadoc for"
#'cider-javadoc-handler))
(declare-function cider-find-file "cider-common")
(declare-function cider-jump-to "cider-interaction")
(defun cider-docview-source ()
"Open the source for the current symbol, if available."
(interactive)
(if cider-docview-file
(if-let ((buffer (and (not (cider--tooling-file-p cider-docview-file))
(cider-find-file cider-docview-file))))
(cider-jump-to buffer (if cider-docview-line
(cons cider-docview-line nil)
cider-docview-symbol)
nil)
(user-error
(substitute-command-keys
"Can't find the source because it wasn't defined with `cider-eval-buffer'")))
(error "No source location for %s" cider-docview-symbol)))
(defvar cider-buffer-ns)
(declare-function cider-grimoire-lookup "cider-grimoire")
(defun cider-docview-grimoire ()
(interactive)
(if cider-buffer-ns
(cider-grimoire-lookup cider-docview-symbol)
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
(declare-function cider-grimoire-web-lookup "cider-grimoire")
(defun cider-docview-grimoire-web ()
(interactive)
(if cider-buffer-ns
(cider-grimoire-web-lookup cider-docview-symbol)
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
(defconst cider-doc-buffer "*cider-doc*")
(add-to-list 'cider-ancillary-buffers cider-doc-buffer)
(defun cider-create-doc-buffer (symbol)
"Populates *cider-doc* with the documentation for SYMBOL."
(when-let ((info (cider-var-info symbol)))
(cider-docview-render (cider-make-popup-buffer cider-doc-buffer) symbol info)))
(defun cider-doc-lookup (symbol)
"Look up documentation for SYMBOL."
(if-let ((buffer (cider-create-doc-buffer symbol)))
(cider-popup-buffer-display buffer t)
(user-error "Symbol %s not resolved" symbol)))
(defun cider-doc (&optional arg)
"Open Clojure documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(funcall (cider-prompt-for-symbol-function arg)
"Doc for"
#'cider-doc-lookup))
;;; Font Lock and Formatting
(defun cider-docview-fontify-code-blocks (buffer mode)
"Font lock BUFFER code blocks using MODE and remove markdown characters.
This processes the triple backtick GFM markdown extension. An overlay is used
to shade the background. Blocks are marked to be ignored by other fonification
and line wrap."
(with-current-buffer buffer
(save-excursion
(while (search-forward-regexp "```\n" nil t)
(replace-match "")
(let ((beg (point))
(bg `(:background ,cider-docview-code-background-color)))
(when (search-forward-regexp "```\n" nil t)
(replace-match "")
(cider-font-lock-region-as mode beg (point))
(overlay-put (make-overlay beg (point)) 'font-lock-face bg)
(put-text-property beg (point) 'block 'code)))))))
(defun cider-docview-fontify-literals (buffer)
"Font lock BUFFER literal text and remove backtick markdown characters.
Preformatted code text blocks are ignored."
(with-current-buffer buffer
(save-excursion
(while (search-forward "`" nil t)
(if (eq (get-text-property (point) 'block) 'code)
(forward-char)
(progn
(replace-match "")
(let ((beg (point)))
(when (search-forward "`" (line-end-position) t)
(replace-match "")
(put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face)))))))))
(defun cider-docview-fontify-emphasis (buffer)
"Font lock BUFFER emphasized text and remove markdown characters.
One '*' represents emphasis, multiple '**'s represent strong emphasis.
Preformatted code text blocks are ignored."
(with-current-buffer buffer
(save-excursion
(while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t)
(if (eq (get-text-property (point) 'block) 'code)
(forward-char)
(progn
(replace-match "\\2")
(let ((beg (1- (point)))
(face (if (> (length (match-string 1)) 1)
'cider-docview-strong-face
'cider-docview-emphasis-face)))
(when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t)
(replace-match "\\1")
(put-text-property beg (point) 'font-lock-face face)))))))))
(defun cider-docview-format-tables (buffer)
"Align BUFFER tables and dim borders.
This processes the GFM table markdown extension using `org-table'.
Tables are marked to be ignored by line wrap."
(with-current-buffer buffer
(save-excursion
(let ((border 'cider-docview-table-border-face))
(org-table-map-tables
(lambda ()
(org-table-align)
(goto-char (org-table-begin))
(while (search-forward-regexp "[+|-]" (org-table-end) t)
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border))
(put-text-property (org-table-begin) (org-table-end) 'block 'table)))))))
(defun cider-docview-wrap-text (buffer)
"For text in BUFFER not propertized as 'block', apply line wrap."
(with-current-buffer buffer
(save-excursion
(while (not (eobp))
(unless (get-text-property (point) 'block)
(fill-region (point) (line-end-position)))
(forward-line)))))
;;; Rendering
(defun cider-docview-render-java-doc (buffer text)
"Emit into BUFFER formatted doc TEXT for a Java class or member."
(with-current-buffer buffer
(let ((beg (point)))
(insert text)
(save-excursion
(goto-char beg)
(cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter
(cider-docview-fontify-literals buffer)
(cider-docview-fontify-emphasis buffer)
(cider-docview-format-tables buffer) ; may contain literals, emphasis
(cider-docview-wrap-text buffer))))) ; ignores code, table blocks
(defun cider-docview-render-info (buffer info)
"Emit into BUFFER formatted INFO for the Clojure or Java symbol."
(let* ((ns (nrepl-dict-get info "ns"))
(name (nrepl-dict-get info "name"))
(added (nrepl-dict-get info "added"))
(depr (nrepl-dict-get info "deprecated"))
(macro (nrepl-dict-get info "macro"))
(special (nrepl-dict-get info "special-form"))
(forms (nrepl-dict-get info "forms-str"))
(args (nrepl-dict-get info "arglists-str"))
(doc (or (nrepl-dict-get info "doc")
"Not documented."))
(url (nrepl-dict-get info "url"))
(class (nrepl-dict-get info "class"))
(member (nrepl-dict-get info "member"))
(javadoc (nrepl-dict-get info "javadoc"))
(super (nrepl-dict-get info "super"))
(ifaces (nrepl-dict-get info "interfaces"))
(clj-name (if ns (concat ns "/" name) name))
(java-name (if member (concat class "/" member) class)))
(with-current-buffer buffer
(cl-flet ((emit (text &optional face)
(insert (if face
(propertize text 'font-lock-face face)
text)
"\n")))
(emit (if class java-name clj-name) 'font-lock-function-name-face)
(when super
(emit (concat " Extends: " (cider-font-lock-as 'java-mode super))))
(when ifaces
(emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces))))
(dolist (iface (cdr ifaces))
(emit (concat " "(cider-font-lock-as 'java-mode iface)))))
(when (or super ifaces)
(insert "\n"))
(when (or forms args)
(emit (cider-font-lock-as-clojure (or forms args))))
(when (or special macro)
(emit (if special "Special Form" "Macro") 'font-lock-comment-face))
(when added
(emit (concat "Added in " added) 'font-lock-comment-face))
(when depr
(emit (concat "Deprecated in " depr) 'font-lock-comment-face))
(if class
(cider-docview-render-java-doc (current-buffer) doc)
(emit (concat " " doc)))
(when url
(insert "\n Please see ")
(insert-text-button url
'url url
'follow-link t
'action (lambda (x)
(browse-url (button-get x 'url))))
(insert "\n"))
(when javadoc
(insert "\n\nFor additional documentation, see the ")
(insert-text-button "Javadoc"
'url javadoc
'follow-link t
'action (lambda (x)
(browse-url (button-get x 'url))))
(insert ".\n"))
(insert "\n")
(insert-text-button "[source]"
'follow-link t
'action (lambda (_x)
(cider-docview-source)))
(let ((beg (point-min))
(end (point-max)))
(nrepl-dict-map (lambda (k v)
(put-text-property beg end k v))
info)))
(current-buffer))))
(defun cider-docview-render (buffer symbol info)
"Emit into BUFFER formatted documentation for SYMBOL's INFO."
(with-current-buffer buffer
(let ((javadoc (nrepl-dict-get info "javadoc"))
(file (nrepl-dict-get info "file"))
(line (nrepl-dict-get info "line"))
(ns (nrepl-dict-get info "ns"))
(inhibit-read-only t))
(cider-docview-mode)
(setq-local cider-buffer-ns ns)
(setq-local cider-docview-symbol symbol)
(setq-local cider-docview-javadoc-url javadoc)
(setq-local cider-docview-file file)
(setq-local cider-docview-line line)
(remove-overlays)
(cider-docview-render-info buffer info)
(goto-char (point-min))
(current-buffer))))
(provide 'cider-doc)
;;; cider-doc.el ends here

164
dotfiles/emacs.d/elpa/cider-20151022.28/cider-eldoc.el

@ -0,0 +1,164 @@
;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; eldoc support for Clojure.
;;; Code:
(require 'cider-client)
(require 'cider-common) ; for cider-symbol-at-point
(require 'cider-compat)
(require 'cider-util)
(require 'cl-lib)
(require 'eldoc)
(defvar cider-extra-eldoc-commands '("yas-expand")
"Extra commands to be added to eldoc's safe commands list.")
(defvar-local cider-eldoc-last-symbol nil
"The eldoc information for the last symbol we checked.")
(defun cider-eldoc-format-thing (thing)
"Format the eldoc THING."
(propertize thing 'face 'font-lock-function-name-face))
(defun cider-highlight-args (arglist pos)
"Format the the function ARGLIST for eldoc.
POS is the index of the currently highlighted argument."
(let* ((rest-pos (cider--find-rest-args-position arglist))
(i 0))
(mapconcat
(lambda (arg)
(let ((argstr (format "%s" arg)))
(if (eq arg '&)
argstr
(prog1
(if (or (= (1+ i) pos)
(and rest-pos (> (+ 1 i) rest-pos)
(> pos rest-pos)))
(propertize argstr 'face
'eldoc-highlight-function-argument)
argstr)
(setq i (1+ i)))))) arglist " ")))
(defun cider--find-rest-args-position (arglist)
"Find the position of & in the ARGLIST vector."
(cl-position '& (append arglist ())))
(defun cider-highlight-arglist (arglist pos)
"Format the ARGLIST for eldoc.
POS is the index of the argument to highlight."
(concat "[" (cider-highlight-args arglist pos) "]"))
(defun cider-eldoc-format-arglist (arglist pos)
"Format all the ARGLIST for eldoc.
POS is the index of current argument."
(concat "("
(mapconcat (lambda (args) (cider-highlight-arglist args pos))
arglist
" ")
")"))
(defun cider-eldoc-beginning-of-sexp ()
"Move to the beginning of current sexp.
Return the number of nested sexp the point was over or after. "
(let ((parse-sexp-ignore-comments t)
(num-skipped-sexps 0))
(condition-case _
(progn
;; First account for the case the point is directly over a
;; beginning of a nested sexp.
(condition-case _
(let ((p (point)))
(forward-sexp -1)
(forward-sexp 1)
(when (< (point) p)
(setq num-skipped-sexps 1)))
(error))
(while
(let ((p (point)))
(forward-sexp -1)
(when (< (point) p)
(setq num-skipped-sexps (1+ num-skipped-sexps))))))
(error))
num-skipped-sexps))
(defun cider-eldoc-info-in-current-sexp ()
"Return a list of the current sexp and the current argument index."
(save-excursion
(let ((argument-index (1- (cider-eldoc-beginning-of-sexp))))
;; If we are at the beginning of function name, this will be -1.
(when (< argument-index 0)
(setq argument-index 0))
;; Don't do anything if current word is inside a string, vector,
;; hash or set literal.
(if (member (or (char-after (1- (point))) 0) '(?\" ?\{ ?\[))
nil
(list (cider-symbol-at-point) argument-index)))))
(defun cider-eldoc-arglist (thing)
"Return the arglist for THING."
(when (and (cider-nrepl-op-supported-p "eldoc")
thing
(not (string= thing ""))
(not (string-prefix-p ":" thing)))
;; check if we can used the cached eldoc info
(if (string= thing (car cider-eldoc-last-symbol))
(cdr cider-eldoc-last-symbol)
(when-let ((eldoc-info (cider-sync-request:eldoc (substring-no-properties thing))))
(let ((arglist (nrepl-dict-get eldoc-info "eldoc")))
(setq cider-eldoc-last-symbol (cons thing arglist))
arglist)))))
(defun cider-eldoc ()
"Backend function for eldoc to show argument list in the echo area."
(when (and (cider-connected-p)
;; don't clobber an error message in the minibuffer
(not (member last-command '(next-error previous-error))))
(let* ((info (cider-eldoc-info-in-current-sexp))
(thing (car info))
(pos (cadr info))
(value (cider-eldoc-arglist thing)))
(when value
(format "%s: %s"
(cider-eldoc-format-thing thing)
(cider-eldoc-format-arglist value pos))))))
(defun cider-eldoc-setup ()
"Turn on eldoc mode in the current buffer."
(setq-local eldoc-documentation-function #'cider-eldoc)
(apply #'eldoc-add-command cider-extra-eldoc-commands))
(define-obsolete-function-alias 'cider-turn-on-eldoc-mode 'eldoc-mode)
(provide 'cider-eldoc)
;;; cider-eldoc.el ends here

112
dotfiles/emacs.d/elpa/cider-20151022.28/cider-grimoire.el

@ -0,0 +1,112 @@
;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Bozhidar Batsov
;;
;; Author: Bozhidar Batsov <bozhidar@batsov.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; A few commands for Grimoire documentation lookup.
;;; Code:
(require 'cider-client)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-popup)
(require 'nrepl-client)
(require 'url-vars)
(defconst cider-grimoire-url "http://conj.io/")
(defun cider-grimoire-replace-special (name)
"Convert the dashes in NAME to a grimoire friendly format."
(thread-last name
(replace-regexp-in-string "\\?" "_QMARK_")
(replace-regexp-in-string "\\." "_DOT_")
(replace-regexp-in-string "\\/" "_SLASH_")
(replace-regexp-in-string "\\(\\`_\\)\\|\\(_\\'\\)" "")))
(defun cider-grimoire-url (name ns)
"Generate a grimoire search v0 url from NAME, NS."
(let ((base-url cider-grimoire-url))
(when (and name ns)
(concat base-url "search/v0/" ns "/" (cider-grimoire-replace-special name) "/"))))
(defun cider-grimoire-web-lookup (symbol)
"Look up the grimoire documentation for SYMBOL."
(if-let ((var-info (cider-var-info symbol)))
(let ((name (nrepl-dict-get var-info "name"))
(ns (nrepl-dict-get var-info "ns")))
(browse-url (cider-grimoire-url name ns)))
(error "Symbol %s not resolved" symbol)))
;;;###autoload
(defun cider-grimoire-web (&optional arg)
"Open grimoire documentation in the default web browser.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(funcall (cider-prompt-for-symbol-function arg)
"Grimoire doc for"
#'cider-grimoire-web-lookup))
(defun cider-create-grimoire-buffer (content)
"Create a new grimoire buffer with CONTENT."
(with-current-buffer (cider-popup-buffer "*cider grimoire*" t)
(read-only-mode -1)
(insert content)
(read-only-mode +1)
(goto-char (point-min))
(current-buffer)))
(defun cider-grimoire-lookup (symbol)
"Look up the grimoire documentation for SYMBOL."
(if-let ((var-info (cider-var-info symbol)))
(let ((name (nrepl-dict-get var-info "name"))
(ns (nrepl-dict-get var-info "ns"))
(url-request-method "GET")
(url-request-extra-headers `(("Content-Type" . "text/plain"))))
(url-retrieve (cider-grimoire-url name ns)
(lambda (_status)
;; we need to strip the http header
(goto-char (point-min))
(re-search-forward "^$")
(delete-region (point-min) (point))
(delete-blank-lines)
;; and create a new buffer with whatever is left
(pop-to-buffer (cider-create-grimoire-buffer (buffer-string))))))
(error "Symbol %s not resolved" symbol)))
;;;###autoload
(defun cider-grimoire (&optional arg)
"Open grimoire documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(funcall (cider-prompt-for-symbol-function arg)
"Grimoire doc for"
#'cider-grimoire-lookup))
(provide 'cider-grimoire)

309
dotfiles/emacs.d/elpa/cider-20151022.28/cider-inspector.el

@ -0,0 +1,309 @@
;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*-
;; Copyright © 2013-2015 Vital Reactor, LLC
;; Copyright © 2014-2015 Bozhidar Batsov
;; Author: Ian Eslick <ian@vitalreactor.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Clojure object inspector inspired by SLIME.
;;; Code:
(require 'cl-lib)
(require 'cider-interaction)
;; ===================================
;; Inspector Key Map and Derived Mode
;; ===================================
(defconst cider-inspector-buffer "*cider inspect*")
;;; Customization
(defgroup cider-inspector nil
"Presentation and behaviour of the cider value inspector."
:prefix "cider-inspector-"
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-inspector-page-size 32
"Default page size in paginated inspector view.
The page size can be also changed interactively within the inspector."
:type '(integer :tag "Page size" 32)
:group 'cider-inspector
:package-version '(cider . "0.10.0"))
(push cider-inspector-buffer cider-ancillary-buffers)
(defvar cider-inspector-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map [return] #'cider-inspector-operate-on-point)
(define-key map "\C-m" #'cider-inspector-operate-on-point)
(define-key map [mouse-1] #'cider-inspector-operate-on-click)
(define-key map "l" #'cider-inspector-pop)
(define-key map "g" #'cider-inspector-refresh)
;; Page-up/down
(define-key map [next] #'cider-inspector-next-page)
(define-key map [prior] #'cider-inspector-prev-page)
(define-key map " " #'cider-inspector-next-page)
(define-key map (kbd "M-SPC") #'cider-inspector-prev-page)
(define-key map (kbd "S-SPC") #'cider-inspector-prev-page)
(define-key map "s" #'cider-inspector-set-page-size)
(define-key map [tab] #'cider-inspector-next-inspectable-object)
(define-key map "\C-i" #'cider-inspector-next-inspectable-object)
(define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object) ; Emacs translates S-TAB
(define-key map [backtab] #'cider-inspector-previous-inspectable-object) ; to BACKTAB on X.
map))
(define-derived-mode cider-inspector-mode fundamental-mode "Inspector"
"Major mode for inspecting Clojure data structures.
\\{cider-inspector-mode-map}"
(set-syntax-table clojure-mode-syntax-table)
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t))
;;;###autoload
(defun cider-inspect (expression)
"Eval the string EXPRESSION and inspect the result."
(interactive
(list (cider-read-from-minibuffer "Inspect value: "
(cider-sexp-at-point))))
(cider-inspect-expr expression (cider-current-ns)))
;; Operations
(defun cider-inspector--value-handler (_buffer value)
(cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode)
(cider-irender cider-inspector-buffer value))
(defun cider-inspector--out-handler (_buffer value)
(cider-emit-interactive-eval-output value))
(defun cider-inspector--err-handler (_buffer err)
(cider-emit-interactive-eval-err-output err))
(defun cider-inspector--done-handler (buffer)
(when (get-buffer cider-inspector-buffer)
(with-current-buffer buffer
(cider-popup-buffer-display cider-inspector-buffer t))))
(defun cider-inspector-response-handler (buffer)
"Create an inspector response handler for BUFFER.
The \"value\" slot of each successive response (if it exists) will be
rendered into `cider-inspector-buffer'. Once a response is received with a
\"status\" slot containing \"done\", `cider-inspector-buffer' will be
displayed.
Used for all inspector nREPL ops."
(nrepl-make-response-handler buffer
#'cider-inspector--value-handler
#'cider-inspector--out-handler
#'cider-inspector--err-handler
#'cider-inspector--done-handler))
(defun cider-inspect-expr (expr ns)
(cider--prep-interactive-eval expr)
(cider-nrepl-send-request (append (nrepl--eval-request expr (cider-current-session) ns)
(list "inspect" "true"
"page-size" (or cider-inspector-page-size 32)))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-pop ()
(interactive)
(cider-nrepl-send-request (list "op" "inspect-pop"
"session" (cider-current-session))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-push (idx)
(cider-nrepl-send-request (list "op" "inspect-push"
"idx" (number-to-string idx)
"session" (cider-current-session))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-refresh ()
(interactive)
(cider-nrepl-send-request (list "op" "inspect-refresh"
"session" (cider-current-session))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-next-page ()
"Jump to the next page when inspecting a paginated sequence/map.
Does nothing if already on the last page."
(interactive)
(cider-nrepl-send-request (list "op" "inspect-next-page"
"session" (cider-current-session))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-prev-page ()
"Jump to the previous page when expecting a paginated sequence/map.
Does nothing if already on the first page."
(interactive)
(cider-nrepl-send-request (list "op" "inspect-prev-page"
"session" (cider-current-session))
(cider-inspector-response-handler (current-buffer))))
(defun cider-inspector-set-page-size (page-size)
"Set the page size in pagination mode to the specified value.
Current page will be reset to zero."
(interactive "nPage size:")
(cider-nrepl-send-request (list "op" "inspect-set-page-size"
"session" (cider-current-session)
"page-size" page-size)
(cider-inspector-response-handler (current-buffer))))
;; Render Inspector from Structured Values
(defun cider-irender (buffer str)
(with-current-buffer buffer
(cider-inspector-mode)
(let ((inhibit-read-only t))
(condition-case nil
(cider-irender* (car (read-from-string str)))
(error (insert "\nInspector error for: " str))))
(goto-char (point-min))))
(defun cider-irender* (elements)
(dolist (el elements)
(cider-irender-el* el)))
(defun cider-irender-el* (el)
(cond ((symbolp el) (insert (symbol-name el)))
((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face)))
((and (consp el) (eq (car el) :newline))
(insert "\n"))
((and (consp el) (eq (car el) :value))
(cider-irender-value (cadr el) (cl-caddr el)))
(t (message "Unrecognized inspector object: %s" el))))
(defun cider-irender-value (value idx)
(cider-propertize-region
(list 'cider-value-idx idx
'mouse-face 'highlight)
(cider-irender-el* (cider-font-lock-as-clojure value))))
;; ===================================================
;; Inspector Navigation (lifted from SLIME inspector)
;; ===================================================
(defun cider-find-inspectable-object (direction limit)
"Find the next/previous inspectable object.
DIRECTION can be either 'next or 'prev.
LIMIT is the maximum or minimum position in the current buffer.
Return a list of two values: If an object could be found, the
starting position of the found object and T is returned;
otherwise LIMIT and NIL is returned."
(let ((finder (cl-ecase direction
(next 'next-single-property-change)
(prev 'previous-single-property-change))))
(let ((prop nil) (curpos (point)))
(while (and (not prop) (not (= curpos limit)))
(let ((newpos (funcall finder curpos 'cider-value-idx nil limit)))
(setq prop (get-text-property newpos 'cider-value-idx))
(setq curpos newpos)))
(list curpos (and prop t)))))
(defun cider-inspector-next-inspectable-object (arg)
"Move point to the next inspectable object.
With optional ARG, move across that many objects.
If ARG is negative, move backwards."
(interactive "p")
(let ((maxpos (point-max)) (minpos (point-min))
(previously-wrapped-p nil))
;; Forward.
(while (> arg 0)
(cl-destructuring-bind (pos foundp)
(cider-find-inspectable-object 'next maxpos)
(if foundp
(progn (goto-char pos) (setq arg (1- arg))
(setq previously-wrapped-p nil))
(if (not previously-wrapped-p) ; cycle detection
(progn (goto-char minpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))
;; Backward.
(while (< arg 0)
(cl-destructuring-bind (pos foundp)
(cider-find-inspectable-object 'prev minpos)
;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page
;; as a presentation at the beginning of the buffer; skip
;; that. (Notice how this problem can not arise in ``Forward.'')
(if (and foundp (/= pos minpos))
(progn (goto-char pos) (setq arg (1+ arg))
(setq previously-wrapped-p nil))
(if (not previously-wrapped-p) ; cycle detection
(progn (goto-char maxpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))))
(defun cider-inspector-previous-inspectable-object (arg)
"Move point to the previous inspectable object.
With optional ARG, move across that many objects.
If ARG is negative, move forwards."
(interactive "p")
(cider-inspector-next-inspectable-object (- arg)))
(defun cider-inspector-property-at-point ()
(let* ((properties '(cider-value-idx cider-range-button
cider-action-number))
(find-property
(lambda (point)
(cl-loop for property in properties
for value = (get-text-property point property)
when value
return (list property value)))))
(or (funcall find-property (point))
(funcall find-property (1- (point))))))
(defun cider-inspector-operate-on-point ()
"Invoke the command for the text at point.
1. If point is on a value then recursivly call the inspector on
that value.
2. If point is on an action then call that action.
3. If point is on a range-button fetch and insert the range."
(interactive)
(cl-destructuring-bind (property value)
(cider-inspector-property-at-point)
(cl-case property
(cider-value-idx
(cider-inspector-push value))
;; TODO: range and action handlers
(t (error "No object at point")))))
(defun cider-inspector-operate-on-click (event)
"Move to EVENT's position and operate the part."
(interactive "@e")
(let ((point (posn-point (event-end event))))
(cond ((and point
(or (get-text-property point 'cider-value-idx)))
;; (get-text-property point 'cider-range-button)
;; (get-text-property point 'cider-action-number)))
(goto-char point)
(cider-inspector-operate-on-point))
(t
(error "No clickable part here")))))
(provide 'cider-inspector)
;;; cider-inspector.el ends here

1603
dotfiles/emacs.d/elpa/cider-20151022.28/cider-interaction.el

File diff suppressed because it is too large Load Diff

208
dotfiles/emacs.d/elpa/cider-20151022.28/cider-macroexpansion.el

@ -0,0 +1,208 @@
;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Macro expansion support.
;;; Code:
(require 'cider-mode)
(require 'cider-compat)
(defconst cider-macroexpansion-buffer "*cider-macroexpansion*")
(push cider-macroexpansion-buffer cider-ancillary-buffers)
(defcustom cider-macroexpansion-display-namespaces 'tidy
"Determines if namespaces are displayed in the macroexpansion buffer.
Possible values are:
'qualified ;=> Vars are fully-qualified in the expansion
'none ;=> Vars are displayed without namespace qualification
'tidy ;=> Vars that are :refer-ed or defined in the current namespace are
displayed with their simple name, non-refered vars from other
namespaces are refered using the alias for that namespace (if
defined), other vars are displayed fully qualified."
:type '(choice (const :tag "Suppress namespaces" none)
(const :tag "Show fully-qualified namespaces" qualified)
(const :tag "Show namespace aliases" tidy))
:group 'cider
:package-version '(cider . "0.7.0"))
(defcustom cider-macroexpansion-print-metadata nil
"Determines if metadata is included in macroexpansion results."
:type 'boolean
:group 'cider
:package-version '(cider . "0.9.0"))
(defun cider-sync-request:macroexpand (expander expr &optional display-namespaces)
"Macroexpand, using EXPANDER, the given EXPR.
The default for DISPLAY-NAMESPACES is taken from
`cider-macroexpansion-display-namespaces'."
(cider-ensure-op-supported "macroexpand")
(thread-first (list "op" "macroexpand"
"expander" expander
"code" expr
"ns" (cider-current-ns)
"display-namespaces"
(or display-namespaces
(symbol-name cider-macroexpansion-display-namespaces)))
(append (when cider-macroexpansion-print-metadata
(list "print-meta" "true")))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "expansion")))
(defun cider-macroexpand-undo (&optional arg)
"Undo the last macroexpansion, using `undo-only'.
ARG is passed along to `undo-only'."
(interactive)
(let ((inhibit-read-only t))
(undo-only arg)))
(defvar cider-last-macroexpand-expression nil
"Specify the last macroexpansion preformed.
This variable specifies both what was expanded and the expander.")
(defun cider-macroexpand-expr (expander expr)
"Macroexpand, use EXPANDER, the given EXPR."
(let* ((expansion (cider-sync-request:macroexpand expander expr)))
(setq cider-last-macroexpand-expression expr)
(cider-initialize-macroexpansion-buffer expansion (cider-current-ns))))
(defun cider-macroexpand-expr-inplace (expander)
"Substitute the form preceding point with its macroexpansion using EXPANDER."
(interactive)
(let* ((expansion (cider-sync-request:macroexpand expander (cider-last-sexp)))
(bounds (cons (save-excursion (clojure-backward-logical-sexp 1) (point)) (point))))
(cider-redraw-macroexpansion-buffer
expansion (current-buffer) (car bounds) (cdr bounds))))
(defun cider-macroexpand-again ()
"Repeat the last macroexpansion."
(interactive)
(cider-initialize-macroexpansion-buffer cider-last-macroexpand-expression (cider-current-ns)))
;;;###autoload
(defun cider-macroexpand-1 (&optional prefix)
"Invoke 'macroexpand-1' on the expression preceding point.
If invoked with a PREFIX argument, use 'macroexpand' instead of
'macroexpand-1'."
(interactive "P")
(let ((expander (if prefix "macroexpand" "macroexpand-1")))
(cider-macroexpand-expr expander (cider-last-sexp))))
(defun cider-macroexpand-1-inplace (&optional prefix)
"Perform inplace 'macroexpand-1' on the expression preceding point.
If invoked with a PREFIX argument, use 'macroexpand' instead of
'macroexpand-1'."
(interactive "P")
(let ((expander (if prefix "macroexpand" "macroexpand-1")))
(cider-macroexpand-expr-inplace expander)))
;;;###autoload
(defun cider-macroexpand-all ()
"Invoke 'clojure.walk/macroexpand-all' on the expression preceding point."
(interactive)
(cider-macroexpand-expr "macroexpand-all" (cider-last-sexp)))
(defun cider-macroexpand-all-inplace ()
"Perform inplace 'clojure.walk/macroexpand-all' on the expression preceding point."
(interactive)
(cider-macroexpand-expr-inplace "macroexpand-all"))
(defun cider-initialize-macroexpansion-buffer (expansion ns)
"Create a new Macroexpansion buffer with EXPANSION and namespace NS."
(pop-to-buffer (cider-create-macroexpansion-buffer))
(setq cider-buffer-ns ns)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
(buffer-undo-list t))
(erase-buffer)
(insert (format "%s" expansion))
(goto-char (point-max))
(cider--font-lock-ensure)))
(defun cider-redraw-macroexpansion-buffer (expansion buffer start end)
"Redraw the macroexpansion with new EXPANSION.
Text in BUFFER from START to END is replaced with new expansion,
and point is placed after the expanded form."
(with-current-buffer buffer
(let ((buffer-read-only nil))
(goto-char start)
(delete-region start end)
(insert (format "%s" expansion))
(goto-char start)
(indent-sexp)
(forward-sexp))))
(declare-function cider-mode "cider-mode")
(defun cider-create-macroexpansion-buffer ()
"Create a new macroexpansion buffer."
(with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer t)
(clojure-mode)
(cider-mode -1)
(cider-macroexpansion-mode 1)
(current-buffer)))
(defvar cider-macroexpansion-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "g") #'cider-macroexpand-again)
(define-key map (kbd "q") #'cider-popup-buffer-quit-function)
(define-key map (kbd "d") #'cider-doc)
(define-key map (kbd "j") #'cider-javadoc)
(define-key map (kbd ".") #'cider-find-var)
(easy-menu-define cider-macroexpansion-mode-menu map
"Menu for CIDER's doc mode"
'("Macroexpansion"
["Restart expansion" cider-macroexpand-again]
["Macroexpand-1" cider-macroexpand-1-inplace]
["Macroexpand-all" cider-macroexpand-all-inplace]
["Go to source" cider-find-var]
["Go to doc" cider-doc]
["Go to Javadoc" cider-docview-javadoc]
["Quit" cider-popup-buffer-quit-function]))
(cl-labels ((redefine-key (from to)
(dolist (mapping (where-is-internal from cider-mode-map))
(define-key map mapping to))))
(redefine-key 'cider-macroexpand-1 #'cider-macroexpand-1-inplace)
(redefine-key 'cider-macroexpand-all #'cider-macroexpand-all-inplace)
(redefine-key 'advertised-undo #'cider-macroexpand-undo)
(redefine-key 'undo #'cider-macroexpand-undo))
map))
(define-minor-mode cider-macroexpansion-mode
"Minor mode for CIDER macroexpansion.
\\{cider-macroexpansion-mode-map}"
nil
" Macroexpand"
cider-macroexpansion-mode-map)
(provide 'cider-macroexpansion)
;;; cider-macroexpansion.el ends here

454
dotfiles/emacs.d/elpa/cider-20151022.28/cider-mode.el

@ -0,0 +1,454 @@
;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Minor mode for REPL interactions.
;;; Code:
(require 'cider-interaction)
(require 'cider-test)
(require 'cider-eldoc)
(require 'cider-resolve)
(require 'cider-doc)
(require 'cider-compat)
(defcustom cider-mode-line-show-connection t
"If the mode-line lighter should detail the connection."
:group 'cider
:type 'boolean
:package-version '(cider "0.10.0"))
(defun cider--modeline-info ()
"Return info for the `cider-mode' modeline.
Info contains project name and host:port endpoint."
(if-let ((current-connection (ignore-errors (cider-current-connection))))
(with-current-buffer current-connection
(concat
(when cider-repl-type
(concat cider-repl-type ":"))
(when cider-mode-line-show-connection
(format "%s@%s:%s"
(or (cider--project-name nrepl-project-dir) "<no project>")
(pcase (car nrepl-endpoint)
("localhost" "")
(x x))
(cadr nrepl-endpoint)))))
"not connected"))
;;;###autoload
(defcustom cider-mode-line
'(:eval (format " cider[%s]" (cider--modeline-info)))
"Mode line lighter for `cider-mode'.
The value of this variable is a mode line template as in
`mode-line-format'. See Info Node `(elisp)Mode Line Format' for
details about mode line templates.
Customize this variable to change how `cider-mode' displays its
status in the mode line. The default value displays the current connection.
Set this variable to nil to disable the mode line
entirely."
:group 'cider
:type 'sexp
:risky t
:package-version '(cider "0.7.0"))
;;; Switching between REPL & source buffers
(defvar-local cider-last-clojure-buffer nil
"A buffer-local variable holding the last Clojure source buffer.
`cider-switch-to-last-clojure-buffer' uses this variable to jump
back to last Clojure source buffer.")
(defcustom cider-switch-to-repl-command 'cider-switch-to-relevant-repl-buffer
"Select the command to be invoked when switching-to-repl.
The default option is `cider-switch-to-relevant-repl-buffer'. If
you'd like to not use smart matching of repl buffer based on
project directory, you can assign it to `cider-switch-to-current-repl-buffer'
which will use the default REPL connection."
:type 'symbol
:group 'cider)
(defun cider-remember-clojure-buffer (buffer)
"Try to remember the BUFFER from which the user jumps.
The BUFFER needs to be a Clojure buffer and current major mode needs
to be `cider-repl-mode'. The user can use `cider-switch-to-last-clojure-buffer'
to jump back to the last Clojure source buffer."
(when (and buffer
(with-current-buffer buffer
(derived-mode-p 'clojure-mode))
(derived-mode-p 'cider-repl-mode))
(setq cider-last-clojure-buffer buffer)))
(defun cider-switch-to-repl-buffer (&optional arg)
"Invoke `cider-switch-to-repl-command'."
(interactive "P")
(funcall cider-switch-to-repl-command arg))
(defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace)
"Select the REPL-BUFFER, when possible in an existing window.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear.
When SET-NAMESPACE is t, sets the namespace in the REPL buffer to
that of the namespace in the Clojure source buffer."
(cider-ensure-connected)
(let ((buffer (current-buffer)))
;; first we switch to the REPL buffer
(if cider-repl-display-in-current-window
(pop-to-buffer-same-window repl-buffer)
(pop-to-buffer repl-buffer))
;; then if necessary we update its namespace
(when set-namespace
(cider-repl-set-ns (with-current-buffer buffer (cider-current-ns))))
(cider-remember-clojure-buffer buffer)
(goto-char (point-max))))
(defun cider-switch-to-default-repl-buffer (&optional set-namespace)
"Select the default REPL buffer, when possible in an existing window.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear.
With a prefix argument SET-NAMESPACE, sets the namespace in the REPL buffer to
that of the namespace in the Clojure source buffer."
(interactive "P")
(cider--switch-to-repl-buffer (cider-default-connection) set-namespace))
(define-obsolete-function-alias 'cider-switch-to-current-repl-buffer
'cider-switch-to-default-repl-buffer "0.10")
(defun cider-switch-to-relevant-repl-buffer (&optional set-namespace)
"Select the REPL buffer, when possible in an existing window.
The buffer chosen is based on the file open in the current buffer.
If the REPL buffer cannot be unambiguously determined, the REPL
buffer is chosen based on the current connection buffer and a
message raised informing the user.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear.
With a prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that
of the namespace in the Clojure source buffer."
(interactive "P")
(cider--switch-to-repl-buffer (cider-current-repl-buffer) set-namespace))
(declare-function cider-load-buffer "cider-interaction")
(defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace)
"Load the current buffer into the relevant REPL buffer and switch to it."
(interactive "P")
(cider-load-buffer)
(cider-switch-to-relevant-repl-buffer set-namespace))
(defun cider-switch-to-last-clojure-buffer ()
"Switch to the last Clojure buffer.
The default keybinding for this command is
the same as `cider-switch-to-repl-buffer',
so that it is very convenient to jump between a
Clojure buffer and the REPL buffer."
(interactive)
(if (and (derived-mode-p 'cider-repl-mode)
(buffer-live-p cider-last-clojure-buffer))
(if cider-repl-display-in-current-window
(pop-to-buffer-same-window cider-last-clojure-buffer)
(pop-to-buffer cider-last-clojure-buffer))
(message "Don't know the original Clojure buffer")))
(defun cider-find-and-clear-repl-buffer ()
"Find the current REPL buffer and clear it.
Returns to the buffer in which the command was invoked."
(interactive)
(let ((origin-buffer (current-buffer)))
(switch-to-buffer (cider-current-repl-buffer))
(cider-repl-clear-buffer)
(switch-to-buffer origin-buffer)))
;;; The minor mode
(defvar cider-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-d") #'cider-doc-map)
(define-key map (kbd "M-.") #'cider-find-var)
(define-key map (kbd "C-c C-.") #'cider-find-ns)
(define-key map (kbd "M-,") #'cider-pop-back)
(define-key map (kbd "C-c M-.") #'cider-find-resource)
(define-key map (kbd "M-TAB") #'complete-symbol)
(define-key map (kbd "C-M-x") #'cider-eval-defun-at-point)
(define-key map (kbd "C-c C-c") #'cider-eval-defun-at-point)
(define-key map (kbd "C-x C-e") #'cider-eval-last-sexp)
(define-key map (kbd "C-c C-e") #'cider-eval-last-sexp)
(define-key map (kbd "C-c C-w") #'cider-eval-last-sexp-and-replace)
(define-key map (kbd "C-c M-e") #'cider-eval-last-sexp-to-repl)
(define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl)
(define-key map (kbd "C-c C-p") #'cider-pprint-eval-last-sexp)
(define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point)
(define-key map (kbd "C-c C-r") #'cider-eval-region)
(define-key map (kbd "C-c C-n") #'cider-eval-ns-form)
(define-key map (kbd "C-c M-:") #'cider-read-and-eval)
(define-key map (kbd "C-c C-u") #'cider-undef)
(define-key map (kbd "C-c C-m") #'cider-macroexpand-1)
(define-key map (kbd "C-c M-m") #'cider-macroexpand-all)
(define-key map (kbd "C-c M-n") #'cider-repl-set-ns)
(define-key map (kbd "C-c M-i") #'cider-inspect)
(define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var)
(define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns)
(define-key map (kbd "C-c C-z") #'cider-switch-to-repl-buffer)
(define-key map (kbd "C-c M-z") #'cider-load-buffer-and-switch-to-repl-buffer)
(define-key map (kbd "C-c M-o") #'cider-find-and-clear-repl-buffer)
(define-key map (kbd "C-c C-k") #'cider-load-buffer)
(define-key map (kbd "C-c C-l") #'cider-load-file)
(define-key map (kbd "C-c C-b") #'cider-interrupt)
(define-key map (kbd "C-c ,") #'cider-test-run-tests)
(define-key map (kbd "C-c C-,") #'cider-test-rerun-tests)
(define-key map (kbd "C-c M-,") #'cider-test-run-test)
(define-key map (kbd "C-c C-t") #'cider-test-show-report)
(define-key map (kbd "C-c M-s") #'cider-selector)
(define-key map (kbd "C-c M-r") #'cider-rotate-default-connection)
(define-key map (kbd "C-c M-d") #'cider-display-connection-info)
(define-key map (kbd "C-c C-x") #'cider-refresh)
(define-key map (kbd "C-c C-q") #'cider-quit)
(easy-menu-define cider-mode-menu map
"Menu for CIDER mode"
`("CIDER"
["Complete symbol" complete-symbol]
"--"
,cider-doc-menu
"--"
("Eval"
["Eval top-level sexp at point" cider-eval-defun-at-point]
["Eval last sexp" cider-eval-last-sexp]
["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp]
["Eval last sexp to REPL buffer" cider-eval-last-sexp-to-repl]
["Eval last sexp and replace" cider-eval-last-sexp-and-replace]
["Eval region" cider-eval-region]
["Eval ns form" cider-eval-ns-form]
["Insert last sexp in REPL" cider-insert-last-sexp-in-repl]
"--"
["Load (eval) buffer" cider-load-buffer]
["Load (eval) file" cider-load-file])
("Macroexpand"
["Macroexpand-1" cider-macroexpand-1]
["Macroexpand-all" cider-macroexpand-all])
("Find"
["Find definition" cider-find-var]
["Find resource" cider-find-resource]
["Go back" cider-pop-back])
("Test"
["Run test" cider-test-run-test]
["Run all tests" cider-test-run-tests]
["Rerun failed/erring tests" cider-test-rerun-tests]
["Show test report" cider-test-show-report])
"--"
["Run project (-main function)" cider-run]
["Inspect" cider-inspect]
["Toggle var tracing" cider-toggle-trace-var]
["Toggle ns tracing" cider-toggle-trace-ns]
["Refresh loaded code" cider-refresh]
["Select any CIDER buffer" cider-selector]
"--"
["Debug top-level form" cider-debug-defun-at-point]
["List instrumented defs" cider-browse-instrumented-defs]
"--"
["Set ns" cider-repl-set-ns]
["Switch to REPL" cider-switch-to-repl-buffer]
["Switch to Relevant REPL" cider-switch-to-relevant-repl-buffer]
["Toggle REPL Pretty Print" cider-repl-toggle-pretty-printing]
["Clear REPL" cider-find-and-clear-repl-buffer]
"--"
("nREPL"
["Describe session" cider-describe-nrepl-session]
["Close session" cider-close-nrepl-session]
["Connection info" cider-display-connection-info]
["Rotate default connection" cider-rotate-default-connection])
"--"
["Interrupt evaluation" cider-interrupt]
"--"
["Quit" cider-quit]
["Restart" cider-restart]
"--"
["View manual online" cider-open-manual]
["Report a bug" cider-report-bug]
["Version info" cider-version]))
map))
;;; Dynamic indentation
(defun cider--get-symbol-indent (symbol-name)
"Return the indent metadata for SYMBOL-NAME in the current namespace."
(when-let ((indent
(nrepl-dict-get (cider-resolve-var (cider-current-ns) symbol-name)
"indent")))
(let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s"
symbol-name)))
(with-demoted-errors format
(cider--deep-vector-to-list (read indent))))))
;;; Dynamic font locking
(defcustom cider-font-lock-dynamically '(macro core deprecated)
"Specifies how much dynamic font-locking CIDER should use.
Dynamic font-locking this refers to applying syntax highlighting to vars
defined in the currently active nREPL connection. This is done in addition
to `clojure-mode's usual (static) font-lock, so even if you set this
variable to nil you'll still see basic syntax highlighting.
The value is a list of symbols, each one indicates a different type of var
that should be font-locked:
`macro' (default): Any defined macro gets the `font-lock-builtin-face'.
`function': Any defined function gets the `font-lock-function-face'.
`var': Any non-local var gets the `font-lock-variable-face'.
`deprecated' (default): Any deprecated var gets the `cider-deprecated' face.
`core' (default): Any symbol from clojure.core (face depends on type).
The value can also be t, which means to font-lock as much as possible."
:type '(choice (set :tag "Fine-tune font-locking"
(const :tag "Any defined macro" macro)
(const :tag "Any defined function" function)
(const :tag "Any defined var" var)
(const :tag "Any defined deprecated" deprecated)
(const :tag "Any symbol from clojure.core" core))
(const :tag "Font-lock as much as possible" t))
:group 'cider
:package-version '(cider . "0.10.0"))
(defface cider-deprecated
'((((background light)) :background "light goldenrod")
(((background dark)) :background "#432"))
"Faced used on depreacted vars"
:group 'cider)
(defconst cider-deprecated-properties
'(face cider-deprecated
help-echo "This var is deprecated. \\[cider-doc] for version information."))
(defun cider--compile-font-lock-keywords (symbols-plist core-plist)
"Return a list of font-lock rules for the symbols in SYMBOLS-PLIST."
(let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t)
'(function var macro core deprecated)
cider-font-lock-dynamically))
deprecated
macros functions vars instrumented)
(when (memq 'core cider-font-lock-dynamically)
(while core-plist
(let ((sym (pop core-plist))
(meta (pop core-plist)))
(when (nrepl-dict-get meta "cider-instrumented")
(push sym instrumented))
(when (nrepl-dict-get meta "deprecated")
(push sym deprecated))
(cond
((nrepl-dict-get meta "macro")
(push sym macros))
((nrepl-dict-get meta "arglists")
(push sym functions))
(t
(push sym vars))))))
(while symbols-plist
(let ((sym (pop symbols-plist))
(meta (pop symbols-plist)))
(when (nrepl-dict-get meta "cider-instrumented")
(push sym instrumented))
(when (and (nrepl-dict-get meta "deprecated")
(memq 'deprecated cider-font-lock-dynamically))
(push sym deprecated))
(cond
((and (memq 'macro cider-font-lock-dynamically)
(nrepl-dict-get meta "macro"))
(push sym macros))
((and (memq 'function cider-font-lock-dynamically)
(nrepl-dict-get meta "arglists"))
(push sym functions))
((memq 'var cider-font-lock-dynamically)
(push sym vars)))))
`(
,@(when macros
`((,(concat (rx (or "(" "#'")) ; Can't take the value of macros.
"\\(" (regexp-opt macros 'symbols) "\\)")
1 font-lock-keyword-face append)))
,@(when functions
`((,(regexp-opt functions 'symbols) 0 font-lock-function-name-face append)))
,@(when vars
`((,(regexp-opt vars 'symbols) 0 font-lock-variable-name-face append)))
,@(when deprecated
`((,(regexp-opt deprecated 'symbols) 0 cider-deprecated-properties append)))
,@(when instrumented
`((,(regexp-opt instrumented 'symbols) 0 'cider-instrumented-face append))))))
(defconst cider--static-font-lock-keywords
(eval-when-compile
`((,(regexp-opt '("#break" "#dbg") 'symbols) 0 font-lock-warning-face)))
"Default expressions to highlight in CIDER mode.")
(defvar-local cider--dynamic-font-lock-keywords nil)
(defun cider-refresh-dynamic-font-lock (&optional ns)
"Ensure that the current buffer has up-to-date font-lock rules.
NS defaults to `cider-current-ns', and it can also be a dict describing the
namespace itself."
(interactive)
(when cider-font-lock-dynamically
(font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)
(when-let ((symbols (cider-resolve-ns-symbols (or ns (cider-current-ns)))))
(setq-local cider--dynamic-font-lock-keywords
(cider--compile-font-lock-keywords
symbols (cider-resolve-ns-symbols (cider-resolve-core-ns))))
(font-lock-add-keywords nil cider--dynamic-font-lock-keywords 'end))
(if (fboundp 'font-lock-flush)
(font-lock-flush)
(with-no-warnings
(font-lock-fontify-buffer)))))
;; Once a new stable of `clojure-mode' is realeased, we can depend on it and
;; ditch this `defvar'.
(defvar clojure-get-indent-function)
;;;###autoload
(define-minor-mode cider-mode
"Minor mode for REPL interaction from a Clojure buffer.
\\{cider-mode-map}"
nil
cider-mode-line
cider-mode-map
(cider-eldoc-setup)
(make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions
#'cider-complete-at-point)
(font-lock-add-keywords nil cider--static-font-lock-keywords)
(cider-refresh-dynamic-font-lock)
(setq-local clojure-get-indent-function #'cider--get-symbol-indent)
(setq next-error-function #'cider-jump-to-compilation-error))
(provide 'cider-mode)
;;; cider-mode.el ends here

210
dotfiles/emacs.d/elpa/cider-20151022.28/cider-overlays.el

@ -0,0 +1,210 @@
;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*-
;; Copyright © 2015 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Use `cider--make-overlay' to place a generic overlay at point. Or use
;; `cider--make-result-overlay' to place an interactive eval result overlay at
;; the end of a specified line.
;;; Code:
(require 'cider-common)
(require 'cider-compat)
(require 'cl-lib)
;;; Customization
(defface cider-result-overlay-face
'((t :inherit font-lock-builtin-face))
"Face used to display evaluation results at the end of line.
Only used on the result string if `cider-overlays-use-font-lock' is nil.
If it is non-nil, this face is only used on the prefix (usually a \"=>\")."
:group 'cider
:package-version "0.9.1")
(defcustom cider-result-use-clojure-font-lock t
"If non-nil, interactive eval results are font-locked as Clojure code."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defcustom cider-overlays-use-font-lock nil
"If non-nil, results overlays are font-locked as Clojure code.
If nil, apply `cider-result-overlay-face' to the entire overlay instead of
font-locking it."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defcustom cider-use-overlays 'both
"Whether to display evaluation results with overlays.
If t, use overlays. If nil, display on the echo area. If both, display on
both places.
Only applies to evaluation commands. To configure the debugger overlays,
see `cider-debug-use-overlays'."
:type '(choice (const :tag "End of line" t)
(const :tag "Bottom of screen" nil)
(const :tag "Both" both))
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-eval-result-prefix "=> "
"The prefix displayed in the minibuffer before a result value."
:type 'string
:group 'cider
:package-version '(cider . "0.5.0"))
(define-obsolete-variable-alias 'cider-interactive-eval-result-prefix 'cider-eval-result-prefix "0.10.0")
(defcustom cider-eval-result-duration 'command
"Duration, in seconds, of CIDER's eval-result overlays.
If nil, overlays last indefinitely.
If the symbol `command', they're erased after the next command.
Also see `cider-use-overlays'."
:type '(choice (integer :tag "Duration in seconds")
(const :tag "Until next command" command)
(const :tag "Last indefinitely" nil))
:group 'cider
:package-version '(cider . "0.10.0"))
;;; Overlay logic
(defun cider--delete-overlay (ov &rest _)
"Safely delete overlay OV.
Never throws errors, and can be used in an overlay's modification-hooks."
(ignore-errors (delete-overlay ov)))
(defun cider--make-overlay (l r type &rest props)
"Place an overlay between L and R and return it.
TYPE is a symbol put on the overlay's cider-type property. It is used to
easily remove all overlays from a region with:
(remove-overlays start end 'cider-type TYPE)
PROPS is a plist of properties and values to add to the overlay."
(let ((o (make-overlay l (or r l) (current-buffer))))
(overlay-put o 'cider-type type)
(while props (overlay-put o (pop props) (pop props)))
(push #'cider--delete-overlay (overlay-get o 'modification-hooks))
o))
(defun cider--remove-result-overlay ()
"Remove result overlay from current buffer.
This function also removes itself from `post-command-hook'."
(remove-hook 'post-command-hook #'cider--remove-result-overlay 'local)
(remove-overlays nil nil 'cider-type 'result))
(defun cider--remove-result-overlay-after-command ()
"Add `cider--remove-result-overlay' locally to `post-command-hook'.
This function also removes itself from `post-command-hook'."
(remove-hook 'post-command-hook #'cider--remove-result-overlay-after-command 'local)
(add-hook 'post-command-hook #'cider--remove-result-overlay nil 'local))
(cl-defun cider--make-result-overlay (value &rest props &key where duration (type 'result) &allow-other-keys)
"Place an overlay displaying VALUE at the end of line.
VALUE is used as the overlay's after-string property, meaning it is
displayed at the end of the overlay. The overlay itself is placed from
beginning to end of current line.
Return nil if the overlay was not placed or if it might not be visible, and
return the overlay otherwise.
Return the overlay if it was placed successfully, and nil if it failed.
This function takes some optional keyword arguments:
If WHERE is a number or a marker, it is the character position of the
line to use, otherwise use `point'.
DURATION takes the same possible values as the
`cider-eval-result-duration' variable.
TYPE is passed to `cider--make-overlay' (defaults to `result').
All arguments beyond these (PROPS) are properties to be used on the
overlay."
(declare (indent 1))
;; If the marker points to a dead buffer, don't do anything.
(if-let ((buffer (if (markerp where) (marker-buffer where)
(current-buffer))))
(with-current-buffer buffer
(remove-overlays nil nil 'cider-type 'result)
(save-excursion
(when where (goto-char where))
;; Make sure the overlay is actually at the end of the sexp.
(skip-chars-backward "\r\n[:blank:]")
(let* ((display-string (concat (propertize " " 'cursor 1000)
(propertize cider-eval-result-prefix
'face 'cider-result-overlay-face)
(format "%s" value)))
(o (apply #'cider--make-overlay
(line-beginning-position) (line-end-position)
type
'after-string
(if cider-overlays-use-font-lock
display-string
(propertize display-string 'face 'cider-result-overlay-face))
props)))
(pcase duration
((pred numberp) (run-at-time duration nil #'cider--delete-overlay o))
(`command
;; If inside a command-loop, tell `cider--remove-result-overlay'
;; to only remove after the *next* command.
(if this-command
(add-hook 'post-command-hook
#'cider--remove-result-overlay-after-command
nil 'local)
(cider--remove-result-overlay-after-command))))
(when-let ((win (get-buffer-window buffer)))
;; Left edge is visible.
(when (and (<= (window-start win) (point))
;; In 24.3 `<=' is still a binary perdicate.
(<= (point) (window-end win))
;; Right edge is visible. This is a little conservative
;; if the overlay contains line breaks.
(or (< (+ (current-column) (string-width value))
(window-width win))
(not truncate-lines)))
o)))))
nil))
;;; Displaying eval result
(defun cider--display-interactive-eval-result (value &optional point)
"Display the result VALUE of an interactive eval operation.
VALUE is syntax-highlighted and displayed in the echo area.
If POINT and `cider-use-overlays' are non-nil, it is also displayed in an
overlay at the end of the line containing POINT.
Note that, while POINT can be a number, it's preferable to be a marker, as
that will better handle some corner cases where the original buffer is not
focused."
(let* ((font-value (if cider-result-use-clojure-font-lock
(cider-font-lock-as-clojure value)
value))
(used-overlay (when (and point cider-use-overlays)
(cider--make-result-overlay font-value
:where point
:duration cider-eval-result-duration))))
(message
"%s"
(propertize (format "%s%s" cider-eval-result-prefix font-value)
;; The following hides the message from the echo-area, but
;; displays it in the Messages buffer. We only hide the message
;; if the user wants to AND if the overlay succeeded.
'invisible (and used-overlay
(not (eq cider-use-overlays 'both)))))))
(provide 'cider-overlays)
;;; cider-overlays.el ends here

12
dotfiles/emacs.d/elpa/cider-20151022.28/cider-pkg.el

@ -0,0 +1,12 @@
(define-package "cider" "20151022.28" "Clojure Interactive Development Environment that Rocks"
'((clojure-mode "5.0.0")
(pkg-info "0.4")
(emacs "24.3")
(queue "0.1.1")
(spinner "1.4")
(seq "1.9"))
:url "http://www.github.com/clojure-emacs/cider" :keywords
'("languages" "clojure" "cider"))
;; Local Variables:
;; no-byte-compile: t
;; End:

122
dotfiles/emacs.d/elpa/cider-20151022.28/cider-popup.el

@ -0,0 +1,122 @@
;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'nrepl-client)
(require 'cider-compat)
(define-minor-mode cider-popup-buffer-mode
"Mode for CIDER popup buffers"
nil
(" cider-tmp")
'(("q" . cider-popup-buffer-quit-function)))
(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit
"The function that is used to quit a temporary popup buffer.")
(defun cider-popup-buffer-quit-function (&optional kill-buffer-p)
"Wrapper to invoke the function `cider-popup-buffer-quit-function'.
KILL-BUFFER-P is passed along."
(interactive)
(funcall cider-popup-buffer-quit-function kill-buffer-p))
(defun cider-popup-buffer (name &optional select mode ancillary)
"Create new popup buffer called NAME.
If SELECT is non-nil, select the newly created window.
If major MODE is non-nil, enable it for the popup buffer.
If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'
and automatically removed when killed."
(thread-first (cider-make-popup-buffer name mode ancillary)
(cider-popup-buffer-display select)))
(defun cider-popup-buffer-display (buffer &optional select)
"Display BUFFER.
If SELECT is non-nil, select the BUFFER."
(let ((window (get-buffer-window buffer)))
(when window
(with-current-buffer buffer
(set-window-point window (point))))
;; If the buffer we are popping up is already displayed in the selected
;; window, the below `inhibit-same-window' logic will cause it to be
;; displayed twice - so we early out in this case. Note that we must check
;; `selected-window', as async request handlers are executed in the context
;; of the current connection buffer (i.e. `current-buffer' is dynamically
;; bound to that).
(unless (eq window (selected-window))
;; Non nil `inhibit-same-window' ensures that current window is not covered
(if select
(pop-to-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows))))
(display-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows)))))))
buffer)
(defun cider-popup-buffer-quit (&optional kill)
"Quit the current (temp) window and bury its buffer using `quit-restore-window'.
If prefix argument KILL is non-nil, kill the buffer instead of burying it."
(interactive)
(quit-restore-window (selected-window) (if kill 'kill 'append)))
(defvar-local cider-popup-output-marker nil)
(defvar cider-ancillary-buffers (list nrepl-message-buffer-name))
(defun cider-make-popup-buffer (name &optional mode ancillary)
"Create a temporary buffer called NAME using major MODE (if specified).
If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'
and automatically removed when killed."
(with-current-buffer (get-buffer-create name)
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
(when mode
(funcall mode))
(cider-popup-buffer-mode 1)
(setq cider-popup-output-marker (point-marker))
(setq buffer-read-only t)
(when ancillary
(add-to-list 'cider-ancillary-buffers name)
(add-hook 'kill-buffer-hook
(lambda () (setq cider-ancillary-buffers (remove name cider-ancillary-buffers)))
nil 'local))
(current-buffer)))
(defun cider-emit-into-popup-buffer (buffer value &optional face)
"Emit into BUFFER the provided VALUE."
;; Long string output renders emacs unresponsive and users might intentionally
;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and
;; silently ignore the output.
(when (buffer-live-p buffer)
(with-current-buffer buffer
(let ((inhibit-read-only t)
(buffer-undo-list t)
(moving (= (point) cider-popup-output-marker)))
(save-excursion
(goto-char cider-popup-output-marker)
(let ((value-str (format "%s" value)))
(when face
(if (fboundp 'add-face-text-property)
(add-face-text-property 0 (length value-str) face nil value-str)
(add-text-properties 0 (length value-str) (list 'face face) value-str)))
(insert value-str))
(indent-sexp)
(set-marker cider-popup-output-marker (point)))
(when moving (goto-char cider-popup-output-marker))))))
(provide 'cider-popup)
;;; cider-popup.el ends here

1198
dotfiles/emacs.d/elpa/cider-20151022.28/cider-repl.el

File diff suppressed because it is too large Load Diff

129
dotfiles/emacs.d/elpa/cider-20151022.28/cider-resolve.el

@ -0,0 +1,129 @@
;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection
;; Copyright © 2015 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The ns cache is a dict of namespaces stored in the connection buffer. This
;; file offers functions to easily get information about variables from this
;; cache, given the variable's name and the file's namespace. This
;; functionality is similar to that offered by the `cider-var-info' function
;; (and others). The difference is that all functions in this file operate
;; without contacting the server (they still rely on an active connection
;; buffer, but no messages are actually exchanged).
;; For this reason, the functions here are well suited for very
;; performance-sentitive operations, such as font-locking or
;; indentation. Meanwhile, operations like code-jumping are better off
;; communicating with the middleware, just in the off chance that the cache is
;; outdated.
;; Below is a typical entry on this cache dict. Note that clojure.core symbols
;; are excluded from the refers to save space.
;; "cider.nrepl.middleware.track-state"
;; (dict "aliases"
;; (dict "cljs" "cider.nrepl.middleware.util.cljs"
;; "misc" "cider.nrepl.middleware.util.misc"
;; "set" "clojure.set")
;; "interns" (dict a
;; "assoc-state" (dict "arglists"
;; (("response"
;; (dict "as" "msg" "keys"
;; ("session")))))
;; "filter-core" (dict "arglists"
;; (("refers")))
;; "make-transport" (dict "arglists"
;; (((dict "as" "msg" "keys"
;; ("transport")))))
;; "ns-as-map" (dict "arglists"
;; (("ns")))
;; "ns-cache" (dict)
;; "relevant-meta" (dict "arglists"
;; (("var")))
;; "update-vals" (dict "arglists"
;; (("m" "f")))
;; "wrap-tracker" (dict "arglists"
;; (("handler"))))
;; "refers" (dict "set-descriptor!" "#'clojure.tools.nrepl.middleware/set-descriptor!"))
;;; Code:
(require 'cider-client)
(require 'nrepl-client)
(require 'cider-util)
(defvar cider-repl-ns-cache)
(defun cider-resolve--get-in (&rest keys)
"Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)."
(when cider-connections
(with-current-buffer (cider-current-connection)
(nrepl-dict-get-in cider-repl-ns-cache keys))))
(defun cider-resolve-alias (ns alias)
"Return the namespace that ALIAS refers to in namespace NS.
If it doesn't point anywhere, returns ALIAS."
(or (cider-resolve--get-in ns "aliases" alias)
alias))
(defconst cider-resolve--prefix-regexp "\\`\\(?:#'\\)?\\([^/]+\\)/")
(defun cider-resolve-var (ns var)
"Return a dict of the metadata of a clojure var VAR in namespace NS.
VAR is a string.
Return nil only if VAR cannot be resolved."
(let* ((var-ns (when (string-match cider-resolve--prefix-regexp var)
(cider-resolve-alias ns (match-string 1 var))))
(name (replace-regexp-in-string cider-resolve--prefix-regexp "" var)))
(or
(cider-resolve--get-in (or var-ns ns) "interns" name)
(unless var-ns
;; If the var had no prefix, it might be referred.
(if-let ((referal (cider-resolve--get-in ns "refers" name)))
(cider-resolve-var ns referal)
;; Or it might be from core.
(unless (equal ns "clojure.core")
(cider-resolve-var "clojure.core" name)))))))
(defun cider-resolve-core-ns ()
"Return a dict of the core namespace for current connection.
This will be clojure.core or cljs.core depending on `cider-repl-type'."
(when (cider-connected-p)
(with-current-buffer (cider-current-connection)
(cider-resolve--get-in (if (equal cider-repl-type "cljs")
"cljs.core"
"clojure.core")))))
(defun cider-resolve-ns-symbols (ns)
"Return a plist of all valid symbols in NS.
Each entry's value is the metadata of the var that the symbol refers to.
NS can be the namespace name, or a dict of the namespace itself."
(when-let ((dict (if (stringp ns)
(cider-resolve--get-in ns)
ns)))
(nrepl-dbind-response dict (interns refers aliases)
(append (cdr interns)
(nrepl-dict-flat-map (lambda (alias namespace)
(nrepl-dict-flat-map (lambda (sym meta)
(list (concat alias "/" sym) meta))
(cider-resolve--get-in namespace "interns")))
aliases)))))
(provide 'cider-resolve)
;;; cider-resolve.el ends here

71
dotfiles/emacs.d/elpa/cider-20151022.28/cider-scratch.el

@ -0,0 +1,71 @@
;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Bozhidar Batsov
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Imitate Emacs's *scratch* buffer.
;;; Code:
(require 'cider-interaction)
(require 'clojure-mode)
(defvar cider-clojure-interaction-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map clojure-mode-map)
(define-key map (kbd "C-j") #'cider-eval-print-last-sexp)
map))
(defconst cider-scratch-buffer-name "*cider-scratch*")
;;;###autoload
(defun cider-scratch ()
"Create a scratch buffer."
(interactive)
(pop-to-buffer (cider-find-or-create-scratch-buffer)))
(defun cider-find-or-create-scratch-buffer ()
"Find or create the scratch buffer."
(or (get-buffer cider-scratch-buffer-name)
(cider-create-scratch-buffer)))
(define-derived-mode cider-clojure-interaction-mode clojure-mode "Clojure Interaction"
"Major mode for typing and evaluating Clojure forms.
Like Lisp mode except that \\[cider-eval-print-last-sexp] evals the Lisp expression
before point, and prints its value into the buffer, advancing point.
\\{cider-clojure-interaction-mode-map}")
(defun cider-create-scratch-buffer ()
"Create a new scratch buffer."
(with-current-buffer (get-buffer-create cider-scratch-buffer-name)
(cider-clojure-interaction-mode)
(insert ";; This buffer is for Clojure experiments and evaluation.\n"
";; Press C-j to evaluate the last expression.\n\n")
(current-buffer)))
(provide 'cider-scratch)
;;; cider-scratch.el ends here

154
dotfiles/emacs.d/elpa/cider-20151022.28/cider-selector.el

@ -0,0 +1,154 @@
;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Buffer selection command inspired by SLIME's selector.
;;; Code:
(require 'cider-client)
(require 'cider-interaction)
(defconst cider-selector-help-buffer "*Selector Help*"
"The name of the selector's help buffer.")
(defvar cider-selector-methods nil
"List of buffer-selection methods for the `cider-selector' command.
Each element is a list (KEY DESCRIPTION FUNCTION).
DESCRIPTION is a one-line description of what the key selects.")
(defvar cider-selector-other-window nil
"If non-nil use `switch-to-buffer-other-window'.")
(defun cider--recently-visited-buffer (mode)
"Return the most recently visited buffer whose `major-mode' is MODE.
Only considers buffers that are not already visible."
(cl-loop for buffer in (buffer-list)
when (and (with-current-buffer buffer (eq major-mode mode))
(not (string-match-p "^ " (buffer-name buffer)))
(null (get-buffer-window buffer 'visible)))
return buffer
finally (error "Can't find unshown buffer in %S" mode)))
;;;###autoload
(defun cider-selector (&optional other-window)
"Select a new buffer by type, indicated by a single character.
The user is prompted for a single character indicating the method by
which to choose a new buffer. The `?' character describes then
available methods. OTHER-WINDOW provides an optional target.
See `def-cider-selector-method' for defining new methods."
(interactive)
(message "Select [%s]: "
(apply #'string (mapcar #'car cider-selector-methods)))
(let* ((cider-selector-other-window other-window)
(ch (save-window-excursion
(select-window (minibuffer-window))
(read-char)))
(method (cl-find ch cider-selector-methods :key #'car)))
(cond (method
(funcall (cl-caddr method)))
(t
(message "No method for character: ?\\%c" ch)
(ding)
(sleep-for 1)
(discard-input)
(cider-selector)))))
(defmacro def-cider-selector-method (key description &rest body)
"Define a new `cider-select' buffer selection method.
KEY is the key the user will enter to choose this method.
DESCRIPTION is a one-line sentence describing how the method
selects a buffer.
BODY is a series of forms which are evaluated when the selector
is chosen. The returned buffer is selected with
`switch-to-buffer'."
(let ((method `(lambda ()
(let ((buffer (progn ,@body)))
(cond ((not (get-buffer buffer))
(message "No such buffer: %S" buffer)
(ding))
((get-buffer-window buffer)
(select-window (get-buffer-window buffer)))
(cider-selector-other-window
(switch-to-buffer-other-window buffer))
(t
(switch-to-buffer buffer)))))))
`(setq cider-selector-methods
(cl-sort (cons (list ,key ,description ,method)
(cl-remove ,key cider-selector-methods :key #'car))
#'< :key #'car))))
(def-cider-selector-method ?? "Selector help buffer."
(ignore-errors (kill-buffer cider-selector-help-buffer))
(with-current-buffer (get-buffer-create cider-selector-help-buffer)
(insert "CIDER Selector Methods:\n\n")
(cl-loop for (key line nil) in cider-selector-methods
do (insert (format "%c:\t%s\n" key line)))
(goto-char (point-min))
(help-mode)
(display-buffer (current-buffer) t))
(cider-selector)
(current-buffer))
(cl-pushnew (list ?4 "Select in other window" (lambda () (cider-selector t)))
cider-selector-methods :key #'car)
(def-cider-selector-method ?c
"Most recently visited clojure-mode buffer."
(cider--recently-visited-buffer 'clojure-mode))
(def-cider-selector-method ?e
"Most recently visited emacs-lisp-mode buffer."
(cider--recently-visited-buffer 'emacs-lisp-mode))
(def-cider-selector-method ?q "Abort."
(top-level))
(def-cider-selector-method ?r
"Current REPL buffer."
(cider-current-repl-buffer))
(def-cider-selector-method ?n
"Connections browser buffer."
(cider-connection-browser)
cider--connection-browser-buffer-name)
(def-cider-selector-method ?m
"*nrepl-messages* buffer."
nrepl-message-buffer-name)
(def-cider-selector-method ?x
"*cider-error* buffer."
cider-error-buffer)
(provide 'cider-selector)
;;; cider-selector.el ends here

610
dotfiles/emacs.d/elpa/cider-20151022.28/cider-stacktrace.el

@ -0,0 +1,610 @@
;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Jeff Valk
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Stacktrace filtering and stack frame source navigation
;;; Code:
(require 'cl-lib)
(require 'cider-popup)
(require 'button)
(require 'easymenu)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-client)
(require 'cider-util)
(require 'seq)
;; Variables
(defgroup cider-stacktrace nil
"Stacktrace filtering and navigation."
:prefix "cider-stacktrace-"
:group 'cider)
(defcustom cider-stacktrace-fill-column t
"Fill column for error messages in stacktrace display.
If nil, messages will not be wrapped. If truthy but non-numeric,
`fill-column' will be used."
:type 'list
:group 'cider-stacktrace
:package-version '(cider . "0.7.0"))
(defcustom cider-stacktrace-default-filters '(tooling dup)
"Frame types to omit from initial stacktrace display."
:type 'list
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defcustom cider-stacktrace-print-length 50
"Set the maximum length of sequences in displayed cause data.
This sets the value of Clojure's `*print-length*` when pretty printing the
`ex-data` map for exception causes in the stacktrace that are instances of
`IExceptionInfo`.
Be advised that setting this to `nil` will cause the attempted printing of
infinite data structures."
:type '(choice integer (const nil))
:group 'cider-stacktrace
:package-version '(cider . "0.9.0"))
(defcustom cider-stacktrace-print-level 50
"Set the maximum level of nesting in displayed cause data.
This sets the value of Clojure's `*print-level*` when pretty printing the
`ex-data` map for exception causes in the stacktrace that are instances of
`IExceptionInfo`.
Be advised that setting this to `nil` will cause the attempted printing of
cyclical data structures."
:type '(choice integer (const nil))
:group 'cider-stacktrace
:package-version '(cider . "0.8.0"))
(defvar cider-stacktrace-detail-max 2
"The maximum detail level for causes.")
(defvar-local cider-stacktrace-hidden-frame-count 0)
(defvar-local cider-stacktrace-filters nil)
(defvar-local cider-stacktrace-prior-filters nil)
(defvar-local cider-stacktrace-cause-visibility nil)
(defconst cider-error-buffer "*cider-error*")
(add-to-list 'cider-ancillary-buffers cider-error-buffer)
;; Faces
(defface cider-stacktrace-error-class-face
'((t (:inherit font-lock-warning-face)))
"Face for exception class names"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-error-message-face
'((t (:inherit font-lock-doc-face)))
"Face for exception messages"
:group 'cider-stacktrace
:package-version '(cider . "0.7.0"))
(defface cider-stacktrace-filter-shown-face
'((t (:inherit button :underline t :weight normal)))
"Face for filter buttons representing frames currently visible"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-filter-hidden-face
'((t (:inherit button :underline nil :weight normal)))
"Face for filter buttons representing frames currently filtered out"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-face
'((t (:inherit default)))
"Face for stack frame text"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-ns-face
'((t (:inherit font-lock-comment-face)))
"Face for stack frame namespace name"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-fn-face
'((t (:inherit default :weight bold)))
"Face for stack frame function name"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
;; Colors & Theme Support
(defvar cider-stacktrace-frames-background-color
(cider-scale-background-color)
"Background color for stacktrace frames.")
(defadvice enable-theme (after cider-stacktrace-adapt-to-theme activate)
"When theme is changed, update `cider-stacktrace-frames-background-color'."
(setq cider-stacktrace-frames-background-color (cider-scale-background-color)))
;; Mode & key bindings
(defvar cider-stacktrace-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "M-p") #'cider-stacktrace-previous-cause)
(define-key map (kbd "M-n") #'cider-stacktrace-next-cause)
(define-key map (kbd "M-.") #'cider-stacktrace-jump)
(define-key map "q" #'cider-popup-buffer-quit-function)
(define-key map "j" #'cider-stacktrace-toggle-java)
(define-key map "c" #'cider-stacktrace-toggle-clj)
(define-key map "r" #'cider-stacktrace-toggle-repl)
(define-key map "t" #'cider-stacktrace-toggle-tooling)
(define-key map "d" #'cider-stacktrace-toggle-duplicates)
(define-key map "a" #'cider-stacktrace-toggle-all)
(define-key map "1" #'cider-stacktrace-cycle-cause-1)
(define-key map "2" #'cider-stacktrace-cycle-cause-2)
(define-key map "3" #'cider-stacktrace-cycle-cause-3)
(define-key map "4" #'cider-stacktrace-cycle-cause-4)
(define-key map "5" #'cider-stacktrace-cycle-cause-5)
(define-key map "0" #'cider-stacktrace-cycle-all-causes)
(define-key map [tab] #'cider-stacktrace-cycle-current-cause)
(define-key map [backtab] #'cider-stacktrace-cycle-all-causes)
(easy-menu-define cider-stacktrace-mode-menu map
"Menu for CIDER's stacktrace mode"
'("Stacktrace"
["Previous cause" cider-stacktrace-previous-cause]
["Next cause" cider-stacktrace-next-cause]
"--"
["Jump to frame source" cider-stacktrace-jump]
"--"
["Cycle current cause detail" cider-stacktrace-cycle-current-cause]
["Cycle cause #1 detail" cider-stacktrace-cycle-cause-1]
["Cycle cause #2 detail" cider-stacktrace-cycle-cause-2]
["Cycle cause #3 detail" cider-stacktrace-cycle-cause-3]
["Cycle cause #4 detail" cider-stacktrace-cycle-cause-4]
["Cycle cause #5 detail" cider-stacktrace-cycle-cause-5]
["Cycle all cause detail" cider-stacktrace-cycle-all-causes]
"--"
["Show/hide Java frames" cider-stacktrace-toggle-java]
["Show/hide Clojure frames" cider-stacktrace-toggle-clj]
["Show/hide REPL frames" cider-stacktrace-toggle-repl]
["Show/hide tooling frames" cider-stacktrace-toggle-tooling]
["Show/hide duplicate frames" cider-stacktrace-toggle-duplicates]
["Show/hide all frames" cider-stacktrace-toggle-all]))
map))
(define-derived-mode cider-stacktrace-mode special-mode "Stacktrace"
"Major mode for filtering and navigating CIDER stacktraces.
\\{cider-stacktrace-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil)
(setq-local cider-stacktrace-prior-filters nil)
(setq-local cider-stacktrace-hidden-frame-count 0)
(setq-local cider-stacktrace-filters cider-stacktrace-default-filters)
(setq-local cider-stacktrace-cause-visibility (make-vector 10 0)))
;; Stacktrace filtering
(defun cider-stacktrace-indicate-filters (filters)
"Update enabled state of filter buttons.
Find buttons with a 'filter property; if filter is a member of FILTERS, or
if filter is nil ('show all') and the argument list is non-nil, fontify the
button as disabled. Upon finding text with a 'hidden-count property, stop
searching and update the hidden count text."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
(get-face (lambda (hide)
(if hide
'cider-stacktrace-filter-hidden-face
'cider-stacktrace-filter-shown-face))))
;; Toggle buttons
(while (not (or (get-text-property (point) 'hidden-count) (eobp)))
(let ((button (button-at (point))))
(when button
(let* ((filter (button-get button 'filter))
(face (funcall get-face (if filter
(member filter filters)
filters))))
(button-put button 'face face)))
(goto-char (or (next-property-change (point))
(point-max)))))
;; Update hidden count
(when (and (get-text-property (point) 'hidden-count)
(re-search-forward "[0-9]+" (line-end-position) t))
(replace-match
(number-to-string cider-stacktrace-hidden-frame-count)))))))
(defun cider-stacktrace-apply-filters (filters)
"Set visibility on stack frames using FILTERS.
Update `cider-stacktrace-hidden-frame-count' and indicate filters applied.
Currently collapsed stacktraces are ignored, and do not contribute to the
hidden count."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
(hidden 0))
(while (not (eobp))
(unless (get-text-property (point) 'collapsed)
(let* ((flags (get-text-property (point) 'flags))
(hide (if (seq-intersection filters flags) t nil)))
(when hide (setq hidden (+ 1 hidden)))
(put-text-property (point) (line-beginning-position 2) 'invisible hide)))
(forward-line 1))
(setq cider-stacktrace-hidden-frame-count hidden)))
(cider-stacktrace-indicate-filters filters)))
(defun cider-stacktrace-apply-cause-visibility ()
"Apply `cider-stacktrace-cause-visibility' to causes and reapply filters."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(cl-flet ((next-detail (end)
(when-let ((pos (next-single-property-change (point) 'detail)))
(when (< pos end)
(goto-char pos)))))
(let ((inhibit-read-only t))
;; For each cause...
(while (cider-stacktrace-next-cause)
(let* ((num (get-text-property (point) 'cause))
(level (elt cider-stacktrace-cause-visibility num))
(cause-end (cadr (cider-property-bounds 'cause))))
;; For each detail level within the cause, set visibility.
(while (next-detail cause-end)
(let* ((detail (get-text-property (point) 'detail))
(detail-end (cadr (cider-property-bounds 'detail)))
(hide (if (> detail level) t nil)))
(add-text-properties (point) detail-end
(list 'invisible hide
'collapsed hide))))))))
(cider-stacktrace-apply-filters
cider-stacktrace-filters))))
;; Interactive functions
(defun cider-stacktrace-previous-cause ()
"Move point to the previous exception cause, if one exists."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((pos (previous-single-property-change (point) 'cause)))
(goto-char pos))))
(defun cider-stacktrace-next-cause ()
"Move point to the next exception cause, if one exists."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((pos (next-single-property-change (point) 'cause)))
(goto-char pos))))
(defun cider-stacktrace-cycle-cause (num &optional level)
"Update element NUM of `cider-stacktrace-cause-visibility', optionally to LEVEL.
If LEVEL is not specified, its current value is incremented. When it reaches 3,
it wraps to 0."
(let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num)))))
(aset cider-stacktrace-cause-visibility num (mod level 3))
(cider-stacktrace-apply-cause-visibility)))
(defun cider-stacktrace-cycle-all-causes ()
"Cycle the visibility of all exception causes."
(interactive)
(with-current-buffer cider-error-buffer
(save-excursion
;; Find nearest cause.
(unless (get-text-property (point) 'cause)
(cider-stacktrace-next-cause)
(unless (get-text-property (point) 'cause)
(cider-stacktrace-previous-cause)))
;; Cycle its level, and apply that to all causes.
(let* ((num (get-text-property (point) 'cause))
(level (1+ (elt cider-stacktrace-cause-visibility num))))
(setq-local cider-stacktrace-cause-visibility
(make-vector 10 (mod level 3)))
(cider-stacktrace-apply-cause-visibility)))))
(defun cider-stacktrace-cycle-current-cause ()
"Cycle the visibility of current exception at point, if any."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((num (get-text-property (point) 'cause)))
(cider-stacktrace-cycle-cause num))))
(defun cider-stacktrace-cycle-cause-1 ()
"Cycle the visibility of exception cause #1."
(interactive)
(cider-stacktrace-cycle-cause 1))
(defun cider-stacktrace-cycle-cause-2 ()
"Cycle the visibility of exception cause #2."
(interactive)
(cider-stacktrace-cycle-cause 2))
(defun cider-stacktrace-cycle-cause-3 ()
"Cycle the visibility of exception cause #3."
(interactive)
(cider-stacktrace-cycle-cause 3))
(defun cider-stacktrace-cycle-cause-4 ()
"Cycle the visibility of exception cause #4."
(interactive)
(cider-stacktrace-cycle-cause 4))
(defun cider-stacktrace-cycle-cause-5 ()
"Cycle the visibility of exception cause #5."
(interactive)
(cider-stacktrace-cycle-cause 5))
(defun cider-stacktrace-toggle-all ()
"Reset `cider-stacktrace-filters' if present; otherwise restore prior filters."
(interactive)
(when cider-stacktrace-filters
(setq-local cider-stacktrace-prior-filters
cider-stacktrace-filters))
(cider-stacktrace-apply-filters
(setq cider-stacktrace-filters
(unless cider-stacktrace-filters ; when current filters are nil,
cider-stacktrace-prior-filters)))) ; reenable prior filter set
(defun cider-stacktrace-toggle (flag)
"Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters."
(cider-stacktrace-apply-filters
(setq cider-stacktrace-filters
(if (memq flag cider-stacktrace-filters)
(remq flag cider-stacktrace-filters)
(cons flag cider-stacktrace-filters)))))
(defun cider-stacktrace-toggle-java ()
"Toggle display of Java stack frames."
(interactive)
(cider-stacktrace-toggle 'java))
(defun cider-stacktrace-toggle-clj ()
"Toggle display of Clojure stack frames."
(interactive)
(cider-stacktrace-toggle 'clj))
(defun cider-stacktrace-toggle-repl ()
"Toggle display of REPL stack frames."
(interactive)
(cider-stacktrace-toggle 'repl))
(defun cider-stacktrace-toggle-tooling ()
"Toggle display of Tooling stack frames (compiler, nREPL middleware, etc)."
(interactive)
(cider-stacktrace-toggle 'tooling))
(defun cider-stacktrace-toggle-duplicates ()
"Toggle display of stack frames that are duplicates of their descendents."
(interactive)
(cider-stacktrace-toggle 'dup))
;; Text button functions
(defun cider-stacktrace-filter (button)
"Apply filter(s) indicated by the BUTTON."
(with-temp-message "Filters may also be toggled with the keyboard."
(let ((flag (button-get button 'filter)))
(if flag
(cider-stacktrace-toggle flag)
(cider-stacktrace-toggle-all)))
(sit-for 5)))
(defun cider-stacktrace-navigate (button)
"Navigate to the stack frame source represented by the BUTTON."
(let* ((var (button-get button 'var))
(class (button-get button 'class))
(method (button-get button 'method))
(info (or (and var (cider-var-info var))
(and class method (cider-member-info class method))
(nrepl-dict)))
;; Stacktrace returns more accurate line numbers, but if the function's
;; line was unreliable, then so is the stacktrace by the same amount.
;; Set `line-shift' to the number of lines from the beginning of defn.
(line-shift (- (or (button-get button 'line) 0)
(or (nrepl-dict-get info "line") 1)))
;; give priority to `info` files as `info` returns full paths.
(info (nrepl-dict-put info "file" (or (nrepl-dict-get info "file")
(button-get button 'file)))))
(cider--jump-to-loc-from-info info t)
(forward-line line-shift)
(back-to-indentation)))
(defun cider-stacktrace-jump (&optional arg)
"Like `cider-find-var', but uses the stack frame source at point, if available."
(interactive "P")
(let ((button (button-at (point))))
(if (and button (button-get button 'line))
(cider-stacktrace-navigate button)
(cider-find-var arg))))
;; Rendering
(defun cider-stacktrace-emit-indented (text indent &optional fill)
"Insert TEXT, and INDENT and optionally FILL the entire block."
(let ((beg (point)))
(insert text)
(goto-char beg)
(while (not (eobp))
(insert indent)
(forward-line))
(when (and fill cider-stacktrace-fill-column)
(when (and (numberp cider-stacktrace-fill-column))
(setq-local fill-column cider-stacktrace-fill-column))
(setq-local fill-prefix indent)
(fill-region beg (point)))))
(defun cider-stacktrace-render-filters (buffer filters)
"Emit into BUFFER toggle buttons for each of the FILTERS."
(with-current-buffer buffer
(insert " Show: ")
(dolist (filter filters)
(insert-text-button (car filter)
'filter (cadr filter)
'follow-link t
'action 'cider-stacktrace-filter
'help-echo (format "Toggle %s stack frames"
(car filter)))
(insert " "))
(let ((hidden "(0 frames hidden)"))
(put-text-property 0 (length hidden) 'hidden-count t hidden)
(insert " " hidden "\n"))))
(defun cider-stacktrace-render-frame (buffer frame)
"Emit into BUFFER function call site info for the stack FRAME.
This associates text properties to enable filtering and source navigation."
(with-current-buffer buffer
(nrepl-dbind-response frame (file line flags class method name var ns fn)
(let ((flags (mapcar 'intern flags))) ; strings -> symbols
(insert-text-button (format "%30s:%5d %s/%s"
(if (member 'repl flags) "REPL" file) line
(if (member 'clj flags) ns class)
(if (member 'clj flags) fn method))
'var var 'class class 'method method
'name name 'file file 'line line
'flags flags 'follow-link t
'action 'cider-stacktrace-navigate
'help-echo "View source at this location"
'face 'cider-stacktrace-face)
(save-excursion
(let ((p4 (point))
(p1 (search-backward " "))
(p2 (search-forward "/"))
(p3 (search-forward-regexp "[^/$]+")))
(put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face)
(put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face)))
(insert "\n")))))
(defun cider-stacktrace--create-go-to-err-button (beg message)
"Create a button that jumps to the relevant error.
Buttons span over the region from BEG to current point.
MESSAGE is parsed to find line, col and buffer name to jump to."
(when (and message
(string-match "\\([^:]+\\):\\([^:]+\\):\\([^:]+\\):\\([^:]+\\)\\'" message))
(let* ((line (string-to-number (match-string 3 message)))
(col (string-to-number (match-string 4 message)))
(buf-name (car (last (split-string (match-string 2 message) "\\/")))))
(when buf-name
(make-button (+ beg 3)
(point)
'action (lambda (_button)
(let ((the-buf-window (get-buffer-window buf-name)))
(if the-buf-window
(select-window the-buf-window)
(switch-to-buffer buf-name)))
(goto-char (point-min))
(forward-line line)
(move-to-column col t)))))))
(defun cider-stacktrace-render-cause (buffer cause num note)
"Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE."
(with-current-buffer buffer
(nrepl-dbind-response cause (class message data stacktrace)
(let ((indent " ")
(class-face 'cider-stacktrace-error-class-face)
(message-face 'cider-stacktrace-error-message-face))
(cider-propertize-region `(cause ,num)
;; Detail level 0: exception class
(cider-propertize-region '(detail 0)
(insert (format "%d. " num)
(propertize note 'font-lock-face 'font-lock-comment-face) " "
(propertize class 'font-lock-face class-face)
"\n"))
;; Detail level 1: message + ex-data
(cider-propertize-region '(detail 1)
(let ((beg (point)))
(cider-stacktrace-emit-indented
(propertize (or message "(No message)") 'font-lock-face message-face) indent t)
(cider-stacktrace--create-go-to-err-button beg message))
(insert "\n")
(when data
(cider-stacktrace-emit-indented
(cider-font-lock-as-clojure data) indent nil)))
;; Detail level 2: stacktrace
(cider-propertize-region '(detail 2)
(insert "\n")
(let ((beg (point))
(bg `(:background ,cider-stacktrace-frames-background-color)))
(dolist (frame stacktrace)
(cider-stacktrace-render-frame buffer frame))
(overlay-put (make-overlay beg (point)) 'font-lock-face bg)))
;; Add line break between causes, even when collapsed.
(cider-propertize-region '(detail 0)
(insert "\n")))))))
(defun cider-stacktrace-initialize (causes)
"Set and apply CAUSES initial visibility, filters, and cursor position."
;; Partially display outermost cause if it's a compiler exception (the
;; description reports reader location of the error).
(nrepl-dbind-response (car causes) (class)
(when (equal class "clojure.lang.Compiler$CompilerException")
(cider-stacktrace-cycle-cause (length causes) 1)))
;; Fully display innermost cause. This also applies visibility/filters.
(cider-stacktrace-cycle-cause 1 cider-stacktrace-detail-max)
;; Move point to first stacktrace frame in displayed cause. If the error
;; buffer is visible in a window, ensure that window is selected while moving
;; point, so as to move both the buffer's and the window's point.
(with-selected-window (or (get-buffer-window cider-error-buffer)
(selected-window))
(with-current-buffer cider-error-buffer
(goto-char (point-min))
(while (cider-stacktrace-next-cause))
(goto-char (next-single-property-change (point) 'flags)))))
(defun cider-stacktrace-render (buffer causes)
"Emit into BUFFER useful stacktrace information for the CAUSES."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(insert "\n")
;; Stacktrace filters
(cider-stacktrace-render-filters
buffer
`(("Clojure" clj) ("Java" java) ("REPL" repl)
("Tooling" tooling) ("Duplicates" dup) ("All" ,nil)))
(insert "\n")
;; Stacktrace exceptions & frames
(let ((num (length causes)))
(dolist (cause causes)
(let ((note (if (= num (length causes)) "Unhandled" "Caused by")))
(cider-stacktrace-render-cause buffer cause num note)
(setq num (1- num))))))
(cider-stacktrace-initialize causes)
(font-lock-refresh-defaults)))
(provide 'cider-stacktrace)
;;; cider-stacktrace.el ends here

499
dotfiles/emacs.d/elpa/cider-20151022.28/cider-test.el

@ -0,0 +1,499 @@
;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*-
;; Copyright © 2014-2015 Jeff Valk
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; This provides execution, reporting, and navigation support for Clojure tests,
;; specifically using the `clojure.test' machinery. This functionality replaces
;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on
;; nREPL middleware for report running and session support.
;;; Code:
(require 'cider-common)
(require 'cider-client)
(require 'cider-popup)
(require 'cider-stacktrace)
(require 'cider-compat)
(require 'button)
(require 'easymenu)
;;; Variables
(defgroup cider-test nil
"Presentation and navigation for test results."
:prefix "cider-test-"
:group 'cider)
(defcustom cider-test-show-report-on-success nil
"Whether to show the `*cider-test-report*` buffer on passing tests."
:type 'boolean
:group 'cider-test
:package-version '(cider . "0.8.0"))
(defcustom cider-auto-select-test-report-buffer t
"Determines if the test-report buffer should be auto-selected."
:type 'boolean
:group 'cider-test
:package-version '(cider . "0.9.0"))
(defvar cider-test-last-test-ns nil
"The namespace for which tests were last run.")
(defvar cider-test-last-results nil
"The results of the last run test.")
(defconst cider-test-report-buffer "*cider-test-report*"
"Buffer name in which to display test reports.")
(add-to-list 'cider-ancillary-buffers cider-test-report-buffer)
;;; Faces
;; These are as defined in clojure-test-mode.
(defface cider-test-failure-face
'((((class color) (background light))
:background "orange red")
(((class color) (background dark))
:background "firebrick"))
"Face for failed tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defface cider-test-error-face
'((((class color) (background light))
:background "orange1")
(((class color) (background dark))
:background "orange4"))
"Face for erring tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defface cider-test-success-face
'((((class color) (background light))
:foreground "black"
:background "green")
(((class color) (background dark))
:foreground "black"
:background "green"))
"Face for passing tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
;;; Report mode & key bindings
;; The primary mode of interacting with test results is the report buffer, which
;; allows navigation among tests, jumping to test definitions, expected/actual
;; diff-ing, and cause/stacktrace inspection for test errors.
(defvar cider-test-report-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c ,") #'cider-test-run-tests)
(define-key map (kbd "C-c C-,") #'cider-test-rerun-tests)
(define-key map (kbd "C-c M-,") #'cider-test-run-test)
(define-key map (kbd "M-p") #'cider-test-previous-result)
(define-key map (kbd "M-n") #'cider-test-next-result)
(define-key map (kbd "M-.") #'cider-test-jump)
(define-key map (kbd "<backtab>") #'cider-test-previous-result)
(define-key map (kbd "TAB") #'cider-test-next-result)
(define-key map (kbd "RET") #'cider-test-jump)
(define-key map (kbd "t") #'cider-test-jump)
(define-key map (kbd "d") #'cider-test-ediff)
(define-key map (kbd "e") #'cider-test-stacktrace)
(define-key map "q" #'cider-popup-buffer-quit-function)
(easy-menu-define cider-test-report-mode-menu map
"Menu for CIDER's test result mode"
'("Test-Report"
["Previous result" cider-test-previous-result]
["Next result" cider-test-next-result]
"--"
["Rerun current test" cider-test-run-test]
["Rerun failed/erring tests" cider-test-rerun-tests]
["Rerun all tests" cider-test-run-tests]
"--"
["Jump to test definition" cider-test-jump]
["Display test error" cider-test-stacktrace]
["Display expected/actual diff" cider-test-ediff]))
map))
(define-derived-mode cider-test-report-mode fundamental-mode "Test Report"
"Major mode for presenting Clojure test results.
\\{cider-test-report-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil))
;; Report navigation
(defun cider-test-show-report ()
"Show the test report buffer, if one exists."
(interactive)
(if-let ((report-buffer (get-buffer cider-test-report-buffer)))
(switch-to-buffer report-buffer)
(message "No test report buffer")))
(defun cider-test-previous-result ()
"Move point to the previous test result, if one exists."
(interactive)
(with-current-buffer (get-buffer cider-test-report-buffer)
(when-let ((pos (previous-single-property-change (point) 'type)))
(goto-char pos))))
(defun cider-test-next-result ()
"Move point to the next test result, if one exists."
(interactive)
(with-current-buffer (get-buffer cider-test-report-buffer)
(when-let ((pos (next-single-property-change (point) 'type)))
(goto-char pos))))
(defun cider-test-jump (&optional arg)
"Like `cider-find-var', but uses the test at point's definition, if available."
(interactive "P")
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var))
(line (get-text-property (point) 'line)))
(if (and ns var)
(cider-find-var arg (concat ns "/" var) line)
(cider-find-var arg))))
;;; Error stacktraces
(defvar cider-auto-select-error-buffer)
(defun cider-test-stacktrace-for (ns var index)
"Display stacktrace for the erring NS VAR test with the assertion INDEX."
(let (causes)
(cider-nrepl-send-request
(append
(list "op" "test-stacktrace" "session" (cider-current-session)
"ns" ns "var" var "index" index)
(when cider-stacktrace-print-length
(list "print-length" cider-stacktrace-print-length))
(when cider-stacktrace-print-level
(list "print-level" cider-stacktrace-print-level)))
(lambda (response)
(nrepl-dbind-response response (class status)
(cond (class (setq causes (cons response causes)))
(status (when causes
(cider-stacktrace-render
(cider-popup-buffer cider-error-buffer
cider-auto-select-error-buffer)
(reverse causes))))))))))
(defun cider-test-stacktrace ()
"Display stacktrace for the erring test at point."
(interactive)
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var))
(index (get-text-property (point) 'index))
(err (get-text-property (point) 'error)))
(if (and err ns var index)
(cider-test-stacktrace-for ns var index)
(message "No test error at point"))))
;;; Expected vs actual diffing
(defvar cider-test-ediff-buffers nil
"The expected/actual buffers used to display diff.")
(defun cider-test-ediff ()
"Show diff of the expected vs actual value for the test at point.
With the actual value, the outermost '(not ...)' s-expression is removed."
(interactive)
(let ((expected (get-text-property (point) 'expected))
(actual (get-text-property (point) 'actual)))
(if (and expected actual)
(let ((expected-buffer (generate-new-buffer " *expected*"))
(actual-buffer (generate-new-buffer " *actual*")))
(with-current-buffer expected-buffer
(insert expected)
(clojure-mode))
(with-current-buffer actual-buffer
(insert actual)
(goto-char (point-min))
(forward-char)
(forward-sexp)
(forward-whitespace 1)
(let ((beg (point)))
(forward-sexp)
(let ((actual* (buffer-substring beg (point))))
(erase-buffer)
(insert actual*)))
(clojure-mode))
(apply 'ediff-buffers
(setq cider-test-ediff-buffers
(list (buffer-name expected-buffer)
(buffer-name actual-buffer)))))
(message "No test failure at point"))))
(defun cider-test-ediff-cleanup ()
"Cleanup expected/actual buffers used for diff."
(interactive)
(mapc (lambda (b) (when (get-buffer b) (kill-buffer b)))
cider-test-ediff-buffers))
(add-hook 'ediff-cleanup-hook #'cider-test-ediff-cleanup)
;;; Report rendering
(defun cider-test-type-face (type)
"Return the font lock face for the test result TYPE."
(pcase type
("pass" 'cider-test-success-face)
("fail" 'cider-test-failure-face)
("error" 'cider-test-error-face)
(_ 'default)))
(defun cider-test-render-summary (buffer summary)
"Emit into BUFFER the report SUMMARY statistics."
(with-current-buffer buffer
(nrepl-dbind-response summary (var test pass fail error)
(insert (format "Ran %d tests, in %d test functions\n" test var))
(unless (zerop fail)
(cider-insert (format "%d failures" fail) 'cider-test-failure-face t))
(unless (zerop error)
(cider-insert (format "%d errors" error) 'cider-test-error-face t))
(when (zerop (+ fail error))
(cider-insert (format "%d passed" pass) 'cider-test-success-face t))
(insert "\n\n"))))
(defun cider-test-render-assertion (buffer test)
"Emit into BUFFER report detail for the TEST assertion."
(with-current-buffer buffer
(nrepl-dbind-response test (var context type message expected actual error)
(cider-propertize-region (cider-intern-keys (cdr test))
(cider-insert (capitalize type) (cider-test-type-face type) nil " in ")
(cider-insert var 'font-lock-function-name-face t)
(when context (cider-insert context 'font-lock-doc-face t))
(when message (cider-insert message 'font-lock-doc-string-face t))
(when expected (cider-insert "expected: " 'font-lock-comment-face nil
(cider-font-lock-as-clojure expected)))
(when actual (cider-insert " actual: " 'font-lock-comment-face)
(if error
(progn (insert-text-button
error
'follow-link t
'action '(lambda (_button) (cider-test-stacktrace))
'help-echo "View causes and stacktrace")
(insert "\n"))
(insert (cider-font-lock-as-clojure actual)))))
(insert "\n"))))
(defun cider-test-render-report (buffer ns summary results)
"Emit into BUFFER the report for the NS, SUMMARY, and test RESULTS."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(cider-test-report-mode)
(cider-insert "Test Summary" 'bold t)
(cider-insert ns 'font-lock-function-name-face t "\n")
(cider-test-render-summary buffer summary)
(nrepl-dbind-response summary (fail error)
(unless (zerop (+ fail error))
(cider-insert "Results" 'bold t "\n")
(nrepl-dict-map
(lambda (_var tests)
(dolist (test tests)
(nrepl-dbind-response test (type)
(unless (equal "pass" type)
(cider-test-render-assertion buffer test)))))
results)))
(goto-char (point-min))
(current-buffer))))
;;; Summary echo
(defun cider-test-echo-summary (summary)
"Echo SUMMARY statistics for a test run."
(nrepl-dbind-response summary (test fail error)
(message
(propertize
(format "Ran %s tests. %s failures, %s errors." test fail error)
'face (cond ((not (zerop error)) 'cider-test-error-face)
((not (zerop fail)) 'cider-test-failure-face)
(t 'cider-test-success-face))))))
;;; Test definition highlighting
;; On receipt of test results, failing/erring test definitions are highlighted.
;; Highlights are cleared on the next report run, and may be cleared manually
;; by the user.
;; NOTE If keybindings specific to test sources are desired, it would be
;; straightforward to turn this into a `cider-test-mode' minor mode, which we
;; enable on test sources, much like the legacy `clojure-test-mode'. At present,
;; though, there doesn't seem to be much value in this, since the report buffer
;; provides the primary means of interacting with test results.
(defun cider-test-highlight-problem (buffer test)
"Highlight the BUFFER test definition for the non-passing TEST."
(with-current-buffer buffer
(nrepl-dbind-response test (type file line message expected actual)
;; we have to watch out for vars without proper location metadata
;; right now everything evaluated interactively lacks this data
;; TODO: Figure out what to do when the metadata is missing
(when (and file line (not (cider--tooling-file-p file)))
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(forward-whitespace 1)
(forward-char)
(let ((beg (point)))
(forward-sexp)
(let ((overlay (make-overlay beg (point))))
(overlay-put overlay 'font-lock-face (cider-test-type-face type))
(overlay-put overlay 'type type)
(overlay-put overlay 'help-echo message)
(overlay-put overlay 'message message)
(overlay-put overlay 'expected expected)
(overlay-put overlay 'actual actual))))))))
(defun cider-find-var-file (var)
"Return the buffer visiting the file in which VAR is defined, or nil if
not found."
(cider-ensure-op-supported "info")
(when-let ((info (cider-var-info var))
(file (nrepl-dict-get info "file")))
(cider-find-file file)))
(defun cider-test-highlight-problems (ns results)
"Highlight all non-passing tests in the NS test RESULTS."
(nrepl-dict-map
(lambda (var tests)
(when-let ((buffer (cider-find-var-file (concat ns "/" var))))
(dolist (test tests)
(nrepl-dbind-response test (type)
(unless (equal "pass" type)
(cider-test-highlight-problem buffer test))))))
results))
(defun cider-test-clear-highlights ()
"Clear highlighting of non-passing tests from the last test run."
(interactive)
(when-let ((ns cider-test-last-test-ns))
(dolist (var (nrepl-dict-keys cider-test-last-results))
(when-let ((buffer (cider-find-var-file (concat ns "/" var))))
(with-current-buffer buffer
(remove-overlays))))))
;;; Test namespaces
;; Test namespace inference exists to enable DWIM test running functions: the
;; same "run-tests" function should be able to be used in a source file, and in
;; its corresponding test namespace. To provide this, we need to map the
;; relationship between those namespaces.
(defcustom cider-test-infer-test-ns 'cider-test-default-test-ns-fn
"Function to infer the test namespace for NS.
The default implementation uses the simple Leiningen convention of appending
'-test' to the namespace name."
:type 'symbol
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defun cider-test-default-test-ns-fn (ns)
"For a NS, return the test namespace, which may be the argument itself.
This uses the Leiningen convention of appending '-test' to the namespace name."
(when ns
(let ((suffix "-test"))
;; string-suffix-p is only available in Emacs 24.4+
(if (string-match-p (rx-to-string `(: ,suffix eos) t) ns)
ns
(concat ns suffix)))))
;;; Test execution
(declare-function cider-emit-interactive-eval-output "cider-interaction")
(declare-function cider-emit-interactive-eval-err-output "cider-interaction")
(defun cider-test-execute (ns &optional retest tests)
"Run tests for NS; optionally RETEST failures or run only specified TESTS.
Upon test completion, results are echoed and a test report is optionally
displayed. When test failures/errors occur, their sources are highlighted."
(cider-test-clear-highlights)
(message "Testing...")
(cider-nrepl-send-request
(list "ns" ns "op" (if retest "retest" "test")
"tests" tests "session" (cider-current-session))
(lambda (response)
(nrepl-dbind-response response (summary results status out err)
(cond ((member "namespace-not-found" status)
(message "No tests namespace: %s" ns))
(out (cider-emit-interactive-eval-output out))
(err (cider-emit-interactive-eval-err-output err))
(results
(nrepl-dbind-response summary (error fail)
(setq cider-test-last-test-ns ns)
(setq cider-test-last-results results)
(cider-test-highlight-problems ns results)
(cider-test-echo-summary summary)
(when (or (not (zerop (+ error fail)))
cider-test-show-report-on-success)
(cider-test-render-report
(cider-popup-buffer cider-test-report-buffer
cider-auto-select-test-report-buffer)
ns summary results)))))))))
(defun cider-test-rerun-tests ()
"Rerun failed and erring tests from the last tested namespace."
(interactive)
(if-let ((ns cider-test-last-test-ns))
(cider-test-execute ns t)
(message "No namespace to retest")))
(defun cider-test-run-tests (suppress-inference)
"Run all tests for the current Clojure source or test report context.
With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the
current ns."
(interactive "P")
(if-let ((ns (if suppress-inference
(clojure-find-ns)
(or (funcall cider-test-infer-test-ns (clojure-find-ns))
(when (eq major-mode 'cider-test-report-mode)
cider-test-last-test-ns)))))
(cider-test-execute ns nil)
(message "No namespace to test in current context")))
(defun cider-test-run-test ()
"Run the test at point.
The test ns/var exist as text properties on report items and on highlighted
failed/erred test definitions. When not found, a test definition at point
is searched."
(interactive)
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var)))
(if (and ns var)
(cider-test-execute ns nil (list var))
(let ((ns (clojure-find-ns))
(def (clojure-find-def)))
(if (and ns (member (car def) '("deftest" "defspec")))
(cider-test-execute ns nil (cdr def))
(message "No test at point"))))))
(provide 'cider-test)
;;; cider-test.el ends here

383
dotfiles/emacs.d/elpa/cider-20151022.28/cider-util.el

@ -0,0 +1,383 @@
;;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Common utility functions that don't belong anywhere else.
;;; Code:
(require 'seq)
(require 'cl-lib)
(require 'clojure-mode)
(defalias 'cider-pop-back 'pop-tag-mark)
(define-obsolete-function-alias 'cider-jump-back 'cider-pop-back "0.10.0")
(defcustom cider-font-lock-max-length 10000
"The max length of strings to fontify in `cider-font-lock-as'.
Setting this to nil removes the fontification restriction."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defun cider-util--hash-keys (hashtable)
"Return a list of keys in HASHTABLE."
(let ((keys '()))
(maphash (lambda (k _v) (setq keys (cons k keys))) hashtable)
keys))
(defun cider-util--clojure-buffers ()
"Return a list of all existing `clojure-mode' buffers."
(seq-filter
(lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode)))
(buffer-list)))
(defun cider-current-dir ()
"Return the directory of the current buffer."
(if buffer-file-name
(file-name-directory buffer-file-name)
default-directory))
(defun cider-in-string-p ()
"Return true if point is in a string."
(let ((beg (save-excursion (beginning-of-defun) (point))))
(nth 3 (parse-partial-sexp beg (point)))))
(defun cider-in-comment-p ()
"Return true if point is in a comment."
(let ((beg (save-excursion (beginning-of-defun) (point))))
(nth 4 (parse-partial-sexp beg (point)))))
(defun cider--tooling-file-p (file-name)
"Return t if FILE-NAME is not a 'real' source file.
Currently, only check if the relative file name starts with 'form-init'
which nREPL uses for temporary evaluation file names."
(let ((fname (file-name-nondirectory file-name)))
(string-match-p "^form-init" fname)))
;;; Thing at point
(defun cider-defun-at-point ()
"Return the text of the top-level sexp at point."
(apply #'buffer-substring-no-properties
(cider--region-for-defun-at-point)))
(defun cider--region-for-defun-at-point ()
"Return the start and end position of defun at point."
(save-excursion
(save-match-data
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(list (point) end)))))
(defun cider-defun-at-point-start-pos ()
"Return the starting position of the current defun."
(car (cider--region-for-defun-at-point)))
(defun cider-ns-form ()
"Retrieve the ns form."
(when (clojure-find-ns)
(save-excursion
(goto-char (match-beginning 0))
(cider-defun-at-point))))
(defun cider-bounds-of-sexp-at-point ()
"Return the bounds sexp at point as a pair (or nil)."
(or (and (equal (char-after) ?\()
(member (char-before) '(?\' ?\, ?\@))
;; hide stuff before ( to avoid quirks with '( etc.
(save-restriction
(narrow-to-region (point) (point-max))
(bounds-of-thing-at-point 'sexp)))
(bounds-of-thing-at-point 'sexp)))
(defun cider-map-indexed (f list)
"Return a list of (F index item) for each item in LIST."
(let ((i 0)
(out))
(dolist (it list (nreverse out))
(push (funcall f i it) out)
(setq i (1+ i)))))
(defun cider-symbol-at-point ()
"Return the name of the symbol at point, otherwise nil."
(let ((str (or (thing-at-point 'symbol) "")))
(if (text-property-any 0 (length str) 'field 'cider-repl-prompt str)
""
str)))
(defun cider-sexp-at-point ()
"Return the sexp at point as a string, otherwise nil."
(let ((bounds (cider-bounds-of-sexp-at-point)))
(if bounds
(buffer-substring-no-properties (car bounds)
(cdr bounds)))))
(defun cider-sexp-at-point-with-bounds ()
"Return a list containing the sexp at point and its bounds."
(let ((bounds (cider-bounds-of-sexp-at-point)))
(if bounds
(let ((start (car bounds))
(end (cdr bounds)))
(list (buffer-substring-no-properties start end)
(cons (set-marker (make-marker) start)
(set-marker (make-marker) end)))))))
(defun cider-last-sexp (&optional bounds)
"Return the sexp preceding the point.
If BOUNDS is non-nil, return a list of its starting and ending position
instead."
(apply (if bounds #'list #'buffer-substring-no-properties)
(save-excursion
(clojure-backward-logical-sexp 1)
(list (point)
(progn (clojure-forward-logical-sexp 1)
(point))))))
;;; Text properties
(defun cider-maybe-intern (name)
"If NAME is a symbol, return it; otherwise, intern it."
(if (symbolp name) name (intern name)))
(defun cider-intern-keys (props)
"Copy plist-style PROPS with any non-symbol keys replaced with symbols."
(cider-map-indexed (lambda (i x) (if (cl-oddp i) x (cider-maybe-intern x))) props))
(defmacro cider-propertize-region (props &rest body)
"Execute BODY and add PROPS to all the text it inserts.
More precisely, PROPS are added to the region between the point's
positions before and after executing BODY."
(declare (indent 1))
(let ((start (cl-gensym)))
`(let ((,start (point)))
(prog1 (progn ,@body)
(add-text-properties ,start (point) ,props)))))
(put 'cider-propertize-region 'lisp-indent-function 1)
(defun cider-property-bounds (prop)
"Return the the positions of the previous and next change to PROP.
PROP is the name of a text property."
(let ((end (next-single-char-property-change (point) prop)))
(list (previous-single-char-property-change end prop) end)))
(defun cider-insert (text &optional face break more-text)
"Insert TEXT with FACE, optionally followed by a line BREAK and MORE-TEXT."
(insert (if face (propertize text 'font-lock-face face) text))
(when more-text (insert more-text))
(when break (insert "\n")))
;;; Font lock
(defun cider--font-lock-ensure ()
"Call `font-lock-ensure' or `font-lock-fontify-buffer', as appropriate."
(if (fboundp 'font-lock-ensure)
(font-lock-ensure)
(with-no-warnings
(font-lock-fontify-buffer))))
(defvar cider--mode-buffers nil
"A list of buffers for different major modes.")
(defun cider--make-buffer-for-mode (mode)
"Return a temp buffer using major-mode MODE.
This buffer is not designed to display anything to the user. For that, use
`cider-make-popup-buffer' instead."
(or (cdr (assq mode cider--mode-buffers))
(let ((b (generate-new-buffer (format " *cider-temp %s*" mode))))
(push (cons mode b) cider--mode-buffers)
(with-current-buffer b
;; suppress major mode hooks as we care only about their font-locking
;; otherwise modes like whitespace-mode and paredit might interfere
(setq-local delay-mode-hooks t)
(setq delayed-mode-hooks nil)
(funcall mode))
b)))
(defun cider-font-lock-as (mode string)
"Use MODE to font-lock the STRING."
(if (or (null cider-font-lock-max-length)
(< (length string) cider-font-lock-max-length))
(with-current-buffer (cider--make-buffer-for-mode mode)
(erase-buffer)
(insert string)
(font-lock-fontify-region (point-min) (point-max))
(buffer-string))
string))
(defun cider-font-lock-region-as (mode beg end &optional buffer)
"Use MODE to font-lock text between BEG and END.
Unless you specify a BUFFER it will default to the current one."
(with-current-buffer (or buffer (current-buffer))
(let ((text (buffer-substring beg end)))
(delete-region beg end)
(goto-char beg)
(insert (cider-font-lock-as mode text)))))
(defun cider-font-lock-as-clojure (string)
"Font-lock STRING as Clojure code."
(cider-font-lock-as 'clojure-mode string))
;;; Colors
(defun cider-scale-color (color scale)
"For a COLOR hex string or name, adjust intensity of RGB components by SCALE."
(let* ((rgb (color-values color))
(scaled-rgb (mapcar (lambda (n)
(format "%04x" (round (+ n (* scale 65535)))))
rgb)))
(apply #'concat "#" scaled-rgb)))
(defun cider-scale-background-color ()
"Scale the current background color to get a slighted muted version."
(let ((color (frame-parameter nil 'background-color))
(dark (eq (frame-parameter nil 'background-mode) 'dark)))
(cider-scale-color color (if dark 0.05 -0.05))))
(autoload 'pkg-info-version-info "pkg-info.el")
(defvar cider-version)
(defun cider--version ()
"Retrieve CIDER's version."
(condition-case nil
(pkg-info-version-info 'cider)
(error cider-version)))
;;; Strings
(defun cider-string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR."
(mapconcat #'identity strings separator))
(defun cider-join-into-alist (candidates &optional separator)
"Make an alist from CANDIDATES.
The keys are the elements joined with SEPARATOR and values are the original
elements. Useful for `completing-read' when candidates are complex
objects."
(mapcar (lambda (el)
(if (listp el)
(cons (cider-string-join el (or separator ":")) el)
(cons el el)))
candidates))
(defun cider-namespace-qualified-p (sym)
"Return t if SYM is namespace-qualified."
(string-match-p "[^/]+/" sym))
(defun cider--readme-button (label section-id)
"Return a button string that links to the online readme.
LABEL is the displayed string, and SECTION-ID is where it points
to."
(with-temp-buffer
(insert-text-button
label
'follow-link t
'action (lambda (&rest _) (interactive)
(browse-url (concat "https://github.com/clojure-emacs/cider#"
section-id))))
(buffer-string)))
(defun cider--project-name (dir)
"Extracts a project name from DIR, possibly nil.
The project name is the final component of DIR if not nil."
(when dir
(file-name-nondirectory (directory-file-name dir))))
;;; Vectors
(defun cider--deep-vector-to-list (x)
"Convert vectors in X to lists.
If X is a sequence, return a list of `cider--deep-vector-to-list' applied to
each of its elements.
Any other value is just returned."
(if (sequencep x)
(mapcar #'cider--deep-vector-to-list x)
x))
;;; Words of inspiration
(defun cider-user-first-name ()
"Find the current user's first name."
(let ((name (if (string= (user-full-name) "")
(user-login-name)
(user-full-name))))
(string-match "^[^ ]*" name)
(capitalize (match-string 0 name))))
(defvar cider-words-of-inspiration
`("The best way to predict the future is to invent it. -Alan Kay"
"A point of view is worth 80 IQ points. -Alan Kay"
"Lisp isn't a language, it's a building material. -Alan Kay"
"Simple things should be simple, complex things should be possible. -Alan Kay"
"Everything should be as simple as possible, but not simpler. -Albert Einstein"
"Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates"
"Controlling complexity is the essence of computer programming. -Brian Kernighan"
"The unavoidable price of reliability is simplicity. -C.A.R. Hoare"
"You're bound to be unhappy if you optimize everything. -Donald Knuth"
"Simplicity is prerequisite for reliability. -Edsger W. Dijkstra"
"Elegance is not a dispensable luxury but a quality that decides between success and failure. -Edsger W. Dijkstra"
"Deleted code is debugged code. -Jeff Sickel"
"The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy"
"First, solve the problem. Then, write the code. -John Johnson"
"Simplicity is the ultimate sophistication. -Leonardo da Vinci"
"Programming is not about typing... it's about thinking. -Rich Hickey"
"Design is about pulling things apart. -Rich Hickey"
"Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey"
"Code never lies, comments sometimes do. -Ron Jeffries"
"The true delight is in the finding out rather than in the knowing. -Isaac Asimov"
"If paredit is not for you, then you need to become the sort of person that paredit is for. -Phil Hagelberg"
"Express Yourself. -Madonna"
"Take this REPL, fellow hacker, and may it serve you well."
"Let the hacking commence!"
"Hacks and glory await!"
"Hack and be merry!"
"Your hacking starts... NOW!"
"May the Source be with you!"
"May the Source shine upon thy REPL!"
"Code long and prosper!"
"Happy hacking!"
"nREPL server is up, CIDER REPL is online!"
"CIDER REPL operational!"
"Your imagination is the only limit to what you can do with this REPL!"
"This REPL is yours to command!"
"Fame is but a hack away!"
"The REPL is not enough, but it is such a perfect place to start..."
,(format "%s, this could be the start of a beautiful program."
(cider-user-first-name)))
"Scientifically-proven optimal words of hackerish encouragement.")
(defun cider-random-words-of-inspiration ()
"Select a random entry from `cider-words-of-inspiration'."
(eval (nth (random (length cider-words-of-inspiration))
cider-words-of-inspiration)))
(provide 'cider-util)
;;; cider-util.el ends here

524
dotfiles/emacs.d/elpa/cider-20151022.28/cider.el

@ -0,0 +1,524 @@
;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com>
;; URL: http://www.github.com/clojure-emacs/cider
;; Version: 0.10.0-cvs
;; Package-Requires: ((clojure-mode "5.0.0") (pkg-info "0.4") (emacs "24.3") (queue "0.1.1") (spinner "1.4") (seq "1.9"))
;; Keywords: languages, clojure, cider
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Provides a Clojure interactive development environment for Emacs, built on
;; top of nREPL.
;;; Installation:
;; Available as a package in marmalade-repo.org and melpa.org
;; (add-to-list 'package-archives
;; '("marmalade" . "http://marmalade-repo.org/packages/"))
;;
;; or
;;
;; (add-to-list 'package-archives
;; '("melpa" . "http://melpa.org/packages/") t)
;;
;; M-x package-install cider
;;; Usage:
;; M-x cider-jack-in
;;; Code:
(defgroup cider nil
"Clojure Interactive Development Environment that Rocks."
:prefix "cider-"
:group 'applications
:link '(url-link :tag "Github" "https://github.com/clojure-emacs/cider")
:link '(emacs-commentary-link :tag "Commentary" "cider"))
(defcustom cider-prompt-for-project-on-connect t
"Controls whether to prompt for associated project on `cider-connect'."
:type 'boolean
:group 'cider
:package-version '(cider . "0.10.0"))
(require 'cider-client)
(require 'cider-eldoc)
(require 'cider-repl)
(require 'cider-mode)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-debug)
(require 'tramp-sh)
(require 'seq)
(defconst cider-version "0.10.0-snapshot"
"Fallback version used when it cannot be extracted automatically.
Normally it won't be used, unless `pkg-info' fails to extract the
version from the CIDER package or library.")
(defcustom cider-lein-command
"lein"
"The command used to execute Leiningen 2.x."
:type 'string
:group 'cider)
(defcustom cider-lein-parameters
"repl :headless"
"Params passed to lein to start an nREPL server via `cider-jack-in'."
:type 'string
:group 'cider)
(defcustom cider-boot-command
"boot"
"The command used to execute Boot."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-boot-parameters
"repl -s wait"
"Params passed to boot to start an nREPL server via `cider-jack-in'."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-default-repl-command
"lein"
"The default command and parameters to use when connecting to nREPL.
This value will only be consulted when no identifying file types, i.e.
project.clj for leiningen or build.boot for boot, could be found."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-known-endpoints nil
"A list of connection endpoints where each endpoint is a list.
For example: '((\"label\" \"host\" \"port\")).
The label is optional so that '(\"host\" \"port\") will suffice.
This variable is used by `cider-connect'."
:type 'list
:group 'cider)
(defcustom cider-connected-hook nil
"List of functions to call when connected to Clojure nREPL server."
:type 'hook
:group 'cider
:version "0.9.0")
(defcustom cider-disconnected-hook nil
"List of functions to call when disconnected from the Clojure nREPL server."
:type 'hook
:group 'cider
:version "0.9.0")
(defcustom cider-auto-mode t
"When non-nil, automatically enable `cider-mode' for all Clojure buffers."
:type 'boolean
:version "0.9.0")
(defvar cider-ps-running-nrepls-command "ps u | grep leiningen"
"Process snapshot command used in `cider-locate-running-nrepl-ports'.")
(defvar cider-ps-running-nrepl-path-regexp-list
'("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D"
"\\(?:-classpath +:?\\(.+?\\)/self-installs\\)")
"Regexp list to extract project paths from output of `cider-ps-running-nrepls-command'.
Sub-match 1 must be the project path.")
(defvar cider-host-history nil
"Completion history for connection hosts.")
;;;###autoload
(defun cider-version ()
"Display CIDER's version."
(interactive)
(message "CIDER %s" (cider--version)))
(defun cider-command-present-p (project-type)
"Check if the command matching PROJECT-TYPE is present."
(pcase project-type
("lein" 'cider--lein-present-p)
("boot" 'cider--boot-present-p)))
(defun cider-jack-in-command (project-type)
"Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE."
(pcase project-type
("lein" cider-lein-command)
("boot" cider-boot-command)))
(defun cider-jack-in-params (project-type)
"Determine the commands params for `cider-jack-in' for the PROJECT-TYPE."
(pcase project-type
("lein" cider-lein-parameters)
("boot" cider-boot-parameters)))
(defcustom cider-cljs-repl "(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))"
"Clojure form that returns a ClojureScript REPL environment.
This is evaluated in a Clojure REPL and it should start a ClojureScript
REPL."
:type '(choice (const :tag "Rhino"
"(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))")
(const :tag "Node (requires NodeJS to be installed)"
"(do (require 'cljs.repl.node) (cemerick.piggieback/cljs-repl (cljs.repl.node/repl-env)))")
(const :tag "Weasel (see Readme for additional configuration)"
"(do (require 'weasel.repl.websocket) (cemerick.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))")
(string :tag "Custom"))
:group 'cider)
(defun cider-create-sibling-cljs-repl (client-buffer)
"Create a ClojureScript REPL with the same server as CLIENT-BUFFER.
The new buffer will correspond to the same project as CLIENT-BUFFER, which
should be the regular Clojure REPL started by the server process filter."
(interactive (list (cider-current-connection)))
(let* ((nrepl-repl-buffer-name-template "*cider-repl CLJS%s*")
(nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer 'new)
(client-process-args (with-current-buffer client-buffer
(unless (or nrepl-server-buffer nrepl-endpoint)
(error "This is not a REPL buffer, is there a REPL active?"))
(list (car nrepl-endpoint)
(elt nrepl-endpoint 1)
(when (buffer-live-p nrepl-server-buffer)
(get-buffer-process nrepl-server-buffer)))))
(cljs-proc (apply #'nrepl-start-client-process client-process-args))
(cljs-buffer (process-buffer cljs-proc)))
(with-current-buffer cljs-buffer
(cider-nrepl-send-request
(list "op" "eval"
"ns" (cider-current-ns)
"session" nrepl-session
"code" cider-cljs-repl)
(cider-repl-handler (current-buffer))))))
(defun cider-find-reusable-repl-buffer (endpoint project-directory)
"Check whether a reusable connection buffer already exists.
Looks for buffers where `nrepl-endpoint' matches ENDPOINT, or
`nrepl-project-dir' matches PROJECT-DIRECTORY. If such a buffer was found,
and has no process, return it. If the process is alive, ask the user for
confirmation and return 'new/nil for y/n answer respectively. If other
REPL buffers with dead process exist, ask the user if any of those should
be reused."
(let* ((repl-buffs (cider-repl-buffers))
(exact-buff (seq-find (lambda (buff)
(with-current-buffer buff
(or (and endpoint (equal endpoint nrepl-endpoint))
(and project-directory (equal project-directory nrepl-project-dir)))))
repl-buffs)))
(cl-flet ((zombie-buffer-or-new
() (let ((zombie-buffs (seq-remove (lambda (buff)
(process-live-p (get-buffer-process buff)))
repl-buffs)))
(if zombie-buffs
(if (y-or-n-p (format "Zombie REPL buffers exist (%s). Reuse? "
(mapconcat #'buffer-name zombie-buffs ", ")))
(if (= (length zombie-buffs) 1)
(car zombie-buffs)
(completing-read "Choose REPL buffer: " zombie-buffs nil t))
'new)
'new))))
(if exact-buff
(if (process-live-p (get-buffer-process exact-buff))
(when (y-or-n-p
(format "REPL buffer already exists (%s). Do you really want to create a new one? "
exact-buff))
(zombie-buffer-or-new))
exact-buff)
(zombie-buffer-or-new)))))
;;;###autoload
(defun cider-jack-in (&optional prompt-project cljs-too)
"Start a nREPL server for the current project and connect to it.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its
own buffer."
(interactive "P")
(setq cider-current-clojure-buffer (current-buffer))
(let ((project-type (or (cider-project-type) cider-default-repl-command)))
(if (funcall (cider-command-present-p project-type))
(let* ((project (when prompt-project
(read-directory-name "Project: ")))
(project-dir (clojure-project-dir
(or project (cider-current-dir))))
(params (if prompt-project
(read-string (format "nREPL server command: %s "
(cider-jack-in-params project-type))
(cider-jack-in-params project-type))
(cider-jack-in-params project-type)))
(cmd (format "%s %s" (cider-jack-in-command project-type) params)))
(when-let ((repl-buff (cider-find-reusable-repl-buffer nil project-dir)))
(let ((nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer repl-buff))
(nrepl-start-server-process
project-dir cmd
(when cljs-too #'cider-create-sibling-cljs-repl)))))
(message "The %s executable (specified by `cider-lein-command' or `cider-boot-command') isn't on your `exec-path'"
(cider-jack-in-command project-type)))))
;;;###autoload
(defun cider-jack-in-clojurescript (&optional prompt-project)
"Start a nREPL server and connect to it both Clojure and ClojureScript REPLs.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server."
(interactive "P")
(cider-jack-in prompt-project 'cljs-too))
;;;###autoload
(defun cider-connect (host port &optional project-dir)
"Connect to an nREPL server identified by HOST and PORT.
Create REPL buffer and start an nREPL client connection.
When the optional param PROJECT-DIR is present, the connection
gets associated with it."
(interactive (cider-select-endpoint))
(setq cider-current-clojure-buffer (current-buffer))
(when-let ((repl-buff (cider-find-reusable-repl-buffer `(,host ,port) nil)))
(let* ((nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer repl-buff)
(conn (process-buffer (nrepl-start-client-process host port))))
(if project-dir
(cider-assoc-project-with-connection project-dir conn)
(when (and cider-prompt-for-project-on-connect
(y-or-n-p "Do you want to associate the new connection with a local project? "))
(cider-assoc-project-with-connection nil conn))))))
(defun cider-current-host ()
"Retrieve the current host."
(if (and (stringp buffer-file-name)
(file-remote-p buffer-file-name))
tramp-current-host
"localhost"))
(defun cider-select-endpoint ()
"Interactively select the host and port to connect to."
(let* ((ssh-hosts (cider--ssh-hosts))
(hosts (seq-uniq (append (when cider-host-history
;; history elements are strings of the form "host:port"
(list (split-string (car cider-host-history) ":")))
(list (list (cider-current-host)))
cider-known-endpoints
ssh-hosts
(when (file-remote-p default-directory)
;; add localhost even in remote buffers
'(("localhost"))))))
(sel-host (cider--completing-read-host hosts))
(host (car sel-host))
(port (or (cadr sel-host)
(cider--completing-read-port host (cider--infer-ports host ssh-hosts)))))
(list host port)))
(defun cider--ssh-hosts ()
"Retrieve all ssh host from local configuration files."
(seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s)))
(let ((tramp-completion-mode t))
(tramp-completion-handle-file-name-all-completions "" "/ssh:"))))
(defun cider--completing-read-host (hosts)
"Interactively select host from HOSTS.
Each element in HOSTS is one of: (host), (host port) or (label host port).
Return a list of the form (HOST PORT), where PORT can be nil."
(let* ((hosts (cider-join-into-alist hosts))
(sel-host (completing-read "Host: " hosts nil nil nil
'cider-host-history (caar hosts)))
(host (or (cdr (assoc sel-host hosts)) (list sel-host))))
;; remove the label
(if (= 3 (length host)) (cdr host) host)))
(defun cider--infer-ports (host ssh-hosts)
"Infer nREPL ports on HOST.
Return a list of elements of the form (directory port). SSH-HOSTS is a list
of remote SSH hosts."
(let ((localp (or (nrepl-local-host-p host)
(not (assoc-string host ssh-hosts)))))
(if localp
;; change dir: current file might be remote
(let* ((change-dir-p (file-remote-p default-directory))
(default-directory (if change-dir-p "~/" default-directory)))
(cider-locate-running-nrepl-ports (unless change-dir-p default-directory)))
(let ((vec (vector "sshx" nil host "" nil))
;; change dir: user might want to connect to a different remote
(dir (when (file-remote-p default-directory)
(with-parsed-tramp-file-name default-directory cur
(when (string= cur-host host) default-directory)))))
(tramp-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(cider-locate-running-nrepl-ports dir))))))
(defun cider--completing-read-port (host ports)
"Interactively select port for HOST from PORTS."
(let* ((ports (cider-join-into-alist ports))
(sel-port (completing-read (format "Port for %s: " host) ports
nil nil nil nil (caar ports)))
(port (or (cdr (assoc sel-port ports)) sel-port))
(port (if (listp port) (cadr port) port)))
(if (stringp port) (string-to-number port) port)))
(defun cider-locate-running-nrepl-ports (&optional dir)
"Locate ports of running nREPL servers.
When DIR is non-nil also look for nREPL port files in DIR. Return a list
of list of the form (project-dir port)."
(let* ((paths (cider--running-nrepl-paths))
(proj-ports (mapcar (lambda (d)
(when-let ((port (and d (nrepl-extract-port (cider--file-path d)))))
(list (file-name-nondirectory (directory-file-name d)) port)))
(cons (clojure-project-dir dir) paths))))
(seq-uniq (delq nil proj-ports))))
(defun cider--running-nrepl-paths ()
"Retrieve project paths of running nREPL servers.
Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'."
(let (paths)
(with-temp-buffer
(insert (shell-command-to-string cider-ps-running-nrepls-command))
(dolist (regexp cider-ps-running-nrepl-path-regexp-list)
(goto-char 1)
(while (re-search-forward regexp nil t)
(setq paths (cons (match-string 1) paths)))))
(seq-uniq paths)))
(defun cider-project-type ()
"Determine the type, either leiningen or boot, of the current project.
If both project file types are present, prompt the user to choose."
(let* ((default-directory (clojure-project-dir (cider-current-dir)))
(lein-project-exists (file-exists-p "project.clj"))
(boot-project-exists (file-exists-p "build.boot")))
(cond ((and lein-project-exists boot-project-exists)
(completing-read "Which command should be used? "
'("lein" "boot") nil t "lein"))
(lein-project-exists "lein")
(boot-project-exists "boot"))))
;; TODO: Implement a check for `cider-lein-command' over tramp
(defun cider--lein-present-p ()
"Check if `cider-lein-command' is on the `exec-path'.
In case `default-directory' is non-local we assume the command is available."
(or (file-remote-p default-directory)
(executable-find cider-lein-command)
(executable-find (concat cider-lein-command ".bat"))))
(defun cider--boot-present-p ()
"Check if `cider-boot-command' is on the `exec-path'.
In case `default-directory' is non-local we assume the command is available."
(or (file-remote-p default-directory)
(executable-find cider-boot-command)
(executable-find (concat cider-boot-command ".exe"))))
;;; Check that the connection is working well
;; TODO: This is nrepl specific. It should eventually go into some cider-nrepl-client
;; file.
(defun cider--check-required-nrepl-ops ()
"Check whether all required nREPL ops are present."
(let* ((current-connection (cider-current-connection))
(missing-ops (seq-remove (lambda (op) (nrepl-op-supported-p op current-connection))
cider-required-nrepl-ops)))
(when missing-ops
(cider-repl-emit-interactive-stderr
(format "WARNING: The following required nREPL ops are not supported: \n%s\nPlease, install (or update) cider-nrepl %s and restart CIDER"
(cider-string-join missing-ops " ")
(upcase cider-version))))))
(defun cider--check-required-nrepl-version ()
"Check whether we're using a compatible nREPL version."
(let ((nrepl-version (cider--nrepl-version)))
(if nrepl-version
(when (version< nrepl-version cider-required-nrepl-version)
(cider-repl-emit-interactive-stderr
(cider--readme-button
(format "WARNING: CIDER requires nREPL %s (or newer) to work properly"
cider-required-nrepl-version)
"warning-saying-you-have-to-use-nrepl-027")))
(cider-repl-emit-interactive-stderr
(format "WARNING: Can't determine nREPL's version. Please, update nREPL to %s."
cider-required-nrepl-version)))))
(defun cider--check-middleware-compatibility-callback (buffer)
"A callback to check if the middleware used is compatible with CIDER."
(nrepl-make-response-handler
buffer
(lambda (_buffer result)
(let ((middleware-version (read result)))
(unless (and middleware-version (equal cider-version middleware-version))
(cider-repl-emit-interactive-stderr
(format "ERROR: CIDER's version (%s) does not match cider-nrepl's version (%s). Things will break!"
cider-version middleware-version)))))
'()
'()
'()))
(defun cider--check-middleware-compatibility ()
"Retrieve the underlying connection's CIDER nREPL version."
(cider-nrepl-request:eval
"(try
(require 'cider.nrepl.version)
(:version-string @(resolve 'cider.nrepl.version/version))
(catch Throwable _ \"not installed\"))"
(cider--check-middleware-compatibility-callback (current-buffer))))
(defun cider--subscribe-repl-to-server-out ()
"Subscribe to the server's *out*."
(cider-nrepl-send-request '("op" "out-subscribe")
(cider-interactive-eval-handler (current-buffer))))
(defun cider--connected-handler ()
"Handle cider initialization after nREPL connection has been established.
This function is appended to `nrepl-connected-hook' in the client process
buffer."
;; `nrepl-connected-hook' is run in connection buffer
(cider-make-connection-default (current-buffer))
(cider-repl-init (current-buffer))
(cider--check-required-nrepl-version)
(cider--check-required-nrepl-ops)
(cider--check-middleware-compatibility)
(cider--debug-init-connection)
(cider--subscribe-repl-to-server-out)
(when cider-auto-mode
(cider-enable-on-existing-clojure-buffers))
(run-hooks 'cider-connected-hook))
(defun cider--disconnected-handler ()
"Cleanup after nREPL connection has been lost or closed.
This function is appended to `nrepl-disconnected-hook' in the client
process buffer."
;; `nrepl-connected-hook' is run in connection buffer
(cider-possibly-disable-on-existing-clojure-buffers)
(run-hooks 'cider-disconnected-hook))
;;;###autoload
(eval-after-load 'clojure-mode
'(progn
(define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in)
(define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect)))
(provide 'cider)
;;; cider.el ends here

1265
dotfiles/emacs.d/elpa/cider-20151022.28/nrepl-client.el

File diff suppressed because it is too large Load Diff

55
dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode-autoloads.el

@ -0,0 +1,55 @@
;;; clojure-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "clojure-mode" "clojure-mode.el" (22059 7731
;;;;;; 396684 120000))
;;; Generated autoloads from clojure-mode.el
(autoload 'clojure-mode "clojure-mode" "\
Major mode for editing Clojure code.
\\{clojure-mode-map}
\(fn)" t nil)
(autoload 'clojurescript-mode "clojure-mode" "\
Major mode for editing ClojureScript code.
\\{clojurescript-mode-map}
\(fn)" t nil)
(autoload 'clojurec-mode "clojure-mode" "\
Major mode for editing ClojureC code.
\\{clojurec-mode-map}
\(fn)" t nil)
(autoload 'clojurex-mode "clojure-mode" "\
Major mode for editing ClojureX code.
\\{clojurex-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode))
(add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode))
(add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode))
(add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode))
(add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; clojure-mode-autoloads.el ends here

1
dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode-pkg.el

@ -0,0 +1 @@
(define-package "clojure-mode" "20151022.27" "Major mode for Clojure code" '((emacs "24.3")) :url "http://github.com/clojure-emacs/clojure-mode" :keywords '("languages" "clojure" "clojurescript" "lisp"))

1220
dotfiles/emacs.d/elpa/clojure-mode-20151022.27/clojure-mode.el

File diff suppressed because it is too large Load Diff

32
dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode-autoloads.el

@ -0,0 +1,32 @@
;;; coffee-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "coffee-mode" "coffee-mode.el" (22059 7732
;;;;;; 93350 790000))
;;; Generated autoloads from coffee-mode.el
(autoload 'coffee-mode "coffee-mode" "\
Major mode for editing CoffeeScript.
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.coffee\\'" . coffee-mode))
(add-to-list 'auto-mode-alist '("\\.iced\\'" . coffee-mode))
(add-to-list 'auto-mode-alist '("Cakefile\\'" . coffee-mode))
(add-to-list 'auto-mode-alist '("\\.cson\\'" . coffee-mode))
(add-to-list 'interpreter-mode-alist '("coffee" . coffee-mode))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; coffee-mode-autoloads.el ends here

1
dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode-pkg.el

@ -0,0 +1 @@
(define-package "coffee-mode" "20151019.2009" "Major mode to edit CoffeeScript files in Emacs" '((emacs "24.1") (cl-lib "0.5")) :url "http://github.com/defunkt/coffee-mode" :keywords '("coffeescript" "major" "mode"))

1259
dotfiles/emacs.d/elpa/coffee-mode-20151019.2009/coffee-mode.el

File diff suppressed because it is too large Load Diff

15
dotfiles/emacs.d/elpa/dash-20151021.113/dash-autoloads.el

@ -0,0 +1,15 @@
;;; dash-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("dash.el") (22059 7730 182656 315000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; dash-autoloads.el ends here

1
dotfiles/emacs.d/elpa/dash-20151021.113/dash-pkg.el

@ -0,0 +1 @@
(define-package "dash" "20151021.113" "A modern list library for Emacs" 'nil :keywords '("lists"))

2435
dotfiles/emacs.d/elpa/dash-20151021.113/dash.el

File diff suppressed because it is too large Load Diff

15
dotfiles/emacs.d/elpa/epl-20150517.433/epl-autoloads.el

@ -0,0 +1,15 @@
;;; epl-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("epl.el") (22059 18172 165131 281000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; epl-autoloads.el ends here

1
dotfiles/emacs.d/elpa/epl-20150517.433/epl-pkg.el

@ -0,0 +1 @@
(define-package "epl" "20150517.433" "Emacs Package Library" '((cl-lib "0.3")) :url "http://github.com/cask/epl" :keywords '("convenience"))

695
dotfiles/emacs.d/elpa/epl-20150517.433/epl.el

@ -0,0 +1,695 @@
;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2015 Sebastian Wiesner
;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
;; Sebastian Wiesner <swiesner@lunaryorn.com>
;; Version: 0.9-cvs
;; Package-Version: 20150517.433
;; Package-Requires: ((cl-lib "0.3"))
;; Keywords: convenience
;; URL: http://github.com/cask/epl
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A package management library for Emacs, based on package.el.
;; The purpose of this library is to wrap all the quirks and hassle of
;; package.el into a sane API.
;; The following functions comprise the public interface of this library:
;;; Package directory selection
;; `epl-package-dir' gets the directory of packages.
;; `epl-default-package-dir' gets the default package directory.
;; `epl-change-package-dir' changes the directory of packages.
;;; Package system management
;; `epl-initialize' initializes the package system and activates all
;; packages.
;; `epl-reset' resets the package system.
;; `epl-refresh' refreshes all package archives.
;; `epl-add-archive' adds a new package archive.
;;; Package objects
;; Struct `epl-requirement' describes a requirement of a package with `name' and
;; `version' slots.
;; `epl-requirement-version-string' gets a requirement version as string.
;; Struct `epl-package' describes an installed or installable package with a
;; `name' and some internal `description'.
;; `epl-package-version' gets the version of a package.
;; `epl-package-version-string' gets the version of a package as string.
;; `epl-package-summary' gets the summary of a package.
;; `epl-package-requirements' gets the requirements of a package.
;; `epl-package-directory' gets the installation directory of a package.
;; `epl-package-from-buffer' creates a package object for the package contained
;; in the current buffer.
;; `epl-package-from-file' creates a package object for a package file, either
;; plain lisp or tarball.
;; `epl-package-from-descriptor-file' creates a package object for a package
;; description (i.e. *-pkg.el) file.
;;; Package database access
;; `epl-package-installed-p' determines whether a package is installed, either
;; built-in or explicitly installed.
;; `epl-package-outdated-p' determines whether a package is outdated, that is,
;; whether a package with a higher version number is available.
;; `epl-built-in-packages', `epl-installed-packages', `epl-outdated-packages'
;; and `epl-available-packages' get all packages built-in, installed, outdated,
;; or available for installation respectively.
;; `epl-find-built-in-package', `epl-find-installed-packages' and
;; `epl-find-available-packages' find built-in, installed and available packages
;; by name.
;; `epl-find-upgrades' finds all upgradable packages.
;; `epl-built-in-p' return true if package is built-in to Emacs.
;;; Package operations
;; `epl-install-file' installs a package file.
;; `epl-package-install' installs a package.
;; `epl-package-delete' deletes a package.
;; `epl-upgrade' upgrades packages.
;;; Code:
(require 'cl-lib)
(require 'package)
(unless (fboundp #'define-error)
;; `define-error' for 24.3 and earlier, copied from subr.el
(defun define-error (name message &optional parent)
"Define NAME as a new error signal.
MESSAGE is a string that will be output to the echo area if such an error
is signaled without being caught by a `condition-case'.
PARENT is either a signal or a list of signals from which it inherits.
Defaults to `error'."
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
(apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
(error "Unknown signal `%s'" parent))))
parent))
(cons parent (get parent 'error-conditions)))))
(put name 'error-conditions
(delete-dups (copy-sequence (cons name conditions))))
(when message (put name 'error-message message)))))
(defsubst epl--package-desc-p (package)
"Whether PACKAGE is a `package-desc' object.
Like `package-desc-p', but return nil, if `package-desc-p' is not
defined as function."
(and (fboundp 'package-desc-p) (package-desc-p package)))
;;; EPL errors
(define-error 'epl-error "EPL error")
(define-error 'epl-invalid-package "Invalid EPL package" 'epl-error)
(define-error 'epl-invalid-package-file "Invalid EPL package file"
'epl-invalid-package)
;;; Package directory
(defun epl-package-dir ()
"Get the directory of packages."
package-user-dir)
(defun epl-default-package-dir ()
"Get the default directory of packages."
(eval (car (get 'package-user-dir 'standard-value))))
(defun epl-change-package-dir (directory)
"Change the directory of packages to DIRECTORY."
(setq package-user-dir directory)
(epl-initialize))
;;; Package system management
(defvar epl--load-path-before-initialize nil
"Remember the load path for `epl-reset'.")
(defun epl-initialize (&optional no-activate)
"Load Emacs Lisp packages and activate them.
With NO-ACTIVATE non-nil, do not activate packages."
(setq epl--load-path-before-initialize load-path)
(package-initialize no-activate))
(defalias 'epl-refresh 'package-refresh-contents)
(defun epl-add-archive (name url)
"Add a package archive with NAME and URL."
(add-to-list 'package-archives (cons name url)))
(defun epl-reset ()
"Reset the package system.
Clear the list of installed and available packages, the list of
package archives and reset the package directory."
(setq package-alist nil
package-archives nil
package-archive-contents nil
load-path epl--load-path-before-initialize)
(when (boundp 'package-obsolete-alist) ; Legacy package.el
(setq package-obsolete-alist nil))
(epl-change-package-dir (epl-default-package-dir)))
;;; Package structures
(cl-defstruct (epl-requirement
(:constructor epl-requirement-create))
"Structure describing a requirement.
Slots:
`name' The name of the required package, as symbol.
`version' The version of the required package, as version list."
name
version)
(defun epl-requirement-version-string (requirement)
"The version of a REQUIREMENT, as string."
(package-version-join (epl-requirement-version requirement)))
(cl-defstruct (epl-package (:constructor epl-package-create))
"Structure representing a package.
Slots:
`name' The package name, as symbol.
`description' The package description.
The format package description varies between package.el
variants. For `package-desc' variants, it is simply the
corresponding `package-desc' object. For legacy variants, it is
a vector `[VERSION REQS DOCSTRING]'.
Do not access `description' directly, but instead use the
`epl-package' accessors."
name
description)
(defmacro epl-package-as-description (var &rest body)
"Cast VAR to a package description in BODY.
VAR is a symbol, bound to an `epl-package' object. This macro
casts this object to the `description' object, and binds the
description to VAR in BODY."
(declare (indent 1))
(unless (symbolp var)
(signal 'wrong-type-argument (list #'symbolp var)))
`(if (epl-package-p ,var)
(let ((,var (epl-package-description ,var)))
,@body)
(signal 'wrong-type-argument (list #'epl-package-p ,var))))
(defsubst epl-package--package-desc-p (package)
"Whether the description of PACKAGE is a `package-desc'."
(epl--package-desc-p (epl-package-description package)))
(defun epl-package-version (package)
"Get the version of PACKAGE, as version list."
(epl-package-as-description package
(cond
((fboundp 'package-desc-version) (package-desc-version package))
;; Legacy
((fboundp 'package-desc-vers)
(let ((version (package-desc-vers package)))
(if (listp version) version (version-to-list version))))
(:else (error "Cannot get version from %S" package)))))
(defun epl-package-version-string (package)
"Get the version from a PACKAGE, as string."
(package-version-join (epl-package-version package)))
(defun epl-package-summary (package)
"Get the summary of PACKAGE, as string."
(epl-package-as-description package
(cond
((fboundp 'package-desc-summary) (package-desc-summary package))
((fboundp 'package-desc-doc) (package-desc-doc package)) ; Legacy
(:else (error "Cannot get summary from %S" package)))))
(defsubst epl-requirement--from-req (req)
"Create a `epl-requirement' from a `package-desc' REQ."
(let ((version (cadr req)))
(epl-requirement-create :name (car req)
:version (if (listp version) version
(version-to-list version)))))
(defun epl-package-requirements (package)
"Get the requirements of PACKAGE.
The requirements are a list of `epl-requirement' objects."
(epl-package-as-description package
(mapcar #'epl-requirement--from-req (package-desc-reqs package))))
(defun epl-package-directory (package)
"Get the directory PACKAGE is installed to.
Return the absolute path of the installation directory of
PACKAGE, or nil, if PACKAGE is not installed."
(cond
((fboundp 'package-desc-dir)
(package-desc-dir (epl-package-description package)))
((fboundp 'package--dir)
(package--dir (symbol-name (epl-package-name package))
(epl-package-version-string package)))
(:else (error "Cannot get package directory from %S" package))))
(defun epl-package-->= (pkg1 pkg2)
"Determine whether PKG1 is before PKG2 by version."
(not (version-list-< (epl-package-version pkg1)
(epl-package-version pkg2))))
(defun epl-package--from-package-desc (package-desc)
"Create an `epl-package' from a PACKAGE-DESC.
PACKAGE-DESC is a `package-desc' object, from recent package.el
variants."
(if (and (fboundp 'package-desc-name)
(epl--package-desc-p package-desc))
(epl-package-create :name (package-desc-name package-desc)
:description package-desc)
(signal 'wrong-type-argument (list 'epl--package-desc-p package-desc))))
(defun epl-package--parse-info (info)
"Parse a package.el INFO."
(if (epl--package-desc-p info)
(epl-package--from-package-desc info)
;; For legacy package.el, info is a vector [NAME REQUIRES DESCRIPTION
;; VERSION COMMENTARY]. We need to re-shape this vector into the
;; `package-alist' format [VERSION REQUIRES DESCRIPTION] to attach it to the
;; new `epl-package'.
(let ((name (intern (aref info 0)))
(info (vector (aref info 3) (aref info 1) (aref info 2))))
(epl-package-create :name name :description info))))
(defun epl-package-from-buffer (&optional buffer)
"Create an `epl-package' object from BUFFER.
BUFFER defaults to the current buffer.
Signal `epl-invalid-package' if the buffer does not contain a
valid package file."
(let ((info (with-current-buffer (or buffer (current-buffer))
(condition-case err
(package-buffer-info)
(error (signal 'epl-invalid-package (cdr err)))))))
(epl-package--parse-info info)))
(defun epl-package-from-lisp-file (file-name)
"Parse the package headers the file at FILE-NAME.
Return an `epl-package' object with the header metadata."
(with-temp-buffer
(insert-file-contents file-name)
(condition-case err
(epl-package-from-buffer (current-buffer))
;; Attach file names to invalid package errors
(epl-invalid-package
(signal 'epl-invalid-package-file (cons file-name (cdr err))))
;; Forward other errors
(error (signal (car err) (cdr err))))))
(defun epl-package-from-tar-file (file-name)
"Parse the package tarball at FILE-NAME.
Return a `epl-package' object with the meta data of the tarball
package in FILE-NAME."
(condition-case nil
;; In legacy package.el, `package-tar-file-info' takes the name of the tar
;; file to parse as argument. In modern package.el, it has no arguments
;; and works on the current buffer. Hence, we just try to call the legacy
;; version, and if that fails because of a mismatch between formal and
;; actual arguments, we use the modern approach. To avoid spurious
;; signature warnings by the byte compiler, we suppress warnings when
;; calling the function.
(epl-package--parse-info (with-no-warnings
(package-tar-file-info file-name)))
(wrong-number-of-arguments
(with-temp-buffer
(insert-file-contents-literally file-name)
;; Switch to `tar-mode' to enable extraction of the file. Modern
;; `package-tar-file-info' relies on `tar-mode', and signals an error if
;; called in a buffer with a different mode.
(tar-mode)
(epl-package--parse-info (with-no-warnings
(package-tar-file-info)))))))
(defun epl-package-from-file (file-name)
"Parse the package at FILE-NAME.
Return an `epl-package' object with the meta data of the package
at FILE-NAME."
(if (string-match-p (rx ".tar" string-end) file-name)
(epl-package-from-tar-file file-name)
(epl-package-from-lisp-file file-name)))
(defun epl-package--parse-descriptor-requirement (requirement)
"Parse a REQUIREMENT in a package descriptor."
;; This function is only called on legacy package.el. On package-desc
;; package.el, we just let package.el do the work.
(cl-destructuring-bind (name version-string) requirement
(list name (version-to-list version-string))))
(defun epl-package-from-descriptor-file (descriptor-file)
"Load a `epl-package' from a package DESCRIPTOR-FILE.
A package descriptor is a file defining a new package. Its name
typically ends with -pkg.el."
(with-temp-buffer
(insert-file-contents descriptor-file)
(goto-char (point-min))
(let ((sexp (read (current-buffer))))
(unless (eq (car sexp) 'define-package)
(error "%S is no valid package descriptor" descriptor-file))
(if (and (fboundp 'package-desc-from-define)
(fboundp 'package-desc-name))
;; In Emacs snapshot, we can conveniently call a function to parse the
;; descriptor
(let ((desc (apply #'package-desc-from-define (cdr sexp))))
(epl-package-create :name (package-desc-name desc)
:description desc))
;; In legacy package.el, we must manually deconstruct the descriptor,
;; because the load function has eval's the descriptor and has a lot of
;; global side-effects.
(cl-destructuring-bind
(name version-string summary requirements) (cdr sexp)
(epl-package-create
:name (intern name)
:description
(vector (version-to-list version-string)
(mapcar #'epl-package--parse-descriptor-requirement
;; Strip the leading `quote' from the package list
(cadr requirements))
summary)))))))
;;; Package database access
(defun epl-package-installed-p (package)
"Determine whether a PACKAGE is installed.
PACKAGE is either a package name as symbol, or a package object."
(let ((name (if (epl-package-p package)
(epl-package-name package)
package))
(version (when (epl-package-p package)
(epl-package-version package))))
(package-installed-p name version)))
(defun epl--parse-built-in-entry (entry)
"Parse an ENTRY from the list of built-in packages.
Return the corresponding `epl-package' object."
(if (fboundp 'package--from-builtin)
;; In package-desc package.el, convert the built-in package to a
;; `package-desc' and convert that to an `epl-package'
(epl-package--from-package-desc (package--from-builtin entry))
(epl-package-create :name (car entry) :description (cdr entry))))
(defun epl-built-in-packages ()
"Get all built-in packages.
Return a list of `epl-package' objects."
;; This looks mighty strange, but it's the only way to force package.el to
;; build the list of built-in packages. Without this, `package--builtins'
;; might be empty.
(package-built-in-p 'foo)
(mapcar #'epl--parse-built-in-entry package--builtins))
(defun epl-find-built-in-package (name)
"Find a built-in package with NAME.
NAME is a package name, as symbol.
Return the built-in package as `epl-package' object, or nil if
there is no built-in package with NAME."
(when (package-built-in-p name)
;; We must call `package-built-in-p' *before* inspecting
;; `package--builtins', because otherwise `package--builtins' might be
;; empty.
(epl--parse-built-in-entry (assq name package--builtins))))
(defun epl-package-outdated-p (package)
"Determine whether a PACKAGE is outdated.
A package is outdated, if there is an available package with a
higher version.
PACKAGE is either a package name as symbol, or a package object.
In the former case, test the installed or built-in package with
the highest version number, in the later case, test the package
object itself.
Return t, if the package is outdated, or nil otherwise."
(let* ((package (if (epl-package-p package)
package
(or (car (epl-find-installed-packages package))
(epl-find-built-in-package package))))
(available (car (epl-find-available-packages
(epl-package-name package)))))
(and package available (version-list-< (epl-package-version package)
(epl-package-version available)))))
(defun epl--parse-package-list-entry (entry)
"Parse a list of packages from ENTRY.
ENTRY is a single entry in a package list, e.g. `package-alist',
`package-archive-contents', etc. Typically it is a cons cell,
but the exact format varies between package.el versions. This
function tries to parse all known variants.
Return a list of `epl-package' objects parsed from ENTRY."
(let ((descriptions (cdr entry)))
(cond
((listp descriptions)
(sort (mapcar #'epl-package--from-package-desc descriptions)
#'epl-package-->=))
;; Legacy package.el has just a single package in an entry, which is a
;; standard description vector
((vectorp descriptions)
(list (epl-package-create :name (car entry)
:description descriptions)))
(:else (error "Cannot parse entry %S" entry)))))
(defun epl-installed-packages ()
"Get all installed packages.
Return a list of package objects."
(apply #'append (mapcar #'epl--parse-package-list-entry package-alist)))
(defsubst epl--filter-outdated-packages (packages)
"Filter outdated packages from PACKAGES."
(let (res)
(dolist (package packages)
(when (epl-package-outdated-p package)
(push package res)))
(nreverse res)))
(defun epl-outdated-packages ()
"Get all outdated packages, as in `epl-package-outdated-p'.
Return a list of package objects."
(epl--filter-outdated-packages (epl-installed-packages)))
(defsubst epl--find-package-in-list (name list)
"Find a package by NAME in a package LIST.
Return a list of corresponding `epl-package' objects."
(let ((entry (assq name list)))
(when entry
(epl--parse-package-list-entry entry))))
(defun epl-find-installed-package (name)
"Find the latest installed package by NAME.
NAME is a package name, as symbol.
Return the installed package with the highest version number as
`epl-package' object, or nil, if no package with NAME is
installed."
(car (epl-find-installed-packages name)))
(make-obsolete 'epl-find-installed-package 'epl-find-installed-packages "0.7")
(defun epl-find-installed-packages (name)
"Find all installed packages by NAME.
NAME is a package name, as symbol.
Return a list of all installed packages with NAME, sorted by
version number in descending order. Return nil, if there are no
packages with NAME."
(epl--find-package-in-list name package-alist))
(defun epl-available-packages ()
"Get all packages available for installation.
Return a list of package objects."
(apply #'append (mapcar #'epl--parse-package-list-entry
package-archive-contents)))
(defun epl-find-available-packages (name)
"Find available packages for NAME.
NAME is a package name, as symbol.
Return a list of available packages for NAME, sorted by version
number in descending order. Return nil, if there are no packages
for NAME."
(epl--find-package-in-list name package-archive-contents))
(cl-defstruct (epl-upgrade
(:constructor epl-upgrade-create))
"Structure describing an upgradable package.
Slots:
`installed' The installed package
`available' The package available for installation."
installed
available)
(defun epl-find-upgrades (&optional packages)
"Find all upgradable PACKAGES.
PACKAGES is a list of package objects to upgrade, defaulting to
all installed packages.
Return a list of `epl-upgrade' objects describing all upgradable
packages."
(let ((packages (or packages (epl-installed-packages)))
upgrades)
(dolist (pkg packages)
(let* ((version (epl-package-version pkg))
(name (epl-package-name pkg))
;; Find the latest available package for NAME
(available-pkg (car (epl-find-available-packages name)))
(available-version (when available-pkg
(epl-package-version available-pkg))))
(when (and available-version (version-list-< version available-version))
(push (epl-upgrade-create :installed pkg
:available available-pkg)
upgrades))))
(nreverse upgrades)))
(defalias 'epl-built-in-p 'package-built-in-p)
;;; Package operations
(defalias 'epl-install-file 'package-install-file)
(defun epl-package-install (package &optional force)
"Install a PACKAGE.
PACKAGE is a `epl-package' object. If FORCE is given and
non-nil, install PACKAGE, even if it is already installed."
(when (or force (not (epl-package-installed-p package)))
(if (epl-package--package-desc-p package)
(package-install (epl-package-description package))
;; The legacy API installs by name. We have no control over versioning,
;; etc.
(package-install (epl-package-name package)))))
(defun epl-package-delete (package)
"Delete a PACKAGE.
PACKAGE is a `epl-package' object to delete."
;; package-delete allows for packages being trashed instead of fully deleted.
;; Let's prevent his silly behavior
(let ((delete-by-moving-to-trash nil))
;; The byte compiler will warn us that we are calling `package-delete' with
;; the wrong number of arguments, since it can't infer that we guarantee to
;; always call the correct version. Thus we suppress all warnings when
;; calling `package-delete'. I wish there was a more granular way to
;; disable just that specific warning, but it is what it is.
(if (epl-package--package-desc-p package)
(with-no-warnings
(package-delete (epl-package-description package)))
;; The legacy API deletes by name (as string!) and version instead by
;; descriptor. Hence `package-delete' takes two arguments. For some
;; insane reason, the arguments are strings here!
(let ((name (symbol-name (epl-package-name package)))
(version (epl-package-version-string package)))
(with-no-warnings
(package-delete name version))
;; Legacy package.el does not remove the deleted package
;; from the `package-alist', so we do it manually here.
(let ((pkg (assq (epl-package-name package) package-alist)))
(when pkg
(setq package-alist (delq pkg package-alist))))))))
(defun epl-upgrade (&optional packages preserve-obsolete)
"Upgrade PACKAGES.
PACKAGES is a list of package objects to upgrade, defaulting to
all installed packages.
The old versions of the updated packages are deleted, unless
PRESERVE-OBSOLETE is non-nil.
Return a list of all performed upgrades, as a list of
`epl-upgrade' objects."
(let ((upgrades (epl-find-upgrades packages)))
(dolist (upgrade upgrades)
(epl-package-install (epl-upgrade-available upgrade) 'force)
(unless preserve-obsolete
(epl-package-delete (epl-upgrade-installed upgrade))))
upgrades))
(provide 'epl)
;;; epl.el ends here

18
dotfiles/emacs.d/elpa/flycheck-20151022.1349/dir

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Flycheck: (flycheck). Modern on-the-fly syntax checking

484
dotfiles/emacs.d/elpa/flycheck-20151022.1349/fdl-1.3.info

@ -0,0 +1,484 @@
This is fdl-1.3.info, produced by makeinfo version 5.2 from
fdl-1.3.texi.
Version 1.3, 3 November 2008
Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
<http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
0. PREAMBLE
The purpose of this License is to make a manual, textbook, or other
functional and useful document "free" in the sense of freedom: to
assure everyone the effective freedom to copy and redistribute it,
with or without modifying it, either commercially or
noncommercially. Secondarily, this License preserves for the
author and publisher a way to get credit for their work, while not
being considered responsible for modifications made by others.
This License is a kind of "copyleft", which means that derivative
works of the document must themselves be free in the same sense.
It complements the GNU General Public License, which is a copyleft
license designed for free software.
We have designed this License in order to use it for manuals for
free software, because free software needs free documentation: a
free program should come with manuals providing the same freedoms
that the software does. But this License is not limited to
software manuals; it can be used for any textual work, regardless
of subject matter or whether it is published as a printed book. We
recommend this License principally for works whose purpose is
instruction or reference.
1. APPLICABILITY AND DEFINITIONS
This License applies to any manual or other work, in any medium,
that contains a notice placed by the copyright holder saying it can
be distributed under the terms of this License. Such a notice
grants a world-wide, royalty-free license, unlimited in duration,
to use that work under the conditions stated herein. The
"Document", below, refers to any such manual or work. Any member
of the public is a licensee, and is addressed as "you". You accept
the license if you copy, modify or distribute the work in a way
requiring permission under copyright law.
A "Modified Version" of the Document means any work containing the
Document or a portion of it, either copied verbatim, or with
modifications and/or translated into another language.
A "Secondary Section" is a named appendix or a front-matter section
of the Document that deals exclusively with the relationship of the
publishers or authors of the Document to the Document's overall
subject (or to related matters) and contains nothing that could
fall directly within that overall subject. (Thus, if the Document
is in part a textbook of mathematics, a Secondary Section may not
explain any mathematics.) The relationship could be a matter of
historical connection with the subject or with related matters, or
of legal, commercial, philosophical, ethical or political position
regarding them.
The "Invariant Sections" are certain Secondary Sections whose
titles are designated, as being those of Invariant Sections, in the
notice that says that the Document is released under this License.
If a section does not fit the above definition of Secondary then it
is not allowed to be designated as Invariant. The Document may
contain zero Invariant Sections. If the Document does not identify
any Invariant Sections then there are none.
The "Cover Texts" are certain short passages of text that are
listed, as Front-Cover Texts or Back-Cover Texts, in the notice
that says that the Document is released under this License. A
Front-Cover Text may be at most 5 words, and a Back-Cover Text may
be at most 25 words.
A "Transparent" copy of the Document means a machine-readable copy,
represented in a format whose specification is available to the
general public, that is suitable for revising the document
straightforwardly with generic text editors or (for images composed
of pixels) generic paint programs or (for drawings) some widely
available drawing editor, and that is suitable for input to text
formatters or for automatic translation to a variety of formats
suitable for input to text formatters. A copy made in an otherwise
Transparent file format whose markup, or absence of markup, has
been arranged to thwart or discourage subsequent modification by
readers is not Transparent. An image format is not Transparent if
used for any substantial amount of text. A copy that is not
"Transparent" is called "Opaque".
Examples of suitable formats for Transparent copies include plain
ASCII without markup, Texinfo input format, LaTeX input format,
SGML or XML using a publicly available DTD, and standard-conforming
simple HTML, PostScript or PDF designed for human modification.
Examples of transparent image formats include PNG, XCF and JPG.
Opaque formats include proprietary formats that can be read and
edited only by proprietary word processors, SGML or XML for which
the DTD and/or processing tools are not generally available, and
the machine-generated HTML, PostScript or PDF produced by some word
processors for output purposes only.
The "Title Page" means, for a printed book, the title page itself,
plus such following pages as are needed to hold, legibly, the
material this License requires to appear in the title page. For
works in formats which do not have any title page as such, "Title
Page" means the text near the most prominent appearance of the
work's title, preceding the beginning of the body of the text.
The "publisher" means any person or entity that distributes copies
of the Document to the public.
A section "Entitled XYZ" means a named subunit of the Document
whose title either is precisely XYZ or contains XYZ in parentheses
following text that translates XYZ in another language. (Here XYZ
stands for a specific section name mentioned below, such as
"Acknowledgements", "Dedications", "Endorsements", or "History".)
To "Preserve the Title" of such a section when you modify the
Document means that it remains a section "Entitled XYZ" according
to this definition.
The Document may include Warranty Disclaimers next to the notice
which states that this License applies to the Document. These
Warranty Disclaimers are considered to be included by reference in
this License, but only as regards disclaiming warranties: any other
implication that these Warranty Disclaimers may have is void and
has no effect on the meaning of this License.
2. VERBATIM COPYING
You may copy and distribute the Document in any medium, either
commercially or noncommercially, provided that this License, the
copyright notices, and the license notice saying this License
applies to the Document are reproduced in all copies, and that you
add no other conditions whatsoever to those of this License. You
may not use technical measures to obstruct or control the reading
or further copying of the copies you make or distribute. However,
you may accept compensation in exchange for copies. If you
distribute a large enough number of copies you must also follow the
conditions in section 3.
You may also lend copies, under the same conditions stated above,
and you may publicly display copies.
3. COPYING IN QUANTITY
If you publish printed copies (or copies in media that commonly
have printed covers) of the Document, numbering more than 100, and
the Document's license notice requires Cover Texts, you must
enclose the copies in covers that carry, clearly and legibly, all
these Cover Texts: Front-Cover Texts on the front cover, and
Back-Cover Texts on the back cover. Both covers must also clearly
and legibly identify you as the publisher of these copies. The
front cover must present the full title with all words of the title
equally prominent and visible. You may add other material on the
covers in addition. Copying with changes limited to the covers, as
long as they preserve the title of the Document and satisfy these
conditions, can be treated as verbatim copying in other respects.
If the required texts for either cover are too voluminous to fit
legibly, you should put the first ones listed (as many as fit
reasonably) on the actual cover, and continue the rest onto
adjacent pages.
If you publish or distribute Opaque copies of the Document
numbering more than 100, you must either include a machine-readable
Transparent copy along with each Opaque copy, or state in or with
each Opaque copy a computer-network location from which the general
network-using public has access to download using public-standard
network protocols a complete Transparent copy of the Document, free
of added material. If you use the latter option, you must take
reasonably prudent steps, when you begin distribution of Opaque
copies in quantity, to ensure that this Transparent copy will
remain thus accessible at the stated location until at least one
year after the last time you distribute an Opaque copy (directly or
through your agents or retailers) of that edition to the public.
It is requested, but not required, that you contact the authors of
the Document well before redistributing any large number of copies,
to give them a chance to provide you with an updated version of the
Document.
4. MODIFICATIONS
You may copy and distribute a Modified Version of the Document
under the conditions of sections 2 and 3 above, provided that you
release the Modified Version under precisely this License, with the
Modified Version filling the role of the Document, thus licensing
distribution and modification of the Modified Version to whoever
possesses a copy of it. In addition, you must do these things in
the Modified Version:
A. Use in the Title Page (and on the covers, if any) a title
distinct from that of the Document, and from those of previous
versions (which should, if there were any, be listed in the
History section of the Document). You may use the same title
as a previous version if the original publisher of that
version gives permission.
B. List on the Title Page, as authors, one or more persons or
entities responsible for authorship of the modifications in
the Modified Version, together with at least five of the
principal authors of the Document (all of its principal
authors, if it has fewer than five), unless they release you
from this requirement.
C. State on the Title page the name of the publisher of the
Modified Version, as the publisher.
D. Preserve all the copyright notices of the Document.
E. Add an appropriate copyright notice for your modifications
adjacent to the other copyright notices.
F. Include, immediately after the copyright notices, a license
notice giving the public permission to use the Modified
Version under the terms of this License, in the form shown in
the Addendum below.
G. Preserve in that license notice the full lists of Invariant
Sections and required Cover Texts given in the Document's
license notice.
H. Include an unaltered copy of this License.
I. Preserve the section Entitled "History", Preserve its Title,
and add to it an item stating at least the title, year, new
authors, and publisher of the Modified Version as given on the
Title Page. If there is no section Entitled "History" in the
Document, create one stating the title, year, authors, and
publisher of the Document as given on its Title Page, then add
an item describing the Modified Version as stated in the
previous sentence.
J. Preserve the network location, if any, given in the Document
for public access to a Transparent copy of the Document, and
likewise the network locations given in the Document for
previous versions it was based on. These may be placed in the
"History" section. You may omit a network location for a work
that was published at least four years before the Document
itself, or if the original publisher of the version it refers
to gives permission.
K. For any section Entitled "Acknowledgements" or "Dedications",
Preserve the Title of the section, and preserve in the section
all the substance and tone of each of the contributor
acknowledgements and/or dedications given therein.
L. Preserve all the Invariant Sections of the Document, unaltered
in their text and in their titles. Section numbers or the
equivalent are not considered part of the section titles.
M. Delete any section Entitled "Endorsements". Such a section
may not be included in the Modified Version.
N. Do not retitle any existing section to be Entitled
"Endorsements" or to conflict in title with any Invariant
Section.
O. Preserve any Warranty Disclaimers.
If the Modified Version includes new front-matter sections or
appendices that qualify as Secondary Sections and contain no
material copied from the Document, you may at your option designate
some or all of these sections as invariant. To do this, add their
titles to the list of Invariant Sections in the Modified Version's
license notice. These titles must be distinct from any other
section titles.
You may add a section Entitled "Endorsements", provided it contains
nothing but endorsements of your Modified Version by various
parties--for example, statements of peer review or that the text
has been approved by an organization as the authoritative
definition of a standard.
You may add a passage of up to five words as a Front-Cover Text,
and a passage of up to 25 words as a Back-Cover Text, to the end of
the list of Cover Texts in the Modified Version. Only one passage
of Front-Cover Text and one of Back-Cover Text may be added by (or
through arrangements made by) any one entity. If the Document
already includes a cover text for the same cover, previously added
by you or by arrangement made by the same entity you are acting on
behalf of, you may not add another; but you may replace the old
one, on explicit permission from the previous publisher that added
the old one.
The author(s) and publisher(s) of the Document do not by this
License give permission to use their names for publicity for or to
assert or imply endorsement of any Modified Version.
5. COMBINING DOCUMENTS
You may combine the Document with other documents released under
this License, under the terms defined in section 4 above for
modified versions, provided that you include in the combination all
of the Invariant Sections of all of the original documents,
unmodified, and list them all as Invariant Sections of your
combined work in its license notice, and that you preserve all
their Warranty Disclaimers.
The combined work need only contain one copy of this License, and
multiple identical Invariant Sections may be replaced with a single
copy. If there are multiple Invariant Sections with the same name
but different contents, make the title of each such section unique
by adding at the end of it, in parentheses, the name of the
original author or publisher of that section if known, or else a
unique number. Make the same adjustment to the section titles in
the list of Invariant Sections in the license notice of the
combined work.
In the combination, you must combine any sections Entitled
"History" in the various original documents, forming one section
Entitled "History"; likewise combine any sections Entitled
"Acknowledgements", and any sections Entitled "Dedications". You
must delete all sections Entitled "Endorsements."
6. COLLECTIONS OF DOCUMENTS
You may make a collection consisting of the Document and other
documents released under this License, and replace the individual
copies of this License in the various documents with a single copy
that is included in the collection, provided that you follow the
rules of this License for verbatim copying of each of the documents
in all other respects.
You may extract a single document from such a collection, and
distribute it individually under this License, provided you insert
a copy of this License into the extracted document, and follow this
License in all other respects regarding verbatim copying of that
document.
7. AGGREGATION WITH INDEPENDENT WORKS
A compilation of the Document or its derivatives with other
separate and independent documents or works, in or on a volume of a
storage or distribution medium, is called an "aggregate" if the
copyright resulting from the compilation is not used to limit the
legal rights of the compilation's users beyond what the individual
works permit. When the Document is included in an aggregate, this
License does not apply to the other works in the aggregate which
are not themselves derivative works of the Document.
If the Cover Text requirement of section 3 is applicable to these
copies of the Document, then if the Document is less than one half
of the entire aggregate, the Document's Cover Texts may be placed
on covers that bracket the Document within the aggregate, or the
electronic equivalent of covers if the Document is in electronic
form. Otherwise they must appear on printed covers that bracket
the whole aggregate.
8. TRANSLATION
Translation is considered a kind of modification, so you may
distribute translations of the Document under the terms of section
4. Replacing Invariant Sections with translations requires special
permission from their copyright holders, but you may include
translations of some or all Invariant Sections in addition to the
original versions of these Invariant Sections. You may include a
translation of this License, and all the license notices in the
Document, and any Warranty Disclaimers, provided that you also
include the original English version of this License and the
original versions of those notices and disclaimers. In case of a
disagreement between the translation and the original version of
this License or a notice or disclaimer, the original version will
prevail.
If a section in the Document is Entitled "Acknowledgements",
"Dedications", or "History", the requirement (section 4) to
Preserve its Title (section 1) will typically require changing the
actual title.
9. TERMINATION
You may not copy, modify, sublicense, or distribute the Document
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense, or distribute it is void,
and will automatically terminate your rights under this License.
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the
copyright holder fails to notify you of the violation by some
reasonable means prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from
that copyright holder, and you cure the violation prior to 30 days
after your receipt of the notice.
Termination of your rights under this section does not terminate
the licenses of parties who have received copies or rights from you
under this License. If your rights have been terminated and not
permanently reinstated, receipt of a copy of some or all of the
same material does not give you any rights to use it.
10. FUTURE REVISIONS OF THIS LICENSE
The Free Software Foundation may publish new, revised versions of
the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
<http://www.gnu.org/copyleft/>.
Each version of the License is given a distinguishing version
number. If the Document specifies that a particular numbered
version of this License "or any later version" applies to it, you
have the option of following the terms and conditions either of
that specified version or of any later version that has been
published (not as a draft) by the Free Software Foundation. If the
Document does not specify a version number of this License, you may
choose any version ever published (not as a draft) by the Free
Software Foundation. If the Document specifies that a proxy can
decide which future versions of this License can be used, that
proxy's public statement of acceptance of a version permanently
authorizes you to choose that version for the Document.
11. RELICENSING
"Massive Multiauthor Collaboration Site" (or "MMC Site") means any
World Wide Web server that publishes copyrightable works and also
provides prominent facilities for anybody to edit those works. A
public wiki that anybody can edit is an example of such a server.
A "Massive Multiauthor Collaboration" (or "MMC") contained in the
site means any set of copyrightable works thus published on the MMC
site.
"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
license published by Creative Commons Corporation, a not-for-profit
corporation with a principal place of business in San Francisco,
California, as well as future copyleft versions of that license
published by that same organization.
"Incorporate" means to publish or republish a Document, in whole or
in part, as part of another Document.
An MMC is "eligible for relicensing" if it is licensed under this
License, and if all works that were first published under this
License somewhere other than this MMC, and subsequently
incorporated in whole or in part into the MMC, (1) had no cover
texts or invariant sections, and (2) were thus incorporated prior
to November 1, 2008.
The operator of an MMC Site may republish an MMC contained in the
site under CC-BY-SA on the same site at any time before August 1,
2009, provided the MMC is eligible for relicensing.
ADDENDUM: How to use this License for your documents
====================================================
To use this License in a document you have written, include a copy of
the License in the document and put the following copyright and license
notices just after the title page:
Copyright (C) YEAR YOUR NAME.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3
or any later version published by the Free Software Foundation;
with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
Texts. A copy of the license is included in the section entitled ``GNU
Free Documentation License''.
If you have Invariant Sections, Front-Cover Texts and Back-Cover
Texts, replace the "with...Texts." line with this:
with the Invariant Sections being LIST THEIR TITLES, with
the Front-Cover Texts being LIST, and with the Back-Cover Texts
being LIST.
If you have Invariant Sections without Cover Texts, or some other
combination of the three, merge those two alternatives to suit the
situation.
If your document contains nontrivial examples of program code, we
recommend releasing these examples in parallel under your choice of free
software license, such as the GNU General Public License, to permit
their use in free software.

Tag Table:

End Tag Table

230
dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-autoloads.el

@ -0,0 +1,230 @@
;;; flycheck-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck" "flycheck.el" (22059 18175 576317
;;;;;; 610000))
;;; Generated autoloads from flycheck.el
(autoload 'flycheck-info "flycheck" "\
Open the Flycheck manual.
\(fn)" t nil)
(autoload 'flycheck-mode "flycheck" "\
Minor mode for on-the-fly syntax checking.
When called interactively, toggle `flycheck-mode'. With prefix
ARG, enable `flycheck-mode' if ARG is positive, otherwise disable
it.
When called from Lisp, enable `flycheck-mode' if ARG is omitted,
nil or positive. If ARG is `toggle', toggle `flycheck-mode'.
Otherwise behave as if called interactively.
In `flycheck-mode' the buffer is automatically syntax-checked
using the first suitable syntax checker from `flycheck-checkers'.
Use `flycheck-select-checker' to select a checker for the current
buffer manually.
\\{flycheck-mode-map}
\(fn &optional ARG)" t nil)
(defvar global-flycheck-mode nil "\
Non-nil if Global-Flycheck mode is enabled.
See the command `global-flycheck-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-flycheck-mode'.")
(custom-autoload 'global-flycheck-mode "flycheck" nil)
(autoload 'global-flycheck-mode "flycheck" "\
Toggle Flycheck mode in all buffers.
With prefix ARG, enable Global-Flycheck mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Flycheck mode is enabled in all buffers where
`flycheck-mode-on-safe' would do it.
See `flycheck-mode' for more information on Flycheck mode.
\(fn &optional ARG)" t nil)
(autoload 'flycheck-define-error-level "flycheck" "\
Define a new error LEVEL with PROPERTIES.
The following PROPERTIES constitute an error level:
`:severity SEVERITY'
A number denoting the severity of this level. The higher
the number, the more severe is this level compared to other
levels. Defaults to 0.
The severity is used by `flycheck-error-level-<' to
determine the ordering of errors according to their levels.
`:compilation-level LEVEL'
A number indicating the broad class of messages that errors
at this level belong to: one of 0 (info), 1 (warning), or
2 or nil (error). Defaults to nil.
This is used by `flycheck-checker-pattern-to-error-regexp'
to map error levels into `compilation-mode''s hierarchy and
to get proper highlighting of errors in `compilation-mode'.
`:overlay-category CATEGORY'
A symbol denoting the overlay category to use for error
highlight overlays for this level. See Info
node `(elisp)Overlay Properties' for more information about
overlay categories.
A category for an error level overlay should at least define
the `face' property, for error highlighting. Another useful
property for error level categories is `priority', to
influence the stacking of multiple error level overlays.
`:fringe-bitmap BITMAP'
A fringe bitmap symbol denoting the bitmap to use for fringe
indicators for this level. See Info node `(elisp)Fringe
Bitmaps' for more information about fringe bitmaps,
including a list of built-in fringe bitmaps.
`:fringe-face FACE'
A face symbol denoting the face to use for fringe indicators
for this level.
`:error-list-face FACE'
A face symbol denoting the face to use for messages of this
level in the error list. See `flycheck-list-errors'.
\(fn LEVEL &rest PROPERTIES)" nil nil)
(put 'flycheck-define-error-level 'lisp-indent-function '1)
(autoload 'flycheck-define-command-checker "flycheck" "\
Define SYMBOL as syntax checker which runs a command.
Define SYMBOL as generic syntax checker via
`flycheck-define-generic-checker', which uses an external command
to check the buffer. SYMBOL and DOCSTRING are the same as for
`flycheck-define-generic-checker'.
In addition to the properties understood by
`flycheck-define-generic-checker', the following PROPERTIES
constitute a command syntax checker. Unless otherwise noted, all
properties are mandatory. Note that the default `:error-filter'
of command checkers is `flycheck-sanitize-errors'.
`:command COMMAND'
The command to run for syntax checking.
COMMAND is a list of the form `(EXECUTABLE [ARG ...])'.
EXECUTABLE is a string with the executable of this syntax
checker. It can be overridden with the variable
`flycheck-SYMBOL-executable'. Note that this variable is
NOT implicitly defined by this function. Use
`flycheck-def-executable-var' to define this variable.
Each ARG is an argument to the executable, either as string,
or as special symbol or form for
`flycheck-substitute-argument', which see.
`:error-patterns PATTERNS'
A list of patterns to parse the output of the `:command'.
Each ITEM in PATTERNS is a list `(LEVEL SEXP ...)', where
LEVEL is a Flycheck error level (see
`flycheck-define-error-level'), followed by one or more RX
`SEXP's which parse an error of that level and extract line,
column, file name and the message.
See `rx' for general information about RX, and
`flycheck-rx-to-string' for some special RX forms provided
by Flycheck.
All patterns are applied in the order of declaration to the
whole output of the syntax checker. Output already matched
by a pattern will not be matched by subsequent patterns. In
other words, the first pattern wins.
This property is optional. If omitted, however, an
`:error-parser' is mandatory.
`:error-parser FUNCTION'
A function to parse errors with.
The function shall accept three arguments OUTPUT CHECKER
BUFFER. OUTPUT is the syntax checker output as string,
CHECKER the syntax checker that was used, and BUFFER a
buffer object representing the checked buffer. The function
must return a list of `flycheck-error' objects parsed from
OUTPUT.
This property is optional. If omitted, it defaults to
`flycheck-parse-with-patterns'. In this case,
`:error-patterns' is mandatory.
Note that you may not give `:start', `:interrupt', and
`:print-doc' for a command checker. You can give a custom
`:verify' function, though, whose results will be appended to the
default `:verify' function of command checkers.
\(fn SYMBOL DOCSTRING &rest PROPERTIES)" nil nil)
(put 'flycheck-define-command-checker 'lisp-indent-function '1)
(put 'flycheck-define-command-checker 'doc-string-elt '2)
(autoload 'flycheck-def-config-file-var "flycheck" "\
Define SYMBOL as config file variable for CHECKER, with default FILE-NAME.
SYMBOL is declared as customizable variable using `defcustom', to
provide a configuration file for the given syntax CHECKER.
CUSTOM-ARGS are forwarded to `defcustom'.
FILE-NAME is the initial value of the new variable. If omitted,
the default value is nil.
Use this together with the `config-file' form in the `:command'
argument to `flycheck-define-checker'.
\(fn SYMBOL CHECKER &optional FILE-NAME &rest CUSTOM-ARGS)" nil t)
(put 'flycheck-def-config-file-var 'lisp-indent-function '3)
(autoload 'flycheck-def-option-var "flycheck" "\
Define SYMBOL as option variable with INIT-VALUE for CHECKER.
SYMBOL is declared as customizable variable using `defcustom', to
provide an option for the given syntax CHECKER. INIT-VALUE is
the initial value of the variable, and DOCSTRING is its
docstring. CUSTOM-ARGS are forwarded to `defcustom'.
Use this together with the `option', `option-list' and
`option-flag' forms in the `:command' argument to
`flycheck-define-checker'.
\(fn SYMBOL INIT-VALUE CHECKER DOCSTRING &rest CUSTOM-ARGS)" nil t)
(put 'flycheck-def-option-var 'lisp-indent-function '3)
(put 'flycheck-def-option-var 'doc-string-elt '4)
;;;***
;;;### (autoloads nil nil ("flycheck-ert.el" "flycheck-pkg.el") (22059
;;;;;; 18175 655857 14000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-autoloads.el ends here

469
dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-ert.el

@ -0,0 +1,469 @@
;;; flycheck-ert.el --- Flycheck: ERT extensions -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2015 Sebastian Wiesner and Flycheck contributors
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Sebastian Wiesner <swiesner@lunaryorn.com>
;; URL: https://github.com/flycheck/flycheck
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit testing library for Flycheck, the modern on-the-fly syntax checking
;; extension for GNU Emacs.
;; Provide various utility functions and unit test helpers to test Flycheck and
;; Flycheck extensions.
;;; Code:
(require 'flycheck)
(require 'ert)
(require 'macroexp) ; For macro utilities
;;; Compatibility
(eval-and-compile
;; Provide `ert-skip' and friends for Emacs 24.3
(defconst flycheck-ert-ert-can-skip (fboundp 'ert-skip)
"Whether ERT supports test skipping.")
(unless flycheck-ert-ert-can-skip
;; Fake skipping
(setf (get 'flycheck-ert-skipped 'error-message) "Test skipped")
(setf (get 'flycheck-ert-skipped 'error-conditions) '(error))
(defun ert-skip (data)
(signal 'flycheck-ert-skipped data))
(defmacro skip-unless (form)
`(unless (ignore-errors ,form)
(signal 'flycheck-ert-skipped ',form)))
(defun ert-test-skipped-p (result)
(and (ert-test-failed-p result)
(eq (car (ert-test-failed-condition result))
'flycheck-ert-skipped)))))
;;; Internal variables
(defvar flycheck-ert--resource-directory nil
"The directory to get resources from in this test suite.")
;;; Resource management macros
(defmacro flycheck-ert-with-temp-buffer (&rest body)
"Eval BODY within a temporary buffer.
Like `with-temp-buffer', but resets the modification state of the
temporary buffer to make sure that it is properly killed even if
it has a backing file and is modified."
(declare (indent 0))
`(with-temp-buffer
(unwind-protect
,(macroexp-progn body)
;; Reset modification state of the buffer, and unlink it from its backing
;; file, if any, because Emacs refuses to kill modified buffers with
;; backing files, even if they are temporary.
(set-buffer-modified-p nil)
(set-visited-file-name nil 'no-query))))
(defmacro flycheck-ert-with-file-buffer (file-name &rest body)
"Create a buffer from FILE-NAME and eval BODY.
BODY is evaluated with `current-buffer' being a buffer with the
contents FILE-NAME."
(declare (indent 1))
`(let ((file-name ,file-name))
(unless (file-exists-p file-name)
(error "%s does not exist" file-name))
(flycheck-ert-with-temp-buffer
(insert-file-contents file-name 'visit)
(set-visited-file-name file-name 'no-query)
(cd (file-name-directory file-name))
;; Mark the buffer as not modified, because we just loaded the file up to
;; now.
(set-buffer-modified-p nil)
,@body)))
(defmacro flycheck-ert-with-help-buffer (&rest body)
"Execute BODY and kill the help buffer afterwards.
Use this macro to test functions that create a Help buffer."
(declare (indent 0))
`(unwind-protect
,(macroexp-progn body)
(when (buffer-live-p (get-buffer (help-buffer)))
(kill-buffer (help-buffer)))))
(defmacro flycheck-ert-with-global-mode (&rest body)
"Execute BODY with Global Flycheck Mode enabled.
After BODY, restore the old state of Global Flycheck Mode."
(declare (indent 0))
`(let ((old-state global-flycheck-mode))
(unwind-protect
(progn
(global-flycheck-mode 1)
,@body)
(global-flycheck-mode (if old-state 1 -1)))))
(defmacro flycheck-ert-with-env (env &rest body)
"Add ENV to `process-environment' in BODY.
Execute BODY with a `process-environment' with contains all
variables from ENV added.
ENV is an alist, where each cons cell `(VAR . VALUE)' is a
environment variable VAR to be added to `process-environment'
with VALUE."
(declare (indent 1))
`(let ((process-environment (copy-sequence process-environment)))
(pcase-dolist (`(,var . ,value) ,env)
(setenv var value))
,@body))
;;; Test resources
(defun flycheck-ert-resource-filename (resource-file)
"Determine the absolute file name of a RESOURCE-FILE.
Relative file names are expanded against
`flycheck-ert-resources-directory'."
(expand-file-name resource-file flycheck-ert--resource-directory))
(defmacro flycheck-ert-with-resource-buffer (resource-file &rest body)
"Create a temp buffer from a RESOURCE-FILE and execute BODY.
The absolute file name of RESOURCE-FILE is determined with
`flycheck-ert-resource-filename'."
(declare (indent 1))
`(flycheck-ert-with-file-buffer
(flycheck-ert-resource-filename ,resource-file)
,@body))
(defun flycheck-ert-locate-config-file (filename _checker)
"Find a configuration FILENAME within unit tests.
_CHECKER is ignored."
(let* ((directory (flycheck-ert-resource-filename "config-files"))
(filepath (expand-file-name filename directory)))
(when (file-exists-p filepath)
filepath)))
;;; Test suite initialization
(defun flycheck-ert-initialize (resource-dir)
"Initialize a test suite with RESOURCE-DIR.
RESOURCE-DIR is the directory, `flycheck-ert-resource-filename'
should use to lookup resource files."
(when flycheck-ert--resource-directory
(error "Test suite already initialized"))
(let ((tests (ert-select-tests t t)))
;; Select all tests
(unless tests
(error "No tests defined. Call `flycheck-ert-initialize' after defining all tests!"))
(setq flycheck-ert--resource-directory resource-dir)
;; Emacs 24.3 don't support skipped tests, so we add poor man's test
;; skipping: We mark skipped tests as expected failures by adjusting the
;; expected result of all test cases. Not particularly pretty, but works :)
(unless flycheck-ert-ert-can-skip
(dolist (test tests)
(let ((result (ert-test-expected-result-type test)))
(setf (ert-test-expected-result-type test)
`(or ,result (satisfies ert-test-skipped-p))))))))
;;; Environment and version information
(defconst flycheck-ert-user-error-type
(if (version< emacs-version "24.2")
'error
'user-error)
"The `user-error' type used by Flycheck.")
(defun flycheck-ert-travis-ci-p ()
"Determine whether we are running on Travis CI."
(string= (getenv "TRAVIS") "true"))
(defun flycheck-ert-check-gpg ()
"Check whether GPG is available."
(or (epg-check-configuration (epg-configuration)) t))
(defun flycheck-ert-extract-version-command (re executable &rest args)
"Use RE to extract the version from EXECUTABLE with ARGS.
Run EXECUTABLE with ARGS, catch the output, and apply RE to find
the version number. Return the text captured by the first group
in RE, or nil, if EXECUTABLE is missing, or if RE failed to
match."
(-when-let (executable (executable-find executable))
(with-temp-buffer
(apply #'call-process executable nil t nil args)
(goto-char (point-min))
(when (re-search-forward re nil 'no-error)
(match-string 1)))))
;;; Test case definitions
(defmacro flycheck-ert-def-checker-test (checker language name
&rest keys-and-body)
"Define a test case for a syntax CHECKER for LANGUAGE.
CHECKER is a symbol or a list of symbols denoting syntax checkers
being tested by the test. The test case is skipped, if any of
these checkers cannot be used. LANGUAGE is a symbol or a list of
symbols denoting the programming languages supported by the
syntax checkers. This is currently only used for tagging the
test appropriately.
NAME is a symbol denoting the local name of the test. The test
itself is ultimately named
`flycheck-define-checker/CHECKER/NAME'. If CHECKER is a list,
the first checker in the list is used for naming the test.
Optionally, the keyword arguments `:tags' and `:expected-result'
may be given. They have the same meaning as in `ert-deftest.',
and are added to the tags and result expectations set up by this
macro.
The remaining forms denote the body of the test case, including
assertions and setup code."
(declare (indent 3))
(unless checker
(error "No syntax checkers specified."))
(unless language
(error "No languages specified"))
(let* ((checkers (if (symbolp checker) (list checker) checker))
(checker (car checkers))
(languages (if (symbolp language) (list language) language))
(language-tags (mapcar (lambda (l) (intern (format "language-%s" l)))
languages))
(checker-tags (mapcar (lambda (c) (intern (format "checker-%s" c)))
checkers))
(local-name (or name 'default))
(full-name (intern (format "flycheck-define-checker/%s/%s"
checker local-name)))
(keys-and-body (ert--parse-keys-and-body keys-and-body))
(body (cadr keys-and-body))
(keys (car keys-and-body))
(default-tags '(syntax-checker external-tool)))
`(ert-deftest ,full-name ()
:expected-result
(list 'or
'(satisfies flycheck-ert-syntax-check-timed-out-p)
,(or (plist-get keys :expected-result) :passed))
:tags (append ',(append default-tags language-tags checker-tags)
,(plist-get keys :tags))
,@(mapcar (lambda (c) `(skip-unless
;; Ignore non-command checkers
(or (not (flycheck-checker-get ',c 'command))
(executable-find (flycheck-checker-executable ',c)))))
checkers)
,@body)))
;;; Test case results
(defun flycheck-ert-syntax-check-timed-out-p (result)
"Whether RESULT denotes a timed-out test.
RESULT is an ERT test result object."
(and (ert-test-failed-p result)
(eq (car (ert-test-failed-condition result))
'flycheck-ert-syntax-check-timed-out)))
;;; Syntax checking in tests
(defvar-local flycheck-ert-syntax-checker-finished nil
"Non-nil if the current checker has finished.")
(add-hook 'flycheck-after-syntax-check-hook
(lambda () (setq flycheck-ert-syntax-checker-finished t)))
(defconst flycheck-ert-checker-wait-time 10
"Time to wait until a checker is finished in seconds.
After this time has elapsed, the checker is considered to have
failed, and the test aborted with failure.")
(put 'flycheck-ert-syntax-check-timed-out 'error-message
"Syntax check timed out.")
(put 'flycheck-ert-syntax-check-timed-out 'error-conditions '(error))
(defun flycheck-ert-wait-for-syntax-checker ()
"Wait until the syntax check in the current buffer is finished."
(let ((starttime (float-time)))
(while (and (not flycheck-ert-syntax-checker-finished)
(< (- (float-time) starttime) flycheck-ert-checker-wait-time))
(sleep-for 1))
(unless (< (- (float-time) starttime) flycheck-ert-checker-wait-time)
(flycheck-stop)
(signal 'flycheck-ert-syntax-check-timed-out nil)))
(setq flycheck-ert-syntax-checker-finished nil))
(defun flycheck-ert-buffer-sync ()
"Like `flycheck-buffer', but synchronously."
(setq flycheck-ert-syntax-checker-finished nil)
(should (not (flycheck-running-p)))
(flycheck-mode) ; This will only start a deferred check,
(flycheck-buffer) ; so we need an explicit manual check
;; After starting the check, the checker should either be running now, or
;; already be finished (if it was fast).
(should (or flycheck-current-syntax-check
flycheck-ert-syntax-checker-finished))
;; Also there should be no deferred check pending anymore
(should-not (flycheck-deferred-check-p))
(flycheck-ert-wait-for-syntax-checker))
(defun flycheck-ert-ensure-clear ()
"Clear the current buffer.
Raise an assertion error if the buffer is not clear afterwards."
(flycheck-clear)
(should (not flycheck-current-errors))
(should (not (-any? (lambda (ov) (overlay-get ov 'flycheck-overlay))
(overlays-in (point-min) (point-max))))))
;;; Test assertions
(defun flycheck-ert-should-overlay (error)
"Test that ERROR has a proper overlay in the current buffer.
ERROR is a Flycheck error object."
(let* ((overlay (-first (lambda (ov) (equal (overlay-get ov 'flycheck-error)
error))
(flycheck-overlays-in 0 (+ 1 (buffer-size)))))
(region (flycheck-error-region-for-mode error 'symbols))
(message (flycheck-error-message error))
(level (flycheck-error-level error))
(category (flycheck-error-level-overlay-category level))
(face (get category 'face))
(fringe-bitmap (flycheck-error-level-fringe-bitmap level))
(fringe-face (flycheck-error-level-fringe-face level))
(fringe-icon (list 'left-fringe fringe-bitmap fringe-face)))
(should overlay)
(should (overlay-get overlay 'flycheck-overlay))
(should (= (overlay-start overlay) (car region)))
(should (= (overlay-end overlay) (cdr region)))
(should (eq (overlay-get overlay 'face) face))
(should (equal (get-char-property 0 'display
(overlay-get overlay 'before-string))
fringe-icon))
(should (eq (overlay-get overlay 'category) category))
(should (equal (overlay-get overlay 'flycheck-error) error))))
(defun flycheck-ert-should-errors (&rest errors)
"Test that the current buffers has ERRORS.
ERRORS is a list of errors expected to be present in the current
buffer. Each error is given as a list of arguments to
`flycheck-error-new-at'.
If ERRORS are omitted, test that there are no errors at all in
the current buffer.
With ERRORS, test that each error in ERRORS is present in the
current buffer, and that the number of errors in the current
buffer is equal to the number of given ERRORS. In other words,
check that the buffer has all ERRORS, and no other errors."
(let ((expected (mapcar (apply-partially #'apply #'flycheck-error-new-at)
errors)))
(should (equal expected flycheck-current-errors))
(mapc #'flycheck-ert-should-overlay expected))
(should (= (length errors)
(length (flycheck-overlays-in (point-min) (point-max))))))
(defun flycheck-ert-should-syntax-check (resource-file modes &rest errors)
"Test a syntax check in RESOURCE-FILE with MODES.
RESOURCE-FILE is the file to check. MODES is a single major mode
symbol or a list thereof, specifying the major modes to syntax
check with. If more than one major mode is specified, the test
is run for each mode separately, so if you give three major
modes, the entire test will run three times. ERRORS is the list
of expected errors, as in `flycheck-ert-should-errors'. If
omitted, the syntax check must not emit any errors. The errors
are cleared after each test.
The syntax checker is selected via standard syntax checker
selection. To test a specific checker, you need to set
`flycheck-checker' or `flycheck-disabled-checkers' accordingly
before using this predicate, depending on whether you want to use
manual or automatic checker selection.
During the syntax check, configuration files of syntax checkers
are also searched in the `config-files' sub-directory of the
resource directory."
(when (symbolp modes)
(setq modes (list modes)))
(dolist (mode modes)
(unless (fboundp mode)
(ert-skip (format "%S missing" mode)))
(flycheck-ert-with-resource-buffer resource-file
(funcall mode)
;; Configure config file locating for unit tests
(dolist (fn '(flycheck-locate-config-file-by-path
flycheck-ert-locate-config-file))
(add-hook 'flycheck-locate-config-file-functions fn 'append 'local))
(let ((process-hook-called 0))
(add-hook 'flycheck-process-error-functions
(lambda (_err)
(setq process-hook-called (1+ process-hook-called))
nil)
nil :local)
(flycheck-ert-buffer-sync)
(apply #'flycheck-ert-should-errors errors)
(should (= process-hook-called (length errors))))
(flycheck-ert-ensure-clear))))
(defun flycheck-ert-at-nth-error (n)
"Determine whether point is at the N'th Flycheck error.
Return non-nil if the point is at the N'th Flycheck error in the
current buffer. Otherwise return nil."
(let* ((error (nth (1- n) flycheck-current-errors))
(mode flycheck-highlighting-mode)
(region (flycheck-error-region-for-mode error mode)))
(and (member error (flycheck-overlay-errors-at (point)))
(= (point) (car region)))))
(defun flycheck-ert-explain--at-nth-error (n)
(let ((errors (flycheck-overlay-errors-at (point))))
(if (null errors)
(format "Expected to be at error %s, but no error at point %s"
n (point))
(let ((pos (cl-position (car errors) flycheck-current-errors)))
(format "Expected to be at error %s, but point %s is at error %s"
n (point) (1+ pos))))))
(put 'flycheck-ert-at-nth-error 'ert-explainer
'flycheck-ert-explain--at-nth-error)
(provide 'flycheck-ert)
;;; flycheck-ert.el ends here

11
dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck-pkg.el

@ -0,0 +1,11 @@
(define-package "flycheck" "20151022.1349" "On-the-fly syntax checking"
'((dash "2.4.0")
(pkg-info "0.4")
(let-alist "1.0.1")
(cl-lib "0.3")
(emacs "24.3"))
:url "https://www.flycheck.org" :keywords
'("convenience" "languages" "tools"))
;; Local Variables:
;; no-byte-compile: t
;; End:

8088
dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck.el

File diff suppressed because it is too large Load Diff

3018
dotfiles/emacs.d/elpa/flycheck-20151022.1349/flycheck.info

File diff suppressed because it is too large Load Diff

29
dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure-autoloads.el

@ -0,0 +1,29 @@
;;; flycheck-clojure-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck-clojure" "flycheck-clojure.el" (22059
;;;;;; 18183 102984 329000))
;;; Generated autoloads from flycheck-clojure.el
(autoload 'flycheck-clojure-parse-cider-errors "flycheck-clojure" "\
Parse cider errors from JSON VALUE from CHECKER.
Return a list of parsed `flycheck-error' objects.
\(fn VALUE CHECKER)" nil nil)
(autoload 'flycheck-clojure-setup "flycheck-clojure" "\
Setup Flycheck for Clojure.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-clojure-autoloads.el ends here

1
dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure-pkg.el

@ -0,0 +1 @@
(define-package "flycheck-clojure" "20150831.631" "Flycheck: Clojure support" '((cider "0.8.1") (flycheck "0.22alpha1") (let-alist "1.0.1") (emacs "24")) :url "https://github.com/clojure-emacs/squiggly-clojure")

205
dotfiles/emacs.d/elpa/flycheck-clojure-20150831.631/flycheck-clojure.el

@ -0,0 +1,205 @@
;;; flycheck-clojure.el --- Flycheck: Clojure support -*- lexical-binding: t; -*-
;; Copyright © 2014 Peter Fraenkel
;; Copyright (C) 2014 Sebastian Wiesner <swiesner@lunaryorn.com>
;;
;; Author: Peter Fraenkel <pnf@podsnap.com>
;; Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Peter Fraenkel <pnf@podsnap.com>
;; URL: https://github.com/clojure-emacs/squiggly-clojure
;; Package-Version: 20150831.631
;; Version: 1.1.0
;; Package-Requires: ((cider "0.8.1") (flycheck "0.22-cvs1") (let-alist "1.0.1") (emacs "24"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Add Clojure support to Flycheck.
;;
;; Provide syntax checkers to check Clojure code using a running Cider repl.
;;
;; Installation:
;;
;; (eval-after-load 'flycheck '(flycheck-clojure-setup))
;;; Code:
(require 'cider-client)
(require 'flycheck)
(require 'json)
(require 'url-parse)
(eval-when-compile (require 'let-alist))
;;;###autoload
(defun flycheck-clojure-parse-cider-errors (value checker)
"Parse cider errors from JSON VALUE from CHECKER.
Return a list of parsed `flycheck-error' objects."
;; Parse the nested JSON from Cider. The outer JSON contains the return value
;; from Cider, and the inner JSON the errors returned by the individual
;; checker.
(let ((error-objects (json-read-from-string (json-read-from-string value))))
(mapcar (lambda (o)
(let-alist o
;; Use the file name reported by the syntax checker, but only if
;; its absolute, because typed reports relative file names that
;; are hard to expand correctly, since they are relative to the
;; source directory (not the project directory).
(let* ((parsed-file (when .file
(url-filename
(url-generic-parse-url .file))))
(filename (if (and parsed-file
(file-name-absolute-p parsed-file))
parsed-file
(buffer-file-name))))
(flycheck-error-new-at .line .column (intern .level) .msg
:checker checker
:filename filename))))
error-objects)))
(defun cider-flycheck-eval (input callback)
"Send the request INPUT and register the CALLBACK as the response handler.
Uses the tooling session, with no specified namespace."
(cider-nrepl-request:eval input callback))
(defun flycheck-clojure-may-use-cider-checker ()
"Determine whether a cider checker may be used.
Checks for `cider-mode', and a current nREPL connection.
Standard predicate for cider checkers."
(let ((connection-buffer (cider-default-connection :no-error)))
(and (bound-and-true-p cider-mode)
connection-buffer
(buffer-live-p (get-buffer connection-buffer))
(clojure-find-ns))))
(defun flycheck-clojure-start-cider (checker callback)
"Start a cider syntax CHECKER with CALLBACK."
(let ((ns (clojure-find-ns))
(form (get checker 'flycheck-clojure-form)))
(cider-flycheck-eval
(funcall form ns)
(nrepl-make-response-handler
(current-buffer)
(lambda (buffer value)
(funcall callback 'finished
(with-current-buffer buffer
(flycheck-clojure-parse-cider-errors value checker))))
nil ; stdout
nil ; stderr
(lambda (_)
;; If the evaluation completes without returning any value, there has
;; gone something wrong. Ideally, we'd report *what* was wrong, but
;; `nrepl-make-response-handler' is close to useless for this :(,
;; because it just `message's for many status codes that are errors for
;; us :(
(funcall callback 'errored "Done with no errors"))
(lambda (_buffer ex _rootex _sess)
(funcall callback 'errored
(format "Form %s of checker %s failed: %s"
form checker ex))))))
)
(defun flycheck-clojure-define-cider-checker (name docstring &rest properties)
"Define a Cider syntax checker with NAME, DOCSTRING and PROPERTIES.
NAME, DOCSTRING, and PROPERTIES are like for
`flycheck-define-generic-checker', except that `:start' and
`:modes' are invalid PROPERTIES. A syntax checker defined with
this function will always check in `clojure-mode', and only if
`cider-mode' is enabled.
Instead of `:start', this syntax checker requires a `:form
FUNCTION' property. FUNCTION takes the current Clojure namespace
as single argument, and shall return a string containing a
Clojure form to be sent to Cider to check the current buffer."
(declare (indent 1)
(doc-string 2))
(let* ((form (plist-get properties :form))
(orig-predicate (plist-get properties :predicate)))
(when (plist-get :start properties)
(error "Checker %s may not have :start" name))
(when (plist-get :modes properties)
(error "Checker %s may not have :modes" name))
(unless (functionp form)
(error ":form %s of %s not a valid function" form name))
(apply #'flycheck-define-generic-checker
name docstring
:start #'flycheck-clojure-start-cider
:modes '(clojure-mode)
:predicate (if orig-predicate
(lambda ()
(and (flycheck-clojure-may-use-cider-checker)
(funcall orig-predicate)))
#'flycheck-clojure-may-use-cider-checker)
properties)
(put name 'flycheck-clojure-form form)))
(flycheck-clojure-define-cider-checker 'clojure-cider-eastwood
"A syntax checker for Clojure, using Eastwood in Cider.
See URL `https://github.com/jonase/eastwood' and URL
`https://github.com/clojure-emacs/cider/' for more information."
:form (lambda (ns)
(format "(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-ew '%s))"
ns))
:next-checkers '(clojure-cider-kibit clojure-cider-typed))
(flycheck-clojure-define-cider-checker 'clojure-cider-kibit
"A syntax checker for Clojure, using Kibit in Cider.
See URL `https://github.com/jonase/kibit' and URL
`https://github.com/clojure-emacs/cider/' for more information."
:form (lambda (ns)
(format
"(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-kb '%s %s))"
ns
;; Escape file name for Clojure
(flycheck-sexp-to-string (buffer-file-name))))
:predicate (lambda () (buffer-file-name))
:next-checkers '(clojure-cider-typed))
(flycheck-clojure-define-cider-checker 'clojure-cider-typed
"A syntax checker for Clojure, using Typed Clojure in Cider.
See URL `https://github.com/clojure-emacs/cider/' and URL
`https://github.com/clojure/core.typed' for more information."
:form (lambda (ns)
(format
"(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-tc '%s))"
ns)))
;;;###autoload
(defun flycheck-clojure-setup ()
"Setup Flycheck for Clojure."
(interactive)
;; Add checkers in reverse order, because `add-to-list' adds to front.
(dolist (checker '(clojure-cider-typed
clojure-cider-kibit
clojure-cider-eastwood))
(add-to-list 'flycheck-checkers checker)))
(provide 'flycheck-clojure)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; flycheck-clojure.el ends here

34
dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell-autoloads.el

@ -0,0 +1,34 @@
;;; flycheck-haskell-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck-haskell" "flycheck-haskell.el" (22059
;;;;;; 18192 819651 53000))
;;; Generated autoloads from flycheck-haskell.el
(autoload 'flycheck-haskell-setup "flycheck-haskell" "\
Setup Haskell support for Flycheck.
If the current file is part of a Cabal project, configure
Flycheck to take the module paths of the Cabal projects into
account.
Also search for Cabal sandboxes and add them to the module search
path as well.
\(fn)" nil nil)
;;;***
;;;### (autoloads nil nil ("flycheck-haskell-pkg.el") (22059 18192
;;;;;; 964493 750000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-haskell-autoloads.el ends here

11
dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell-pkg.el

@ -0,0 +1,11 @@
(define-package "flycheck-haskell" "20151010.340" "Flycheck: Cabal projects and sandboxes"
'((emacs "24.1")
(flycheck "0.22")
(haskell-mode "13.7")
(dash "2.4.0")
(let-alist "1.0.1"))
:url "https://github.com/flycheck/flycheck-haskell" :keywords
'("tools" "convenience"))
;; Local Variables:
;; no-byte-compile: t
;; End:

299
dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/flycheck-haskell.el

@ -0,0 +1,299 @@
;;; flycheck-haskell.el --- Flycheck: Cabal projects and sandboxes -*- lexical-binding: t; -*-
;; Copyright (C) 2014, 2015 Sebastian Wiesner <swiesner@lunaryorn.com>
;; Copyright (C) 2015 Michael Alan Dorman <mdorman@ironicdesign.com>
;; Copyright (C) 2015 Alex Rozenshteyn <rpglover64@gmail.com>
;; Copyright (C) 2014 Gracjan Polak <gracjanpolak@gmail.com>
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; URL: https://github.com/flycheck/flycheck-haskell
;; Keywords: tools, convenience
;; Version: 0.8-cvs
;; Package-Requires: ((emacs "24.1") (flycheck "0.22") (haskell-mode "13.7") (dash "2.4.0") (let-alist "1.0.1"))
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Configure Haskell syntax checking by Flycheck.
;;;; Cabal support
;; Try to find Cabal project files for Haskell buffers, and configure the
;; Haskell syntax checkers in Flycheck according to the contents of the Cabal
;; file:
;;
;; - Add all source directories to the GHC search path
;; - Add build directories from Cabal to the GHC search path to speed up
;; checking and support non-Haskell modules such as hsc files
;; - Add auto-generated files from Cabal to the GHC search path
;; - Set the language from Cabal
;; - Enable language extensions from Cabal
;;;; Cabal sandboxes
;; Try to find a Cabal sandbox configuration for this project, and configure the
;; Haskell syntax checkers in Flycheck to use the package database from the
;; Sandbox.
;;;; Setup
;; (add-hook 'flycheck-mode-hook #'flycheck-haskell-setup)
;;; Code:
(eval-when-compile
(require 'rx)
(require 'let-alist))
(require 'haskell-cabal)
(require 'flycheck)
(require 'dash)
;;; Customization
(defgroup flycheck-haskell nil
"Haskell support for Flycheck."
:prefix "flycheck-haskell-"
:group 'flycheck
:link '(url-link :tag "Github" "https://github.com/flycheck/flycheck-haskell"))
(defcustom flycheck-haskell-runghc-command
(if (executable-find "stack")
'("stack" "--verbosity" "silent" "runghc")
'("runghc"))
"Command for `runghc'.
This library uses `runghc' to run various Haskell helper scripts
to extract information from Cabal files. This option provides
the command to invoke `runghc'. The default is to use `stack'
and otherwise fall back to standard `runghc'."
:type '(repeat (string :tag "Command"))
:risky t
:group 'flycheck-haskell)
;;; Cabal support
(defconst flycheck-haskell-directory
(file-name-directory (if load-in-progress
load-file-name
(buffer-file-name)))
"The package directory of flycheck-haskell.")
(defconst flycheck-haskell-helper
(expand-file-name "get-cabal-configuration.hs" flycheck-haskell-directory)
"The helper to dump the Cabal configuration.")
(defconst flycheck-haskell-flags-helper
(expand-file-name "get-flags.hs" flycheck-haskell-directory)
"The helper to get compiler flags for the Cabal helper.")
(defun flycheck-haskell-runghc-command (args)
"Create a runghc command with ARGS.
Take the base command from `flycheck-haskell-runghc-command'."
(append flycheck-haskell-runghc-command args nil))
(defun flycheck-haskell--get-flags ()
"Get GHC flags to run the Cabal helper."
(ignore-errors
(apply #'process-lines
(flycheck-haskell-runghc-command
(list flycheck-haskell-flags-helper)))))
(defun flycheck-haskell-read-cabal-configuration (cabal-file)
"Read the Cabal configuration from CABAL-FILE."
(let* ((args (append (flycheck-haskell--get-flags)
(list flycheck-haskell-helper cabal-file)))
(command (flycheck-haskell-runghc-command args)))
(with-temp-buffer
(pcase (apply 'call-process (car command) nil t nil (cdr command))
(0 (goto-char (point-min))
(read (current-buffer)))
(retcode (message "Reading Haskell configuration failed with exit code %s and output:\n%s"
retcode (buffer-string))
nil)))))
;;; Cabal configuration caching
(defconst flycheck-haskell-config-cache (make-hash-table :test 'equal)
"Cache of Cabal configuration.
A hash table, mapping the name of a cabal file to a
cons-cell `(MODTIME . CONFIG)', where MODTIME is the modification
time of the cabal file, and CONFIG the extracted configuration.")
(defun flycheck-haskell-clear-config-cache ()
"Clear the cache of configurations."
(interactive)
(clrhash flycheck-haskell-config-cache))
(defun flycheck-haskell-get-cached-configuration (cabal-file)
"Get the cached configuration for CABAL-FILE.
Return the cached configuration, or nil, if there is no cache
entry, or if the cache entry is outdated."
(pcase-let* ((cache-entry (gethash cabal-file flycheck-haskell-config-cache))
(`(,modtime . ,config) cache-entry))
(when (and modtime (file-exists-p cabal-file))
(let ((current-modtime (nth 5 (file-attributes cabal-file))))
(if (time-less-p modtime current-modtime)
;; The entry is outdated, drop it. `remhash' always
;; returns nil, so we are safe to use it here.
(remhash cabal-file flycheck-haskell-config-cache)
;; The configuration is up to date, use it
config)))))
(defun flycheck-haskell-read-and-cache-configuration (cabal-file)
"Read and cache configuration from CABAL-FILE.
Return the configuration."
(let ((modtime (nth 5 (file-attributes cabal-file)))
(config (flycheck-haskell-read-cabal-configuration cabal-file)))
(puthash cabal-file (cons modtime config) flycheck-haskell-config-cache)
config))
(defun flycheck-haskell-get-configuration (cabal-file)
"Get the Cabal configuration from CABAL-FILE.
Get the configuration either from our cache, or by reading the
CABAL-FILE.
Return the configuration."
(or (flycheck-haskell-get-cached-configuration cabal-file)
(flycheck-haskell-read-and-cache-configuration cabal-file)))
;;; Cabal sandbox support
(defconst flycheck-haskell-cabal-config "cabal.config"
"The file name of a Cabal configuration.")
(defconst flycheck-haskell-cabal-config-keys '(with-compiler)
"Keys to parse from a Cabal configuration file.")
(defconst flycheck-haskell-sandbox-config "cabal.sandbox.config"
"The file name of a Cabal sandbox configuration.")
(defconst flycheck-haskell-sandbox-config-keys '(package-db)
"Keys to parse from a Cabal sandbox configuration.")
(defmacro flycheck-haskell-with-config-file-buffer (file-name &rest body)
"Eval BODY in a buffer with the contents of FILE-NAME."
(declare (indent 1))
`(with-temp-buffer
(insert-file-contents ,file-name)
(goto-char (point-min))
,@body))
(defun flycheck-haskell-get-config-value (key)
"Get the value of a configuration KEY from this buffer.
KEY is a symbol denoting the key whose value to get. Return
a `(KEY . VALUE)' cons cell."
(save-excursion
(goto-char (point-min))
(-when-let (setting (haskell-cabal-get-setting (symbol-name key)))
(cons key (substring-no-properties setting)))))
(defun flycheck-haskell-parse-config-file (keys config-file)
"Parse KEYS from CONFIG-FILE.
KEYS is a list of symbols. Return an alist with all parsed
KEYS."
(flycheck-haskell-with-config-file-buffer config-file
(mapcar #'flycheck-haskell-get-config-value keys)))
(defun flycheck-haskell-find-config (config-file)
"Find a CONFIG-FILE for the current buffer.
Return the absolute path of CONFIG-FILE as string, or nil if
CONFIG-FILE was not found."
(-when-let (root-dir (locate-dominating-file (buffer-file-name) config-file))
(expand-file-name config-file root-dir)))
(defun flycheck-haskell-get-cabal-config ()
"Get Cabal configuration for the current buffer.
Return an alist with the Cabal configuration for the current
buffer."
(-when-let (file-name (flycheck-haskell-find-config
flycheck-haskell-cabal-config))
(flycheck-haskell-parse-config-file flycheck-haskell-cabal-config-keys
file-name)))
(defun flycheck-haskell-get-sandbox-config ()
"Get sandbox configuration for the current buffer.
Return an alist with the sandbox configuration for the current
buffer."
(-when-let (file-name (flycheck-haskell-find-config
flycheck-haskell-sandbox-config))
(flycheck-haskell-parse-config-file flycheck-haskell-sandbox-config-keys
file-name)))
;;; Buffer setup
(defun flycheck-haskell-process-configuration (config)
"Process the a Cabal CONFIG."
(let-alist config
(setq-local flycheck-ghc-search-path
(append .build-directories .source-directories
flycheck-ghc-search-path))
(setq-local flycheck-ghc-language-extensions
(append .extensions .languages
flycheck-ghc-language-extensions))
(setq-local flycheck-ghc-args
(append .other-options flycheck-ghc-args))))
(defun flycheck-haskell-configure ()
"Set paths and package database for the current project."
(interactive)
(when (and (buffer-file-name) (file-directory-p default-directory))
(-when-let* ((cabal-file (haskell-cabal-find-file))
(config (flycheck-haskell-get-configuration cabal-file)))
(flycheck-haskell-process-configuration config))
(let-alist (flycheck-haskell-get-cabal-config)
(when .with-compiler
(setq-local flycheck-haskell-ghc-executable .with-compiler)))
(let-alist (flycheck-haskell-get-sandbox-config)
(when .package-db
(setq-local flycheck-ghc-package-databases
(cons .package-db flycheck-ghc-package-databases))
(setq-local flycheck-ghc-no-user-package-database t)))))
;;;###autoload
(defun flycheck-haskell-setup ()
"Setup Haskell support for Flycheck.
If the current file is part of a Cabal project, configure
Flycheck to take the module paths of the Cabal projects into
account.
Also search for Cabal sandboxes and add them to the module search
path as well."
(add-hook 'hack-local-variables-hook #'flycheck-haskell-configure))
(provide 'flycheck-haskell)
;; Local Variables:
;; indent-tabs-mode: nil
;; coding: utf-8
;; End:
;;; flycheck-haskell.el ends here

209
dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/get-cabal-configuration.hs

@ -0,0 +1,209 @@
-- Copyright (C) 2014, 2015 Sebastian Wiesner <swiesner@lunaryorn.com>
-- Copyright (C) 2014 Gracjan Polak <gracjanpolak@gmail.com>
-- Copyright (C) 2015 Michael Alan Dorman <mdorman@ironicdesign.com>
-- This file is not part of GNU Emacs.
-- This program is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-- details.
-- You should have received a copy of the GNU General Public License along with
-- this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Arrow (second)
import Data.List (nub, isPrefixOf)
import Data.Maybe (listToMaybe)
#ifdef USE_COMPILER_ID
import Distribution.Compiler
(CompilerFlavor(GHC), CompilerId(CompilerId), buildCompilerFlavor)
#else
import Distribution.Compiler
(AbiTag(NoAbiTag), CompilerFlavor(GHC), CompilerId(CompilerId),
CompilerInfo, buildCompilerFlavor, unknownCompilerInfo)
#endif
import Distribution.Package
(PackageName(..), PackageIdentifier(..), Dependency(..))
import Distribution.PackageDescription
(PackageDescription(..), allBuildInfo, BuildInfo(..),
usedExtensions, allLanguages, hcOptions, exeName, testEnabled,
condTestSuites, benchmarkEnabled, condBenchmarks)
import Distribution.PackageDescription.Configuration
(finalizePackageDescription, mapTreeData)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Simple.BuildPaths (defaultDistPref)
import Distribution.System (buildPlatform)
import Distribution.Verbosity (silent)
import Language.Haskell.Extension (Extension(..),Language(..))
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath ((</>),dropFileName,normalise)
import System.Info (compilerVersion)
data Sexp
= SList [Sexp]
| SString String
| SSymbol String
sym :: String -> Sexp
sym = SSymbol
instance Show Sexp where
show (SSymbol s) = s
show (SString s) = show s -- Poor man's escaping
show (SList s) = "(" ++ unwords (map show s) ++ ")"
class ToSexp a where
toSexp :: a -> Sexp
instance ToSexp String where
toSexp = SString
instance ToSexp Extension where
toSexp (EnableExtension ext) = toSexp (show ext)
toSexp (DisableExtension ext) = toSexp ("No" ++ show ext)
toSexp (UnknownExtension ext) = toSexp ext
instance ToSexp Language where
toSexp (UnknownLanguage lang) = toSexp lang
toSexp lang = toSexp (show lang)
instance ToSexp Dependency where
toSexp (Dependency (PackageName dependency) _) = toSexp dependency
instance ToSexp Sexp where
toSexp = id
cons :: (ToSexp a, ToSexp b) => a -> [b] -> Sexp
cons h t = SList (toSexp h : map toSexp t)
getBuildDirectories :: PackageDescription -> FilePath -> [String]
getBuildDirectories pkgDesc cabalDir =
case library pkgDesc of
Just _ -> buildDir : buildDirs
Nothing -> buildDirs
where
distDir = cabalDir </> defaultDistPref
buildDir = distDir </> "build"
autogenDir = buildDir </> "autogen"
executableBuildDir e = buildDir </> exeName e </> (exeName e ++ "-tmp")
buildDirs = autogenDir : map executableBuildDir (executables pkgDesc)
getSourceDirectories :: [BuildInfo] -> FilePath -> [String]
getSourceDirectories buildInfo cabalDir =
map (cabalDir </>) (concatMap hsSourceDirs buildInfo)
allowedOptions :: [String]
allowedOptions =
[ "-W"
, "-w"
, "-Wall"
, "-fglasgow-exts"
, "-fpackage-trust"
, "-fhelpful-errors"
, "-F"
, "-cpp"]
allowedOptionPrefixes :: [String]
allowedOptionPrefixes =
[ "-fwarn-"
, "-fno-warn-"
, "-fcontext-stack="
, "-firrefutable-tuples"
, "-D"
, "-U"
, "-I"
, "-fplugin="
, "-fplugin-opt="
, "-pgm"
, "-opt"]
isAllowedOption :: String -> Bool
isAllowedOption opt =
elem opt allowedOptions || any (`isPrefixOf` opt) allowedOptionPrefixes
dumpPackageDescription :: PackageDescription -> FilePath -> Sexp
dumpPackageDescription pkgDesc cabalFile =
SList
[ cons (sym "build-directories") buildDirs
, cons (sym "source-directories") sourceDirs
, cons (sym "extensions") exts
, cons (sym "languages") langs
, cons (sym "dependencies") deps
, cons (sym "other-options") otherOptions]
where
cabalDir = dropFileName cabalFile
buildInfo = allBuildInfo pkgDesc
buildDirs = nub (map normalise (getBuildDirectories pkgDesc cabalDir))
sourceDirs = nub (map normalise (getSourceDirectories buildInfo cabalDir))
exts = nub (concatMap usedExtensions buildInfo)
langs = nub (concatMap allLanguages buildInfo)
thisPackage = (pkgName . package) pkgDesc
deps =
nub
(filter
(\(Dependency name _) ->
name /= thisPackage)
(buildDepends pkgDesc))
otherOptions =
nub (filter isAllowedOption (concatMap (hcOptions GHC) buildInfo))
dumpCabalConfiguration :: String -> IO ()
dumpCabalConfiguration cabalFile = do
genericDesc <- readPackageDescription silent cabalFile
-- This let block is eerily like one in Cabal.Distribution.Simple.Configure
let enableTest t =
t
{ testEnabled = True
}
flaggedTests =
map (second (mapTreeData enableTest)) (condTestSuites genericDesc)
enableBenchmark bm =
bm
{ benchmarkEnabled = True
}
flaggedBenchmarks =
map
(second (mapTreeData enableBenchmark))
(condBenchmarks genericDesc)
genericDesc' =
genericDesc
{ condTestSuites = flaggedTests
, condBenchmarks = flaggedBenchmarks
}
case finalizePackageDescription
[]
(const True)
buildPlatform
buildCompilerId
[]
genericDesc' of
Left e -> putStrLn $ "Issue with package configuration\n" ++ show e
Right (pkgDesc,_) -> print (dumpPackageDescription pkgDesc cabalFile)
#ifdef USE_COMPILER_ID
buildCompilerId :: CompilerId
buildCompilerId = CompilerId buildCompilerFlavor compilerVersion
#else
buildCompilerId :: CompilerInfo
buildCompilerId =
unknownCompilerInfo
(CompilerId buildCompilerFlavor compilerVersion)
NoAbiTag
#endif
main :: IO ()
main = do
args <- getArgs
let cabalFile = listToMaybe args
maybe exitFailure dumpCabalConfiguration cabalFile

48
dotfiles/emacs.d/elpa/flycheck-haskell-20151010.340/get-flags.hs

@ -0,0 +1,48 @@
-- Copyright (C) 2015 Michael Alan Dorman <mdorman@ironicdesign.com>
-- This file is not part of GNU Emacs.
-- This program is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-- details.
-- You should have received a copy of the GNU General Public License along with
-- this program. If not, see <http://www.gnu.org/licenses/>.
import Data.Version (Version (Version))
import Distribution.Simple.Utils (cabalVersion)
import System.Environment (getArgs)
data Mode
= GHC
| HLint
define :: Mode -> String -> String
define GHC def = "-D" ++ def
define HLint def = "--cpp-define=" ++ def
legacyFlags :: Mode -> [String]
legacyFlags mode = [define mode "USE_COMPILER_ID"]
isLegacyCabal :: Bool
isLegacyCabal = cabalVersion < Version [1, 22] []
getMode :: [String] -> Mode
getMode ("hlint":_) = HLint
getMode _ = GHC
main :: IO ()
main = do
args <- getArgs
mapM_ putStrLn (flags (getMode args))
where
flags mode =
if isLegacyCabal
then legacyFlags mode
else []

26
dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip-autoloads.el

@ -0,0 +1,26 @@
;;; flycheck-pos-tip-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck-pos-tip" "flycheck-pos-tip.el" (22059
;;;;;; 18194 602984 397000))
;;; Generated autoloads from flycheck-pos-tip.el
(autoload 'flycheck-pos-tip-error-messages "flycheck-pos-tip" "\
Display the tooltip that the messages of ERRORS.
Concatenate all non-nil messages of ERRORS separated by empty
lines, and display them with `pos-tip-show-no-propertize', which shows
the messages in tooltip, depending on the number of lines.
\(fn ERRORS)" nil nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-pos-tip-autoloads.el ends here

1
dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip-pkg.el

@ -0,0 +1 @@
(define-package "flycheck-pos-tip" "20140606.510" "Flycheck errors display in tooltip" '((flycheck "0.18") (popup "0.5.0")) :url "https://github.com/flycheck/flycheck-pos-tip" :keywords '("tools" "convenience"))

61
dotfiles/emacs.d/elpa/flycheck-pos-tip-20140606.510/flycheck-pos-tip.el

@ -0,0 +1,61 @@
;;; flycheck-pos-tip.el --- Flycheck errors display in tooltip
;; Copyright (C) 2014 Akiha Senda
;; Author: Akiha Senda <senda.akiha@gmail.com>
;; URL: https://github.com/flycheck/flycheck-pos-tip
;; Package-Version: 20140606.510
;; Keywords: tools, convenience
;; Version: 0.0.1
;; Package-Requires: ((flycheck "0.18") (popup "0.5.0"))
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Add error message display method for Flycheck.
;;;; Setup
;; (eval-after-load 'flycheck
;; '(custom-set-variables
;; '(flycheck-display-errors-function #'flycheck-pos-tip-error-messages)))
;;; Code:
(require 'flycheck)
(require 'popup)
(defgroup flycheck-pos-tip nil
"Flycheck errors display in tooltip"
:prefix "flycheck-pos-tip-"
:group 'flycheck
:link '(url-link :tag "Github" "https://github.com/flycheck/flycheck-pos-tip"))
;;;###autoload
(defun flycheck-pos-tip-error-messages (errors)
"Display the tooltip that the messages of ERRORS.
Concatenate all non-nil messages of ERRORS separated by empty
lines, and display them with `pos-tip-show-no-propertize', which shows
the messages in tooltip, depending on the number of lines."
(-when-let (messages (-keep #'flycheck-error-message errors))
(popup-tip
(mapconcat 'identity messages "\n"))))
(provide 'flycheck-pos-tip)
;;; flycheck-pos-tip.el ends here

25
dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust-autoloads.el

@ -0,0 +1,25 @@
;;; flycheck-rust-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck-rust" "flycheck-rust.el" (22059 18193
;;;;;; 346317 727000))
;;; Generated autoloads from flycheck-rust.el
(autoload 'flycheck-rust-setup "flycheck-rust" "\
Setup Rust in Flycheck.
If the current file is part of a Cargo project, configure
Flycheck according to the Cargo project layout.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-rust-autoloads.el ends here

1
dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust-pkg.el

@ -0,0 +1 @@
(define-package "flycheck-rust" "20150609.1248" "Flycheck: Rust additions and Cargo support" '((emacs "24.1") (flycheck "0.20") (dash "2.4.0")) :url "https://github.com/flycheck/flycheck-rust" :keywords '("tools" "convenience"))

121
dotfiles/emacs.d/elpa/flycheck-rust-20150609.1248/flycheck-rust.el

@ -0,0 +1,121 @@
;;; flycheck-rust.el --- Flycheck: Rust additions and Cargo support -*- lexical-binding: t; -*-
;; Copyright (C) 2014, 2015 Sebastian Wiesner <swiesner@lunaryorn.com>
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; URL: https://github.com/flycheck/flycheck-rust
;; Package-Version: 20150609.1248
;; Keywords: tools, convenience
;; Version: 0.1-cvs
;; Package-Requires: ((emacs "24.1") (flycheck "0.20") (dash "2.4.0"))
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This Flycheck extension configures Flycheck automatically for the current
;; Cargo project.
;;
;; # Setup
;;
;; (add-hook 'flycheck-mode-hook #'flycheck-rust-setup)
;;
;; # Usage
;;
;; Just use Flycheck as usual in your Rust/Cargo projects.
;;
;; Note: You must run `cargo build` initially to install all dependencies. If
;; you add new dependencies to `Cargo.toml` you need to run `cargo build`
;; again. Otherwise you will see spurious errors about missing crates.
;;; Code:
(require 'dash)
(require 'flycheck)
(defun flycheck-rust-executable-p (rel-name)
"Whether REL-NAME denotes an executable.
REL-NAME is the file relative to the Cargo.toml file."
(or (string= "src/main.rs" rel-name)
(string-prefix-p "src/bin/" rel-name)))
(defun flycheck-rust-test-p (rel-name)
"Whether REL-NAME denotes a test.
REL-NAME is the file relative to the Cargo.toml file."
(string-prefix-p "tests/" rel-name))
(defun flycheck-rust-bench-p (rel-name)
"Whether REL-NAME denotes a bench.
REL-NAME is the file relative to the Cargo.toml file."
(string-prefix-p "benches/" rel-name))
(defun flycheck-rust-example-p (rel-name)
"Whether REL-NAME denotes an example.
REL-NAME is the file relative to the Cargo.toml file."
(string-prefix-p "examples/" rel-name))
(defun flycheck-rust-project-root ()
"Get the project root for the current buffer.
Return the directory containing the Cargo file, or nil if there
is none."
(locate-dominating-file (buffer-file-name) "Cargo.toml"))
(defun flycheck-rust-find-crate-root ()
"Get the crate root (the nearest lib.rs or main.rs)
relative to the current file."
(-if-let (lib-crate-dir (locate-dominating-file (buffer-file-name) "lib.rs"))
(expand-file-name "lib.rs" lib-crate-dir)
(-when-let (exe-crate-dir (locate-dominating-file (buffer-file-name) "main.rs"))
(expand-file-name "main.rs" exe-crate-dir))))
;;;###autoload
(defun flycheck-rust-setup ()
"Setup Rust in Flycheck.
If the current file is part of a Cargo project, configure
Flycheck according to the Cargo project layout."
(interactive)
(when (buffer-file-name)
(-when-let (root (flycheck-rust-project-root))
(let ((rel-name (file-relative-name (buffer-file-name) root)))
;; These are valid crate roots as by Cargo's layout
(unless (or (flycheck-rust-executable-p rel-name)
(flycheck-rust-test-p rel-name)
(flycheck-rust-bench-p rel-name)
(flycheck-rust-example-p rel-name)
(string= "src/lib.rs" rel-name))
;; For other files, the library is either the default library or the
;; executable
(setq-local flycheck-rust-crate-root (flycheck-rust-find-crate-root)))
;; Check tests in libraries and integration tests
(setq-local flycheck-rust-check-tests
(not (flycheck-rust-executable-p rel-name)))
;; Set the crate type
(setq-local flycheck-rust-crate-type
(if (flycheck-rust-executable-p rel-name) "bin" "lib"))
;; Find build libraries
(setq-local flycheck-rust-library-path
(list (expand-file-name "target/debug" root)
(expand-file-name "target/debug/deps" root)))))))
(provide 'flycheck-rust)
;;; flycheck-rust.el ends here

24
dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode-autoloads.el

@ -0,0 +1,24 @@
;;; gitignore-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "gitignore-mode" "gitignore-mode.el" (22059
;;;;;; 18195 132984 409000))
;;; Generated autoloads from gitignore-mode.el
(autoload 'gitignore-mode "gitignore-mode" "\
A major mode for editing .gitignore files.
\(fn)" t nil)
(dolist (pattern (list "/\\.gitignore\\'" "/\\.git/info/exclude\\'" "/git/ignore\\'")) (add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; gitignore-mode-autoloads.el ends here

1
dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode-pkg.el

@ -0,0 +1 @@
(define-package "gitignore-mode" "20150330.1048" "Major mode for editing .gitignore files" 'nil :url "https://github.com/magit/git-modes" :keywords '("convenience" "vc" "git"))

61
dotfiles/emacs.d/elpa/gitignore-mode-20150330.1048/gitignore-mode.el

@ -0,0 +1,61 @@
;;; gitignore-mode.el --- Major mode for editing .gitignore files -*- lexical-binding: t; -*-
;; Copyright (c) 2012-2013 Sebastian Wiesner
;; Copyright (C) 2012-2015 The Magit Project Developers
;; Author: Sebastian Wiesner <lunaryorn@gmail.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/git-modes
;; Keywords: convenience vc git
;; Package-Version: 20150330.1048
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A major mode for editing .gitignore files.
;;; Code:
(require 'conf-mode)
(defvar gitignore-mode-font-lock-keywords
'(("^\\s<.*$" . font-lock-comment-face)
("^!" . font-lock-negation-char-face) ; Negative pattern
("/" . font-lock-constant-face) ; Directory separators
("[*?]" . font-lock-keyword-face) ; Glob patterns
("\\[.+?\\]" . font-lock-keyword-face))) ; Ranged glob patterns
;;;###autoload
(define-derived-mode gitignore-mode conf-unix-mode "Gitignore"
"A major mode for editing .gitignore files."
(conf-mode-initialize "#")
;; Disable syntactic font locking, because comments are only valid at
;; beginning of line.
(setq font-lock-defaults '(gitignore-mode-font-lock-keywords t t))
(set (make-local-variable 'conf-assignment-sign) nil))
;;;###autoload
(dolist (pattern (list "/\\.gitignore\\'"
"/\\.git/info/exclude\\'"
"/git/ignore\\'"))
(add-to-list 'auto-mode-alist (cons pattern 'gitignore-mode)))
(provide 'gitignore-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; gitignore-mode.el ends here

BIN
dotfiles/emacs.d/elpa/gnupg/pubring.kbx~

Binary file not shown.

438
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/NEWS

@ -0,0 +1,438 @@
Haskell Mode NEWS -*- org -*-
This file uses Org mode. Some useful (default) key-bindings:
- Use "C-c C-n"/"C-c C-p" to jump to next/prev heading
- Use "<tab>" to expand/collapse nodes
- Use "<backtab>" to cycle visibility of all nodes
- Use "C-c C-o" to open links
* Changes in 13.12
- Added haskell-bot.el
- Added support for cabal repl build targets
- Automatically add import lines via Hoogle
- Automatically add package to cabal file
- Added w3m-haddock.el
- Added debugger mode
- Added preliminary :present support
- Added haskell-sort-imports
- Added haskell-complete-module
- Support if and multi-way if in indentation
- Add support to generate tags on windows
- Add haskell-language-extensions variable
- Improve haskell-simple-indent mode
- Improve test cases
* Changes in 13.10
- Small fix for haskell-simple-indent: Certain indentation situations
cause valname-string to be nil, which haskell-trim did not handle
gracefully (naturally, since nil != "").
- Luke Hoersten's Shnippet merged in under snippets/.
- haskell-presentation-mode is now a haskell-mode derived mode.
- Small improvement to haskell-process-do-info (works on constructors
now and underscored names).
- Add haskell-indent-spaces configuration variable.
- The command string to run cabal commands is slightly more
configurable. See: C-h f haskell-process-do-cabal-format-string
* Changes in 13.8
See also [[https://github.com/haskell/haskell-mode/compare/v13.07...v13.08][detailed Git history]].
- Make `haskell-simple-indent-mode' a proper minor mode with `SInd` as
mode-line lighter
- Support popular "λ> " prompt in inf-haskell by default
- Hide internal `*print-haskell-mode*' buffers
(used when `haskell-interactive-mode-eval-mode' is active)
- Add tab-completion support for haskell-interactive-mode
(requires `:complete' command support in GHCi)
- Add support to `haskell-process-do-info` to perform `:browse!` query
on module name when called on import statement line
- `haskell-decl-scan-mode':
- New customize group `haskell-decl-scan'
- New flag `haskell-decl-scan-bindings-as-variables' for controlling
whether to put value bindings into the "Variables" category.
- New flag `haskell-decl-scan-add-to-menubar' for controlling
whether to add "Declarations" menu entry to menu bar.
- New manual section node `(haskell-mode)haskell-decl-scan-mode'
- Add support for [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#lambda-case][LambdaCase]] syntax extension to `haskell-indentation`
- Change `haskell-indentation-mode' to never jump back a whole line
when pressing DEL. The old behavior can be restored by setting
`haskell-indentation-delete-backward-jump-line' to t
- New convenience function `haskell-cabal-visit-file' for locating and
visiting most likely `.cabal` file associated with current buffer
- Add support for [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#package-import][PackageImports]] and [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#safe-imports-ext][SafeHaskell]] syntax extensions to
`haskell-decl-scan-mode' parser
- Add `turn-{on,off}-haskell-doc' commands as aliases for the existing
`turn-{on,off}-haskell-doc-mode' commands
- Add support for "cabal repl" process type to `haskell-interactive-mode'
- Add new Haskell compilation sub-mode and associated `haskell-compile'
command
* Changes in 13.7
See also [[https://github.com/haskell/haskell-mode/compare/v13.06...v13.07][detailed Git history]].
- Convert NEWS (this file) to Org mode style and include NEWS file in
package and add command for visiting NEWS file
(M-x haskell-mode-view-news)
- Officially drop support for versions prior to Emacs 23
- New work-in-progress Info manual for haskell-mode
- Remove deprecated `haskell-{hugs,ghci}' modules
- Font-locking changes:
- Remove deprecated `turn-on-haskell-font-lock` function
- Improve font-locking of type-signatures in presence of newlines
- Use `font-lock-preprocessor-face' instead of the previously used
`font-lock-warning-face` for CPP directives
- Use `font-lock-warning-face` instead of the previously used
`font-lock-preprocessor-face` for Git merge conflict annotations.
- Improvements to `haskell-move-nested' module:
- Add support for operating on active regions
- New interactive commands `haskell-move-nested-{left,right}` which
support numeric prefix arguments for controlling the amount of
shifting to apply.
- Add `haskell-unicode-input-method.el` to distribution
(enable with `turn-on-haskell-unicode-input-method`)
- Fix all byte-compilation warnings
- Build-system:
- For in-place installation, `haskell-site-file.el' is renamed
to `haskell-mode-autoloads.el`
- Auto-generate ELPA compatible README file by extracting header of
haskell-mode.el
- New "make check" target
- Add Travis-CI build jobs for testing byte-compilation with
multiple Emacs versions
- Reorganize customize settings
- Add new convenience function for browsing all Haskell Mode settings
(M-x haskell-customize)
- Add `:link' keywords pointing to the new Info manual
- Add `:group' keywords to modes to make (M-x customize-mode) work
- Create new customization groups `haskell-interactive' and `inferior-haskell'
to clean up namespace
- Create new customization group `ghc-core` containing the two new
customization variables `ghc-core-program` and `ghc-core-program-args`.
- Improvements to haskell-interactive-mode
- Add support for deleting compile messages superseded by recompile/reloads
(M-x customize-variable RET haskell-interactive-mode-delete-superseded-errors)
- Fix `C-u M-x haskell-process-do-type` inserting bad signatures
- Integrate with Emacs' `next-error` subsystem
- Add "C-c C-f" binding to REPL keymap for enabling `next-error-follow-minor-mode'
- Add support for `-ferror-spans`-style compile messages
- Add `-ferror-spans` as default for `haskell-process-args-ghci`
- Add optional argument to
`haskell-session-{all,installed,project}-modules' to suppress
session-creation. This is useful for yasnippet usage, see commit
517fd7e for an example.
- Change default for `haskell-process-path-ghci` to a static "ghci"
- Fix `haskell-interactive-switch` not selecting the REPL window
- Make `*haskell-process-log*` buffer configurable
(controlled via new `haskell-process-log` customize option)
* Changes in 13.6
See also [[https://github.com/haskell/haskell-mode/compare/2_9_1...v13.06][detailed Git history]].
- Switch to new versioning scheme
- Switch to MELPA/Marmalade based packaging
- Cleanup/refactor build-system
- Enhance `M-x haskell-version` to report more detailed versioning
information
- Make haskell-interactive-mode emulate comint/eshell history navigation
(see commit 0e96843 for more details)
- Improvements to haskell-interactive-mode
- Improve killing/restarting haskell-interactive sessions
- Improve directory prompting and resolution
- Fix redundant-import suggest trigger to support qualified imports
- Detect all abbreviations of an user-inputted ":quit"
- Fix regexps for recent GHC 7.x compiler messages
- Customizable commandline args for GHCi
(M-x customize-variable RET haskell-process-args-ghci)
- New command to load or reload via prefix argument
(M-x haskell-process-load-or-reload)
- Fix haskell-interactive-mode prompt detection
- Add cabal-ghci as supported process mode
- Add a customization option for the visibility of multi-line errors
(M-x customize-variable RET haskell-interactive-mode-hide-multi-line-errors)
- Add forward declarations to reduce Elisp bytecompile warnings
- Improvements to `haskell-indentation`
- Add support for the UnicodeSyntax tokens `→`, `←`, and `∷`.
- Indent "=" following data/type/newtype declarations.
- Align "->"/"→" arrows in types under "::"/"∷"
- Make customizable whether "<backspace>" deletes indentation too
(via `haskell-indentation-delete-backward-indentation` and
`haskell-indentation-delete-indentation`)
- Properly indent 'rec' keyword, same as 'mdo'
- Minor optimizations.
- Add support for "'"-prefixed constructors (-> DataKinds) to font-locking
- New experimental haskell session menu mode (M-x haskell-menu)
- Various minor cleanups/fixes/improvements...
* Changes in 2.9.1
See also [[https://github.com/haskell/haskell-mode/compare/2_9_0...2_9_1][detailed Git history]].
- Bugfix release adding missing autoload declaration
* Changes in 2.9.0
See also [[https://github.com/haskell/haskell-mode/compare/2_8_0...2_9_0][detailed Git history]].
- This is the first release after haskell-mode was migrated to GitHub
- New experimental `haskell-interactive-mode' module implementing a
new REPL interaction mode for GHCi sessions to eventually replace
the existing "inf-haskell" mode.
- New `haskell-process-cabal' command for interaction with cabal-install
- New `haskell-checkers' module
- Update haskell-cabal-mode font-lock keywords
- Improve scrolling of hoogle output (haskell-mode.el)
- Derive `haskell-mode` from `prog-mode` for Emacs 24+
- Add new binding for "<backtab>" to haskell-mode's keymap which
unindents current line
- New modules `haskell-navigate-imports`, `haskell-sort-imports' and
`haskell-align-imports' for operating on module import lines in
Haskell source code
- Add new binding for "C-c C-." to haskell-mode's keymap to sort and
realign Haskell module imports
- Add new binding for "C-c i" to haskell-mode's keymap to jump back and
forth from/to the current Haskell module's module import section.
- New `inferior-haskell-kind' function for querying kind via GHCi's ":kind"
- New `inferior-haskell-send-decl' for sending declarations to GHCi
(bound to "C-x C-d" by default)
- Add new `haskell-doc-use-inf-haskell` customization variable
- Add support for bird-style literate haskell editing and a new
related customization variable
`haskell-indentation-birdtrack-extra-space'
- Font locking improvements
- Add support for Git's merge annotation
(with `font-lock-preprocessor-face')
- Improve `import', `foreign import' and `foreign export' font
locking
- Add support for `rec', `proc' and `mdo` as keywords
- Make whitespace within `-- |' and `{- |' optional when possible
- New `haskell-move-nested` module providing utilities for
interactively {in,de}denting nested "hanging" blocks.
- Add stylish-haskell support
(enable via `haskell-stylish-on-save` customization variable)
- Add support for generating tags on save
(enable via `haskell-tags-on-save' customization variable)
- Set sensible dabbrev defaults in haskell-mode
- Added `SCC` pragma insert/delete commands
(`haskell-mode-insert-scc-at-point` and `haskell-mode-kill-scc-at-point')
- New experimental `haskell-mode-contextual-space' command
- And a couple more cleanups/fixes/improvements...
* Changes in 2.8.0 (since 2.7.0)
See also [[https://github.com/haskell/haskell-mode/compare/2_7_0...2_8_0][detailed Git history]].
- Minimal indentation support for arrow syntax
- Avoid opening a new inf-haskell window if one is already visible.
Windows on other virtual desktops or iconified frames don't count.
- Force comint-process-echoes to nil
- Autolaunch haskell-mode for files starting with #!/usr/bin/runghc
and similar
- Added minimal major mode for parsing GHC core files, courtesy of Johan Tibell.
There is a corresponding Haskell menu entry.
- Allow configuration of where-clause indentation; M-x customize-group
haskell-indentation.
* Changes since 2.6.4
- fill-paragraph (M-q) now only affects comments, and correctly
handles Haddock commentary. adaptive-fill-mode is turned off, as it
was interfering.
- Yet more unicode symbols
- Better support for unicode encoding of haskell source files
- mdo correctly indented
- Indentation fixes, fixes to the fixes, and fixes to the fixes to the
fixes
- New command: M-x haskell-check, calls (by default) hlint on the
current file. Also bound to C-c C-v.
You can also use the flymake minor mode with this.
* Changes since 2.5.1
- Parser corrections for haskell-indentation and haskell-decl-scan
- haskell-indentation: Pressing tab in the rightmost position now
moves to the leftmost, by default with a warning.
- Typo fix: One haskell-indentation variable had ended up in the
haskell-ntation customize group.
- haskell-hoogle aliased to hoogle, haskell-hayoo aliased to hayoo
- Courtesy of Alex Ott:
- Additional unicode symbols for font-lock-symbols: () == /= >= <= !! && || sqrt
- M-x haskell-hayoo search added, opens using browse-url
- Bug-fix for inferior-haskell-type
- If haskell-indentation errors out, it now fail-safes to inserting
a literal newline or deleting one character, for return and
backspace respectively.
* Changes since 2.4:
- haskell-indentation, a new minor mode for indentation.
* Changes since 2.3:
- Update license to GPLv3.
- New derived major mode for .hsc files.
- Removed the C-c C-r binding to reload a file. You can still call
inferior-haskell-reload-file (and/or bind it to your favorite key,
including C-c C-r) or you can now use C-u C-c C-l.
- C-c C-d looks up the symbol at point in the Haddock docs.
- Haddock comments are highlighted with font-lock-doc-face if it exists.
- Use `tex' rather than `latex' for haskell-literate.
- inf-haskell.el tries to find the root of the module hierarchy to determine
the root of a project (either by looking for a Cabal file or relying on
the `module' declaration line). If all works well, this will make C-c C-l
automatically switch to the root dir, so that dependencies in other
directories are automatically found. If it doesn't, complain and/or set
inferior-haskell-find-project-root to nil.
- The new command haskell-hoogle helps you query Hoogle from Emacs.
* Changes since 2.2:
- Trivial support for Cabal package description files.
- Minor bug fixes.
* Changes since 2.1:
- There are now commands to find type and info of identifiers by querying an
inferior haskell process. Available under C-c C-t, C-c C-i, and C-c M-.
- Indentation now looks back further, until a line that has no indentation.
To recover the earlier behavior of stopping at the first empty line
instead, configure haskell-indent-look-past-empty-line.
- inf-haskell can wait until a file load completes and jump directly to the
first error, like haskell-ghci and haskell-hugs used to do. See the var
inferior-haskell-wait-and-jump.
* Changes since 2.0:
- inf-haskell uses ghci if hugs is absent.
- Fix up some binding conflicts (C-c C-o in haskell-doc)
- Many (hopefully minor) changes to the indentation.
- New symbols in haskell-font-lock-symbols-alist.
* Changes since 1.45:
- keybindings C-c <char> have been replaced by C-c C-<char> so as not
to collide with minor modes.
- The following modules are now automatically activated without having to
add anything to haskell-mode-hook:
haskell-font-lock (just turn on global-font-lock-mode).
haskell-decl-scan (just bind `imenu' to some key).
- In recent Emacsen, haskell-doc hooks into eldoc-mode.
- haskell-hugs and haskell-ghci are superceded by inf-haskell.
- Indentation rules have been improved when using layout inside parens/braces.
- Symbols like -> and \ can be displayed as actual arrows and lambdas.
See haskell-font-lock-symbols.
- Tweaks to the font-lock settings. Among other things paren-matching
with things like \(x,y) should work correctly now.
- New maintainer <monnier@gnu.org>.

18
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/dir

@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "?" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Haskell Mode: (haskell-mode). Haskell Development Environment for Emacs(en)

125
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/ghc-core.el

@ -0,0 +1,125 @@
;;; ghc-core.el --- Syntax highlighting module for GHC Core -*- lexical-binding: t -*-
;; Copyright (C) 2010 Johan Tibell
;; Author: Johan Tibell <johan.tibell@gmail.com>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Purpose:
;;
;; To make it easier to read GHC Core output by providing highlighting
;; and removal of commonly ignored annotations.
;;; Code:
(require 'haskell-mode)
(require 'haskell-font-lock)
;;;###autoload
(defgroup ghc-core nil
"Major mode for viewing pretty printed GHC Core output."
:link '(custom-manual "(haskell-mode)")
:group 'haskell
:prefix "ghc-core-")
;;;###autoload
(defcustom ghc-core-program
"ghc"
"Name of the GHC executable (excluding any arguments)."
:type 'string
:group 'ghc-core)
;;;###autoload
(defcustom ghc-core-program-args
'("-O2")
"Additional options to be passed to GHC when generating core output.
GHC (see variable `ghc-core-program') is invoked with the basic
command line options \"-ddump-simpl -c <source-file>\"
followed by the additional options defined here.
The following `-ddump-simpl` options might be of interest:
- `-dsuppress-all'
- `-dsuppress-uniques'
- `-dsuppress-idinfo'
- `-dsuppress-module-prefixes'
- `-dsuppress-type-signatures'
- `-dsuppress-type-applications'
- `-dsuppress-coercions'
See `M-x manual-entry RET ghc' for more details."
:type '(repeat (string :tag "Argument"))
:group 'ghc-core)
(define-obsolete-variable-alias 'ghc-core-create-options 'ghc-core-program-args
"haskell-mode 13.7")
(defun ghc-core-clean-region (start end)
"Remove commonly ignored annotations and namespace prefixes
in the region between START and END."
(interactive "r")
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (search-forward-regexp "GHC\.[^\.]*\." nil t)
(replace-match "" nil t))
(goto-char (point-min))
(while (flush-lines "^ *GblId *$" nil))
(goto-char (point-min))
(while (flush-lines "^ *LclId *$" nil))
(goto-char (point-min))
(while (flush-lines (concat "^ *\\[\\(?:Arity [0-9]+\\|NoCafRefs\\|"
"Str: DmdType\\|Worker \\)"
"\\([^]]*\\n?\\).*\\] *$") nil))
(goto-char (point-min))
(while (search-forward "Main." nil t) (replace-match "" nil t))))
(defun ghc-core-clean-buffer ()
"Remove commonly ignored annotations and namespace prefixes
in the current buffer."
(interactive)
(ghc-core-clean-region (point-min) (point-max)))
;;;###autoload
(defun ghc-core-create-core ()
"Compile and load the current buffer as tidy core."
(interactive)
(save-buffer)
(let* ((core-buffer (generate-new-buffer "ghc-core"))
(neh (lambda () (kill-buffer core-buffer))))
(add-hook 'next-error-hook neh)
(apply #'call-process ghc-core-program nil core-buffer nil
"-ddump-simpl" "-c" (buffer-file-name) ghc-core-program-args)
(display-buffer core-buffer)
(with-current-buffer core-buffer
(ghc-core-mode))
(remove-hook 'next-error-hook neh)))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.hcr\\'" . ghc-core-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.dump-simpl\\'" . ghc-core-mode))
;;;###autoload
(define-derived-mode ghc-core-mode haskell-mode "GHC-Core"
"Major mode for GHC Core files.")
(provide 'ghc-core)
;;; ghc-core.el ends here

68
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/ghci-script-mode.el

@ -0,0 +1,68 @@
;;; ghci-script-mode.el --- GHCi scripts major mode -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'haskell)
(defvar ghci-script-mode-keywords
;; The comment syntax can't be described simply in syntax-table.
;; We could use font-lock-syntactic-keywords, but is it worth it?
'(("^[ \t]*--.*" . font-lock-comment-face)
("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face))
("^:[a-z{]+ *\\+" . font-lock-keyword-face)
("^:[a-z{]+ " . font-lock-keyword-face)))
;;;###autoload
(define-derived-mode ghci-script-mode text-mode "GHCi-Script"
"Major mode for working with .ghci files."
(set (make-local-variable 'adaptive-fill-mode) nil)
(set (make-local-variable 'comment-start) "-- ")
(set (make-local-variable 'comment-padding) 0)
(set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)")
(set (make-local-variable 'indent-line-function) 'haskell-mode-suggest-indent-choice)
(set (make-local-variable 'font-lock-defaults)
'(ghci-script-mode-keywords t t nil nil))
(set (make-local-variable 'indent-tabs-mode) nil)
(set (make-local-variable 'tab-width) 8)
(when (boundp 'electric-indent-inhibit)
(setq electric-indent-inhibit t))
(set (make-local-variable 'dabbrev-case-fold-search) nil)
(set (make-local-variable 'dabbrev-case-distinction) nil)
(set (make-local-variable 'dabbrev-case-replace) nil)
(set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|[.]")
(setq haskell-literate nil))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.ghci\\'" . ghci-script-mode))
(define-key ghci-script-mode-map (kbd "C-c C-l") 'ghci-script-mode-load)
(defun ghci-script-mode-load ()
"Load the current script file into the GHCi session."
(interactive)
(let ((buffer (haskell-session-interactive-buffer (haskell-session)))
(filename (buffer-file-name)))
(save-buffer)
(with-current-buffer buffer
(set-marker haskell-interactive-mode-prompt-start (point-max))
(haskell-interactive-mode-run-expr
(concat ":script " filename)))))
(provide 'ghci-script-mode)

231
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-align-imports.el

@ -0,0 +1,231 @@
;;; haskell-align-imports.el --- Align the import lines in a Haskell file -*- lexical-binding: t -*-
;; Copyright (C) 2010 Chris Done
;; Author: Chris Done <chrisdone@gmail.com>
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be
;; useful, but WITHOUT ANY WARRANTY; without even the implied
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE. See the GNU General Public License for more details.
;; You should have received a copy of the GNU General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Consider the following imports list:
;;
;; import One
;; import Two as A
;; import qualified Three
;; import qualified Four as PRELUDE
;; import Five (A)
;; import Six (A,B)
;; import qualified Seven (A,B)
;; import "abc" Eight
;; import "abc" Nine as TWO
;; import qualified "abc" Ten
;; import qualified "defg" Eleven as PRELUDE
;; import "barmu" Twelve (A)
;; import "zotconpop" Thirteen (A,B)
;; import qualified "z" Fourteen (A,B)
;; import Fifteen hiding (A)
;; import Sixteen as TWO hiding (A)
;; import qualified Seventeen hiding (A)
;; import qualified Eighteen as PRELUDE hiding (A)
;; import "abc" Nineteen hiding (A)
;; import "abc" Twenty as TWO hiding (A)
;;
;; When haskell-align-imports is run within the same buffer, the
;; import list is transformed to:
;;
;; import "abc" Eight
;; import qualified Eighteen as PRELUDE hiding (A)
;; import qualified "defg" Eleven as PRELUDE
;; import Fifteen hiding (A)
;; import Five (A)
;; import qualified Four as PRELUDE
;; import qualified "z" Fourteen (A,B)
;; import "abc" Nine as TWO
;; import "abc" Nineteen hiding (A)
;; import One
;; import qualified Seven (A,B)
;; import qualified Seventeen hiding (A)
;; import Six (A,B)
;; import Sixteen as TWO hiding (A)
;; import qualified "abc" Ten
;; import "zotconpop" Thirteen (A,B)
;; import qualified Three
;; import "barmu" Twelve (A)
;; import "abc" Twenty as TWO hiding (A)
;; import Two as A
;;
;; If you want everything after module names to be padded out, too,
;; customize `haskell-align-imports-pad-after-name', and you'll get:
;;
;; import One
;; import Two as A
;; import qualified Three
;; import qualified Four as PRELUDE
;; import Five (A)
;; import Six (A,B)
;; import qualified Seven (A,B)
;; import "abc" Eight
;; import "abc" Nine as TWO
;; import qualified "abc" Ten
;; import qualified "defg" Eleven as PRELUDE
;; import "barmu" Twelve (A)
;; import "zotconpop" Thirteen (A,B)
;; import qualified "z" Fourteen (A,B)
;; import Fifteen hiding (A)
;; import Sixteen as TWO hiding (A)
;; import qualified Seventeen hiding (A)
;; import qualified Eighteen as PRELUDE hiding (A)
;; import "abc" Nineteen hiding (A)
;; import "abc" Twenty as TWO hiding (A)
;;; Code:
(require 'cl-lib)
(defvar haskell-align-imports-regexp
(concat "^\\(import[ ]+\\)"
"\\(qualified \\)?"
"[ ]*\\(\"[^\"]*\" \\)?"
"[ ]*\\([A-Za-z0-9_.']+\\)"
"[ ]*\\([ ]*as [A-Z][^ ]*\\)?"
"[ ]*\\((.*)\\)?"
"\\([ ]*hiding (.*)\\)?"
"\\( -- .*\\)?[ ]*$")
"Regex used for matching components of an import.")
;;;###autoload
(defcustom haskell-align-imports-pad-after-name
nil
"Pad layout after the module name also."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defun haskell-align-imports ()
"Align all the imports in the buffer."
(interactive)
(when (haskell-align-imports-line-match)
(save-excursion
(goto-char (point-min))
(let* ((imports (haskell-align-imports-collect))
(padding (haskell-align-imports-padding imports)))
(mapc (lambda (x)
(goto-char (cdr x))
(delete-region (point) (line-end-position))
(insert (haskell-align-imports-chomp
(haskell-align-imports-fill padding (car x)))))
imports))))
nil)
(defun haskell-align-imports-line-match ()
"Try to match the current line as a regexp."
(let ((line (buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
(if (string-match "^import " line)
line
nil)))
(defun haskell-align-imports-collect ()
"Collect a list of mark / import statement pairs."
(let ((imports '()))
(while (not (or (equal (point) (point-max)) (haskell-align-imports-after-imports-p)))
(let ((line (haskell-align-imports-line-match-it)))
(when line
(let ((match
(haskell-align-imports-merge-parts
(cl-loop for i from 1 to 8
collect (haskell-align-imports-chomp (match-string i line))))))
(setq imports (cons (cons match (line-beginning-position))
imports)))))
(forward-line))
imports))
(defun haskell-align-imports-merge-parts (l)
"Merge together parts of an import statement that shouldn't be separated."
(let ((parts (apply #'vector l))
(join (lambda (ls)
(cl-reduce (lambda (a b)
(concat a
(if (and (> (length a) 0)
(> (length b) 0))
" "
"")
b))
ls))))
(if haskell-align-imports-pad-after-name
(list (funcall join (list (aref parts 0)
(aref parts 1)
(aref parts 2)))
(aref parts 3)
(funcall join (list (aref parts 4)
(aref parts 5)
(aref parts 6)))
(aref parts 7))
(list (funcall join (list (aref parts 0)
(aref parts 1)
(aref parts 2)))
(funcall join (list (aref parts 3)
(aref parts 4)
(aref parts 5)
(aref parts 6)
(aref parts 7)))))))
(defun haskell-align-imports-chomp (str)
"Chomp leading and tailing whitespace from STR."
(if str
(replace-regexp-in-string "\\(^[[:space:]\n]*\\|[[:space:]\n]*$\\)" ""
str)
""))
(defun haskell-align-imports-padding (imports)
"Find the padding for each part of the import statements."
(if (null imports)
imports
(cl-reduce (lambda (a b) (cl-mapcar #'max a b))
(mapcar (lambda (x) (mapcar #'length (car x)))
imports))))
(defun haskell-align-imports-fill (padding line)
"Fill an import line using the padding worked out from all statements."
(mapconcat #'identity
(cl-mapcar (lambda (pad part)
(if (> (length part) 0)
(concat part (make-string (- pad (length part)) ? ))
(make-string pad ? )))
padding
line)
" "))
(defun haskell-align-imports-line-match-it ()
"Try to match the current line as a regexp."
(let ((line (buffer-substring-no-properties (line-beginning-position)
(line-end-position))))
(if (string-match haskell-align-imports-regexp line)
line
nil)))
(defun haskell-align-imports-after-imports-p ()
"Are we after the imports list?"
(save-excursion
(goto-char (line-beginning-position))
(not (not (search-forward-regexp "\\( = \\|\\<instance\\>\\| :: \\| ∷ \\)"
(line-end-position) t 1)))))
(provide 'haskell-align-imports)
;;; haskell-align-imports.el ends here

181
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-bot.el

@ -0,0 +1,181 @@
;;; haskell-bot.el --- A Lambdabot interaction mode -*- lexical-binding: t -*-
;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Copyright (C) 2001 Chris Webb
;; Copyright (C) 1998, 1999 Guy Lapalme
;; Keywords: inferior mode, Bot interaction mode, Haskell
;;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Purpose:
;;
;; To send a Haskell buffer to another buffer running a Bot
;; interpreter.
;;
;; This mode is derived from version 1.1 of Guy Lapalme's
;; haskell-hugs.el, which can be obtained from:
;;
;; http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html
;;
;; This in turn was adapted from Chris Van Humbeeck's hugs-mode.el,
;; which can be obtained from:
;;
;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el
;;
;;
;; Installation:
;;
;; To use with Moss and Thorn's haskell-mode.el
;;
;; http://www.haskell.org/haskell-mode
;;
;; add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'haskell-bot-mode)
;;
;;
;; Customisation:
;;
;; The name of the Bot interpreter is in haskell-bot-program-name.
;;
;; Arguments can be sent to the Bot interpreter when it is started by
;; setting haskell-bot-program-args (empty by default) to a list of
;; string args to pass it. This value can be set interactively by
;; calling C-c C-s with an argument (i.e. C-u C-c C-s).
;;
;; `haskell-bot-hook' is invoked in the *bot* buffer once Bot is
;; started.
;;
;; All functions/variables start with `turn-{on,off}-haskell-bot' or
;; `haskell-bot-'.
;;; Code:
(require 'comint)
;;;###autoload
(defgroup haskell-bot nil
"Major mode for interacting with an inferior Bot session."
:group 'haskell
:prefix "haskell-bot-")
(define-derived-mode haskell-bot-mode comint-mode "Lambdabot")
;; Bot interface:
(require 'comint)
(require 'shell)
(defvar haskell-bot-process nil
"The active Bot subprocess corresponding to current buffer.")
(defvar haskell-bot-process-buffer nil
"*Buffer used for communication with Bot subprocess for current buffer.")
;;;###autoload
(defcustom haskell-bot-program-name "lambdabot"
"*The name of the Bot interpreter program."
:type 'string
:group 'haskell-bot)
;;;###autoload
(defcustom haskell-bot-program-args nil
"*A list of string args to pass when starting the Bot interpreter."
:type '(repeat string)
:group 'haskell-bot)
(defvar haskell-bot-load-end nil
"Position of the end of the last load command.")
(defvar haskell-bot-error-pos nil
"Position of the end of the last load command.")
(defvar haskell-bot-send-end nil
"Position of the end of the last send command.")
(defvar haskell-bot-comint-prompt-regexp
"^lambdabot> "
"A regexp that matches the Bot prompt.")
(defun haskell-bot-start-process (arg)
"Start a Bot process and invoke `haskell-bot-hook' if not nil.
Prompt for a list of args if called with an argument."
(interactive "P")
(if arg
;; XXX [CDW] Fix to use more natural 'string' version of the
;; XXX arguments rather than a sexp.
(setq haskell-bot-program-args
(read-minibuffer (format "List of args for %s:"
haskell-bot-program-name)
(prin1-to-string haskell-bot-program-args))))
;; Start the Bot process in a new comint buffer.
(message "Starting Lambdabot process `%s'." haskell-bot-program-name)
(setq haskell-bot-process-buffer
(apply 'make-comint
"lambdabot" haskell-bot-program-name nil
haskell-bot-program-args))
(setq haskell-bot-process
(get-buffer-process haskell-bot-process-buffer))
;; Select Bot buffer temporarily.
(set-buffer haskell-bot-process-buffer)
(haskell-bot-mode)
(setq comint-prompt-regexp haskell-bot-comint-prompt-regexp)
;; History syntax of comint conflicts with Haskell, e.g. !!, so better
;; turn it off.
(setq comint-input-autoexpand nil)
(setq comint-process-echoes nil)
(run-hooks 'haskell-bot-hook)
;; Clear message area.
(message ""))
(defun haskell-bot-wait-for-output ()
"Wait until output arrives and go to the last input."
(while (progn
(goto-char comint-last-input-end)
(not (re-search-forward comint-prompt-regexp nil t)))
(accept-process-output haskell-bot-process)))
(defun haskell-bot-send (&rest string)
"Send `haskell-bot-process' the arguments (one or more strings).
A newline is sent after the strings and they are inserted into the
current buffer after the last output."
(haskell-bot-wait-for-output) ; wait for prompt
(goto-char (point-max)) ; position for this input
(apply 'insert string)
(comint-send-input)
(setq haskell-bot-send-end (marker-position comint-last-input-end)))
(defun haskell-bot-show-bot-buffer ()
"Go to the *bot* buffer."
(interactive)
(if (or (not haskell-bot-process-buffer)
(not (buffer-live-p haskell-bot-process-buffer)))
(haskell-bot-start-process nil))
(pop-to-buffer haskell-bot-process-buffer))
(provide 'haskell-bot)
;;; haskell-bot.el ends here

974
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-cabal.el

@ -0,0 +1,974 @@
;;; haskell-cabal.el --- Support for Cabal packages -*- lexical-binding: t -*-
;; Copyright (C) 2007, 2008 Stefan Monnier
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Todo:
;; - distinguish continued lines from indented lines.
;; - indent-line-function.
;; - outline-minor-mode.
;;; Code:
;; (defun haskell-cabal-extract-fields-from-doc ()
;; (require 'xml)
;; (with-no-warnings (require 'cl))
;; (let ((section (completing-read
;; "Section: "
;; '("general-fields" "library" "executable" "buildinfo"))))
;; (goto-char (point-min))
;; (search-forward (concat "<sect3 id=\"" section "\">")))
;; (let* ((xml (xml-parse-region
;; (progn (search-forward "<variablelist>") (match-beginning 0))
;; (progn (search-forward "</variablelist>") (point))))
;; (varlist (remove-if-not 'consp (cddar xml)))
;; (syms (mapcar (lambda (entry) (caddr (assq 'literal (assq 'term entry))))
;; varlist))
;; (fields (mapcar (lambda (sym) (substring-no-properties sym 0 -1)) syms)))
;; fields))
(require 'cl-lib)
(require 'haskell-utils)
(defconst haskell-cabal-general-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields")
'("name" "version" "cabal-version" "license" "license-file" "copyright"
"author" "maintainer" "stability" "homepage" "package-url" "synopsis"
"description" "category" "tested-with" "build-depends" "data-files"
"extra-source-files" "extra-tmp-files"))
(defconst haskell-cabal-library-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "library")
'("exposed-modules"))
(defconst haskell-cabal-executable-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "executable")
'("executable" "main-is"))
(defconst haskell-cabal-buildinfo-fields
;; Extracted with (haskell-cabal-extract-fields-from-doc "buildinfo")
'("buildable" "other-modules" "hs-source-dirs" "extensions" "ghc-options"
"ghc-prof-options" "hugs-options" "nhc-options" "includes"
"install-includes" "include-dirs" "c-sources" "extra-libraries"
"extra-lib-dirs" "cc-options" "ld-options" "frameworks"))
(defvar haskell-cabal-mode-syntax-table
(let ((st (make-syntax-table)))
;; The comment syntax can't be described simply in syntax-table.
;; We could use font-lock-syntactic-keywords, but is it worth it?
;; (modify-syntax-entry ?- ". 12" st)
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?. "w" st)
(modify-syntax-entry ?- "w" st)
st))
(defvar haskell-cabal-font-lock-keywords
;; The comment syntax can't be described simply in syntax-table.
;; We could use font-lock-syntactic-keywords, but is it worth it?
'(("^[ \t]*--.*" . font-lock-comment-face)
("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face))
("^\\(Library\\)[ \t]*\\({\\|$\\)" (1 font-lock-keyword-face))
("^\\(Executable\\|Test-Suite\\|Benchmark\\)[ \t]+\\([^\n \t]*\\)"
(1 font-lock-keyword-face) (2 font-lock-function-name-face))
("^\\(Flag\\)[ \t]+\\([^\n \t]*\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
("^\\(Source-Repository\\)[ \t]+\\(head\\|this\\)"
(1 font-lock-keyword-face) (2 font-lock-constant-face))
("^ *\\(if\\)[ \t]+.*\\({\\|$\\)" (1 font-lock-keyword-face))
("^ *\\(}[ \t]*\\)?\\(else\\)[ \t]*\\({\\|$\\)"
(2 font-lock-keyword-face))))
(defvar haskell-cabal-buffers nil
"List of Cabal buffers.")
(defun haskell-cabal-buffers-clean (&optional buffer)
(let ((bufs ()))
(dolist (buf haskell-cabal-buffers)
(if (and (buffer-live-p buf) (not (eq buf buffer))
(with-current-buffer buf (derived-mode-p 'haskell-cabal-mode)))
(push buf bufs)))
(setq haskell-cabal-buffers bufs)))
(defun haskell-cabal-unregister-buffer ()
(haskell-cabal-buffers-clean (current-buffer)))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode))
(defvar haskell-cabal-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-s") 'haskell-cabal-subsection-arrange-lines)
(define-key map (kbd "C-M-n") 'haskell-cabal-next-section)
(define-key map (kbd "C-M-p") 'haskell-cabal-previous-section)
(define-key map (kbd "M-n") 'haskell-cabal-next-subsection)
(define-key map (kbd "M-p") 'haskell-cabal-previous-subsection)
(define-key map (kbd "C-<down>") 'haskell-cabal-next-subsection)
(define-key map (kbd "C-<up>") 'haskell-cabal-previous-subsection)
(define-key map (kbd "C-c C-f") 'haskell-cabal-find-or-create-source-file)
(define-key map (kbd "M-g l") 'haskell-cabal-goto-library-section)
(define-key map (kbd "M-g e") 'haskell-cabal-goto-executable-section)
(define-key map (kbd "M-g b") 'haskell-cabal-goto-benchmark-section)
(define-key map (kbd "M-g t") 'haskell-cabal-goto-test-suite-section)
map))
;;;###autoload
(define-derived-mode haskell-cabal-mode fundamental-mode "Haskell-Cabal"
"Major mode for Cabal package description files."
(set (make-local-variable 'font-lock-defaults)
'(haskell-cabal-font-lock-keywords t t nil nil))
(add-to-list 'haskell-cabal-buffers (current-buffer))
(add-hook 'change-major-mode-hook 'haskell-cabal-unregister-buffer nil 'local)
(add-hook 'kill-buffer-hook 'haskell-cabal-unregister-buffer nil 'local)
(set (make-local-variable 'comment-start) "-- ")
(set (make-local-variable 'comment-start-skip) "\\(^[ \t]*\\)--[ \t]*")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-end-skip) "[ \t]*\\(\\s>\\|\n\\)")
(set (make-local-variable 'indent-line-function) 'haskell-cabal-indent-line)
(setq indent-tabs-mode nil)
)
(defun haskell-cabal-get-setting (name)
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
(when (re-search-forward
(concat "^[ \t]*" (regexp-quote name)
":[ \t]*\\(.*\\(\n[ \t]+[ \t\n].*\\)*\\)")
nil t)
(let ((val (match-string 1))
(start 1))
(when (match-end 2) ;Multiple lines.
;; The documentation is not very precise about what to do about
;; the \n and the indentation: are they part of the value or
;; the encoding? I take the point of view that \n is part of
;; the value (so that values can span multiple lines as well),
;; and that only the first char in the indentation is part of
;; the encoding, the rest is part of the value (otherwise, lines
;; in the value cannot start with spaces or tabs).
(while (string-match "^[ \t]\\(?:\\.$\\)?" val start)
(setq start (1+ (match-beginning 0)))
(setq val (replace-match "" t t val))))
val)))))
;;;###autoload
(defun haskell-cabal-guess-setting (name)
"Guess the specified setting of this project.
If there is no valid .cabal file to get the setting from (or
there is no corresponding setting with that name in the .cabal
file), then this function returns nil."
(interactive)
(when (and name buffer-file-name)
(let ((cabal-file (haskell-cabal-find-file)))
(when (and cabal-file (file-readable-p cabal-file))
(with-temp-buffer
(insert-file-contents cabal-file)
(haskell-cabal-get-setting name))))))
;;;###autoload
(defun haskell-cabal-get-dir (&optional use-defaults)
"Get the Cabal dir for a new project. Various ways of figuring this out,
and indeed just prompting the user. Do them all."
(let* ((file (haskell-cabal-find-file))
(dir (if file (file-name-directory file) default-directory)))
(if use-defaults
dir
(haskell-utils-read-directory-name
(format "Cabal dir%s: " (if file (format " (guessed from %s)" (file-relative-name file)) ""))
dir))))
(defun haskell-cabal-compute-checksum (dir)
"Compute MD5 checksum of package description file in DIR.
Return nil if no Cabal description file could be located via
`haskell-cabal-find-pkg-desc'."
(let ((cabal-file (haskell-cabal-find-pkg-desc dir)))
(when cabal-file
(with-temp-buffer
(insert-file-contents cabal-file)
(md5 (buffer-string))))))
(defun haskell-cabal-find-file (&optional dir)
"Search for package description file upwards starting from DIR.
If DIR is nil, `default-directory' is used as starting point for
directory traversal. Upward traversal is aborted if file owner
changes. Uses`haskell-cabal-find-pkg-desc' internally."
(let ((use-dir (or dir default-directory)))
(while (and use-dir (not (file-directory-p use-dir)))
(setq use-dir (file-name-directory (directory-file-name use-dir))))
(when use-dir
(catch 'found
(let ((user (nth 2 (file-attributes use-dir)))
;; Abbreviate, so as to stop when we cross ~/.
(root (abbreviate-file-name use-dir)))
;; traverse current dir up to root as long as file owner doesn't change
(while (and root (equal user (nth 2 (file-attributes root))))
(let ((cabal-file (haskell-cabal-find-pkg-desc root)))
(when cabal-file
(throw 'found cabal-file)))
(let ((proot (file-name-directory (directory-file-name root))))
(if (equal proot root) ;; fix-point reached?
(throw 'found nil)
(setq root proot))))
nil)))))
(defun haskell-cabal-find-pkg-desc (dir &optional allow-multiple)
"Find a package description file in the directory DIR.
Returns nil if none or multiple \".cabal\" files were found. If
ALLOW-MULTIPLE is non nil, in case of multiple \".cabal\" files,
a list is returned instead of failing with a nil result."
;; This is basically a port of Cabal's
;; Distribution.Simple.Utils.findPackageDesc function
;; http://hackage.haskell.org/packages/archive/Cabal/1.16.0.3/doc/html/Distribution-Simple-Utils.html
;; but without the exception throwing.
(let* ((cabal-files
(cl-remove-if 'file-directory-p
(cl-remove-if-not 'file-exists-p
(directory-files dir t ".\\.cabal\\'")))))
(cond
((= (length cabal-files) 1) (car cabal-files)) ;; exactly one candidate found
(allow-multiple cabal-files) ;; pass-thru multiple candidates
(t nil))))
(defun haskell-cabal-find-dir (&optional dir)
"Like `haskell-cabal-find-file' but returns directory instead.
See `haskell-cabal-find-file' for meaning of DIR argument."
(let ((cabal-file (haskell-cabal-find-file dir)))
(when cabal-file
(file-name-directory cabal-file))))
;;;###autoload
(defun haskell-cabal-visit-file (other-window)
"Locate and visit package description file for file visited by current buffer.
This uses `haskell-cabal-find-file' to locate the closest
\".cabal\" file and open it. This command assumes a common Cabal
project structure where the \".cabal\" file is in the top-folder
of the project, and all files related to the project are in or
below the top-folder. If called with non-nil prefix argument
OTHER-WINDOW use `find-file-other-window'."
(interactive "P")
;; Note: We aren't allowed to rely on haskell-session here (which,
;; in pathological cases, can have a different .cabal file
;; associated with the current buffer)
(if buffer-file-name
(let ((cabal-file (haskell-cabal-find-file (file-name-directory buffer-file-name))))
(if cabal-file
(if other-window
(find-file-other-window cabal-file)
(find-file cabal-file))
(error "Could not locate \".cabal\" file for %S" buffer-file-name)))
(error "Cannot locate \".cabal\" file for buffers not visiting any file")))
(defvar haskell-cabal-commands
'("install"
"update"
"list"
"info"
"upgrade"
"fetch"
"unpack"
"check"
"sdist"
"upload"
"report"
"init"
"configure"
"build"
"copy"
"haddock"
"clean"
"hscolour"
"register"
"test"
"help"
"run"))
;;;###autoload
(defgroup haskell-cabal nil
"Haskell cabal files"
:group 'haskell
)
;;;###autoload
(defcustom haskell-cabal-list-comma-position
'before
"Where to put the comma in lists"
:safe t
:group 'haskell-cabal
:type '(choice (const before)
(const after)))
(defconst haskell-cabal-section-header-regexp "^[[:alnum:]]" )
(defconst haskell-cabal-subsection-header-regexp "^[ \t]*[[:alnum:]]\\w*:")
(defconst haskell-cabal-comment-regexp "^[ \t]*--")
(defconst haskell-cabal-empty-regexp "^[ \t]*$")
(defconst haskell-cabal-conditional-regexp "^[ \t]*\\(\\if\\|else\\|}\\)")
(defun haskell-cabal-classify-line ()
"Classify the current line into 'section-header 'subsection-header 'section-data 'comment and 'empty '"
(save-excursion
(beginning-of-line)
(cond
((looking-at haskell-cabal-subsection-header-regexp ) 'subsection-header)
((looking-at haskell-cabal-section-header-regexp) 'section-header)
((looking-at haskell-cabal-comment-regexp) 'comment)
((looking-at haskell-cabal-empty-regexp ) 'empty)
((looking-at haskell-cabal-conditional-regexp ) 'conditional)
(t 'section-data))))
(defun haskell-cabal-header-p ()
"Is the current line a section or subsection header?"
(cl-case (haskell-cabal-classify-line)
((section-header subsection-header) t)))
(defun haskell-cabal-section-header-p ()
"Is the current line a section or subsection header?"
(cl-case (haskell-cabal-classify-line)
((section-header) t)))
(defun haskell-cabal-section-beginning ()
"Find the beginning of the current section"
(save-excursion
(while (not (or (bobp) (haskell-cabal-section-header-p)))
(forward-line -1))
(point)))
(defun haskell-cabal-beginning-of-section ()
"go to the beginning of the section"
(interactive)
(goto-char (haskell-cabal-section-beginning))
)
(defun haskell-cabal-section-end ()
"Find the end of the current section"
(interactive)
(save-excursion
(if (re-search-forward "\n\\([ \t]*\n\\)*[[:alnum:]]" nil t)
(match-beginning 0)
(point-max))))
(defun haskell-cabal-end-of-section ()
"go to the end of the section"
(interactive)
(goto-char (haskell-cabal-section-end)))
(defun haskell-cabal-next-section ()
"Go to the next extion"
(interactive)
(when (haskell-cabal-section-header-p) (forward-line))
(while (not (or (eobp) (haskell-cabal-section-header-p)))
(forward-line)))
(defun haskell-cabal-previous-section ()
"Go to the next extion"
(interactive)
(when (haskell-cabal-section-header-p) (forward-line -1))
(while (not (or (bobp) (haskell-cabal-section-header-p)))
(forward-line -1)))
(defun haskell-cabal-subsection-end ()
"find the end of the current subsection"
(save-excursion
(haskell-cabal-beginning-of-subsection)
(forward-line)
(while (and (not (eobp))
(member (haskell-cabal-classify-line) '(empty section-data)))
(forward-line))
(unless (eobp) (forward-line -1))
(while (and (equal (haskell-cabal-classify-line) 'empty)
(not (bobp)))
(forward-line -1))
(end-of-line)
(point)))
(defun haskell-cabal-end-of-subsection ()
"go to the end of the current subsection"
(interactive)
(goto-char (haskell-cabal-subsection-end)))
(defun haskell-cabal-section ()
"Get the name and data of the associated section"
(save-excursion
(haskell-cabal-beginning-of-section)
(when (and (haskell-cabal-section-header-p)
(looking-at "^\\(\\w+\\)[ \t]*\\(.*\\)$"))
(list :name (match-string-no-properties 1)
:value (match-string-no-properties 2)
:beginning (match-beginning 0)
:end (haskell-cabal-section-end)))))
(defun haskell-cabal-subsection ()
"Get the name and bounds of of the current subsection"
(save-excursion
(haskell-cabal-beginning-of-subsection)
(when (looking-at "\\([ \t]*\\(\\w*\\):\\)[ \t]*")
(list :name (match-string-no-properties 2)
:beginning (match-end 0)
:end (save-match-data (haskell-cabal-subsection-end))
:data-start-column (save-excursion (goto-char (match-end 0))
(current-column)
)))))
(defun haskell-cabal-section-name (section)
(plist-get section :name))
(defun haskell-cabal-section-value (section)
(plist-get section :value))
(defun haskell-cabal-section-start (section)
(plist-get section :beginning))
(defun haskell-cabal-section-data-start-column (section)
(plist-get section :data-start-column))
(defun haskell-cabal-enum-targets ()
"Enumerate .cabal targets."
(let ((cabal-file (haskell-cabal-find-file)))
(when (and cabal-file (file-readable-p cabal-file))
(with-temp-buffer
(insert-file-contents cabal-file)
(haskell-cabal-mode)
(let (matches)
(goto-char (point-min))
(haskell-cabal-next-section)
(while (not (eobp))
(if (haskell-cabal-source-section-p (haskell-cabal-section))
(let ((val (haskell-cabal-section-value (haskell-cabal-section))))
(if (string= val "")
(push "library" matches)
(push val matches))))
(haskell-cabal-next-section))
(reverse matches))))))
(defmacro haskell-cabal-with-subsection (subsection replace &rest funs)
"Copy subsection data into a temporary buffer, save indentation
and execute FORMS
If REPLACE is non-nil the subsection data is replaced with the
resultung buffer-content"
(let ((section (make-symbol "section"))
(beg (make-symbol "beg"))
(end (make-symbol "end"))
(start-col (make-symbol "start-col"))
(section-data (make-symbol "section-data")))
`(let* ((,section ,subsection)
(,beg (plist-get ,section :beginning))
(,end (plist-get ,section :end))
(,start-col (plist-get ,section :data-start-column))
(,section-data (buffer-substring ,beg ,end)))
(save-excursion
(prog1
(with-temp-buffer
(setq indent-tabs-mode nil)
(indent-to ,start-col)
(insert ,section-data)
(goto-char (point-min))
(prog1
(progn (haskell-cabal-save-indentation ,@funs))
(goto-char (point-min))
(when (looking-at (format "[ ]\\{0,%d\\}" (1+ ,start-col)))
(replace-match ""))
(setq ,section-data (buffer-substring (point-min) (point-max)))))
,@(when replace
`((delete-region ,beg ,end)
(goto-char ,beg)
(insert ,section-data))))))))
(defmacro haskell-cabal-each-line (&rest fun)
"Execute FOMRS on each line"
`(save-excursion
(while (< (point) (point-max))
,@fun
(forward-line))))
(defun haskell-cabal-chomp-line ()
"Remove leading and trailing whitespaces from current line"
(beginning-of-line)
(when (looking-at "^[ \t]*\\([^ \t]\\|\\(?:[^ \t].*[^ \t]\\)\\)[ \t]*$")
(replace-match (match-string 1) nil t)
t))
(defun haskell-cabal-min-indentation (&optional beg end)
"Compute largest common whitespace prefix of each line in between BEG and END"
(save-excursion
(goto-char (or beg (point-min)))
(let ((min-indent nil))
(while (< (point) (or end (point-max)))
(let ((indent (current-indentation)))
(if (and (not (haskell-cabal-ignore-line-p))
(or (not min-indent)
(< indent min-indent)))
(setq min-indent indent)))
(forward-line))
min-indent)))
(defun haskell-cabal-ignore-line-p ()
"Does line only contain whitespaces and comments?"
(save-excursion
(beginning-of-line)
(looking-at "^[ \t]*\\(?:--.*\\)?$")))
(defun haskell-cabal-kill-indentation ()
"Remove longest common whitespace prefix from each line"
(goto-char (point-min))
(let ((indent (haskell-cabal-min-indentation)))
(haskell-cabal-each-line (unless (haskell-cabal-ignore-line-p)
(delete-char indent)) )
indent))
(defun haskell-cabal-add-indentation (indent)
(goto-char (point-min))
(haskell-cabal-each-line
(unless (haskell-cabal-ignore-line-p)
(indent-to indent))))
(defmacro haskell-cabal-save-indentation (&rest funs)
"Strip indentation from each line, execute FORMS and reinstate indentation
so that the indentation of the FIRST LINE matches"
(let ((old-l1-indent (make-symbol "new-l1-indent"))
(new-l1-indent (make-symbol "old-l1-indent")))
`(let ( (,old-l1-indent (save-excursion
(goto-char (point-min))
(current-indentation))))
(unwind-protect
(progn
(haskell-cabal-kill-indentation)
,@funs)
(progn
(goto-char (point-min))
(let ((,new-l1-indent (current-indentation)))
(haskell-cabal-add-indentation (- ,old-l1-indent
,new-l1-indent))))))))
(defun haskell-cabal-strip-list ()
"strip commas from comma-seperated list"
(goto-char (point-min))
;; split list items on single line
(while (re-search-forward
"\\([^ \t,\n]\\)[ \t]*,[ \t]*\\([^ \t,\n]\\)" nil t)
(replace-match "\\1\n\\2" nil nil))
(goto-char (point-min))
(while (re-search-forward "^\\([ \t]*\\),\\([ \t]*\\)" nil t)
(replace-match "" nil nil))
(goto-char (point-min))
(while (re-search-forward ",[ \t]*$" nil t)
(replace-match "" nil nil))
(goto-char (point-min))
(haskell-cabal-each-line (haskell-cabal-chomp-line)))
(defun haskell-cabal-listify ()
"Add commas so that buffer contains a comma-seperated list"
(cl-case haskell-cabal-list-comma-position
('before
(goto-char (point-min))
(while (haskell-cabal-ignore-line-p) (forward-line))
(indent-to 2)
(forward-line)
(haskell-cabal-each-line
(unless (haskell-cabal-ignore-line-p)
(insert ", "))))
('after
(goto-char (point-max))
(while (not (bobp))
(unless (haskell-cabal-ignore-line-p)
(forward-line -1)
(end-of-line)
(insert ",")
(beginning-of-line))))))
(defmacro haskell-cabal-with-cs-list (&rest funs)
"format buffer so that each line contains a list element "
`(progn
(save-excursion (haskell-cabal-strip-list))
(unwind-protect (progn ,@funs)
(haskell-cabal-listify))))
(defun haskell-cabal-sort-lines-key-fun ()
(when (looking-at "[ \t]*--[ \t,]*")
(goto-char (match-end 0)))
nil)
(defmacro haskell-cabal-save-position (&rest forms)
"Save position as mark, execute FORMs and go back to mark"
`(prog2
(haskell-cabal-mark)
(progn ,@forms)
(haskell-cabal-goto-mark)
(haskell-cabal-remove-mark)))
(defun haskell-cabal-subsection-arrange-lines ()
"Sort lines of current subsection"
(interactive)
(haskell-cabal-save-position
(haskell-cabal-with-subsection
(haskell-cabal-subsection) t
(haskell-cabal-with-cs-list
(sort-subr nil 'forward-line 'end-of-line
'haskell-cabal-sort-lines-key-fun)
))))
(defun haskell-cabal-subsection-beginning ()
"find the beginning of the current subsection"
(save-excursion
(while (and (not (bobp))
(not (haskell-cabal-header-p)))
(forward-line -1))
(back-to-indentation)
(point)))
(defun haskell-cabal-beginning-of-subsection ()
"go to the beginniing of the current subsection"
(interactive)
(goto-char (haskell-cabal-subsection-beginning)))
(defun haskell-cabal-next-subsection ()
"go to the next subsection"
(interactive)
(if (haskell-cabal-header-p) (forward-line))
(while (and (not (eobp))
(not (haskell-cabal-header-p)))
(forward-line))
(haskell-cabal-forward-to-line-entry))
(defun haskell-cabal-previous-subsection ()
"go to the next subsection"
(interactive)
(if (haskell-cabal-header-p) (forward-line -1))
(while (and (not (bobp))
(not (haskell-cabal-header-p)))
(forward-line -1))
(haskell-cabal-forward-to-line-entry)
)
(defun haskell-cabal-find-subsection-by (section pred)
"Find sunsection with name NAME"
(save-excursion
(when section (goto-char (haskell-cabal-section-start section)))
(let* ((end (if section (haskell-cabal-section-end) (point-max)))
(found nil))
(while (and (< (point) end)
(not found))
(let ((subsection (haskell-cabal-subsection)))
(when (and subsection (funcall pred subsection))
(setq found subsection)))
(haskell-cabal-next-subsection))
found)))
(defun haskell-cabal-find-subsection (section name)
"Find sunsection with name NAME"
(let ((downcase-name (downcase name)))
(haskell-cabal-find-subsection-by
section
`(lambda (subsection)
(string= (downcase (haskell-cabal-section-name subsection))
,downcase-name)))))
(defun haskell-cabal-goto-subsection (name)
(let ((subsection (haskell-cabal-find-subsection (haskell-cabal-section) name)))
(when subsection
(goto-char (haskell-cabal-section-start subsection)))))
(defun haskell-cabal-goto-exposed-modules ()
(interactive)
(haskell-cabal-goto-subsection "exposed-modules"))
(defun haskell-cabal-subsection-entry-list (section name)
"Get the data of a subsection as a list"
(let ((subsection (haskell-cabal-find-subsection section name)))
(when subsection
(haskell-cabal-with-subsection
subsection nil
(haskell-cabal-with-cs-list
(delete-matching-lines
(format "\\(?:%s\\)\\|\\(?:%s\\)"
haskell-cabal-comment-regexp
haskell-cabal-empty-regexp)
(point-min) (point-max))
(split-string (buffer-substring-no-properties (point-min) (point-max))
"\n" t))))))
(defun haskell-cabal-remove-mark ()
(remove-list-of-text-properties (point-min) (point-max)
'(haskell-cabal-marker)))
(defun haskell-cabal-mark ()
"Mark the current position with the text property haskell-cabal-marker"
(haskell-cabal-remove-mark)
(put-text-property (line-beginning-position) (line-end-position)
'haskell-cabal-marker 'marked-line)
(put-text-property (point) (1+ (point))
'haskell-cabal-marker 'marked))
(defun haskell-cabal-goto-mark ()
"Go to marked line"
(let ((marked-pos (text-property-any (point-min) (point-max)
'haskell-cabal-marker
'marked))
(marked-line (text-property-any (point-min) (point-max)
'haskell-cabal-marker
'marked-line) )
)
(cond (marked-pos (goto-char marked-pos))
(marked-line (goto-char marked-line)))))
(defmacro haskell-cabal-with-subsection-line (replace &rest forms)
"Mark line and "
`(progn
(haskell-cabal-mark)
(unwind-protect
(haskell-cabal-with-subsection (haskell-cabal-subsection) ,replace
(haskell-cabal-goto-mark)
,@forms)
(haskell-cabal-remove-mark))))
(defun haskell-cabal-get-line-content ()
(haskell-cabal-with-subsection-line
nil
(haskell-cabal-with-cs-list
(haskell-cabal-goto-mark)
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))))
(defun haskell-cabal-module-to-filename (module)
(concat (replace-regexp-in-string "[.]" "/" module ) ".hs"))
(defconst haskell-cabal-module-sections '("exposed-modules" "other-modules")
"List of sections that contain module names"
)
(defconst haskell-cabal-file-sections
'("main-is" "c-sources" "data-files" "extra-source-files"
"extra-doc-files" "extra-tmp-files" )
"List of subsections that contain filenames"
)
(defconst haskell-cabal-source-bearing-sections
'("library" "executable" "test-suite" "benchmark"))
(defun haskell-cabal-source-section-p (section)
(not (not (member (downcase (haskell-cabal-section-name section))
haskell-cabal-source-bearing-sections))))
(defun haskell-cabal-line-filename ()
"Expand filename in current line according to the subsection type
Module names in exposed-modules and other-modules are expanded by replacing each dot (.) in the module name with a foward slash (/) and appending \".hs\"
Example: Foo.Bar.Quux ==> Foo/Bar/Quux.hs
Source names from main-is and c-sources sections are left untouched
"
(let ((entry (haskell-cabal-get-line-content))
(subsection (downcase (haskell-cabal-section-name
(haskell-cabal-subsection)))))
(cond ((member subsection haskell-cabal-module-sections)
(haskell-cabal-module-to-filename entry))
((member subsection haskell-cabal-file-sections) entry))))
(defun haskell-cabal-join-paths (&rest args)
"Crude hack to replace f-join"
(mapconcat 'identity args "/")
)
(defun haskell-cabal-find-or-create-source-file ()
"Open the source file this line refers to"
(interactive)
(let* ((src-dirs (append (haskell-cabal-subsection-entry-list
(haskell-cabal-section) "hs-source-dirs")
'("")))
(base-dir (file-name-directory (buffer-file-name)))
(filename (haskell-cabal-line-filename)))
(when filename
(let ((candidates
(delq nil (mapcar
(lambda (dir)
(let ((file (haskell-cabal-join-paths base-dir dir filename)))
(when (and (file-readable-p file)
(not (file-directory-p file)))
file)))
src-dirs))))
(if (null candidates)
(let* ((src-dir (haskell-cabal-join-paths base-dir (or (car src-dirs) "")))
(newfile (haskell-cabal-join-paths src-dir filename))
(do-create-p (y-or-n-p (format "Create file %s ?" newfile))))
(when do-create-p
(find-file-other-window newfile )))
(find-file-other-window (car candidates)))))))
(defun haskell-cabal-find-section-type (type &optional wrap)
(save-excursion
(haskell-cabal-next-section)
(while
(not
(or
(eobp)
(string=
(downcase type)
(downcase (haskell-cabal-section-name (haskell-cabal-section))))))
(haskell-cabal-next-section))
(if (eobp)
(if wrap (progn
(goto-char (point-min))
(haskell-cabal-find-section-type type nil) )
nil)
(point))))
(defun haskell-cabal-goto-section-type (type)
(let ((section (haskell-cabal-find-section-type type t)))
(if section (goto-char section)
(message "No %s section found" type))))
(defun haskell-cabal-goto-library-section ()
(interactive)
(haskell-cabal-goto-section-type "library"))
(defun haskell-cabal-goto-test-suite-section ()
(interactive)
(haskell-cabal-goto-section-type "test-suite"))
(defun haskell-cabal-goto-executable-section ()
(interactive)
(haskell-cabal-goto-section-type "executable"))
(defun haskell-cabal-goto-benchmark-section ()
(interactive)
(haskell-cabal-goto-section-type "benchmark"))
(defun haskell-cabal-line-entry-column ()
"Column at which the line entry starts"
(save-excursion
(cl-case (haskell-cabal-classify-line)
(section-data (beginning-of-line)
(when (looking-at "[ ]*\\(?:,[ ]*\\)?")
(goto-char (match-end 0))
(current-column)))
(subsection-header
(haskell-cabal-section-data-start-column (haskell-cabal-subsection))))))
(defun haskell-cabal-forward-to-line-entry ()
"go forward to the beginning of the line entry (but never move backwards)"
(let ((col (haskell-cabal-line-entry-column)))
(when (and col (< (current-column) col))
(beginning-of-line)
(forward-char col))))
(defun haskell-cabal-indent-line ()
"Indent current line according to subsection"
(interactive)
(cl-case (haskell-cabal-classify-line)
(section-data
(save-excursion
(let ((indent (haskell-cabal-section-data-start-column
(haskell-cabal-subsection))))
(indent-line-to indent)
(beginning-of-line)
(when (looking-at "[ ]*\\([ ]\\{2\\},[ ]*\\)")
(replace-match ", " t t nil 1)))))
(empty
(indent-relative)))
(haskell-cabal-forward-to-line-entry))
(defun haskell-cabal-map-sections (fun)
"Execute fun over each section, collecting the result"
(save-excursion
(goto-char (point-min))
(let ((results nil))
(while (not (eobp))
(let* ((section (haskell-cabal-section))
(result (and section (funcall fun (haskell-cabal-section)))))
(when section (setq results (cons result results))))
(haskell-cabal-next-section))
(nreverse results))))
(defun haskell-cabal-section-add-build-dependency (dependency &optional sort sec)
"Add a build dependency to the build-depends section"
(let* ((section (or sec (haskell-cabal-section)))
(subsection (and section
(haskell-cabal-find-subsection section "build-depends"))))
(when subsection
(haskell-cabal-with-subsection
subsection t
(haskell-cabal-with-cs-list
(insert dependency)
(insert "\n")
(when sort
(goto-char (point-min))
(sort-subr nil 'forward-line 'end-of-line
'haskell-cabal-sort-lines-key-fun)))))))
(defun haskell-cabal-add-build-dependency (dependency &optional sort silent)
"Add a build dependencies to sections"
(haskell-cabal-map-sections
(lambda (section)
(when (haskell-cabal-source-section-p section)
(when (or silent
(y-or-n-p (format "Add dependency %s to %s section %s?"
dependency
(haskell-cabal-section-name section)
(haskell-cabal-section-value section))))
(haskell-cabal-section-add-build-dependency dependency sort section)
nil)))))
(defun haskell-cabal-add-dependency (package &optional version no-prompt
sort silent)
"Add PACKAGE (and optionally suffix -VERSION) to the cabal
file. Prompts the user before doing so.
If VERSION is non-nil it will be appended as a minimum version.
If NO-PROMPT is nil the minimum-version is read from the minibuffer
When SORT is non-nil the package entries are sorted afterwards
If SILENT ist nil the user is prompted for each source-section
"
(interactive
(list (read-from-minibuffer "Package entry: ")
nil t t nil))
(save-window-excursion
(find-file-other-window (haskell-cabal-find-file))
(let ((entry (if no-prompt package
(read-from-minibuffer
"Package entry: "
(concat package (if version (concat " >= " version) ""))))))
(haskell-cabal-add-build-dependency entry sort silent)
(when (or silent (y-or-n-p "Save cabal file?"))
(save-buffer)))))
(provide 'haskell-cabal)
;;; haskell-cabal.el ends here

184
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-checkers.el

@ -0,0 +1,184 @@
;;; haskell-checkers.el --- Emacs interface to haskell lint and style checkers -*- lexical-binding: t -*-
;; Copyright (C) 2009-2011 Alex Ott, Liam O'Reilly
;;
;; Author: Alex Ott <alexott@gmail.com>, Liam O'Reilly <csliam@swansea.ac.uk>
;; Keywords: haskell, lint, hlint, style scanner
;; Requirements: hlint, scan, haskell
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'compile)
;;;###autoload
(defgroup haskell-checkers nil
"Run HLint as inferior of Emacs, parse error messages."
:group 'haskell)
;;;###autoload
(defcustom haskell-lint-command "hlint"
"The default lint command for \\[hlint]."
:type 'string
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-scan-command "scan"
"The default scan command for \\[haskell-scan]."
:type 'string
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-scan-options ""
"The default options for \\[haskell-scan]."
:type 'string
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-lint-options ""
"The default options for \\[hlint]."
:type 'string
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-checkers-save-files t
"Save modified files when run checker or not (ask user)"
:type 'boolean
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-checkers-replace-with-suggestions nil
"Replace user's code with suggested replacements (hlint only)"
:type 'boolean
:group 'haskell-checkers)
;;;###autoload
(defcustom haskell-checkers-replace-without-ask nil
"Replace user's code with suggested replacements automatically (hlint only)"
:type 'boolean
:group 'haskell-checkers)
;; regex for replace HLint's suggestions
;;
;; ^\(.*?\):\([0-9]+\):\([0-9]+\): .*
;; Found:
;; \s +\(.*\)
;; Why not:
;; \s +\(.*\)
(defvar haskell-lint-regex
"^\\(.*?\\):\\([0-9]+\\):\\([0-9]+\\): .*[\n\C-m]Found:[\n\C-m]\\s +\\(.*\\)[\n\C-m]Why not:[\n\C-m]\\s +\\(.*\\)[\n\C-m]"
"Regex for HLint messages")
(defun haskell-checkers-make-short-string (str maxlen)
(if (< (length str) maxlen)
str
(concat (substring str 0 (- maxlen 3)) "...")))
;; TODO: check, is it possible to adopt it for haskell-scan?
(defun haskell-lint-replace-suggestions ()
"Perform actual replacement of HLint's suggestions"
(goto-char (point-min))
(while (re-search-forward haskell-lint-regex nil t)
(let* ((fname (match-string 1))
(fline (string-to-number (match-string 2)))
(old-code (match-string 4))
(new-code (match-string 5))
(msg (concat "Replace '" (haskell-checkers-make-short-string old-code 30)
"' with '" (haskell-checkers-make-short-string new-code 30) "'"))
(bline 0)
(eline 0)
(spos 0)
(new-old-code ""))
(save-excursion
(switch-to-buffer (get-file-buffer fname))
(goto-char (point-min))
(forward-line (1- fline))
(beginning-of-line)
(setq bline (point))
(when (or haskell-checkers-replace-without-ask
(yes-or-no-p msg))
(end-of-line)
(setq eline (point))
(beginning-of-line)
(setq old-code (regexp-quote old-code))
(while (string-match "\\\\ " old-code spos)
(setq new-old-code (concat new-old-code
(substring old-code spos (match-beginning 0))
"\\ *"))
(setq spos (match-end 0)))
(setq new-old-code (concat new-old-code (substring old-code spos)))
(remove-text-properties bline eline '(composition nil))
(when (re-search-forward new-old-code eline t)
(replace-match new-code nil t)))))))
(defun haskell-lint-finish-hook (_buf _msg)
"Function, that is executed at the end of HLint or scan execution"
(if haskell-checkers-replace-with-suggestions
(haskell-lint-replace-suggestions)
(next-error 1 t)))
(defun haskell-scan-finish-hook (_buf _msg)
"Function, that is executed at the end of haskell-scan execution"
(next-error 1 t))
(defun haskell-scan-make-command (file)
"Generates command line for scan"
(concat haskell-scan-command " " haskell-scan-options " \"" file "\""))
(defun haskell-lint-make-command (file)
"Generates command line for scan"
(concat haskell-lint-command " \"/" file "/\"" " " haskell-lint-options))
(defmacro haskell-checkers-setup (type name)
"Performs setup of corresponding checker. Receives two arguments:
type - checker's type (lint or scan) that is expanded into functions and hooks names
name - user visible name for this mode"
(let ((nm (concat "haskell-" (symbol-name type))))
`(progn
;;;###autoload
(defvar ,(intern (concat nm "-setup-hook")) nil
,(concat "Hook, that will executed before running " name))
(defun ,(intern (concat nm "-process-setup")) ()
"Setup compilation variables and buffer for `hlint'."
(run-hooks ',(intern (concat nm "-setup-hook"))))
;;;###autoload
(define-compilation-mode ,(intern (concat nm "-mode")) ,name
,(concat "Mode to check Haskell source code using " name)
(set (make-local-variable 'compilation-process-setup-function)
',(intern (concat nm "-process-setup")))
(set (make-local-variable 'compilation-disable-input) t)
(set (make-local-variable 'compilation-scroll-output) nil)
(set (make-local-variable 'compilation-finish-functions)
(list ',(intern (concat nm "-finish-hook")))))
;;;###autoload
(defun ,(intern nm) ()
,(concat "Run " name " for current buffer with haskell source")
(interactive)
(save-some-buffers haskell-checkers-save-files)
(compilation-start (,(intern (concat nm "-make-command")) buffer-file-name)
',(intern (concat nm "-mode")))))
))
(haskell-checkers-setup lint "HLint")
(haskell-checkers-setup scan "HScan")
(provide 'haskell-checkers)
;;; haskell-checkers.el ends here

65
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-collapse.el

@ -0,0 +1,65 @@
;;; haskell-collapse.el --- Collapse expressions -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(define-button-type 'haskell-collapse-toggle-button
'action 'haskell-collapse-toggle-button-callback
'follow-link t
'help-echo "Click to expand…")
(defun haskell-collapse (beg end)
"Collapse."
(interactive "r")
(goto-char end)
(let ((break nil))
(while (and (not break)
(search-backward-regexp "[[({]" beg t 1))
(unless (elt (syntax-ppss) 3)
(let ((orig (point)))
(haskell-collapse-sexp)
(goto-char orig)
(forward-char -1)
(when (= (point) orig)
(setq break t)))))))
(defun haskell-collapse-sexp ()
"Collapse the sexp starting at point."
(let ((beg (point)))
(forward-sexp)
(let ((end (point)))
(let ((o (make-overlay beg end)))
(overlay-put o 'invisible t)
(let ((start (point)))
(insert "")
(let ((button (make-text-button start (point)
:type 'haskell-collapse-toggle-button)))
(button-put button 'overlay o)
(button-put button 'hide-on-click t)))))))
(defun haskell-collapse-toggle-button-callback (btn)
"The callback to toggle the overlay visibility."
(let ((overlay (button-get btn 'overlay)))
(when overlay
(overlay-put overlay
'invisible
(not (overlay-get overlay
'invisible)))))
(button-put btn 'invisible t)
(delete-region (button-start btn) (button-end btn)))
(provide 'haskell-collapse)

944
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-commands.el

@ -0,0 +1,944 @@
;;; haskell-commands.el --- Commands that can be run on the process -*- lexical-binding: t -*-
;;; Commentary:
;;; This module provides varoius `haskell-mode' and `haskell-interactive-mode'
;;; specific commands such as show type signature, show info, haskell process
;;; commands and etc.
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'etags)
(require 'haskell-compat)
(require 'haskell-process)
(require 'haskell-font-lock)
(require 'haskell-interactive-mode)
(require 'haskell-session)
(require 'haskell-presentation-mode)
(require 'haskell-utils)
(require 'highlight-uses-mode)
;;;###autoload
(defun haskell-process-restart ()
"Restart the inferior Haskell process."
(interactive)
(haskell-process-reset (haskell-interactive-process))
(haskell-process-set (haskell-interactive-process) 'command-queue nil)
(haskell-process-start (haskell-interactive-session)))
(defun haskell-process-start (session)
"Start the inferior Haskell process with a given SESSION.
You can create new session using function `haskell-session-make'."
(let ((existing-process (get-process (haskell-session-name (haskell-interactive-session)))))
(when (processp existing-process)
(haskell-interactive-mode-echo session "Restarting process ...")
(haskell-process-set (haskell-session-process session) 'is-restarting t)
(delete-process existing-process)))
(let ((process (or (haskell-session-process session)
(haskell-process-make (haskell-session-name session))))
(old-queue (haskell-process-get (haskell-session-process session)
'command-queue)))
(haskell-session-set-process session process)
(haskell-process-set-session process session)
(haskell-process-set-cmd process nil)
(haskell-process-set (haskell-session-process session) 'is-restarting nil)
(let ((default-directory (haskell-session-cabal-dir session))
(log-and-command (haskell-process-compute-process-log-and-command session (haskell-process-type))))
(haskell-session-prompt-set-current-dir session (not haskell-process-load-or-reload-prompt))
(haskell-process-set-process
process
(progn
(haskell-process-log (propertize (format "%S" log-and-command)))
(apply #'start-process (cdr log-and-command)))))
(progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel)
(set-process-filter (haskell-process-process process) 'haskell-process-filter))
(haskell-process-send-startup process)
(unless (or (eq 'cabal-repl (haskell-process-type))
(eq 'stack-ghci (haskell-process-type))) ;; Both "cabal repl" and "stack ghci" set the proper CWD.
(haskell-process-change-dir session
process
(haskell-session-current-dir session)))
(haskell-process-set process 'command-queue
(append (haskell-process-get (haskell-session-process session)
'command-queue)
old-queue))
process))
(defun haskell-process-send-startup (process)
"Send the necessary start messages to haskell PROCESS."
(haskell-process-queue-command
process
(make-haskell-command
:state process
:go (lambda (process)
;; We must set the prompt last, so that this command as a
;; whole produces only one prompt marker as a response.
(haskell-process-send-string process "Prelude.putStrLn \"\"")
(haskell-process-send-string process ":set -v1")
(haskell-process-send-string process ":set prompt \"\\4\""))
:live (lambda (process buffer)
(when (haskell-process-consume
process
"^\*\*\* WARNING: \\(.+\\) is writable by someone else, IGNORING!$")
(let ((path (match-string 1 buffer)))
(haskell-session-modify
(haskell-process-session process)
'ignored-files
(lambda (files)
(cl-remove-duplicates (cons path files) :test 'string=)))
(haskell-interactive-mode-compile-warning
(haskell-process-session process)
(format "GHCi is ignoring: %s (run M-x haskell-process-unignore)"
path)))))
:complete (lambda (process _)
(haskell-interactive-mode-echo
(haskell-process-session process)
(concat (nth (random (length haskell-process-greetings))
haskell-process-greetings)
(when haskell-process-show-debug-tips
"
If I break, you can:
1. Restart: M-x haskell-process-restart
2. Configure logging: C-h v haskell-process-log (useful for debugging)
3. General config: M-x customize-mode
4. Hide these tips: C-h v haskell-process-show-debug-tips")))))))
(defun haskell-commands-process ()
"Get the Haskell session, throws an error if not available."
(or (haskell-session-process (haskell-session-maybe))
(error "No Haskell session/process associated with this
buffer. Maybe run M-x haskell-session-change?")))
;;;###autoload
(defun haskell-process-clear ()
"Clear the current process."
(interactive)
(haskell-process-reset (haskell-commands-process))
(haskell-process-set (haskell-commands-process) 'command-queue nil))
;;;###autoload
(defun haskell-process-interrupt ()
"Interrupt the process (SIGINT)."
(interactive)
(interrupt-process (haskell-process-process (haskell-commands-process))))
(defun haskell-process-reload-with-fbytecode (process module-buffer)
"Query a PROCESS to reload MODULE-BUFFER with -fbyte-code set.
Restores -fobject-code after reload finished.
MODULE-BUFFER is the actual Emacs buffer of the module being loaded."
(haskell-process-queue-without-filters process ":set -fbyte-code")
;; We prefix the module's filename with a "*", which asks ghci to
;; ignore any existing object file and interpret the module.
;; Dependencies will still use their object files as usual.
(haskell-process-queue-without-filters
process
(format ":load \"*%s\""
(replace-regexp-in-string
"\""
"\\\\\""
(buffer-file-name module-buffer))))
(haskell-process-queue-without-filters process ":set -fobject-code"))
(defvar url-http-response-status)
(defvar url-http-end-of-headers)
(defvar haskell-cabal-targets-history nil
"History list for session targets.")
(defun haskell-process-hayoo-ident (ident)
;; FIXME Obsolete doc string, CALLBACK is not used.
"Hayoo for IDENT, return a list of modules asyncronously through CALLBACK."
;; We need a real/simulated closure, because otherwise these
;; variables will be unbound when the url-retrieve callback is
;; called.
;; TODO: Remove when this code is converted to lexical bindings by
;; default (Emacs 24.1+)
(let ((url (format haskell-process-hayoo-query-url (url-hexify-string ident))))
(with-current-buffer (url-retrieve-synchronously url)
(if (= 200 url-http-response-status)
(progn
(goto-char url-http-end-of-headers)
(let* ((res (json-read))
(results (assoc-default 'result res)))
;; TODO: gather packages as well, and when we choose a
;; given import, check that we have the package in the
;; cabal file as well.
(cl-mapcan (lambda (r)
;; append converts from vector -> list
(append (assoc-default 'resultModules r) nil))
results)))
(warn "HTTP error %s fetching %s" url-http-response-status url)))))
(defun haskell-process-hoogle-ident (ident)
"Hoogle for IDENT, return a list of modules."
(with-temp-buffer
(let ((hoogle-error (call-process "hoogle" nil t nil "search" "--exact" ident)))
(goto-char (point-min))
(unless (or (/= 0 hoogle-error)
(looking-at "^No results found")
(looking-at "^package "))
(while (re-search-forward "^\\([^ ]+\\).*$" nil t)
(replace-match "\\1" nil nil))
(cl-remove-if (lambda (a) (string= "" a))
(split-string (buffer-string)
"\n"))))))
(defun haskell-process-haskell-docs-ident (ident)
"Search with haskell-docs for IDENT, return a list of modules."
(cl-remove-if-not
(lambda (a) (string-match "^[[:upper:]][[:alnum:]_'.]+$" a))
(split-string
(with-output-to-string
(with-current-buffer
standard-output
(call-process "haskell-docs"
nil ; no infile
t ; output to current buffer (that is string)
nil ; do not redisplay
"--modules" ident)))
"\n")))
(defun haskell-process-import-modules (process modules)
"Query PROCESS `:m +' command to import MODULES."
(when haskell-process-auto-import-loaded-modules
(haskell-process-queue-command
process
(make-haskell-command
:state (cons process modules)
:go (lambda (state)
(haskell-process-send-string
(car state)
(format ":m + %s" (mapconcat 'identity (cdr state) " "))))))))
;;;###autoload
(defun haskell-describe (ident)
"Describe the given identifier IDENT."
(interactive (list (read-from-minibuffer "Describe identifier: "
(haskell-ident-at-point))))
(let ((results (read (shell-command-to-string
(concat "haskell-docs --sexp "
ident)))))
(help-setup-xref (list #'haskell-describe ident)
(called-interactively-p 'interactive))
(save-excursion
(with-help-window (help-buffer)
(with-current-buffer (help-buffer)
(if results
(cl-loop for result in results
do (insert (propertize ident 'font-lock-face
'((:inherit font-lock-type-face
:underline t)))
" is defined in "
(let ((module (cadr (assoc 'module result))))
(if module
(concat module " ")
""))
(cadr (assoc 'package result))
"\n\n")
do (let ((type (cadr (assoc 'type result))))
(when type
(insert (haskell-fontify-as-mode type 'haskell-mode)
"\n")))
do (let ((args (cadr (assoc 'type results))))
(cl-loop for arg in args
do (insert arg "\n"))
(insert "\n"))
do (insert (cadr (assoc 'documentation result)))
do (insert "\n\n"))
(insert "No results for " ident)))))))
;;;###autoload
(defun haskell-rgrep (&optional prompt)
"Grep the effective project for the symbol at point.
Very useful for codebase navigation.
Prompts for an arbitrary regexp given a prefix arg PROMPT."
(interactive "P")
(let ((sym (if prompt
(read-from-minibuffer "Look for: ")
(haskell-ident-at-point))))
(rgrep sym
"*.hs" ;; TODO: common Haskell extensions.
(haskell-session-current-dir (haskell-interactive-session)))))
;;;###autoload
(defun haskell-process-do-info (&optional prompt-value)
"Print info on the identifier at point.
If PROMPT-VALUE is non-nil, request identifier via mini-buffer."
(interactive "P")
(let ((at-point (haskell-ident-at-point)))
(when (or prompt-value at-point)
(let* ((ident (replace-regexp-in-string
"^!\\([A-Z_a-z]\\)"
"\\1"
(if prompt-value
(read-from-minibuffer "Info: " at-point)
at-point)))
(modname (unless prompt-value
(haskell-utils-parse-import-statement-at-point)))
(command (cond
(modname
(format ":browse! %s" modname))
((string= ident "") ; For the minibuffer input case
nil)
(t (format (if (string-match "^[a-zA-Z_]" ident)
":info %s"
":info (%s)")
(or ident
at-point))))))
(when command
(haskell-process-show-repl-response command))))))
;;;###autoload
(defun haskell-process-do-type (&optional insert-value)
;; FIXME insert value functionallity seems to be missing.
"Print the type of the given expression.
Given INSERT-VALUE prefix indicates that result type signature
should be inserted."
(interactive "P")
(if insert-value
(haskell-process-insert-type)
(let* ((expr
(if (use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end))
(haskell-ident-at-point)))
(expr-okay (and expr
(not (string-match-p "\\`[[:space:]]*\\'" expr))
(not (string-match-p "\n" expr)))))
;; No newlines in expressions, and surround with parens if it
;; might be a slice expression
(when expr-okay
(haskell-process-show-repl-response
(format
(if (or (string-match-p "\\`(" expr)
(string-match-p "\\`[_[:alpha:]]" expr))
":type %s"
":type (%s)")
expr))))))
;;;###autoload
(defun haskell-mode-jump-to-def-or-tag (&optional _next-p)
;; FIXME NEXT-P arg is not used
"Jump to the definition.
Jump to definition of identifier at point by consulting GHCi, or
tag table as fallback.
Remember: If GHCi is busy doing something, this will delay, but
it will always be accurate, in contrast to tags, which always
work but are not always accurate.
If the definition or tag is found, the location from which you jumped
will be pushed onto `xref--marker-ring', so you can return to that
position with `xref-pop-marker-stack'."
(interactive "P")
(let ((initial-loc (point-marker))
(loc (haskell-mode-find-def (haskell-ident-at-point))))
(if loc
(haskell-mode-handle-generic-loc loc)
(call-interactively 'haskell-mode-tag-find))
(unless (equal initial-loc (point-marker))
(xref-push-marker-stack initial-loc))))
;;;###autoload
(defun haskell-mode-goto-loc ()
"Go to the location of the thing at point.
Requires the :loc-at command from GHCi."
(interactive)
(let ((loc (haskell-mode-loc-at)))
(when loc
(haskell-mode-goto-span loc))))
(defun haskell-mode-goto-span (span)
"Jump to the SPAN, whatever file and line and column it needs to get there."
(xref-push-marker-stack)
(find-file (expand-file-name (plist-get span :path)
(haskell-session-cabal-dir (haskell-interactive-session))))
(goto-char (point-min))
(forward-line (1- (plist-get span :start-line)))
(forward-char (plist-get span :start-col)))
(defun haskell-process-insert-type ()
"Get the identifer at the point and insert its type.
Use GHCi's :type if it's possible."
(let ((ident (haskell-ident-at-point)))
(when ident
(let ((process (haskell-interactive-process))
(query (format (if (string-match "^[_[:lower:][:upper:]]" ident)
":type %s"
":type (%s)")
ident)))
(haskell-process-queue-command
process
(make-haskell-command
:state (list process query (current-buffer))
:go (lambda (state)
(haskell-process-send-string (nth 0 state)
(nth 1 state)))
:complete (lambda (state response)
(cond
;; TODO: Generalize this into a function.
((or (string-match "^Top level" response)
(string-match "^<interactive>" response))
(message response))
(t
(with-current-buffer (nth 2 state)
(goto-char (line-beginning-position))
(insert (format "%s\n" (replace-regexp-in-string "\n$" "" response)))))))))))))
(defun haskell-mode-find-def (ident)
;; TODO Check if it possible to exploit `haskell-process-do-info'
"Find definition location of identifier IDENT.
Uses the GHCi process to find the location. Returns nil if it
can't find the identifier or the identifier isn't a string.
Returns:
(library <package> <module>)
(file <path> <line> <col>)
(module <name>)
nil"
(when (stringp ident)
(let ((reply (haskell-process-queue-sync-request
(haskell-interactive-process)
(format (if (string-match "^[a-zA-Z_]" ident)
":info %s"
":info (%s)")
ident))))
(let ((match (string-match "-- Defined \\(at\\|in\\) \\(.+\\)$" reply)))
(when match
(let ((defined (match-string 2 reply)))
(let ((match (string-match "\\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)$" defined)))
(cond
(match
(list 'file
(expand-file-name (match-string 1 defined)
(haskell-session-current-dir (haskell-interactive-session)))
(string-to-number (match-string 2 defined))
(string-to-number (match-string 3 defined))))
(t
(let ((match (string-match "`\\(.+?\\):\\(.+?\\)'$" defined)))
(if match
(list 'library
(match-string 1 defined)
(match-string 2 defined))
(let ((match (string-match "`\\(.+?\\)'$" defined)))
(if match
(list 'module
(match-string 1 defined)))))))))))))))
;;;###autoload
(defun haskell-mode-jump-to-def (ident)
"Jump to definition of identifier IDENT at point."
(interactive (list (haskell-ident-at-point)))
(let ((loc (haskell-mode-find-def ident)))
(when loc
(haskell-mode-handle-generic-loc loc))))
(defun haskell-mode-handle-generic-loc (loc)
"Either jump to or echo a generic location LOC.
Either a file or a library."
(cl-case (car loc)
(file (haskell-mode-jump-to-loc (cdr loc)))
(library (message "Defined in `%s' (%s)."
(elt loc 2)
(elt loc 1)))
(module (message "Defined in `%s'."
(elt loc 1)))))
(defun haskell-mode-loc-at ()
"Get the location at point.
Requires the :loc-at command from GHCi."
(let ((pos (or (when (region-active-p)
(cons (region-beginning)
(region-end)))
(haskell-spanable-pos-at-point)
(cons (point)
(point)))))
(when pos
(let ((reply (haskell-process-queue-sync-request
(haskell-interactive-process)
(save-excursion
(format ":loc-at %s %d %d %d %d %s"
(buffer-file-name)
(progn (goto-char (car pos))
(line-number-at-pos))
(1+ (current-column)) ;; GHC uses 1-based columns.
(progn (goto-char (cdr pos))
(line-number-at-pos))
(1+ (current-column)) ;; GHC uses 1-based columns.
(buffer-substring-no-properties (car pos)
(cdr pos)))))))
(if reply
(if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
reply)
(list :path (match-string 1 reply)
:start-line (string-to-number (match-string 2 reply))
;; ;; GHC uses 1-based columns.
:start-col (1- (string-to-number (match-string 3 reply)))
:end-line (string-to-number (match-string 4 reply))
;; GHC uses 1-based columns.
:end-col (1- (string-to-number (match-string 5 reply))))
(error (propertize reply 'face 'compilation-error)))
(error (propertize "No reply. Is :loc-at supported?"
'face 'compilation-error)))))))
;;;###autoload
(defun haskell-process-cd (&optional _not-interactive)
;; FIXME optional arg is not used
"Change directory."
(interactive)
(let* ((session (haskell-interactive-session))
(dir (haskell-session-prompt-set-current-dir session)))
(haskell-process-log
(propertize (format "Changing directory to %s ...\n" dir)
'face font-lock-comment-face))
(haskell-process-change-dir session
(haskell-interactive-process)
dir)))
(defun haskell-session-buffer-default-dir (session &optional buffer)
"Try to deduce a sensible default directory for SESSION and BUFFER,
of which the latter defaults to the current buffer."
(or (haskell-session-get session 'current-dir)
(haskell-session-get session 'cabal-dir)
(if (buffer-file-name buffer)
(file-name-directory (buffer-file-name buffer))
"~/")))
(defun haskell-session-prompt-set-current-dir (session &optional use-default)
"Prompt for the current directory.
Return current working directory for SESSION."
(let ((default (haskell-session-buffer-default-dir session)))
(haskell-session-set-current-dir
session
(if use-default
default
(haskell-utils-read-directory-name "Set current directory: " default))))
(haskell-session-get session 'current-dir))
(defun haskell-process-change-dir (session process dir)
"Change SESSION's current directory.
Query PROCESS to `:cd` to directory DIR."
(haskell-process-queue-command
process
(make-haskell-command
:state (list session process dir)
:go
(lambda (state)
(haskell-process-send-string
(cadr state) (format ":cd %s" (cl-caddr state))))
:complete
(lambda (state _)
(haskell-session-set-current-dir (car state) (cl-caddr state))
(haskell-interactive-mode-echo (car state)
(format "Changed directory: %s"
(cl-caddr state)))))))
;;;###autoload
(defun haskell-process-cabal-macros ()
"Send the cabal macros string."
(interactive)
(haskell-process-queue-without-filters (haskell-interactive-process)
":set -optP-include -optPdist/build/autogen/cabal_macros.h"))
(defun haskell-process-do-try-info (sym)
"Get info of SYM and echo in the minibuffer."
(let ((process (haskell-interactive-process)))
(haskell-process-queue-command
process
(make-haskell-command
:state (cons process sym)
:go (lambda (state)
(haskell-process-send-string
(car state)
(if (string-match "^[A-Za-z_]" (cdr state))
(format ":info %s" (cdr state))
(format ":info (%s)" (cdr state)))))
:complete (lambda (_state response)
(unless (or (string-match "^Top level" response)
(string-match "^<interactive>" response))
(haskell-mode-message-line response)))))))
(defun haskell-process-do-try-type (sym)
"Get type of SYM and echo in the minibuffer."
(let ((process (haskell-interactive-process)))
(haskell-process-queue-command
process
(make-haskell-command
:state (cons process sym)
:go (lambda (state)
(haskell-process-send-string
(car state)
(if (string-match "^[A-Za-z_]" (cdr state))
(format ":type %s" (cdr state))
(format ":type (%s)" (cdr state)))))
:complete (lambda (_state response)
(unless (or (string-match "^Top level" response)
(string-match "^<interactive>" response))
(haskell-mode-message-line response)))))))
;;;###autoload
(defun haskell-mode-show-type-at (&optional insert-value)
"Show type of the thing at point or within active region asynchronously.
This function requires GHCi-ng and `:set +c` option enabled by
default (please follow GHCi-ng README available at URL
`https://github.com/chrisdone/ghci-ng').
\\<haskell-interactive-mode-map>
To make this function works sometimes you need to load the file in REPL
first using command `haskell-process-load-or-reload' bound to
\\[haskell-process-load-or-reload].
Optional argument INSERT-VALUE indicates that
recieved type signature should be inserted (but only if nothing
happened since function invocation)."
(interactive "P")
(let* ((pos (haskell-command-capture-expr-bounds))
(req (haskell-utils-compose-type-at-command pos))
(process (haskell-interactive-process))
(buf (current-buffer))
(pos-reg (cons pos (region-active-p))))
(haskell-process-queue-command
process
(make-haskell-command
:state (list process req buf insert-value pos-reg)
:go
(lambda (state)
(let* ((prc (car state))
(req (nth 1 state)))
(haskell-utils-async-watch-changes)
(haskell-process-send-string prc req)))
:complete
(lambda (state response)
(let* ((init-buffer (nth 2 state))
(insert-value (nth 3 state))
(pos-reg (nth 4 state))
(wrap (cdr pos-reg))
(min-pos (caar pos-reg))
(max-pos (cdar pos-reg))
(sig (haskell-utils-reduce-string response))
(res-type (haskell-utils-parse-repl-response sig)))
(cl-case res-type
;; neither popup presentation buffer
;; nor insert response in error case
('unknown-command
(message
(concat
"This command requires GHCi-ng. "
"Please read command description for details.")))
('option-missing
(message
(concat
"Could not infer type signature. "
"You need to load file first. "
"Also :set +c is required. "
"Please read command description for details.")))
('interactive-error (message "Wrong REPL response: %s" sig))
(otherwise
(if insert-value
;; Only insert type signature and do not present it
(if (= (length haskell-utils-async-post-command-flag) 1)
(if wrap
;; Handle region case
(progn
(deactivate-mark)
(save-excursion
(delete-region min-pos max-pos)
(goto-char min-pos)
(insert (concat "(" sig ")"))))
;; Non-region cases
(haskell-command-insert-type-signature sig))
;; Some commands registered, prevent insertion
(let* ((rev (reverse haskell-utils-async-post-command-flag))
(cs (format "%s" (cdr rev))))
(message
(concat
"Type signature insertion was prevented. "
"These commands were registered:"
cs))))
;; Present the result only when response is valid and not asked
;; to insert result
(haskell-command-echo-or-present response)))
(haskell-utils-async-stop-watching-changes init-buffer))))))))
;;;###autoload
(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
function `xref-find-definitions' after new table was generated."
(interactive)
(let ((process (haskell-interactive-process)))
(haskell-process-queue-command
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 f \\( -name '*.hs' -or -name '*.lhs' -or -name '*.hsc' \\) -not \\( -name '#*' -or -name '.*' \\) -print0"
"xargs -0 hasktags -e -x"))))
:complete (lambda (state _response)
(when (cdr state)
(let ((session-tags
(haskell-session-tags-filename
(haskell-process-session (car state)))))
(add-to-list 'tags-table-list session-tags)
(setq tags-file-name nil))
(xref-find-definitions (cdr state)))
(haskell-mode-message-line "Tags generated."))))))
(defun haskell-process-add-cabal-autogen ()
"Add cabal's autogen dir to the GHCi search path.
Add <cabal-project-dir>/dist/build/autogen/ to GHCi seatch path.
This allows modules such as 'Path_...', generated by cabal, to be
loaded by GHCi."
(unless (eq 'cabal-repl (haskell-process-type)) ;; redundant with "cabal repl"
(let*
((session (haskell-interactive-session))
(cabal-dir (haskell-session-cabal-dir session))
(ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir)))
(haskell-process-queue-without-filters
(haskell-interactive-process)
(format ":set -i%s" ghci-gen-dir)))))
;;;###autoload
(defun haskell-process-unignore ()
"Unignore any ignored files.
Do not ignore files that were specified as being ignored by the
inferior GHCi process."
(interactive)
(let ((session (haskell-interactive-session))
(changed nil))
(if (null (haskell-session-get session
'ignored-files))
(message "Nothing to unignore!")
(cl-loop for file in (haskell-session-get session
'ignored-files)
do (cl-case (read-event
(propertize (format "Set permissions? %s (y, n, v: stop and view file)"
file)
'face 'minibuffer-prompt))
(?y
(haskell-process-unignore-file session file)
(setq changed t))
(?v
(find-file file)
(cl-return))))
(when (and changed
(y-or-n-p "Restart GHCi process now? "))
(haskell-process-restart)))))
;;;###autoload
(defun haskell-session-change-target (target)
"Set the build TARGET for cabal REPL."
(interactive
(list
(completing-read "New build target: " (haskell-cabal-enum-targets)
nil nil nil 'haskell-cabal-targets-history)))
(let* ((session haskell-session)
(old-target (haskell-session-get session 'target)))
(when session
(haskell-session-set-target session target)
(when (and (not (string= old-target target))
(y-or-n-p "Target changed, restart haskell process?"))
(haskell-process-start session)))))
;;;###autoload
(defun haskell-mode-stylish-buffer ()
"Apply stylish-haskell to the current buffer."
(interactive)
(let ((column (current-column))
(line (line-number-at-pos)))
(haskell-mode-buffer-apply-command "stylish-haskell")
(goto-char (point-min))
(forward-line (1- line))
(goto-char (+ column (point)))))
(defun haskell-mode-buffer-apply-command (cmd)
"Execute shell command CMD with current buffer as input and output.
Use buffer as input and replace the whole buffer with the
output. If CMD fails the buffer remains unchanged."
(set-buffer-modified-p t)
(let* ((chomp (lambda (str)
(while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
(setq str (replace-match "" t t str)))
str))
(_errout (lambda (fmt &rest args)
(let* ((warning-fill-prefix " "))
(display-warning cmd (apply 'format fmt args) :warning))))
(filename (buffer-file-name (current-buffer)))
(cmd-prefix (replace-regexp-in-string " .*" "" cmd))
(tmp-file (make-temp-file cmd-prefix))
(err-file (make-temp-file cmd-prefix))
(default-directory (if (and (boundp 'haskell-session)
haskell-session)
(haskell-session-cabal-dir haskell-session)
default-directory))
(_errcode (with-temp-file tmp-file
(call-process cmd filename
(list (current-buffer) err-file) nil)))
(stderr-output
(with-temp-buffer
(insert-file-contents err-file)
(funcall chomp (buffer-substring-no-properties (point-min) (point-max)))))
(stdout-output
(with-temp-buffer
(insert-file-contents tmp-file)
(buffer-substring-no-properties (point-min) (point-max)))))
(if (string= "" stderr-output)
(if (string= "" stdout-output)
(message "Error: %s produced no output, leaving buffer alone" cmd)
(save-restriction
(widen)
;; command successful, insert file with replacement to preserve
;; markers.
(insert-file-contents tmp-file nil nil nil t)))
(progn
;; non-null stderr, command must have failed
(message "Error: %s ended with errors, leaving buffer alone" cmd)
;; use (warning-minimum-level :debug) to see this
(display-warning cmd stderr-output :debug)))
(delete-file tmp-file)
(delete-file err-file)))
;;;###autoload
(defun haskell-mode-find-uses ()
"Find use cases of the identifier at point and highlight them all."
(interactive)
(let ((spans (haskell-mode-uses-at)))
(unless (null spans)
(highlight-uses-mode 1)
(cl-loop for span in spans
do (haskell-mode-make-use-highlight span)))))
(defun haskell-mode-make-use-highlight (span)
"Make a highlight overlay at the given SPAN."
(save-window-excursion
(save-excursion
(haskell-mode-goto-span span)
(save-excursion
(highlight-uses-mode-highlight
(progn
(goto-char (point-min))
(forward-line (1- (plist-get span :start-line)))
(forward-char (plist-get span :start-col))
(point))
(progn
(goto-char (point-min))
(forward-line (1- (plist-get span :end-line)))
(forward-char (plist-get span :end-col))
(point)))))))
(defun haskell-mode-uses-at ()
"Get the locations of use cases for the ident at point.
Requires the :uses command from GHCi."
(let ((pos (or (when (region-active-p)
(cons (region-beginning)
(region-end)))
(haskell-ident-pos-at-point)
(cons (point)
(point)))))
(when pos
(let ((reply (haskell-process-queue-sync-request
(haskell-interactive-process)
(save-excursion
(format ":uses %s %d %d %d %d %s"
(buffer-file-name)
(progn (goto-char (car pos))
(line-number-at-pos))
(1+ (current-column)) ;; GHC uses 1-based columns.
(progn (goto-char (cdr pos))
(line-number-at-pos))
(1+ (current-column)) ;; GHC uses 1-based columns.
(buffer-substring-no-properties (car pos)
(cdr pos)))))))
(if reply
(let ((lines (split-string reply "\n" t)))
(cl-remove-if
#'null
(mapcar (lambda (line)
(if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
line)
(list :path (match-string 1 line)
:start-line (string-to-number (match-string 2 line))
;; ;; GHC uses 1-based columns.
:start-col (1- (string-to-number (match-string 3 line)))
:end-line (string-to-number (match-string 4 line))
;; GHC uses 1-based columns.
:end-col (1- (string-to-number (match-string 5 line))))
(error (propertize line 'face 'compilation-error))))
lines)))
(error (propertize "No reply. Is :uses supported?"
'face 'compilation-error)))))))
(defun haskell-command-echo-or-present (msg)
"Present message in some manner depending on configuration.
If variable `haskell-process-use-presentation-mode' is NIL it will output
modified message MSG to echo area."
(if haskell-process-use-presentation-mode
(let ((session (haskell-process-session (haskell-interactive-process))))
(haskell-presentation-present session msg))
(let ((m (haskell-utils-reduce-string msg)))
(message m))))
(defun haskell-command-capture-expr-bounds ()
"Capture position bounds of expression at point.
If there is an active region then it returns region
bounds. Otherwise it uses `haskell-spanable-pos-at-point` to
capture identifier bounds. If latter function returns NIL this function
will return cons cell where min and max positions both are equal
to point."
(or (when (region-active-p)
(cons (region-beginning)
(region-end)))
(haskell-spanable-pos-at-point)
(cons (point) (point))))
(defun haskell-command-insert-type-signature (signature)
"Insert type signature.
In case of active region is present, wrap it by parentheses and
append SIGNATURE to original expression. Otherwise tries to
carefully insert SIGNATURE above identifier at point. Removes
newlines and extra whitespace in signature before insertion."
(let* ((ident-pos (or (haskell-ident-pos-at-point)
(cons (point) (point))))
(min-pos (car ident-pos))
(sig (haskell-utils-reduce-string signature)))
(save-excursion
(goto-char min-pos)
(let ((col (current-column)))
(insert sig "\n")
(indent-to col)))))
(provide 'haskell-commands)
;;; haskell-commands.el ends here

70
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-compat.el

@ -0,0 +1,70 @@
;;; haskell-compat.el --- legacy/compatibility backports for haskell-mode -*- lexical-binding: t -*-
;;
;; Filename: haskell-compat.el
;; Description: legacy/compatibility backports for haskell-mode
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'etags)
(require 'ring)
(require 'outline)
(require 'xref nil t)
(eval-when-compile
(setq byte-compile-warnings '(not cl-functions obsolete)))
;; Missing in Emacs23, stolen from Emacs24's `subr.el'
(unless (fboundp 'process-live-p)
(defun process-live-p (process)
"Returns non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
`listen', `connect' or `stop'."
(memq (process-status process)
'(run open listen connect stop))))
;; Cross-referencing commands have been replaced since Emacs 25.1.
;; These aliases are required to provide backward compatibility.
(unless (fboundp 'xref-push-marker-stack)
(defalias 'xref-pop-marker-stack 'pop-tag-mark)
(defun xref-push-marker-stack (&optional m)
"Add point to the marker stack."
(ring-insert find-tag-marker-ring (or m (point-marker)))))
(unless (fboundp 'outline-hide-sublevels)
(defalias 'outline-hide-sublevels 'hide-sublevels))
(unless (fboundp 'outline-show-subtree)
(defalias 'outline-show-subtree 'show-subtree))
(unless (fboundp 'outline-hide-sublevels)
(defalias 'outline-hide-sublevels 'hide-sublevels))
(unless (fboundp 'outline-show-subtree)
(defalias 'outline-show-subtree 'show-subtree))
(unless (fboundp 'xref-find-definitions)
(defun xref-find-definitions (ident)
(let ((next-p (and (boundp 'xref-prompt-for-identifier)
xref-prompt-for-identifier)))
(find-tag ident next-p))))
(provide 'haskell-compat)
;;; haskell-compat.el ends here

163
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-compile.el

@ -0,0 +1,163 @@
;;; haskell-compile.el --- Haskell/GHC compilation sub-mode -*- lexical-binding: t -*-
;; Copyright (C) 2013 Herbert Valerio Riedel
;; Author: Herbert Valerio Riedel <hvr@gnu.org>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Simple GHC-centric compilation sub-mode; see info node
;; `(haskell-mode)compilation' for more information
;;; Code:
(require 'compile)
(require 'haskell-cabal)
;;;###autoload
(defgroup haskell-compile nil
"Settings for Haskell compilation mode"
:link '(custom-manual "(haskell-mode)compilation")
:group 'haskell)
;;;###autoload
(defcustom haskell-compile-cabal-build-command
"cd %s && cabal build --ghc-option=-ferror-spans"
"Default build command to use for `haskell-cabal-build' when a cabal file is detected.
The `%s' placeholder is replaced by the cabal package top folder."
:group 'haskell-compile
:type 'string)
;;;###autoload
(defcustom haskell-compile-cabal-build-alt-command
"cd %s && cabal clean -s && cabal build --ghc-option=-ferror-spans"
"Alternative build command to use when `haskell-cabal-build' is called with a negative prefix argument.
The `%s' placeholder is replaced by the cabal package top folder."
:group 'haskell-compile
:type 'string)
;;;###autoload
(defcustom haskell-compile-command
"ghc -Wall -ferror-spans -fforce-recomp -c %s"
"Default build command to use for `haskell-cabal-build' when no cabal file is detected.
The `%s' placeholder is replaced by the current buffer's filename."
:group 'haskell-compile
:type 'string)
;;;###autoload
(defcustom haskell-compile-ghc-filter-linker-messages
t
"Filter out unremarkable \"Loading package...\" linker messages during compilation."
:group 'haskell-compile
:type 'boolean)
(defconst haskell-compilation-error-regexp-alist
`((,(concat
"^ *\\(?1:[^ \t\r\n]+?\\):"
"\\(?:"
"\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?" ;; "121:1" & "12:3-5"
"\\|"
"(\\(?2:[0-9]+\\),\\(?4:[0-9]+\\))-(\\(?3:[0-9]+\\),\\(?5:[0-9]+\\))" ;; "(289,5)-(291,36)"
"\\)"
":\\(?6: Warning:\\)?")
1 (2 . 3) (4 . 5) (6 . nil)) ;; error/warning locus
;; multiple declarations
("^ \\(?:Declared at:\\| \\) \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)$"
1 2 4 0) ;; info locus
;; this is the weakest pattern as it's subject to line wrapping et al.
(" at \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?[)]?$"
1 2 (4 . 5) 0)) ;; info locus
"Regexps used for matching GHC compile messages.
See `compilation-error-regexp-alist' for semantics.")
(defvar haskell-compilation-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map compilation-mode-map))
"Keymap for `haskell-compilation-mode' buffers.
This is a child of `compilation-mode-map'.")
(defun haskell-compilation-filter-hook ()
"Local `compilation-filter-hook' for `haskell-compilation-mode'."
(when haskell-compile-ghc-filter-linker-messages
(delete-matching-lines "^ *Loading package [^ \t\r\n]+ [.]+ linking [.]+ done\\.$"
(if (boundp 'compilation-filter-start) ;; available since Emacs 24.2
(save-excursion (goto-char compilation-filter-start)
(line-beginning-position))
(point-min))
(point))))
(define-compilation-mode haskell-compilation-mode "HsCompilation"
"Haskell/GHC specific `compilation-mode' derivative.
This mode provides support for GHC 7.[46]'s compile
messages. Specifically, also the `-ferror-spans` source location
format is supported, as well as info-locations within compile
messages pointing to additional source locations.
See Info node `(haskell-mode)compilation' for more details."
(set (make-local-variable 'compilation-error-regexp-alist)
haskell-compilation-error-regexp-alist)
(add-hook 'compilation-filter-hook
'haskell-compilation-filter-hook nil t)
)
;;;###autoload
(defun haskell-compile (&optional edit-command)
"Compile the Haskell program including the current buffer.
Tries to locate the next cabal description in current or parent
folders via `haskell-cabal-find-dir' and if found, invoke
`haskell-compile-cabal-build-command' from the cabal package root
folder. If no cabal package could be detected,
`haskell-compile-command' is used instead.
If prefix argument EDIT-COMMAND is non-nil (and not a negative
prefix `-'), `haskell-compile' prompts for custom compile
command.
If EDIT-COMMAND contains the negative prefix argument `-',
`haskell-compile' calls the alternative command defined in
`haskell-compile-cabal-build-alt-command' if a cabal package was
detected.
`haskell-compile' uses `haskell-compilation-mode' which is
derived from `compilation-mode'. See Info
node `(haskell-mode)compilation' for more details."
(interactive "P")
(save-some-buffers (not compilation-ask-about-save)
(if (boundp 'compilation-save-buffers-predicate) ;; since Emacs 24.1(?)
compilation-save-buffers-predicate))
(let* ((cabdir (haskell-cabal-find-dir))
(command1 (if (eq edit-command '-)
haskell-compile-cabal-build-alt-command
haskell-compile-cabal-build-command))
(srcname (buffer-file-name))
(command (if cabdir
(format command1 cabdir)
(if (and srcname (derived-mode-p 'haskell-mode))
(format haskell-compile-command srcname)
command1))))
(when (and edit-command (not (eq edit-command '-)))
(setq command (compilation-read-command command)))
(compilation-start command 'haskell-compilation-mode)))
(provide 'haskell-compile)
;;; haskell-compile.el ends here

133
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-complete-module.el

@ -0,0 +1,133 @@
;;; haskell-complete-module.el --- A fast way to complete Haskell module names -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
;;;###autoload
(defcustom haskell-complete-module-preferred
'()
"Override ordering of module results by specifying preferred modules."
:group 'haskell
:type '(repeat string))
;;;###autoload
(defcustom haskell-complete-module-max-display
10
"Maximum items to display in minibuffer."
:group 'haskell
:type 'number)
(defun haskell-complete-module-read (prompt candidates)
"Interactively auto-complete from a list of candidates."
(let ((stack (list))
(pattern "")
(result nil))
(delete-dups candidates)
(setq candidates
(sort candidates
(lambda (a b)
(let ((a-mem (member a haskell-complete-module-preferred))
(b-mem (member b haskell-complete-module-preferred)))
(cond
((and a-mem (not b-mem))
t)
((and b-mem (not a-mem))
nil)
(t
(string< a b)))))))
(while (not result)
(let ((key
(key-description
(vector
(read-key
(concat (propertize prompt 'face 'minibuffer-prompt)
(propertize pattern 'face 'font-lock-type-face)
"{"
(mapconcat #'identity
(let* ((i 0))
(cl-loop for candidate in candidates
while (<= i haskell-complete-module-max-display)
do (cl-incf i)
collect (cond ((> i haskell-complete-module-max-display)
"...")
((= i 1)
(propertize candidate 'face 'ido-first-match-face))
(t candidate))))
" | ")
"}"))))))
(cond
((string= key "C-g")
(keyboard-quit))
((string= key "DEL")
(unless (null stack)
(setq candidates (pop stack)))
(unless (string= "" pattern)
(setq pattern (substring pattern 0 -1))))
((string= key "RET")
(setq result (or (car candidates)
pattern)))
((string= key "<left>")
(setq candidates
(append (last candidates)
(butlast candidates))))
((string= key "<right>")
(setq candidates
(append (cdr candidates)
(list (car candidates)))))
(t
(when (string-match "[A-Za-z0-9_'.]+" key)
(push candidates stack)
(setq pattern (concat pattern key))
(setq candidates (haskell-complete-module pattern candidates)))))))
result))
(defun haskell-complete-module (pattern candidates)
"Filter the CANDIDATES using PATTERN."
(let ((case-fold-search t))
(cl-loop for candidate in candidates
when (haskell-complete-module-match pattern candidate)
collect candidate)))
(defun haskell-complete-module-match (pattern text)
"Match PATTERN against TEXT."
(string-match (haskell-complete-module-regexp pattern)
text))
(defun haskell-complete-module-regexp (pattern)
"Make a regular expression for the given module pattern. Example:
\"c.m.s\" -> \"^c[^.]*\\.m[^.]*\\.s[^.]*\"
"
(let ((components (mapcar #'haskell-complete-module-component
(split-string pattern "\\." t))))
(concat "^"
(mapconcat #'identity
components
"\\."))))
(defun haskell-complete-module-component (component)
"Make a regular expression for the given component. Example:
\"co\" -> \"c[^.]*o[^.]*\"
"
(replace-regexp-in-string "\\(.\\)" "\\1[^.]*" component))
(provide 'haskell-complete-module)

266
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-completions.el

@ -0,0 +1,266 @@
;;; haskell-completions.el --- Haskell Completion package -*- lexical-binding: t -*-
;; Copyright © 2015 Athur Fayzrakhmanov. All rights reserved.
;; This file is part of haskell-mode package.
;; You can contact with authors using GitHub issue tracker:
;; https://github.com/haskell/haskell-mode/issues
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This package provides completions related functionality for
;; Haskell Mode such grab completion prefix at point, and etc..
;; Some description
;; ================
;;
;; For major use function `haskell-completions-grab-prefix' is supposed, and
;; other prefix grabbing functions are used internally by it. So, only this
;; funciton have prefix minimal length functionality and invokes predicate
;; function `haskell-completions-can-grab-prefix'.
;;; Code:
(require 'haskell-mode)
(require 'haskell-process)
(require 'haskell-interactive-mode)
(defvar haskell-completions-pragma-names
(list "DEPRECATED"
"INCLUDE"
"INCOHERENT"
"INLINABLE"
"INLINE"
"LANGUAGE"
"LINE"
"MINIMAL"
"NOINLINE"
"NOUNPACK"
"OPTIONS"
"OPTIONS_GHC"
"OVERLAPPABLE"
"OVERLAPPING"
"OVERLAPS"
"RULES"
"SOURCE"
"SPECIALIZE"
"UNPACK"
"WARNING")
"A list of supported pragmas.
This list comes from GHC documentation (URL
`https://downloads.haskell.org/~ghc/7.10.1/docs/html/users_guide/pragmas.html'.
")
(defun haskell-completions-can-grab-prefix ()
"Check if the case is appropriate for grabbing completion prefix.
Returns t if point is either at whitespace character, or at
punctuation, or at line end and preceeding character is not a
whitespace or new line, otherwise returns nil.
Returns nil in presense of active region."
(when (not (region-active-p))
(when (looking-at-p (rx (| space line-end punct)))
(when (not (bobp))
(save-excursion
(backward-char)
(not (looking-at-p (rx (| space line-end)))))))))
(defun haskell-completions-grab-pragma-prefix ()
"Grab completion prefix for pragma completions.
Returns a list of form '(prefix-start-position
prefix-end-position prefix-value prefix-type) for pramga names
such as WARNING, DEPRECATED, LANGUAGE and etc. Also returns
completion prefixes for options in case OPTIONS_GHC pragma, or
language extensions in case of LANGUAGE pragma. Obsolete OPTIONS
pragma is supported also."
(when (nth 4 (syntax-ppss))
;; We're inside comment
(let ((p (point))
(comment-start (nth 8 (syntax-ppss)))
(case-fold-search nil)
prefix-start
prefix-end
prefix-type
prefix-value)
(save-excursion
(goto-char comment-start)
(when (looking-at (rx "{-#" (1+ (| space "\n"))))
(let ((pragma-start (match-end 0)))
(when (> p pragma-start)
;; point stands after `{-#`
(goto-char pragma-start)
(when (looking-at (rx (1+ (| upper "_"))))
;; found suitable sequence for pragma name
(let ((pragma-end (match-end 0))
(pragma-value (match-string-no-properties 0)))
(if (eq p pragma-end)
;; point is at the end of (in)complete pragma name
;; prepare resulting values
(progn
(setq prefix-start pragma-start)
(setq prefix-end pragma-end)
(setq prefix-value pragma-value)
(setq prefix-type
'haskell-completions-pragma-name-prefix))
(when (and (> p pragma-end)
(or (equal "OPTIONS_GHC" pragma-value)
(equal "OPTIONS" pragma-value)
(equal "LANGUAGE" pragma-value)))
;; point is after pragma name, so we need to check
;; special cases of `OPTIONS_GHC` and `LANGUAGE` pragmas
;; and provide a completion prefix for possible ghc
;; option or language extension.
(goto-char pragma-end)
(when (re-search-forward
(rx (* anything)
(1+ (regexp "\\S-")))
p
t)
(let* ((str (match-string-no-properties 0))
(split (split-string str (rx (| space "\n")) t))
(val (car (last split)))
(end (point)))
(when (and (equal p end)
(not (string-match-p "#" val)))
(setq prefix-value val)
(backward-char (length val))
(setq prefix-start (point))
(setq prefix-end end)
(setq
prefix-type
(if (not (equal "LANGUAGE" pragma-value))
'haskell-completions-ghc-option-prefix
'haskell-completions-language-extension-prefix
)))))))))))))
(when prefix-value
(list prefix-start prefix-end prefix-value prefix-type)))))
(defun haskell-completions-grab-identifier-prefix ()
"Grab completion prefix for identifier at point.
Returns a list of form '(prefix-start-position
prefix-end-position prefix-value prefix-type) for haskell
identifier at point depending on result of function
`haskell-ident-pos-at-point'."
(let ((pos-at-point (haskell-ident-pos-at-point))
(p (point)))
(when pos-at-point
(let* ((start (car pos-at-point))
(end (cdr pos-at-point))
(type 'haskell-completions-identifier-prefix)
(case-fold-search nil)
value)
;; we need end position of result, becase of
;; `haskell-ident-pos-at-point' ignores trailing whitespace, e.g. the
;; result will be same for `map|` and `map |` invocations.
(when (<= p end)
(setq end p)
(setq value (buffer-substring-no-properties start end))
(when (string-match-p (rx bos upper) value)
;; we need to check if found identifier is a module name
(save-excursion
(goto-char (line-beginning-position))
(when (re-search-forward
(rx "import"
(? (1+ space) "qualified")
(1+ space)
upper
(1+ (| alnum ".")))
p ;; bound
t) ;; no-error
(if (equal p (point))
(setq type 'haskell-completions-module-name-prefix)
(when (re-search-forward
(rx (| " as " "("))
start
t)
;; but uppercase ident could occur after `as` keyword, or in
;; module imports after opening parenthesis, in this case
;; restore identifier type again, it's neccessary to
;; distinguish the means of completions retrieval
(setq type 'haskell-completions-identifier-prefix))))))
(when (nth 8 (syntax-ppss))
;; eighth element of syntax-ppss result is string or comment start,
;; so when it's not nil word at point is inside string or comment,
;; return special literal prefix type
(setq type 'haskell-completions-general-prefix))
;; finally take in account minlen if given and return the result
(when value (list start end value type)))))))
(defun haskell-completions-grab-prefix (&optional minlen)
"Grab prefix at point for possible completion.
Returns a list of form '(prefix-start-position
prefix-end-position prefix-value prefix-type) depending on
situation, e.g. is it needed to complete pragma, module name,
arbitrary identifier, and etc. Rerurns nil in case it is
impossible to grab prefix.
If provided optional MINLEN parameter this function will return
result only if prefix length is not less than MINLEN."
(when (haskell-completions-can-grab-prefix)
(let ((prefix (cond
((haskell-completions-grab-pragma-prefix))
((haskell-completions-grab-identifier-prefix)))))
(cond ((and minlen prefix)
(when (>= (length (nth 2 prefix)) minlen)
prefix))
(prefix prefix)))))
(defun haskell-completions-sync-completions-at-point ()
"A `completion-at-point' function using the current haskell process.
Returns nil if no completions available."
(let ((prefix-data (haskell-completions-grab-prefix)))
(when prefix-data
(cl-destructuring-bind (beg end pfx typ) prefix-data
(let ((imp (eql typ 'haskell-completions-module-name-prefix))
lst)
(setq lst
(cl-case typ
;; non-interactive completions first
('haskell-completions-pragma-name-prefix
haskell-completions-pragma-names)
('haskell-completions-ghc-option-prefix
haskell-ghc-supported-options)
('haskell-completions-language-extension-prefix
haskell-ghc-supported-extensions)
(otherwise
(when (and
(not (eql typ 'haskell-completions-general-prefix))
(haskell-session-maybe)
(not
(haskell-process-cmd (haskell-interactive-process))))
;; if REPL is available and not busy try to query it
;; for completions list in case of module name or
;; identifier prefixes
(haskell-completions-sync-complete-repl pfx imp)))))
(when lst
(list beg end lst)))))))
(defun haskell-completions-sync-complete-repl (prefix &optional import)
"Return completion list for given PREFIX quering REPL synchronously.
When optional IMPORT argument is non-nil complete PREFIX
prepending \"import \" keyword (useful for module names). This
function is supposed for internal use."
(haskell-process-get-repl-completions
(haskell-interactive-process)
(if import
(concat "import " prefix)
prefix)))
(provide 'haskell-completions)
;;; haskell-completions.el ends here

429
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-customize.el

@ -0,0 +1,429 @@
;;; haskell-customize.el --- Customization settings -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization variables
;;;###autoload
(defcustom haskell-process-load-or-reload-prompt nil
"Nil means there will be no prompts on starting REPL. Defaults will be accepted."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defgroup haskell nil
"Major mode for editing Haskell programs."
:link '(custom-manual "(haskell-mode)")
:group 'languages
:prefix "haskell-")
(defvar haskell-mode-pkg-base-dir (file-name-directory load-file-name)
"Package base directory of installed `haskell-mode'.
Used for locating additional package data files.")
;;;###autoload
(defcustom haskell-completing-read-function 'ido-completing-read
"Default function to use for completion."
:group 'haskell
:type '(choice
(function-item :tag "ido" :value ido-completing-read)
(function-item :tag "helm" :value helm--completing-read-default)
(function-item :tag "completing-read" :value completing-read)
(function :tag "Custom function")))
;;;###autoload
(defcustom haskell-process-type
'auto
"The inferior Haskell process type to use.
When set to 'auto (the default), the directory contents and
available programs will be used to make a best guess at the
process type:
If the project directory or one of its parents contains a
\"cabal.sandbox.config\" file, then cabal-repl will be used.
If there's a \"stack.yaml\" file and the \"stack\" executable can
be located, then stack-ghci will be used.
Otherwise if there's a *.cabal file, cabal-repl will be used.
If none of the above apply, ghci will be used."
:type '(choice (const auto) (const ghci) (const cabal-repl) (const stack-ghci))
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-wrapper-function
#'identity
"Wrap or transform haskell process commands using this function.
Can be set to a custom function which takes a list of arguments
and returns a possibly-modified list.
The following example function arranges for all haskell process
commands to be started in the current nix-shell environment:
(lambda (argv) (append (list \"nix-shell\" \"-I\" \".\" \"--command\" )
(list (mapconcat 'identity argv \" \"))))
See Info Node `(emacs)Directory Variables' for a way to set this option on
a per-project basis."
:group 'haskell-interactive
:type '(choice
(function-item :tag "None" :value identity)
(function :tag "Custom function")))
;;;###autoload
(defcustom haskell-ask-also-kill-buffers
t
"Ask whether to kill all associated buffers when a session
process is killed."
:type 'boolean
:group 'haskell-interactive)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Configuration
;;;###autoload
(defcustom haskell-doc-prettify-types t
"Replace some parts of types with Unicode characters like \"\"
when showing type information about symbols."
:group 'haskell-doc
:type 'boolean
:safe 'booleanp)
(defvar haskell-process-end-hook nil
"Hook for when the haskell process ends.")
;;;###autoload
(defgroup haskell-interactive nil
"Settings for REPL interaction via `haskell-interactive-mode'"
:link '(custom-manual "(haskell-mode)haskell-interactive-mode")
:group 'haskell)
;;;###autoload
(defcustom haskell-process-path-ghci
"ghci"
"The path for starting ghci."
:group 'haskell-interactive
:type '(choice string (repeat string)))
;;;###autoload
(defcustom haskell-process-path-cabal
"cabal"
"Path to the `cabal' executable."
:group 'haskell-interactive
:type '(choice string (repeat string)))
;;;###autoload
(defcustom haskell-process-path-stack
"stack"
"The path for starting stack."
:group 'haskell-interactive
:type '(choice string (repeat string)))
;;;###autoload
(defcustom haskell-process-args-ghci
'("-ferror-spans")
"Any arguments for starting ghci."
:group 'haskell-interactive
:type '(repeat (string :tag "Argument")))
;;;###autoload
(defcustom haskell-process-args-cabal-repl
'("--ghc-option=-ferror-spans")
"Additional arguments for `cabal repl' invocation.
Note: The settings in `haskell-process-path-ghci' and
`haskell-process-args-ghci' are not automatically reused as `cabal repl'
currently invokes `ghc --interactive'. Use
`--with-ghc=<path-to-executable>' if you want to use a different
interactive GHC frontend; use `--ghc-option=<ghc-argument>' to
pass additional flags to `ghc'."
:group 'haskell-interactive
:type '(repeat (string :tag "Argument")))
;;;###autoload
(defcustom haskell-process-args-stack-ghci
'("--ghc-options=-ferror-spans")
"Additional arguments for `stack ghci' invocation."
:group 'haskell-interactive
:type '(repeat (string :tag "Argument")))
;;;###autoload
(defcustom haskell-process-do-cabal-format-string
":!cd %s && %s"
"The way to run cabal comands. It takes two arguments -- the directory and the command.
See `haskell-process-do-cabal' for more details."
:group 'haskell-interactive
:type 'string)
;;;###autoload
(defcustom haskell-process-log
nil
"Enable debug logging to \"*haskell-process-log*\" buffer."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-show-debug-tips
t
"Show debugging tips when starting the process."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-notify-p
nil
"Notify using notifications.el (if loaded)?"
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-no-warn-orphans
t
"Suggest adding -fno-warn-orphans pragma to file when getting orphan warnings."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-hoogle-imports
nil
"Suggest to add import statements using Hoogle as a backend."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-hayoo-imports
nil
"Suggest to add import statements using Hayoo as a backend."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-hayoo-query-url
"http://hayoo.fh-wedel.de/json/?query=%s"
"Query url for json hayoo results."
:type 'string
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-haskell-docs-imports
nil
"Suggest to add import statements using haskell-docs as a backend."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-add-package
t
"Suggest to add packages to your .cabal file when Cabal says it
is a member of the hidden package, blah blah."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-language-pragmas
t
"Suggest adding LANGUAGE pragmas recommended by GHC."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-remove-import-lines
nil
"Suggest removing import lines as warned by GHC."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-overloaded-strings
t
"Suggest adding OverloadedStrings pragma to file when getting type mismatches with [Char]."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-check-cabal-config-on-load
t
"Check changes cabal config on loading Haskell files and
restart the GHCi process if changed.."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-prompt-restart-on-cabal-change
t
"Ask whether to restart the GHCi process when the Cabal file
has changed?"
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-auto-import-loaded-modules
nil
"Auto import the modules reported by GHC to have been loaded?"
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-reload-with-fbytecode
nil
"When using -fobject-code, auto reload with -fbyte-code (and
then restore the -fobject-code) so that all module info and
imports become available?"
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-use-presentation-mode
nil
"Use presentation mode to show things like type info instead of
printing to the message area."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-process-suggest-restart
t
"Suggest restarting the process when it has died"
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-mode-scroll-to-bottom
nil
"Scroll to bottom in the REPL always."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-popup-errors
t
"Popup errors in a separate buffer."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-mode-collapse
nil
"Collapse printed results."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-types-for-show-ambiguous
t
"Show types when there's no Show instance or there's an
ambiguous class constraint."
:type 'boolean
:group 'haskell-interactive)
(defvar haskell-interactive-prompt "λ> "
"The prompt to use.")
;;;###autoload
(defcustom haskell-interactive-mode-eval-mode
nil
"Use the given mode's font-locking to render some text."
:type '(choice function (const :tag "None" nil))
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-mode-hide-multi-line-errors
nil
"Hide collapsible multi-line compile messages by default."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-mode-delete-superseded-errors
t
"Whether to delete compile messages superseded by recompile/reloads."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-interactive-mode-include-file-name
t
"Include the file name of the module being compiled when
printing compilation messages."
:type 'boolean
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-import-mapping
'()
"Support a mapping from module to import lines.
E.g. '((\"Data.Map\" . \"import qualified Data.Map as M
import Data.Map (Map)
\"))
This will import
import qualified Data.Map as M
import Data.Map (Map)
when Data.Map is the candidate.
"
:type '(repeat (cons (string :tag "Module name")
(string :tag "Import lines")))
:group 'haskell-interactive)
;;;###autoload
(defcustom haskell-language-extensions
'()
"Language extensions in use. Should be in format: -XFoo,
-XNoFoo etc. The idea is that various tools written with HSE (or
any haskell-mode code that needs to be aware of syntactical
properties; such as an indentation mode) that don't know what
extensions to use can use this variable. Examples: hlint,
hindent, structured-haskell-mode, tool-de-jour, etc.
You can set this per-project with a .dir-locals.el file, in the
same vein as `haskell-indent-spaces'."
:group 'haskell
:type '(repeat 'string))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Accessor functions
(defun haskell-process-type ()
"Return `haskell-process-type', or a guess if that variable is 'auto."
(if (eq 'auto haskell-process-type)
(cond
;; User has explicitly initialized this project with cabal
((locate-dominating-file default-directory "cabal.sandbox.config")
'cabal-repl)
((and (locate-dominating-file default-directory "stack.yaml")
(executable-find "stack"))
'stack-ghci)
((locate-dominating-file
default-directory
(lambda (d)
(cl-find-if (lambda (f) (string-match-p ".\\.cabal\\'" f)) (directory-files d))))
'cabal-repl)
(t 'ghci))
haskell-process-type))
(provide 'haskell-customize)

744
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-debug.el

@ -0,0 +1,744 @@
;;; haskell-debug.el --- Debugging mode via GHCi -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'haskell-session)
(require 'haskell-process)
(require 'haskell-interactive-mode)
(require 'haskell-font-lock)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Configuration
;;;###autoload
(defgroup haskell-debug nil
"Settings for debugging support."
:link '(custom-manual "(haskell-mode)haskell-debug")
:group 'haskell)
;;;###autoload
(defface haskell-debug-warning-face
'((t :inherit 'compilation-warning))
"Face for warnings."
:group 'haskell-debug)
;;;###autoload
(defface haskell-debug-trace-number-face
'((t :weight bold :background "#f5f5f5"))
"Face for numbers in backtrace."
:group 'haskell-debug)
;;;###autoload
(defface haskell-debug-newline-face
'((t :weight bold :background "#f0f0f0"))
"Face for newlines in trace steps."
:group 'haskell-debug)
;;;###autoload
(defface haskell-debug-keybinding-face
'((t :inherit 'font-lock-type-face :weight bold))
"Face for keybindings."
:group 'haskell-debug)
;;;###autoload
(defface haskell-debug-heading-face
'((t :inherit 'font-lock-keyword-face))
"Face for headings."
:group 'haskell-debug)
;;;###autoload
(defface haskell-debug-muted-face
'((t :foreground "#999"))
"Face for muteds."
:group 'haskell-debug)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mode
(define-derived-mode haskell-debug-mode
text-mode "Debug"
"Major mode for debugging Haskell via GHCi.")
(define-key haskell-debug-mode-map (kbd "g") 'haskell-debug/refresh)
(define-key haskell-debug-mode-map (kbd "s") 'haskell-debug/step)
(define-key haskell-debug-mode-map (kbd "t") 'haskell-debug/trace)
(define-key haskell-debug-mode-map (kbd "d") 'haskell-debug/delete)
(define-key haskell-debug-mode-map (kbd "b") 'haskell-debug/break-on-function)
(define-key haskell-debug-mode-map (kbd "a") 'haskell-debug/abandon)
(define-key haskell-debug-mode-map (kbd "c") 'haskell-debug/continue)
(define-key haskell-debug-mode-map (kbd "p") 'haskell-debug/previous)
(define-key haskell-debug-mode-map (kbd "n") 'haskell-debug/next)
(define-key haskell-debug-mode-map (kbd "RET") 'haskell-debug/select)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Globals
(defvar haskell-debug-history-cache nil
"Cache of the tracing history.")
(defvar haskell-debug-bindings-cache nil
"Cache of the current step's bindings.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Macros
(defmacro haskell-debug-with-breakpoints (&rest body)
"Breakpoints need to exist to start stepping."
`(if (haskell-debug-get-breakpoints)
,@body
(error "No breakpoints to step into!")))
(defmacro haskell-debug-with-modules (&rest body)
"Modules need to exist to do debugging stuff."
`(if (haskell-debug-get-modules)
,@body
(error "No modules loaded!")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interactive functions
(defun haskell-debug/select ()
"Select whatever is at point."
(interactive)
(cond
((get-text-property (point) 'break)
(let ((break (get-text-property (point) 'break)))
(haskell-debug-highlight (plist-get break :path)
(plist-get break :span))))
((get-text-property (point) 'module)
(let ((break (get-text-property (point) 'module)))
(haskell-debug-highlight (plist-get break :path))))))
(defun haskell-debug/abandon ()
"Abandon the current computation."
(interactive)
(haskell-debug-with-breakpoints
(haskell-process-queue-sync-request (haskell-debug-process) ":abandon")
(message "Computation abandoned.")
(setq haskell-debug-history-cache nil)
(setq haskell-debug-bindings-cache nil)
(haskell-debug/refresh)))
(defun haskell-debug/continue ()
"Continue the current computation."
(interactive)
(haskell-debug-with-breakpoints
(haskell-process-queue-sync-request (haskell-debug-process) ":continue")
(message "Computation continued.")
(setq haskell-debug-history-cache nil)
(setq haskell-debug-bindings-cache nil)
(haskell-debug/refresh)))
(defun haskell-debug/break-on-function ()
"Break on function IDENT."
(interactive)
(haskell-debug-with-modules
(let ((ident (read-from-minibuffer "Function: "
(haskell-ident-at-point))))
(haskell-process-queue-sync-request
(haskell-debug-process)
(concat ":break "
ident))
(message "Breaking on function: %s" ident)
(haskell-debug/refresh))))
(defun haskell-debug/start-step (expr)
"Start stepping EXPR."
(interactive (list (read-from-minibuffer "Expression to step through: ")))
(haskell-debug/step expr))
(defun haskell-debug/breakpoint-numbers ()
"List breakpoint numbers."
(interactive)
(let ((breakpoints (mapcar (lambda (breakpoint)
(number-to-string (plist-get breakpoint :number)))
(haskell-debug-get-breakpoints))))
(if (null breakpoints)
(message "No breakpoints.")
(message "Breakpoint(s): %s"
(mapconcat #'identity
breakpoints
", ")))))
(defun haskell-debug/next ()
"Go to next step to inspect bindings."
(interactive)
(haskell-debug-with-breakpoints
(haskell-debug-navigate "forward")))
(defun haskell-debug/previous ()
"Go to previous step to inspect the bindings."
(interactive)
(haskell-debug-with-breakpoints
(haskell-debug-navigate "back")))
(defun haskell-debug/refresh ()
"Refresh the debugger buffer."
(interactive)
(with-current-buffer (haskell-debug-buffer-name (haskell-debug-session))
(cd (haskell-session-current-dir (haskell-debug-session)))
(let ((inhibit-read-only t)
(p (point)))
(erase-buffer)
(insert (propertize (concat "Debugging "
(haskell-session-name (haskell-debug-session))
"\n\n")
'face `((:weight bold))))
(let ((modules (haskell-debug-get-modules))
(breakpoints (haskell-debug-get-breakpoints))
(context (haskell-debug-get-context))
(history (haskell-debug-get-history)))
(unless modules
(insert (propertize "You have to load a module to start debugging."
'face
'haskell-debug-warning-face)
"\n\n"))
(haskell-debug-insert-bindings modules breakpoints context)
(when modules
(haskell-debug-insert-current-context context history)
(haskell-debug-insert-breakpoints breakpoints))
(haskell-debug-insert-modules modules))
(insert "\n")
(goto-char (min (point-max) p)))))
(defun haskell-debug/delete ()
"Delete whatever's at the point."
(interactive)
(cond
((get-text-property (point) 'break)
(let ((break (get-text-property (point) 'break)))
(when (y-or-n-p (format "Delete breakpoint #%d?"
(plist-get break :number)))
(haskell-process-queue-sync-request
(haskell-debug-process)
(format ":delete %d"
(plist-get break :number)))
(haskell-debug/refresh))))))
(defun haskell-debug/trace ()
"Trace the expression."
(interactive)
(haskell-debug-with-modules
(haskell-debug-with-breakpoints
(let ((expr (read-from-minibuffer "Expression to trace: "
(haskell-ident-at-point))))
(haskell-process-queue-sync-request
(haskell-debug-process)
(concat ":trace " expr))
(message "Tracing expression: %s" expr)
(haskell-debug/refresh)))))
(defun haskell-debug/step (&optional expr)
"Step into the next function."
(interactive)
(haskell-debug-with-breakpoints
(let* ((breakpoints (haskell-debug-get-breakpoints))
(context (haskell-debug-get-context))
(string
(haskell-process-queue-sync-request
(haskell-debug-process)
(if expr
(concat ":step " expr)
":step"))))
(cond
((string= string "not stopped at a breakpoint\n")
(if haskell-debug-bindings-cache
(progn (setq haskell-debug-bindings-cache nil)
(haskell-debug/refresh))
(call-interactively 'haskell-debug/start-step)))
(t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string)))
(cond
(maybe-stopped-at
(setq haskell-debug-bindings-cache
maybe-stopped-at)
(message "Computation paused.")
(haskell-debug/refresh))
(t
(if context
(message "Computation finished.")
(when (y-or-n-p "Computation completed without breaking. Reload the module and retry?")
(message "Reloading and resetting breakpoints...")
(haskell-interactive-mode-reset-error (haskell-debug-session))
(cl-loop for break in breakpoints
do (haskell-process-queue-sync-request
(haskell-debug-process)
(concat ":load " (plist-get break :path))))
(cl-loop for break in breakpoints
do (haskell-debug-break break))
(haskell-debug/step expr)))))))))
(haskell-debug/refresh)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions
(defun haskell-debug-session ()
"Get the Haskell session."
(or (haskell-session-maybe)
(error "No Haskell session associated with this debug
buffer. Please just close the buffer and start again.")))
(defun haskell-debug-process ()
"Get the Haskell session."
(or (haskell-session-process (haskell-session-maybe))
(error "No Haskell session associated with this debug
buffer. Please just close the buffer and start again.")))
(defun haskell-debug-buffer-name (session)
"The debug buffer name for the current session."
(format "*debug:%s*"
(haskell-session-name session)))
(defun haskell-debug-get-breakpoints ()
"Get the list of breakpoints currently set."
(let ((string (haskell-process-queue-sync-request
(haskell-debug-process)
":show breaks")))
(if (string= string "No active breakpoints.\n")
(list)
(mapcar #'haskell-debug-parse-break-point
(haskell-debug-split-string string)))))
(defun haskell-debug-get-modules ()
"Get the list of modules currently set."
(let ((string (haskell-process-queue-sync-request
(haskell-debug-process)
":show modules")))
(if (string= string "")
(list)
(mapcar #'haskell-debug-parse-module
(haskell-debug-split-string string)))))
(defun haskell-debug-get-context ()
"Get the current context."
(let ((string (haskell-process-queue-sync-request
(haskell-debug-process)
":show context")))
(if (string= string "")
nil
(haskell-debug-parse-context string))))
(defun haskell-debug-get-history ()
"Get the step history."
(let ((string (haskell-process-queue-sync-request
(haskell-debug-process)
":history")))
(if (or (string= string "")
(string= string "Not stopped at a breakpoint\n"))
nil
(if (string= string "Empty history. Perhaps you forgot to use :trace?\n")
nil
(let ((entries (mapcar #'haskell-debug-parse-history-entry
(cl-remove-if (lambda (line) (or (string= "<end of history>" line)
(string= "..." line)))
(haskell-debug-split-string string)))))
(setq haskell-debug-history-cache
entries)
entries)))))
(defun haskell-debug-insert-bindings (modules breakpoints context)
"Insert a list of bindings."
(if breakpoints
(progn (haskell-debug-insert-binding "t" "trace an expression")
(haskell-debug-insert-binding "s" "step into an expression")
(haskell-debug-insert-binding "b" "breakpoint" t))
(progn
(when modules
(haskell-debug-insert-binding "b" "breakpoint"))
(when breakpoints
(haskell-debug-insert-binding "s" "step into an expression" t))))
(when breakpoints
(haskell-debug-insert-binding "d" "delete breakpoint"))
(when context
(haskell-debug-insert-binding "a" "abandon context")
(haskell-debug-insert-binding "c" "continue" t))
(when context
(haskell-debug-insert-binding "p" "previous step")
(haskell-debug-insert-binding "n" "next step" t))
(haskell-debug-insert-binding "g" "refresh" t)
(insert "\n"))
(defun haskell-debug-insert-current-context (context history)
"Insert the current context."
(haskell-debug-insert-header "Context")
(if context
(haskell-debug-insert-context context history)
(haskell-debug-insert-debug-finished))
(insert "\n"))
(defun haskell-debug-insert-breakpoints (breakpoints)
"insert the list of breakpoints."
(haskell-debug-insert-header "Breakpoints")
(if (null breakpoints)
(haskell-debug-insert-muted "No active breakpoints.")
(cl-loop for break in breakpoints
do (insert (propertize (format "%d"
(plist-get break :number))
'face `((:weight bold))
'break break)
(haskell-debug-muted " - ")
(propertize (plist-get break :module)
'break break
'break break)
(haskell-debug-muted
(format " (%d:%d)"
(plist-get (plist-get break :span) :start-line)
(plist-get (plist-get break :span) :start-col)))
"\n")))
(insert "\n"))
(defun haskell-debug-insert-modules (modules)
"Insert the list of modules."
(haskell-debug-insert-header "Modules")
(if (null modules)
(haskell-debug-insert-muted "No loaded modules.")
(progn (cl-loop for module in modules
do (insert (propertize (plist-get module :module)
'module module
'face `((:weight bold)))
(haskell-debug-muted " - ")
(propertize (file-name-nondirectory (plist-get module :path))
'module module))
do (insert "\n")))))
(defun haskell-debug-split-string (string)
"Split GHCi's line-based output, stripping the trailing newline."
(split-string string "\n" t))
(defun haskell-debug-parse-context (string)
"Parse the context."
(cond
((string-match "^--> \\(.+\\)\n \\(.+\\)" string)
(let ((name (match-string 1 string))
(stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
(list :name name
:path (plist-get stopped :path)
:span (plist-get stopped :span))))))
(defun haskell-debug-insert-binding (binding desc &optional end)
"Insert a helpful keybinding."
(insert (propertize binding 'face 'haskell-debug-keybinding-face)
(haskell-debug-muted " - ")
desc
(if end
"\n"
(haskell-debug-muted ", "))))
(defun haskell-debug-insert-header (title)
"Insert a header title."
(insert (propertize title
'face 'haskell-debug-heading-face)
"\n\n"))
(defun haskell-debug-insert-context (context history)
"Insert the context and history."
(when context
(insert (propertize (plist-get context :name) 'face `((:weight bold)))
(haskell-debug-muted " - ")
(file-name-nondirectory (plist-get context :path))
(haskell-debug-muted " (stopped)")
"\n"))
(when haskell-debug-bindings-cache
(insert "\n")
(let ((bindings haskell-debug-bindings-cache))
(insert
(haskell-debug-get-span-string
(plist-get bindings :path)
(plist-get bindings :span)))
(insert "\n\n")
(cl-loop for binding in (plist-get bindings :types)
do (insert (haskell-fontify-as-mode binding 'haskell-mode)
"\n"))))
(let ((history (or history
(list (haskell-debug-make-fake-history context)))))
(when history
(insert "\n")
(haskell-debug-insert-history history))))
(defun haskell-debug-insert-debug-finished ()
"Insert message that no debugging is happening, but if there is
some old history, then display that."
(if haskell-debug-history-cache
(progn (haskell-debug-insert-muted "Finished debugging.")
(insert "\n")
(haskell-debug-insert-history haskell-debug-history-cache))
(haskell-debug-insert-muted "Not debugging right now.")))
(defun haskell-debug-insert-muted (text)
"Insert some muted text."
(insert (haskell-debug-muted text)
"\n"))
(defun haskell-debug-muted (text)
"Make some muted text."
(propertize text 'face 'haskell-debug-muted-face))
(defun haskell-debug-parse-logged (string)
"Parse the logged breakpoint."
(cond
((string= "no more logged breakpoints\n" string)
nil)
((string= "already at the beginning of the history\n" string)
nil)
(t
(with-temp-buffer
(insert string)
(goto-char (point-min))
(list :path (progn (search-forward " at ")
(buffer-substring-no-properties
(point)
(1- (search-forward ":"))))
:span (haskell-debug-parse-span
(buffer-substring-no-properties
(point)
(line-end-position)))
:types (progn (forward-line)
(haskell-debug-split-string
(buffer-substring-no-properties
(point)
(point-max)))))))))
(defun haskell-debug-parse-stopped-at (string)
"Parse the location stopped at from the given string.
For example:
Stopped at /home/foo/project/src/x.hs:6:25-36
"
(let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
string)))
(when index
(list :path (match-string 1 string)
:span (haskell-debug-parse-span (match-string 2 string))
:types (cdr (haskell-debug-split-string (substring string index)))))))
(defun haskell-debug-get-span-string (path span)
"Get the string from the PATH and the SPAN."
(save-window-excursion
(find-file path)
(buffer-substring
(save-excursion
(goto-char (point-min))
(forward-line (1- (plist-get span :start-line)))
(forward-char (1- (plist-get span :start-col)))
(point))
(save-excursion
(goto-char (point-min))
(forward-line (1- (plist-get span :end-line)))
(forward-char (plist-get span :end-col))
(point)))))
(defun haskell-debug-make-fake-history (context)
"Make a fake history item."
(list :index -1
:path (plist-get context :path)
:span (plist-get context :span)))
(defun haskell-debug-insert-history (history)
"Insert tracing HISTORY."
(let ((i (length history)))
(cl-loop for span in history
do (let ((string (haskell-debug-get-span-string
(plist-get span :path)
(plist-get span :span))))
(insert (propertize (format "%4d" i)
'face 'haskell-debug-trace-number-face)
" "
(haskell-debug-preview-span
(plist-get span :span)
string
t)
"\n")
(setq i (1- i))))))
(defun haskell-debug-parse-span (string)
"Parse a source span from a string.
Examples:
(5,1)-(6,37)
6:25-36
5:20
People like to make other people's lives interesting by making
variances in source span notation."
(cond
((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
string)
(list :start-line (string-to-number (match-string 1 string))
:start-col (string-to-number (match-string 2 string))
:end-line (string-to-number (match-string 1 string))
:end-col (string-to-number (match-string 3 string))))
((string-match "\\([0-9]+\\):\\([0-9]+\\)"
string)
(list :start-line (string-to-number (match-string 1 string))
:start-col (string-to-number (match-string 2 string))
:end-line (string-to-number (match-string 1 string))
:end-col (string-to-number (match-string 2 string))))
((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
string)
(list :start-line (string-to-number (match-string 1 string))
:start-col (string-to-number (match-string 2 string))
:end-line (string-to-number (match-string 3 string))
:end-col (string-to-number (match-string 4 string))))
(t (error "Unable to parse source span from string: %s"
string))))
(defun haskell-debug-preview-span (span string &optional collapsed)
"Make a one-line preview of the given expression."
(with-temp-buffer
(haskell-mode)
(insert string)
(when (/= 0 (plist-get span :start-col))
(indent-rigidly (point-min)
(point-max)
1))
(if (fboundp 'font-lock-ensure)
(font-lock-ensure)
(with-no-warnings (font-lock-fontify-buffer)))
(when (/= 0 (plist-get span :start-col))
(indent-rigidly (point-min)
(point-max)
-1))
(goto-char (point-min))
(if collapsed
(replace-regexp-in-string
"\n[ ]*"
(propertize " " 'face 'haskell-debug-newline-face)
(buffer-substring (point-min)
(point-max)))
(buffer-string))))
(defun haskell-debug-start (session)
"Start the debug mode."
(setq buffer-read-only t)
(haskell-session-assign session)
(haskell-debug/refresh))
(defun haskell-debug ()
"Start the debugger for the current Haskell (GHCi) session."
(interactive)
(let ((session (haskell-debug-session)))
(switch-to-buffer-other-window (haskell-debug-buffer-name session))
(unless (eq major-mode 'haskell-debug-mode)
(haskell-debug-mode)
(haskell-debug-start session))))
(defun haskell-debug-break (break)
"Set BREAK breakpoint in module at line/col."
(haskell-process-queue-without-filters
(haskell-debug-process)
(format ":break %s %s %d"
(plist-get break :module)
(plist-get (plist-get break :span) :start-line)
(plist-get (plist-get break :span) :start-col))))
(defun haskell-debug-navigate (direction)
"Navigate in DIRECTION \"back\" or \"forward\"."
(let ((string (haskell-process-queue-sync-request
(haskell-debug-process)
(concat ":" direction))))
(let ((bindings (haskell-debug-parse-logged string)))
(setq haskell-debug-bindings-cache
bindings)
(when (not bindings)
(message "No more %s results!" direction)))
(haskell-debug/refresh)))
(defun haskell-debug-session-debugging-p (session)
"Does the session have a debugging buffer open?"
(not (not (get-buffer (haskell-debug-buffer-name session)))))
(defun haskell-debug-highlight (path &optional span)
"Highlight the file at span."
(let ((p (make-overlay
(line-beginning-position)
(line-end-position))))
(overlay-put p 'face `((:background "#eee")))
(with-current-buffer
(if span
(save-window-excursion
(find-file path)
(current-buffer))
(find-file path)
(current-buffer))
(let ((o (when span
(make-overlay
(save-excursion
(goto-char (point-min))
(forward-line (1- (plist-get span :start-line)))
(forward-char (1- (plist-get span :start-col)))
(point))
(save-excursion
(goto-char (point-min))
(forward-line (1- (plist-get span :end-line)))
(forward-char (plist-get span :end-col))
(point))))))
(when o
(overlay-put o 'face `((:background "#eee"))))
(sit-for 0.5)
(when o
(delete-overlay o))
(delete-overlay p)))))
(defun haskell-debug-parse-history-entry (string)
"Parse a history entry."
(if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$"
string)
(list :index (string-to-number (match-string 1 string))
:name (match-string 2 string)
:path (match-string 3 string)
:span (haskell-debug-parse-span (match-string 4 string)))
(error "Unable to parse history entry: %s" string)))
(defun haskell-debug-parse-module (string)
"Parse a module and path.
For example:
X ( /home/foo/X.hs, interpreted )
"
(if (string-match "^\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [a-z]+ )$"
string)
(list :module (match-string 1 string)
:path (match-string 2 string))
(error "Unable to parse module from string: %s"
string)))
(defun haskell-debug-parse-break-point (string)
"Parse a breakpoint number, module and location from a string.
For example:
[13] Main /home/foo/src/x.hs:(5,1)-(6,37)
"
(if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$"
string)
(list :number (string-to-number (match-string 1 string))
:module (match-string 2 string)
:path (match-string 3 string)
:span (haskell-debug-parse-span (match-string 4 string)))
(error "Unable to parse breakpoint from string: %s"
string)))
(provide 'haskell-debug)
;;; haskell-debug.el ends here

619
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-decl-scan.el

@ -0,0 +1,619 @@
;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode -*- lexical-binding: t -*-
;; Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc.
;; Copyright (C) 1997-1998 Graeme E Moss
;; Author: 1997-1998 Graeme E Moss <gem@cs.york.ac.uk>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;; Keywords: declarations menu files Haskell
;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-decl-scan.el?rev=HEAD
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Purpose:
;;
;; Top-level declarations are scanned and placed in a menu. Supports
;; full Latin1 Haskell 1.4 as well as literate scripts.
;;
;;
;; Installation:
;;
;; To turn declaration scanning on for all Haskell buffers under the
;; Haskell mode of Moss&Thorn, add this to .emacs:
;;
;; (add-hook 'haskell-mode-hook 'haskell-decl-scan-mode)
;;
;; Otherwise, call `haskell-decl-scan-mode'.
;;
;;
;; Customisation:
;;
;; M-x customize-group haskell-decl-scan
;;
;;
;; History:
;;
;; If you have any problems or suggestions, after consulting the list
;; below, email gem@cs.york.ac.uk quoting the version of the library
;; you are using, the version of Emacs you are using, and a small
;; example of the problem or suggestion. Note that this library
;; requires a reasonably recent version of Emacs.
;;
;; Uses `imenu' under Emacs.
;;
;; Version 1.2:
;; Added support for LaTeX-style literate scripts.
;;
;; Version 1.1:
;; Use own syntax table. Fixed bug for very small buffers. Use
;; markers instead of pointers (markers move with the text).
;;
;; Version 1.0:
;; Brought over from Haskell mode v1.1.
;;
;;
;; Present Limitations/Future Work (contributions are most welcome!):
;;
;; . Declarations requiring information extending beyond starting line
;; don't get scanned properly, eg.
;; > class Eq a =>
;; > Test a
;;
;; . Comments placed in the midst of the first few lexemes of a
;; declaration will cause havoc, eg.
;; > infixWithComments :: Int -> Int -> Int
;; > x {-nastyComment-} `infixWithComments` y = x + y
;; but are not worth worrying about.
;;
;; . Would be nice to scan other top-level declarations such as
;; methods of a class, datatype field labels... any more?
;;
;; . Support for GreenCard?
;;
;; . Re-running (literate-)haskell-imenu should not cause the problems
;; that it does. The ability to turn off scanning would also be
;; useful. (Note that re-running (literate-)haskell-mode seems to
;; cause no problems.)
;; All functions/variables start with
;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'.
;; The imenu support is based on code taken from `hugs-mode',
;; thanks go to Chris Van Humbeeck.
;; Version.
;;; Code:
(require 'cl-lib)
(require 'haskell-mode)
(require 'syntax)
(require 'imenu)
;;;###autoload
(defgroup haskell-decl-scan nil
"Haskell declaration scanning (`imenu' support)."
:link '(custom-manual "(haskell-mode)haskell-decl-scan-mode")
:group 'haskell
:prefix "haskell-decl-scan-")
;;;###autoload
(defcustom haskell-decl-scan-bindings-as-variables nil
"Whether to put top-level value bindings into a \"Variables\" category."
:group 'haskell-decl-scan
:type 'boolean)
;;;###autoload
(defcustom haskell-decl-scan-add-to-menubar t
"Whether to add a \"Declarations\" menu entry to menu bar."
:group 'haskell-decl-scan
:type 'boolean)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; General declaration scanning functions.
(defvar haskell-ds-start-keywords-re
(concat "\\(\\<"
"class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\\)\\|stance\\)\\)\\|"
"module\\|primitive\\|type\\|newtype"
"\\)\\>")
"Keywords that may start a declaration.")
(defvar haskell-ds-syntax-table
(let ((table (copy-syntax-table haskell-mode-syntax-table)))
(modify-syntax-entry ?\' "w" table)
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?\\ "_" table)
table)
"Syntax table used for Haskell declaration scanning.")
(defun haskell-ds-get-variable (prefix)
"Return variable involved in value binding or type signature.
Assumes point is looking at the regexp PREFIX followed by the
start of a declaration (perhaps in the middle of a series of
declarations concerning a single variable). Otherwise return nil.
Point is not changed."
;; I think I can now handle all declarations bar those with comments
;; nested before the second lexeme.
(save-excursion
(with-syntax-table haskell-ds-syntax-table
(if (looking-at prefix) (goto-char (match-end 0)))
;; Keyword.
(if (looking-at haskell-ds-start-keywords-re)
nil
(or ;; Parenthesized symbolic variable.
(and (looking-at "(\\(\\s_+\\))") (match-string-no-properties 1))
;; General case.
(if (looking-at
(if (eq ?\( (char-after))
;; Skip paranthesised expression.
(progn
(forward-sexp)
;; Repeating this code and avoiding moving point if
;; possible speeds things up.
"\\(\\'\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)")
"\\(\\sw+\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)"))
(let ((match2 (match-string-no-properties 2)))
;; Weed out `::', `∷',`=' and `|' from potential infix
;; symbolic variable.
(if (member match2 '("::" "" "=" "|"))
;; Variable identifier.
(match-string-no-properties 1)
(if (eq (aref match2 0) ?\`)
;; Infix variable identifier.
(match-string-no-properties 3)
;; Infix symbolic variable.
match2))))
;; Variable identifier.
(and (looking-at "\\sw+") (match-string-no-properties 0)))))))
(defun haskell-ds-move-to-start-regexp (inc regexp)
"Move to beginning of line that succeeds/precedes (INC = 1/-1)
current line that starts with REGEXP and is not in `font-lock-comment-face'."
;; Making this defsubst instead of defun appears to have little or
;; no effect on efficiency. It is probably not called enough to do
;; so.
(while (and (= (forward-line inc) 0)
(or (not (looking-at regexp))
(eq (get-text-property (point) 'face)
'font-lock-comment-face)))))
(defun haskell-ds-move-to-start-regexp-skipping-comments (inc regexp)
"Like haskell-ds-move-to-start-regexp, but uses syntax-ppss to
skip comments"
(let (p)
(cl-loop
do (setq p (point))
(haskell-ds-move-to-start-regexp inc regexp)
while (and (nth 4 (syntax-ppss))
(/= p (point))))))
(defvar literate-haskell-ds-line-prefix "> ?"
"Regexp matching start of a line of Bird-style literate code.
Current value is \"> \" as we assume top-level declarations start
at column 3. Must not contain the special \"^\" regexp as we may
not use the regexp at the start of a regexp string. Note this is
only for `imenu' support.")
(defvar haskell-ds-start-decl-re "\\(\\sw\\|(\\)"
"The regexp that starts a Haskell declaration.")
(defvar literate-haskell-ds-start-decl-re
(concat literate-haskell-ds-line-prefix haskell-ds-start-decl-re)
"The regexp that starts a Bird-style literate Haskell declaration.")
(defun haskell-ds-move-to-decl (direction bird-literate fix)
"General function for moving to the start of a declaration,
either forwards or backwards from point, with normal or with Bird-style
literate scripts. If DIRECTION is t, then forward, else backward. If
BIRD-LITERATE is t, then treat as Bird-style literate scripts, else
normal scripts. Returns point if point is left at the start of a
declaration, and nil otherwise, ie. because point is at the beginning
or end of the buffer and no declaration starts there. If FIX is t,
then point does not move if already at the start of a declaration."
;; As `haskell-ds-get-variable' cannot separate an infix variable
;; identifier out of a value binding with non-alphanumeric first
;; argument, this function will treat such value bindings as
;; separate from the declarations surrounding it.
(let ( ;; The variable typed or bound in the current series of
;; declarations.
name
;; The variable typed or bound in the new declaration.
newname
;; Hack to solve hard problem for Bird-style literate scripts
;; that start with a declaration. We are in the abyss if
;; point is before start of this declaration.
abyss
(line-prefix (if bird-literate literate-haskell-ds-line-prefix ""))
;; The regexp to match for the start of a declaration.
(start-decl-re (if bird-literate
literate-haskell-ds-start-decl-re
haskell-ds-start-decl-re))
(increment (if direction 1 -1))
(bound (if direction (point-max) (point-min))))
;; Change syntax table.
(with-syntax-table haskell-ds-syntax-table
;; move to beginning of line that starts the "current
;; declaration" (dependent on DIRECTION and FIX), and then get
;; the variable typed or bound by this declaration, if any.
(let ( ;; Where point was at call of function.
(here (point))
;; Where the declaration on this line (if any) starts.
(start (progn
(beginning-of-line)
;; Checking the face to ensure a declaration starts
;; here seems to be the only addition to make this
;; module support LaTeX-style literate scripts.
(if (and (looking-at start-decl-re)
(not (elt (syntax-ppss) 4)))
(match-beginning 1)))))
(if (and start
;; This complicated boolean determines whether we
;; should include the declaration that starts on the
;; current line as the "current declaration" or not.
(or (and (or (and direction (not fix))
(and (not direction) fix))
(>= here start))
(and (or (and direction fix)
(and (not direction) (not fix)))
(> here start))))
;; If so, we are already at start of the current line, so
;; do nothing.
()
;; If point was before start of a declaration on the first
;; line of the buffer (possible for Bird-style literate
;; scripts) then we are in the abyss.
(if (and start (bobp))
(setq abyss t)
;; Otherwise we move to the start of the first declaration
;; on a line preceding the current one, skipping comments
(haskell-ds-move-to-start-regexp-skipping-comments -1 start-decl-re))))
;; If we are in the abyss, position and return as appropriate.
(if abyss
(if (not direction)
nil
(re-search-forward (concat "\\=" line-prefix) nil t)
(point))
;; Get the variable typed or bound by this declaration, if any.
(setq name (haskell-ds-get-variable line-prefix))
(if (not name)
;; If no such variable, stop at the start of this
;; declaration if moving backward, or move to the next
;; declaration if moving forward.
(if direction
(haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re))
;; If there is a variable, find the first
;; succeeding/preceding declaration that does not type or
;; bind it. Check for reaching start/end of buffer and
;; comments.
(haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re)
(while (and (/= (point) bound)
(and (setq newname (haskell-ds-get-variable line-prefix))
(string= name newname)))
(setq name newname)
(haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re))
;; If we are going backward, and have either reached a new
;; declaration or the beginning of a buffer that does not
;; start with a declaration, move forward to start of next
;; declaration (which must exist). Otherwise, we are done.
(if (and (not direction)
(or (and (looking-at start-decl-re)
(not (string= name
;; Note we must not use
;; newname here as this may
;; not have been set if we
;; have reached the beginning
;; of the buffer.
(haskell-ds-get-variable
line-prefix))))
(and (not (looking-at start-decl-re))
(bobp))))
(haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re)))
;; Store whether we are at the start of a declaration or not.
;; Used to calculate final result.
(let ((at-start-decl (looking-at start-decl-re)))
;; If we are at the beginning of a line, move over
;; line-prefix, if present at point.
(if (bolp)
(re-search-forward (concat "\\=" line-prefix) (point-max) t))
;; Return point if at the start of a declaration and nil
;; otherwise.
(if at-start-decl (point) nil))))))
(defun haskell-ds-bird-p ()
(and (boundp 'haskell-literate) (eq haskell-literate 'bird)))
(defun haskell-ds-backward-decl ()
"Move backward to the first character that starts a top-level declaration.
A series of declarations concerning one variable is treated as one
declaration by this function. So, if point is within a top-level
declaration then move it to the start of that declaration. If point
is already at the start of a top-level declaration, then move it to
the start of the preceding declaration. Returns point if point is
left at the start of a declaration, and nil otherwise, ie. because
point is at the beginning of the buffer and no declaration starts
there."
(interactive)
(haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil))
(defun haskell-ds-forward-decl ()
"As `haskell-ds-backward-decl' but forward."
(interactive)
(haskell-ds-move-to-decl t (haskell-ds-bird-p) nil))
(defun haskell-ds-generic-find-next-decl (bird-literate)
"Find the name, position and type of the declaration at or after point.
Return ((NAME . (START-POSITION . NAME-POSITION)) . TYPE)
if one exists and nil otherwise. The start-position is at the start
of the declaration, and the name-position is at the start of the name
of the declaration. The name is a string, the positions are buffer
positions and the type is one of the symbols \"variable\", \"datatype\",
\"class\", \"import\" and \"instance\"."
(let ( ;; The name, type and name-position of the declaration to
;; return.
name
type
name-pos
;; Buffer positions marking the start and end of the space
;; containing a declaration.
start
end)
;; Change to declaration scanning syntax.
(with-syntax-table haskell-ds-syntax-table
;; Stop when we are at the end of the buffer or when a valid
;; declaration is grabbed.
(while (not (or (eobp) name))
;; Move forward to next declaration at or after point.
(haskell-ds-move-to-decl t bird-literate t)
;; Start and end of search space is currently just the starting
;; line of the declaration.
(setq start (point)
end (line-end-position))
(cond
;; If the start of the top-level declaration does not begin
;; with a starting keyword, then (if legal) must be a type
;; signature or value binding, and the variable concerned is
;; grabbed.
((not (looking-at haskell-ds-start-keywords-re))
(setq name (haskell-ds-get-variable ""))
(if name
(progn
(setq type 'variable)
(re-search-forward (regexp-quote name) end t)
(setq name-pos (match-beginning 0)))))
;; User-defined datatype declaration.
((re-search-forward "\\=\\(data\\|newtype\\|type\\)\\>" end t)
(re-search-forward "=>" end t)
(if (looking-at "[ \t]*\\(\\sw+\\)")
(progn
(setq name (match-string-no-properties 1))
(setq name-pos (match-beginning 1))
(setq type 'datatype))))
;; Class declaration.
((re-search-forward "\\=class\\>" end t)
(re-search-forward "=>" end t)
(if (looking-at "[ \t]*\\(\\sw+\\)")
(progn
(setq name (match-string-no-properties 1))
(setq name-pos (match-beginning 1))
(setq type 'class))))
;; Import declaration.
((looking-at "import[ \t]+\\(?:safe[\t ]+\\)?\\(?:qualified[ \t]+\\)?\\(?:\"[^\"]*\"[\t ]+\\)?\\(\\(?:\\sw\\|.\\)+\\)")
(setq name (match-string-no-properties 1))
(setq name-pos (match-beginning 1))
(setq type 'import))
;; Instance declaration.
((re-search-forward "\\=instance[ \t]+" end t)
(re-search-forward "=>[ \t]+" end t)
;; The instance "title" starts just after the `instance' (and
;; any context) and finishes just before the _first_ `where'
;; if one exists. This solution is ugly, but I can't find a
;; nicer one---a simple regexp will pick up the last `where',
;; which may be rare but nevertheless...
(setq name-pos (point))
(setq name (buffer-substring-no-properties
(point)
(progn
;; Look for a `where'.
(if (re-search-forward "\\<where\\>" end t)
;; Move back to just before the `where'.
(progn
(re-search-backward "\\s-where")
(point))
;; No `where' so move to last non-whitespace
;; before `end'.
(progn
(goto-char end)
(skip-chars-backward " \t")
(point))))))
;; If we did not manage to extract a name, cancel this
;; declaration (eg. when line ends in "=> ").
(if (string-match "^[ \t]*$" name) (setq name nil))
(setq type 'instance)))
;; Move past start of current declaration.
(goto-char end))
;; If we have a valid declaration then return it, otherwise return
;; nil.
(if name
(cons (cons name (cons (copy-marker start t) (copy-marker name-pos t)))
type)
nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Declaration scanning via `imenu'.
;;;###autoload
(defun haskell-ds-create-imenu-index ()
"Function for finding `imenu' declarations in Haskell mode.
Finds all declarations (classes, variables, imports, instances and
datatypes) in a Haskell file for the `imenu' package."
;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'.
;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'.
(let* ((bird-literate (haskell-ds-bird-p))
(index-alist '())
(index-class-alist '()) ;; Classes
(index-var-alist '()) ;; Variables
(index-imp-alist '()) ;; Imports
(index-inst-alist '()) ;; Instances
(index-type-alist '()) ;; Datatypes
;; Variables for showing progress.
(bufname (buffer-name))
(divisor-of-progress (max 1 (/ (buffer-size) 100)))
;; The result we wish to return.
result)
(goto-char (point-min))
;; Loop forwards from the beginning of the buffer through the
;; starts of the top-level declarations.
(while (< (point) (point-max))
(message "Scanning declarations in %s... (%3d%%)" bufname
(/ (- (point) (point-min)) divisor-of-progress))
;; Grab the next declaration.
(setq result (haskell-ds-generic-find-next-decl bird-literate))
(if result
;; If valid, extract the components of the result.
(let* ((name-posns (car result))
(name (car name-posns))
(posns (cdr name-posns))
(start-pos (car posns))
(type (cdr result)))
;; Place `(name . start-pos)' in the correct alist.
(cl-case type
(variable
(setq index-var-alist
(cl-acons name start-pos index-var-alist)))
(datatype
(setq index-type-alist
(cl-acons name start-pos index-type-alist)))
(class
(setq index-class-alist
(cl-acons name start-pos index-class-alist)))
(import
(setq index-imp-alist
(cl-acons name start-pos index-imp-alist)))
(instance
(setq index-inst-alist
(cl-acons name start-pos index-inst-alist)))))))
;; Now sort all the lists, label them, and place them in one list.
(message "Sorting declarations in %s..." bufname)
(when index-type-alist
(push (cons "Datatypes"
(sort index-type-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(when index-inst-alist
(push (cons "Instances"
(sort index-inst-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(when index-imp-alist
(push (cons "Imports"
(sort index-imp-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(when index-class-alist
(push (cons "Classes"
(sort index-class-alist 'haskell-ds-imenu-label-cmp))
index-alist))
(when index-var-alist
(if haskell-decl-scan-bindings-as-variables
(push (cons "Variables"
(sort index-var-alist 'haskell-ds-imenu-label-cmp))
index-alist)
(setq index-alist (append index-alist
(sort index-var-alist 'haskell-ds-imenu-label-cmp)))))
(message "Sorting declarations in %s...done" bufname)
;; Return the alist.
index-alist))
(defun haskell-ds-imenu-label-cmp (el1 el2)
"Predicate to compare labels in lists from `haskell-ds-create-imenu-index'."
(string< (car el1) (car el2)))
(defun haskell-ds-imenu ()
"Install `imenu' for Haskell scripts."
(setq imenu-create-index-function 'haskell-ds-create-imenu-index)
(when haskell-decl-scan-add-to-menubar
(imenu-add-to-menubar "Declarations")))
;; The main functions to turn on declaration scanning.
;;;###autoload
(defun turn-on-haskell-decl-scan ()
"Unconditionally activate `haskell-decl-scan-mode'."
(interactive)
(haskell-decl-scan-mode))
(make-obsolete 'turn-on-haskell-decl-scan
'haskell-decl-scan-mode
"2015-07-23")
;;;###autoload
(define-minor-mode haskell-decl-scan-mode
"Toggle Haskell declaration scanning minor mode on or off.
With a prefix argument ARG, enable minor mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
See also info node `(haskell-mode)haskell-decl-scan-mode' for
more details about this minor mode.
Top-level declarations are scanned and listed in the menu item
\"Declarations\" (if enabled via option
`haskell-decl-scan-add-to-menubar'). Selecting an item from this
menu will take point to the start of the declaration.
\\[beginning-of-defun] and \\[end-of-defun] move forward and backward to the start of a declaration.
This may link with `haskell-doc-mode'.
For non-literate and LaTeX-style literate scripts, we assume the
common convention that top-level declarations start at the first
column. For Bird-style literate scripts, we assume the common
convention that top-level declarations start at the third column,
ie. after \"> \".
Anything in `font-lock-comment-face' is not considered for a
declaration. Therefore, using Haskell font locking with comments
coloured in `font-lock-comment-face' improves declaration scanning.
Literate Haskell scripts are supported: If the value of
`haskell-literate' (set automatically by `literate-haskell-mode')
is `bird', a Bird-style literate script is assumed. If it is nil
or `tex', a non-literate or LaTeX-style literate script is
assumed, respectively.
Invokes `haskell-decl-scan-mode-hook' on activation."
:group 'haskell-decl-scan
(kill-local-variable 'beginning-of-defun-function)
(kill-local-variable 'end-of-defun-function)
(kill-local-variable 'imenu-create-index-function)
(unless haskell-decl-scan-mode
;; How can we cleanly remove the "Declarations" menu?
(when haskell-decl-scan-add-to-menubar
(local-set-key [menu-bar index] nil)))
(when haskell-decl-scan-mode
(set (make-local-variable 'beginning-of-defun-function)
'haskell-ds-backward-decl)
(set (make-local-variable 'end-of-defun-function)
'haskell-ds-forward-decl)
(haskell-ds-imenu)))
;; Provide ourselves:
(provide 'haskell-decl-scan)
;;; haskell-decl-scan.el ends here

1914
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-doc.el

File diff suppressed because it is too large Load Diff

589
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-font-lock.el

@ -0,0 +1,589 @@
;;; haskell-font-lock.el --- Font locking module for Haskell Mode -*- lexical-binding: t -*-
;; Copyright 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright 1997-1998 Graeme E Moss, and Tommy Thorn
;; Author: 1997-1998 Graeme E Moss <gem@cs.york.ac.uk>
;; 1997-1998 Tommy Thorn <thorn@irisa.fr>
;; 2003 Dave Love <fx@gnu.org>
;; Keywords: faces files Haskell
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'haskell-mode)
(require 'font-lock)
;;;###autoload
(defcustom haskell-font-lock-symbols nil
"Display \\ and -> and such using symbols in fonts.
This may sound like a neat trick, but be extra careful: it changes the
alignment and can thus lead to nasty surprises w.r.t layout."
:group 'haskell
:type 'boolean)
;;;###autoload
(defcustom haskell-font-lock-symbols-alist
'(("\\" . "λ")
("not" . "¬")
("->" . "")
("<-" . "")
("=>" . "")
("()" . "")
("==" . "")
("/=" . "")
(">=" . "")
("<=" . "")
("!!" . "")
("&&" . "")
("||" . "")
("sqrt" . "")
("undefined" . "")
("pi" . "π")
("~>" . "") ;; Omega language
;; ("~>" "↝") ;; less desirable
("-<" . "") ;; Paterson's arrow syntax
;; ("-<" "⤙") ;; nicer but uncommon
("::" . "")
("." "" ; "○"
;; Need a predicate here to distinguish the . used by
;; forall <foo> . <bar>.
haskell-font-lock-dot-is-not-composition)
("forall" . ""))
"Alist mapping Haskell symbols to chars.
Each element has the form (STRING . COMPONENTS) or (STRING
COMPONENTS PREDICATE).
STRING is the Haskell symbol.
COMPONENTS is a representation specification suitable as an argument to
`compose-region'.
PREDICATE if present is a function of one argument (the start position
of the symbol) which should return non-nil if this mapping should
be disabled at that position."
:type '(alist string string)
:group 'haskell)
(defun haskell-font-lock-dot-is-not-composition (start)
"Return non-nil if the \".\" at START is not a composition operator.
This is the case if the \".\" is part of a \"forall <tvar> . <type>\"."
(save-excursion
(goto-char start)
(or (re-search-backward "\\<forall\\>[^.\"]*\\="
(line-beginning-position) t)
(not (or
(string= " " (string (char-after start)))
(string= " " (string (char-before start))))))))
;;;###autoload
(defface haskell-keyword-face
'((t :inherit font-lock-keyword-face))
"Face used to highlight Haskell keywords."
:group 'haskell)
;;;###autoload
(defface haskell-constructor-face
'((t :inherit font-lock-type-face))
"Face used to highlight Haskell constructors."
:group 'haskell)
;; This used to be `font-lock-variable-name-face' but it doesn't result in
;; a highlighting that's consistent with other modes (it's mostly used
;; for function defintions).
(defface haskell-definition-face
'((t :inherit font-lock-function-name-face))
"Face used to highlight Haskell definitions."
:group 'haskell)
;; This is probably just wrong, but it used to use
;; `font-lock-function-name-face' with a result that was not consistent with
;; other major modes, so I just exchanged with `haskell-definition-face'.
;;;###autoload
(defface haskell-operator-face
'((t :inherit font-lock-variable-name-face))
"Face used to highlight Haskell operators."
:group 'haskell)
;;;###autoload
(defface haskell-pragma-face
'((t :inherit font-lock-preprocessor-face))
"Face used to highlight Haskell pragmas."
:group 'haskell)
;;;###autoload
(defface haskell-literate-comment-face
'((t :inherit font-lock-doc-face))
"Face with which to fontify literate comments.
Inherit from `default' to avoid fontification of them."
:group 'haskell)
(defun haskell-font-lock-compose-symbol (alist)
"Compose a sequence of ascii chars into a symbol.
Regexp match data 0 points to the chars."
;; Check that the chars should really be composed into a symbol.
(let* ((start (match-beginning 0))
(end (match-end 0))
(syntaxes (cond
((eq (char-syntax (char-after start)) ?w) '(?w))
((eq (char-syntax (char-after start)) ?.) '(?.))
;; Special case for the . used for qualified names.
((and (eq (char-after start) ?\.) (= end (1+ start)))
'(?_ ?\\ ?w))
(t '(?_ ?\\))))
sym-data)
(if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
(memq (char-syntax (or (char-after end) ?\ )) syntaxes)
(or (elt (syntax-ppss) 3) (elt (syntax-ppss) 4))
(and (consp (setq sym-data (cdr (assoc (match-string 0) alist))))
(let ((pred (cadr sym-data)))
(setq sym-data (car sym-data))
(funcall pred start))))
;; No composition for you. Let's actually remove any composition
;; we may have added earlier and which is now incorrect.
(remove-text-properties start end '(composition))
;; That's a symbol alright, so add the composition.
(compose-region start end sym-data)))
;; Return nil because we're not adding any face property.
nil)
(defun haskell-font-lock-symbols-keywords ()
(when (and haskell-font-lock-symbols
haskell-font-lock-symbols-alist
(fboundp 'compose-region))
`((,(regexp-opt (mapcar 'car haskell-font-lock-symbols-alist) t)
(0 (haskell-font-lock-compose-symbol ',haskell-font-lock-symbols-alist)
;; In Emacs-21, if the `override' field is nil, the face
;; expressions is only evaluated if the text has currently
;; no face. So force evaluation by using `keep'.
keep)))))
;; The font lock regular expressions.
(defun haskell-font-lock-keywords-create (literate)
"Create fontification definitions for Haskell scripts.
Returns keywords suitable for `font-lock-keywords'."
(let* (;; Bird-style literate scripts start a line of code with
;; "^>", otherwise a line of code starts with "^".
(line-prefix (if (eq literate 'bird) "^> ?" "^"))
(varid "\\b[[:lower:]_][[:alnum:]'_]*\\b")
;; We allow ' preceding conids because of DataKinds/PolyKinds
(conid "\\b'?[[:upper:]][[:alnum:]'_]*\\b")
(modid (concat "\\b" conid "\\(\\." conid "\\)*\\b"))
(qvarid (concat modid "\\." varid))
(qconid (concat modid "\\." conid))
(sym "\\s.+")
;; Reserved identifiers
(reservedid
(concat "\\<"
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
;; (regexp-opt
;; '("case" "class" "data" "default" "deriving" "do"
;; "else" "if" "import" "in" "infix" "infixl"
;; "infixr" "instance" "let" "module" "newtype" "of"
;; "then" "type" "where" "_") t)
"\\(_\\|c\\(ase\\|lass\\)\\|d\\(ata\\|e\\(fault\\|riving\\)\\|o\\)\\|else\\|i\\(mport\\|n\\(fix[lr]?\\|stance\\)\\|[fn]\\)\\|let\\|module\\|mdo\\|newtype\\|of\\|rec\\|proc\\|t\\(hen\\|ype\\)\\|where\\)"
"\\>"))
;; Top-level declarations
(topdecl-var
(concat line-prefix "\\(" varid "\\(?:\\s-*,\\s-*" varid "\\)*" "\\)\\s-*"
;; optionally allow for a single newline after identifier
;; NOTE: not supported for bird-style .lhs files
(if (eq literate 'bird) nil "\\([\n]\\s-+\\)?")
;; A toplevel declaration can be followed by a definition
;; (=), a type (::) or (∷), a guard, or a pattern which can
;; either be a variable, a constructor, a parenthesized
;; thingy, or an integer or a string.
"\\(" varid "\\|" conid "\\|::\\|∷\\|=\\||\\|\\s(\\|[0-9\"']\\)"))
(topdecl-var2
(concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*`\\(" varid "\\)`"))
(topdecl-bangpat
(concat line-prefix "\\(" varid "\\)\\s-*!"))
(topdecl-sym
(concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*\\(" sym "\\)"))
(topdecl-sym2 (concat line-prefix "(\\(" sym "\\))"))
keywords)
(setq keywords
`(;; NOTICE the ordering below is significant
;;
("^#.*$" 0 'font-lock-preprocessor-face t)
,@(haskell-font-lock-symbols-keywords)
(,reservedid 1 'haskell-keyword-face)
;; Special case for `as', `hiding', `safe' and `qualified', which are
;; keywords in import statements but are not otherwise reserved.
("\\<import[ \t]+\\(?:\\(safe\\>\\)[ \t]*\\)?\\(?:\\(qualified\\>\\)[ \t]*\\)?\\(?:\"[^\"]*\"[\t ]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\<as\\>\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\<hiding\\>\\)?"
(1 'haskell-keyword-face nil lax)
(2 'haskell-keyword-face nil lax)
(3 'haskell-keyword-face nil lax)
(4 'haskell-keyword-face nil lax))
;; Special case for `foreign import'
;; keywords in foreign import statements but are not otherwise reserved.
("\\<\\(foreign\\)[ \t]+\\(import\\)[ \t]+\\(?:\\(ccall\\|stdcall\\|cplusplus\\|jvm\\|dotnet\\)[ \t]+\\)?\\(?:\\(safe\\|unsafe\\|interruptible\\)[ \t]+\\)?"
(1 'haskell-keyword-face nil lax)
(2 'haskell-keyword-face nil lax)
(3 'haskell-keyword-face nil lax)
(4 'haskell-keyword-face nil lax))
;; Special case for `foreign export'
;; keywords in foreign export statements but are not otherwise reserved.
("\\<\\(foreign\\)[ \t]+\\(export\\)[ \t]+\\(?:\\(ccall\\|stdcall\\|cplusplus\\|jvm\\|dotnet\\)[ \t]+\\)?"
(1 'haskell-keyword-face nil lax)
(2 'haskell-keyword-face nil lax)
(3 'haskell-keyword-face nil lax))
;; Toplevel Declarations.
;; Place them *before* generic id-and-op highlighting.
(,topdecl-var (1 'haskell-definition-face))
(,topdecl-var2 (2 'haskell-definition-face))
(,topdecl-bangpat (1 'haskell-definition-face))
(,topdecl-sym (2 (unless (member (match-string 2) '("\\" "=" "->" "" "<-" "" "::" "" "," ";" "`"))
'haskell-definition-face)))
(,topdecl-sym2 (1 (unless (member (match-string 1) '("\\" "=" "->" "" "<-" "" "::" "" "," ";" "`"))
'haskell-definition-face)))
;; These four are debatable...
("(\\(,*\\|->\\))" 0 'haskell-constructor-face)
("\\[\\]" 0 'haskell-constructor-face)
(,(concat "`" varid "`") 0 'haskell-operator-face)
(,(concat "`" conid "`") 0 'haskell-operator-face)
(,(concat "`" qvarid "`") 0 'haskell-operator-face)
(,(concat "`" qconid "`") 0 'haskell-operator-face)
(,qconid 0 'haskell-constructor-face)
(,conid 0 'haskell-constructor-face)
(,sym 0 (if (and (eq (char-after (match-beginning 0)) ?:)
(not (member (match-string 0) '("::" ""))))
'haskell-constructor-face
'haskell-operator-face))))
keywords))
(defvar haskell-font-lock-latex-cache-pos nil
"Position of cache point used by `haskell-font-lock-latex-cache-in-comment'.
Should be at the start of a line.")
(make-variable-buffer-local 'haskell-font-lock-latex-cache-pos)
(defvar haskell-font-lock-latex-cache-in-comment nil
"If `haskell-font-lock-latex-cache-pos' is outside a
\\begin{code}..\\end{code} block (and therefore inside a comment),
this variable is set to t, otherwise nil.")
(make-variable-buffer-local 'haskell-font-lock-latex-cache-in-comment)
(defun haskell-font-lock-latex-comments (end)
"Sets `match-data' according to the region of the buffer before end
that should be commented under LaTeX-style literate scripts."
(let ((start (point)))
(if (= start end)
;; We're at the end. No more to fontify.
nil
(if (not (eq start haskell-font-lock-latex-cache-pos))
;; If the start position is not cached, calculate the state
;; of the start.
(progn
(setq haskell-font-lock-latex-cache-pos start)
;; If the previous \begin{code} or \end{code} is a
;; \begin{code}, then start is not in a comment, otherwise
;; it is in a comment.
(setq haskell-font-lock-latex-cache-in-comment
(if (and
(re-search-backward
"^\\(\\(\\\\begin{code}\\)\\|\\(\\\\end{code}\\)\\)$"
(point-min) t)
(match-end 2))
nil t))
;; Restore position.
(goto-char start)))
(if haskell-font-lock-latex-cache-in-comment
(progn
;; If start is inside a comment, search for next \begin{code}.
(re-search-forward "^\\\\begin{code}$" end 'move)
;; Mark start to end of \begin{code} (if present, till end
;; otherwise), as a comment.
(set-match-data (list start (point)))
;; Return point, as a normal regexp would.
(point))
;; If start is inside a code block, search for next \end{code}.
(if (re-search-forward "^\\\\end{code}$" end t)
;; If one found, mark it as a comment, otherwise finish.
(point))))))
(defconst haskell-basic-syntactic-keywords
'(;; Character constants (since apostrophe can't have string syntax).
;; Beware: do not match something like 's-}' or '\n"+' since the first '
;; might be inside a comment or a string.
;; This still gets fooled with "'"'"'"'"'"', but ... oh well.
("\\Sw\\('\\)\\([^\\'\n]\\|\\\\.[^\\'\n \"}]*\\)\\('\\)" (1 "\"") (3 "\""))
;; Deal with instances of `--' which don't form a comment
("[!#$%&*+./:<=>?@^|~\\]*--[!#$%&*+./:<=>?@^|~\\-]*" (0 (cond ((or (nth 3 (syntax-ppss)) (numberp (nth 4 (syntax-ppss))))
;; There are no such instances inside
;; nestable comments or strings
nil)
((string-match "\\`-*\\'" (match-string 0))
;; Sequence of hyphens. Do nothing in
;; case of things like `{---'.
nil)
((string-match "\\`[^-]+--.*" (match-string 0))
;; Extra characters before comment starts
".")
(t ".")))) ; other symbol sequence
;; Implement Haskell Report 'escape' and 'gap' rules. Backslash
;; inside of a string is escaping unless it is preceeded by
;; another escaping backslash. There can be whitespace between
;; those two.
;;
;; Backslashes outside of string never escape.
;;
;; Note that (> 0 (skip-syntax-backward ".")) this skips over *escaping*
;; backslashes only.
("\\\\" (0 (when (save-excursion (and (nth 3 (syntax-ppss))
(goto-char (match-beginning 0))
(skip-syntax-backward "->")
(or (not (eq ?\\ (char-before)))
(> 0 (skip-syntax-backward ".")))))
"\\")))
;; QuasiQuotes syntax: [quoter| string |], quoter is unqualified
;; name, no spaces, string is arbitrary (including newlines),
;; finishes at the first occurence of |], no escaping is provided.
;;
;; The quoter cannot be "e", "t", "d", or "p", since those overlap
;; with Template Haskell quotations.
;;
;; QuasiQuotes opens only when outside of a string or a comment
;; and closes only when inside a quasiquote.
;;
;; (syntax-ppss) returns list with two interesting elements:
;; nth 3. non-nil if inside a string. (it is the character that will
;; terminate the string, or t if the string should be terminated
;; by a generic string delimiter.)
;; nth 4. nil if outside a comment, t if inside a non-nestable comment,
;; else an integer (the current comment nesting).
;;
;; Note also that we need to do in in a single pass, hence a regex
;; that covers both the opening and the ending of a quasiquote.
("\\(\\[[[:alnum:]]+\\)?\\(|\\)\\(]\\)?"
(2 (save-excursion
(goto-char (match-beginning 0))
(if (eq ?\[ (char-after))
;; opening case
(unless (or (nth 3 (syntax-ppss))
(nth 4 (syntax-ppss))
(member (match-string 1)
'("[e" "[t" "[d" "[p")))
"\"")
;; closing case
(when (and (eq ?| (nth 3 (syntax-ppss)))
(equal "]" (match-string 3))
)
"\"")))))
))
(defconst haskell-bird-syntactic-keywords
(cons '("^[^\n>]" (0 "<"))
haskell-basic-syntactic-keywords))
(defconst haskell-latex-syntactic-keywords
(append
'(("^\\\\begin{code}\\(\n\\)" 1 "!")
;; Note: buffer is widened during font-locking.
("\\`\\(.\\|\n\\)" (1 "!")) ; start comment at buffer start
("^\\(\\\\\\)end{code}$" 1 "!"))
haskell-basic-syntactic-keywords))
(defun haskell-syntactic-face-function (state)
"`font-lock-syntactic-face-function' for Haskell."
(cond
((nth 3 state) 'font-lock-string-face) ; as normal
;; Else comment. If it's from syntax table, use default face.
((or (eq 'syntax-table (nth 7 state))
(and (eq haskell-literate 'bird)
(memq (char-before (nth 8 state)) '(nil ?\n))))
'haskell-literate-comment-face)
;; Detect pragmas. A pragma is enclosed in special comment
;; delimeters {-# .. #-}.
((save-excursion
(goto-char (nth 8 state))
(and (looking-at "{-#")
(forward-comment 1)
(goto-char (- (point) 3))
(looking-at "#-}")))
'haskell-pragma-face)
;; Haddock comment start with either "-- [|^*$]" or "{- ?[|^*$]"
;; (note space optional for nested comments and mandatory for
;; double dash comments).
;;
;; Haddock comment will also continue on next line, provided:
;; - current line is a double dash haddock comment
;; - next line is also double dash comment
;; - there is only whitespace between
;;
;; We recognize double dash haddock comments by property
;; 'font-lock-doc-face attached to newline. In case of bounded
;; comments newline is outside of comment.
((save-excursion
(goto-char (nth 8 state))
(or (looking-at "\\(?:{- ?\\|-- \\)[|^*$]")
(and (looking-at "--") ; are we at double dash comment
(forward-line -1) ; this is nil on first line
(eq (get-text-property (line-end-position) 'face)
'font-lock-doc-face) ; is a doc face
(forward-line)
(skip-syntax-forward "-") ; see if there is only whitespace
(eq (point) (nth 8 state))))) ; we are back in position
'font-lock-doc-face)
(t 'font-lock-comment-face)))
(defconst haskell-font-lock-keywords
(haskell-font-lock-keywords-create nil)
"Font lock definitions for non-literate Haskell.")
(defconst haskell-font-lock-bird-literate-keywords
(haskell-font-lock-keywords-create 'bird)
"Font lock definitions for Bird-style literate Haskell.")
(defconst haskell-font-lock-latex-literate-keywords
(haskell-font-lock-keywords-create 'latex)
"Font lock definitions for LaTeX-style literate Haskell.")
;;;###autoload
(defun haskell-font-lock-choose-keywords ()
(let ((literate (if (boundp 'haskell-literate) haskell-literate)))
(cl-case literate
(bird haskell-font-lock-bird-literate-keywords)
((latex tex) haskell-font-lock-latex-literate-keywords)
(t haskell-font-lock-keywords))))
(defun haskell-font-lock-choose-syntactic-keywords ()
(let ((literate (if (boundp 'haskell-literate) haskell-literate)))
(cl-case literate
(bird haskell-bird-syntactic-keywords)
((latex tex) haskell-latex-syntactic-keywords)
(t haskell-basic-syntactic-keywords))))
(defun haskell-font-lock-defaults-create ()
"Locally set `font-lock-defaults' for Haskell."
(set (make-local-variable 'font-lock-defaults)
'(haskell-font-lock-choose-keywords
nil nil ((?\' . "w") (?_ . "w")) nil
(font-lock-syntactic-keywords
. haskell-font-lock-choose-syntactic-keywords)
(font-lock-syntactic-face-function
. haskell-syntactic-face-function)
;; Get help from font-lock-syntactic-keywords.
(parse-sexp-lookup-properties . t))))
;; The main functions.
(defun turn-on-haskell-font-lock ()
"Turns on font locking in current buffer for Haskell 1.4 scripts.
Changes the current buffer's `font-lock-defaults', and adds the
following variables:
`haskell-keyword-face' for reserved keywords and syntax,
`haskell-constructor-face' for data- and type-constructors, class names,
and module names,
`haskell-operator-face' for symbolic and alphanumeric operators,
`haskell-default-face' for ordinary code.
The variables are initialised to the following font lock default faces:
`haskell-keyword-face' `font-lock-keyword-face'
`haskell-constructor-face' `font-lock-type-face'
`haskell-operator-face' `font-lock-function-name-face'
`haskell-default-face' <default face>
Two levels of fontification are defined: level one (the default)
and level two (more colour). The former does not colour operators.
Use the variable `font-lock-maximum-decoration' to choose
non-default levels of fontification. For example, adding this to
.emacs:
(setq font-lock-maximum-decoration '((haskell-mode . 2) (t . 0)))
uses level two fontification for `haskell-mode' and default level for
all other modes. See documentation on this variable for further
details.
To alter an attribute of a face, add a hook. For example, to change
the foreground colour of comments to brown, add the following line to
.emacs:
(add-hook 'haskell-font-lock-hook
(lambda ()
(set-face-foreground 'haskell-comment-face \"brown\")))
Note that the colours available vary from system to system. To see
what colours are available on your system, call
`list-colors-display' from emacs.
To turn font locking on for all Haskell buffers, add this to .emacs:
(add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
To turn font locking on for the current buffer, call
`turn-on-haskell-font-lock'. To turn font locking off in the current
buffer, call `turn-off-haskell-font-lock'.
Bird-style literate Haskell scripts are supported: If the value of
`haskell-literate-bird-style' (automatically set by the Haskell mode
of Moss&Thorn) is non-nil, a Bird-style literate script is assumed.
Invokes `haskell-font-lock-hook' if not nil."
(haskell-font-lock-defaults-create)
(run-hooks 'haskell-font-lock-hook)
(turn-on-font-lock))
(defun turn-off-haskell-font-lock ()
"Turns off font locking in current buffer."
(font-lock-mode -1))
(defun haskell-fontify-as-mode (text mode)
"Fontify TEXT as MODE, returning the fontified text."
(with-temp-buffer
(funcall mode)
(insert text)
(if (fboundp 'font-lock-ensure)
(font-lock-ensure)
(with-no-warnings (font-lock-fontify-buffer)))
(buffer-substring (point-min) (point-max))))
;; Provide ourselves:
(provide 'haskell-font-lock)
;; Local Variables:
;; coding: utf-8-unix
;; tab-width: 8
;; End:
;;; haskell-font-lock.el ends here

1598
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-indent.el

File diff suppressed because it is too large Load Diff

1174
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-indentation.el

File diff suppressed because it is too large Load Diff

1117
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-interactive-mode.el

File diff suppressed because it is too large Load Diff

223
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-lexeme.el

@ -0,0 +1,223 @@
;;; haskell-lexeme.el --- haskell lexical tokens -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2015 Gracjan Polak
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'rx)
(unless (category-docstring ?P)
(define-category ?P "Haskell symbol constituent characters")
(map-char-table
#'(lambda (key val)
(if (or
(and (consp key) (> (car key) 128))
(and (numberp key) (> key 128)))
(if (member val '(Pc Pd Po Sm Sc Sk So))
(modify-category-entry key ?P))))
unicode-category-table)
(dolist (key (string-to-list "!#$%&*+./<=>?@^|~\\-"))
(modify-category-entry key ?P)))
(defconst haskell-lexeme-modid
"[[:upper:]][[:alnum:]'_]*"
"Regexp matching a valid Haskell module identifier.
Note that GHC accepts Unicode category UppercaseLetter as a first
character. Following letters are from Unicode categories
UppercaseLetter, LowercaseLetter, OtherLetter, TitlecaseLetter,
ModifierLetter, DecimalNumber, OtherNumber, backslash or
underscore.
Note that this differs from constructor identifier as the latter
one can have any number of hash character at the end to
accommodate MagicHash extension.")
(defconst haskell-lexeme-id
"[[:alpha:]_][[:alnum:]'_]*#*"
"Regexp matching a valid Haskell identifier.
GHC accepts a string starting with any alphabetic character or
underscore followed by any alphanumeric character or underscore
or apostrophe.")
(defconst haskell-lexeme-sym
"\\(:?\\cP\\|:\\)+"
"Regexp matching a valid Haskell variable or constructor symbol.
GHC accepts a string of chars from the set
[:!#$%&*+./<=>?@^|~\\-] or Unicode category Symbol for chars with
codes larger than 128 only.")
(defconst haskell-lexeme-modid-opt-prefix
(concat "\\(?:" haskell-lexeme-modid "\\.\\)*")
"Regexp matching a valid Haskell module prefix, potentially empty.
Module path prefix is separated by dots and finishes with a
dot. For path component syntax see `haskell-lexeme-modid'.")
(defconst haskell-lexeme-qid-or-qsym
(rx-to-string `(: (regexp ,haskell-lexeme-modid-opt-prefix)
(group (| (regexp ,haskell-lexeme-id) (regexp ,haskell-lexeme-sym)
))))
"Regexp matching a valid qualified identifier or symbol.
Note that (match-string 1) returns the unqualified part.")
(defconst haskell-lexeme-qid
(rx-to-string `(: (regexp "'*")
(regexp ,haskell-lexeme-modid-opt-prefix)
(group (regexp ,haskell-lexeme-id))))
"Regexp matching a valid qualified identifier.
Note that (match-string 1) returns the unqualified part.")
(defconst haskell-lexeme-qsym
(rx-to-string `(: (regexp "'*")
(regexp ,haskell-lexeme-modid-opt-prefix)
(group (regexp ,haskell-lexeme-id))))
"Regexp matching a valid qualified symbol.
Note that (match-string 1) returns the unqualified part.")
(defconst haskell-lexeme-number
(rx (| (: (regexp "[0-9]+\\.[0-9]+") (opt (regexp "[eE][-+]?[0-9]+")))
(regexp "[0-9]+[eE][-+]?[0-9]+")
(regexp "0[xX][0-9a-fA-F]+")
(regexp "0[oO][0-7]+")
(regexp "[0-9]+")))
"Regexp matching a floating point, decimal, octal or hexadecimal number.
Note that negative sign char is not part of a number.")
(defconst haskell-lexeme-char-literal-inside
(rx (| (regexp "[^\n'\\]")
(: "\\"
(| "a" "b" "f" "n" "r" "t" "v" "\\" "\"" "'"
"NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK"
"BEL" "BS" "HT" "LF" "VT" "FF" "CR" "SO" "SI" "DLE"
"DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" "CAN"
"EM" "SUB" "ESC" "FS" "GS" "RS" "US" "SP" "DEL"
(: "^" (regexp "[]A-Z@^_\\[]"))))))
"Regexp matching an inside of a character literal.")
(defconst haskell-lexeme-char-literal
(rx-to-string `(: "'" (regexp ,haskell-lexeme-char-literal-inside) "'"))
"Regexp matching a character literal.")
(defconst haskell-lexeme-string-literal-inside
(rx (* (| (regexp "[^\n\"\\]")
(: "\\"
(| "a" "b" "f" "n" "r" "t" "v" "\\" "\"" "'" "&"
"NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK"
"BEL" "BS" "HT" "LF" "VT" "FF" "CR" "SO" "SI" "DLE"
"DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" "CAN"
"EM" "SUB" "ESC" "FS" "GS" "RS" "US" "SP" "DEL"
(: "^" (regexp "[]A-Z@^_\\[]"))
(regexp "[ \t\n\r\v\f]*\\\\"))))))
"Regexp matching an inside of a string literal.")
(defconst haskell-lexeme-string-literal
(rx-to-string `(: "\"" (regexp ,haskell-lexeme-string-literal-inside) "\""))
"Regexp matching a string literal.")
(defun haskell-lexeme-classify-by-first-char (char)
"Classify token by CHAR.
CHAR is a chararacter that is assumed to be first character of a token."
(let ((category (get-char-code-property char 'general-category)))
(cond
((or (member char '(?! ?# ?$ ?% ?& ?* ?+ ?. ?/ ?< ?= ?> ?? ?@ ?^ ?| ?~ ?\\ ?-))
(and (> char 127)
(member category '(Pc Pd Po Sm Sc Sk So))))
'varsym)
((equal char ?:)
'consym)
((equal char ?\')
'char)
((equal char ?\")
'string)
((member category '(Lu Lt))
'conid)
((or (equal char ?_)
(member category '(Ll Lo)))
'varsym)
((and (>= char ?0) (<= char 9))
'number)
((member char '(?\] ?\[ ?\( ?\) ?\{ ?\} ?\` ?\, ?\;))
'special))))
(defun haskell-lexeme-looking-at-token ()
"Like `looking-at' but understands Haskell lexemes.
Moves point forward over whitespace. Returns a symbol describing
type of Haskell token recognized. Use `match-string',
`match-beginning' and `match-end' with argument 0 to query match
result.
Possible results are:
- 'special: for chars [](){}`,;
- 'comment: for single line comments
- 'nested-comment: for multiline comments
- 'qsymid: for qualified identifiers or symbols
- 'string: for strings literals
- 'char: for char literals
- 'decimal: for decimal, float, hexadecimal and octal number literals
- 'template-haskell-quote: for a string of apostrophes for template haskell
Note that for qualified symbols (match-string 1) returns the
unqualified identifier or symbol. Further qualification for
symbol or identifier can be done with:
(haskell-lexeme-classify-by-first-char (char-after (match-beginning 1)))
See `haskell-lexeme-classify-by-first-char' for details."
(skip-syntax-forward "->")
(let
((case-fold-search nil)
(point (point-marker)))
(or
(and (looking-at "{-")
(progn
(save-excursion
(forward-comment 1)
(set-match-data (list point (point-marker))))
'nested-comment))
(and (looking-at haskell-lexeme-char-literal)
'char)
(and (looking-at haskell-lexeme-string-literal)
'string)
(and (looking-at "[][(){}`,;]")
'special)
(and (looking-at haskell-lexeme-qid-or-qsym)
(if (and (eq (- (match-end 0) (match-beginning 0)) 2)
(equal (match-string 0) "--"))
(progn
(set-match-data (list point (set-marker (make-marker) (line-end-position))))
'comment)
'qsymid))
(and (looking-at haskell-lexeme-number)
'number)
(and (looking-at "'+")
'template-haskell-quote))))
(provide 'haskell-lexeme)
;;; haskell-lexeme.el ends here

529
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-load.el

@ -0,0 +1,529 @@
;;; haskell-load.el --- Compiling and loading modules in the GHCi process -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'haskell-process)
(require 'haskell-interactive-mode)
(require 'haskell-modules)
(require 'haskell-commands)
(require 'haskell-session)
(defun haskell-process-look-config-changes (session)
"Checks whether a cabal configuration file has
changed. Restarts the process if that is the case."
(let ((current-checksum (haskell-session-get session 'cabal-checksum))
(new-checksum (haskell-cabal-compute-checksum
(haskell-session-get session 'cabal-dir))))
(when (not (string= current-checksum new-checksum))
(haskell-interactive-mode-echo session (format "Cabal file changed: %s" new-checksum))
(haskell-session-set-cabal-checksum session
(haskell-session-get session 'cabal-dir))
(unless (and haskell-process-prompt-restart-on-cabal-change
(not (y-or-n-p "Cabal file changed; restart GHCi process? ")))
(haskell-process-start (haskell-interactive-session))))))
(defun haskell-process-live-build (process buffer echo-in-repl)
"Show live updates for loading files."
(cond ((haskell-process-consume
process
(concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
" Compiling \\([^ ]+\\)[ ]+"
"( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
(haskell-process-echo-load-message process buffer echo-in-repl nil)
t)
((haskell-process-consume
process
(concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]"
" Compiling \\[TH\\] \\([^ ]+\\)[ ]+"
"( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+"))
(haskell-process-echo-load-message process buffer echo-in-repl t)
t)
((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n")
(haskell-mode-message-line
(format "Loading: %s"
(match-string 1 buffer)))
t)
((haskell-process-consume
process
"^Preprocessing executables for \\(.+?\\)\\.\\.\\.")
(let ((msg (format "Preprocessing: %s" (match-string 1 buffer))))
(haskell-interactive-mode-echo
(haskell-process-session process)
msg)
(haskell-mode-message-line msg)))
((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.")
(let ((msg (format "Linking: %s" (match-string 1 buffer))))
(haskell-interactive-mode-echo (haskell-process-session process) msg)
(haskell-mode-message-line msg)))
((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.")
(let ((msg (format "Building: %s" (match-string 1 buffer))))
(haskell-interactive-mode-echo
(haskell-process-session process)
msg)
(haskell-mode-message-line msg)))))
(defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont)
"Handle the complete loading response. BUFFER is the string of
text being sent over the process pipe. MODULE-BUFFER is the
actual Emacs buffer of the module being loaded."
(when (get-buffer (format "*%s:splices*" (haskell-session-name session)))
(with-current-buffer (haskell-interactive-mode-splices-buffer session)
(erase-buffer)))
(let* ((ok (cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)\\.$") t)
((haskell-process-consume process "Failed, modules loaded: \\(.+\\)\\.$") nil)
(t (error (message "Unexpected response from haskell process.")))))
(modules (haskell-process-extract-modules buffer))
(cursor (haskell-process-response-cursor process))
(warning-count 0))
(haskell-process-set-response-cursor process 0)
(haskell-check-remove-overlays module-buffer)
(while (haskell-process-errors-warnings module-buffer session process buffer)
(setq warning-count (1+ warning-count)))
(haskell-process-set-response-cursor process cursor)
(if (and (not reload)
haskell-process-reload-with-fbytecode)
(haskell-process-reload-with-fbytecode process module-buffer)
(haskell-process-import-modules process (car modules)))
(if ok
(haskell-mode-message-line (if reload "Reloaded OK." "OK."))
(haskell-interactive-mode-compile-error session "Compilation failed."))
(when cont
(condition-case e
(funcall cont ok)
(error (message "%S" e))
(quit nil)))))
(defun haskell-process-suggest-imports (session file modules ident)
"Given a list of MODULES, suggest adding them to the import section."
(cl-assert session)
(cl-assert file)
(cl-assert ident)
(let* ((process (haskell-session-process session))
(suggested-already (haskell-process-suggested-imports process))
(module (cond ((> (length modules) 1)
(when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?"
ident))
(haskell-complete-module-read "Module: " modules)))
((= (length modules) 1)
(let ((module (car modules)))
(unless (member module suggested-already)
(haskell-process-set-suggested-imports process (cons module suggested-already))
(when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?"
ident
module))
module)))))))
(when module
(haskell-process-find-file session file)
(haskell-add-import module))))
(defun haskell-process-trigger-suggestions (session msg file line)
"Trigger prompting to add any extension suggestions."
(cond ((let ((case-fold-search nil))
(or (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg)
(not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg)))
(string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg)
(string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg)
(string-match "use \\([A-Z][A-Za-z]+\\)" msg)
(string-match "You need \\([A-Z][A-Za-z]+\\)" msg)))
(when haskell-process-suggest-language-pragmas
(haskell-process-suggest-pragma session "LANGUAGE" (match-string 1 msg) file)))
((string-match " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant" msg)
(when haskell-process-suggest-remove-import-lines
(haskell-process-suggest-remove-import session
file
(match-string 2 msg)
line)))
((string-match "Warning: orphan instance: " msg)
(when haskell-process-suggest-no-warn-orphans
(haskell-process-suggest-pragma session "OPTIONS" "-fno-warn-orphans" file)))
((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg)
(string-match "with actual type [‘`‛]\\[Char\\]['’]" msg))
(when haskell-process-suggest-overloaded-strings
(haskell-process-suggest-pragma session "LANGUAGE" "OverloadedStrings" file)))
((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg)
(let* ((match1 (match-string 1 msg))
(ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1)
;; Skip qualification.
(match-string 1 match1)
match1)))
(when haskell-process-suggest-hoogle-imports
(let ((modules (haskell-process-hoogle-ident ident)))
(haskell-process-suggest-imports session file modules ident)))
(when haskell-process-suggest-haskell-docs-imports
(let ((modules (haskell-process-haskell-docs-ident ident)))
(haskell-process-suggest-imports session file modules ident)))
(when haskell-process-suggest-hayoo-imports
(let ((modules (haskell-process-hayoo-ident ident)))
(haskell-process-suggest-imports session file modules ident)))))
((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\([^@\r\n]+\\).*['’].$" msg)
(when haskell-process-suggest-add-package
(haskell-process-suggest-add-package session msg)))))
(defun haskell-process-do-cabal (command)
"Run a Cabal command."
(let ((process (haskell-interactive-process)))
(cond
((let ((child (haskell-process-process process)))
(not (equal 'run (process-status child))))
(message "Process is not running, so running directly.")
(shell-command (concat "cabal " command)
(get-buffer-create "*haskell-process-log*")
(get-buffer-create "*haskell-process-log*"))
(switch-to-buffer-other-window (get-buffer "*haskell-process-log*")))
(t (haskell-process-queue-command
process
(make-haskell-command
:state (list (haskell-interactive-session) process command 0)
:go
(lambda (state)
(haskell-process-send-string
(cadr state)
(format haskell-process-do-cabal-format-string
(haskell-session-cabal-dir (car state))
(format "%s %s"
(cl-ecase (haskell-process-type)
('ghci haskell-process-path-cabal)
('cabal-repl haskell-process-path-cabal)
('cabal-ghci haskell-process-path-cabal)
('stack-ghci haskell-process-path-stack))
(cl-caddr state)))))
:live
(lambda (state buffer)
(let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*"
"\\1"
(cl-caddr state))))
(cond ((or (string= cmd "build")
(string= cmd "install"))
(haskell-process-live-build (cadr state) buffer t))
(t
(haskell-process-cabal-live state buffer)))))
:complete
(lambda (state response)
(let* ((process (cadr state))
(session (haskell-process-session process))
(message-count 0)
(cursor (haskell-process-response-cursor process)))
;; XXX: what the hell about the rampant code duplication?
(haskell-process-set-response-cursor process 0)
(while (haskell-process-errors-warnings nil session process response)
(setq message-count (1+ message-count)))
(haskell-process-set-response-cursor process cursor)
(let ((msg (format "Complete: cabal %s (%s compiler messages)"
(cl-caddr state)
message-count)))
(haskell-interactive-mode-echo session msg)
(when (= message-count 0)
(haskell-interactive-mode-echo
session
"No compiler messages, dumping complete output:")
(haskell-interactive-mode-echo session response))
(haskell-mode-message-line msg)
(when (and haskell-notify-p
(fboundp 'notifications-notify))
(notifications-notify
:title (format "*%s*" (haskell-session-name (car state)))
:body msg
:app-name (cl-ecase (haskell-process-type)
('ghci haskell-process-path-cabal)
('cabal-repl haskell-process-path-cabal)
('cabal-ghci haskell-process-path-cabal)
('stack-ghci haskell-process-path-stack))
:app-icon haskell-process-logo)))))))))))
(defun haskell-process-echo-load-message (process buffer echo-in-repl th)
"Echo a load message."
(let ((session (haskell-process-session process))
(module-name (match-string 3 buffer))
(file-name (match-string 4 buffer)))
(haskell-interactive-show-load-message
session
'compiling
module-name
(haskell-session-strip-dir session file-name)
echo-in-repl
th)))
(defun haskell-process-extract-modules (buffer)
"Extract the modules from the process buffer."
(let* ((modules-string (match-string 1 buffer))
(modules (split-string modules-string ", ")))
(cons modules modules-string)))
;;;###autoload
(defface haskell-error-face
'((((supports :underline (:style wave)))
:underline (:style wave :color "#dc322f"))
(t
:inherit error))
"Face used for marking error lines."
:group 'haskell-mode)
;;;###autoload
(defface haskell-warning-face
'((((supports :underline (:style wave)))
:underline (:style wave :color "#b58900"))
(t
:inherit warning))
"Face used for marking warning lines."
:group 'haskell-mode)
;;;###autoload
(defface haskell-hole-face
'((((supports :underline (:style wave)))
:underline (:style wave :color "#6c71c4"))
(t
:inherit warning))
"Face used for marking hole lines."
:group 'haskell-mode)
(defvar haskell-check-error-fringe (propertize "!" 'display '(left-fringe exclamation-mark)))
(defvar haskell-check-warning-fringe (propertize "?" 'display '(left-fringe question-mark)))
(defvar haskell-check-hole-fringe (propertize "_" 'display '(left-fringe horizontal-bar)))
(defun haskell-check-overlay-p (ovl)
(overlay-get ovl 'haskell-check))
(defun haskell-check-filter-overlays (xs)
(cl-remove-if-not 'haskell-check-overlay-p xs))
(defun haskell-check-remove-overlays (buffer)
(with-current-buffer buffer
(remove-overlays (point-min) (point-max) 'haskell-check t)))
(defmacro with-overlay-properties (proplist ovl &rest body)
"Evaluate BODY with names in PROPLIST bound to the values of
correspondingly-named overlay properties of OVL."
(let ((ovlvar (cl-gensym "OVL-")))
`(let* ((,ovlvar ,ovl)
,@(mapcar (lambda (p) `(,p (overlay-get ,ovlvar ',p))) proplist))
,@body)))
(defun overlay-start> (o1 o2)
(> (overlay-start o1) (overlay-start o2)))
(defun overlay-start< (o1 o2)
(< (overlay-start o1) (overlay-start o2)))
(defun first-overlay-in-if (test beg end)
(let ((ovls (cl-remove-if-not test (overlays-in beg end))))
(cl-first (sort (cl-copy-list ovls) 'overlay-start<))))
(defun last-overlay-in-if (test beg end)
(let ((ovls (cl-remove-if-not test (overlays-in beg end))))
(cl-first (sort (cl-copy-list ovls) 'overlay-start>))))
(defun haskell-error-overlay-briefly (ovl)
(with-overlay-properties (haskell-msg haskell-msg-type) ovl
(cond ((not (eq haskell-msg-type 'warning))
haskell-msg)
((string-prefix-p "Warning:\n " haskell-msg)
(cl-subseq haskell-msg 13))
(t (error "Invariant failed: a warning message from GHC has unexpected form: %s." haskell-msg)))))
(defun haskell-goto-error-overlay (ovl)
(cond (ovl
(goto-char (overlay-start ovl))
(haskell-mode-message-line (haskell-error-overlay-briefly ovl)))
(t
(message "No further notes from Haskell compiler."))))
(defun haskell-goto-prev-error ()
(interactive)
(haskell-goto-error-overlay
(let ((ovl-at (cl-first (haskell-check-filter-overlays (overlays-at (point))))))
(or (last-overlay-in-if 'haskell-check-overlay-p
(point-min) (if ovl-at (overlay-start ovl-at) (point)))
ovl-at))))
(defun haskell-goto-next-error ()
(interactive)
(haskell-goto-error-overlay
(let ((ovl-at (cl-first (haskell-check-filter-overlays (overlays-at (point))))))
(or (first-overlay-in-if 'haskell-check-overlay-p
(if ovl-at (overlay-end ovl-at) (point)) (point-max))
ovl-at))))
(defun haskell-check-paint-overlay (buffer error-from-this-file-p line msg file type hole coln)
(with-current-buffer buffer
(let (beg end)
(goto-char (point-min))
;; XXX: we can avoid excess buffer walking by relying on the maybe-fact that
;; GHC sorts error messages by line number, maybe.
(cond
(error-from-this-file-p
(forward-line (1- line))
(forward-char (1- coln))
(setq beg (point))
(if (eq type 'hole)
(forward-char (length hole))
(skip-chars-forward "^[:space:]" (line-end-position)))
(setq end (point)))
(t
(setq beg (point))
(forward-line)
(setq end (point))))
(let ((ovl (make-overlay beg end)))
(overlay-put ovl 'haskell-check t)
(overlay-put ovl 'haskell-file file)
(overlay-put ovl 'haskell-msg msg)
(overlay-put ovl 'haskell-msg-type type)
(overlay-put ovl 'help-echo msg)
(overlay-put ovl 'haskell-hole hole)
(cl-destructuring-bind (face fringe) (cl-case type
(warning (list 'haskell-warning-face haskell-check-warning-fringe))
(hole (list 'haskell-hole-face haskell-check-hole-fringe))
(error (list 'haskell-error-face haskell-check-error-fringe)))
(overlay-put ovl 'before-string fringe)
(overlay-put ovl 'face face))))))
(defun haskell-process-errors-warnings (module-buffer session process buffer &optional return-only)
"Trigger handling type errors or warnings. Either prints the
messages in the interactive buffer or if CONT is specified,
passes the error onto that.
When MODULE-BUFFER is non-NIL, paint error overlays."
(save-excursion
(cond
((haskell-process-consume
process
"\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed")
(let ((err (match-string 1 buffer)))
(if (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err)
(let* ((default-directory (haskell-session-current-dir session))
(module (match-string 1 err))
(file (match-string 2 err))
(relative-file-name (file-relative-name file)))
(unless return-only
(haskell-interactive-show-load-message
session
'import-cycle
module
relative-file-name
nil
nil)
(haskell-interactive-mode-compile-error
session
(format "%s:1:0: %s"
relative-file-name
err)))
(list :file file :line 1 :col 0 :msg err :type 'error))
t)))
((haskell-process-consume
process
(concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):"
"[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]"))
(haskell-process-set-response-cursor process
(- (haskell-process-response-cursor process) 1))
(let* ((buffer (haskell-process-response process))
(file (match-string 1 buffer))
(location-raw (match-string 2 buffer))
(error-msg (match-string 3 buffer))
(type (cond ((string-match "^Warning:" error-msg) 'warning)
((string-match "^Splicing " error-msg) 'splice)
(t 'error)))
(critical (not (eq type 'warning)))
;; XXX: extract hole information, pass down to `haskell-check-paint-overlay'
(final-msg (format "%s:%s: %s"
(haskell-session-strip-dir session file)
location-raw
error-msg))
(location (haskell-process-parse-error (concat file ":" location-raw ": x")))
(line (plist-get location :line))
(col1 (plist-get location :col)))
(when module-buffer
(haskell-check-paint-overlay module-buffer (string= (file-truename (buffer-file-name module-buffer)) (file-truename file))
line error-msg file type nil col1))
(if return-only
(list :file file :line line :col col1 :msg error-msg :type type)
(progn (funcall (cl-case type
(warning 'haskell-interactive-mode-compile-warning)
(splice 'haskell-interactive-mode-compile-splice)
(error 'haskell-interactive-mode-compile-error))
session final-msg)
(when critical
(haskell-mode-message-line final-msg))
(haskell-process-trigger-suggestions
session
error-msg
file
(plist-get (haskell-process-parse-error final-msg) :line))
t)))))))
(defun haskell-interactive-show-load-message (session type module-name file-name echo th)
"Show the '(Compiling|Loading) X' message."
(let ((msg (concat
(cl-ecase type
('compiling
(if haskell-interactive-mode-include-file-name
(format "Compiling: %s (%s)" module-name file-name)
(format "Compiling: %s" module-name)))
('loading (format "Loading: %s" module-name))
('import-cycle (format "Module has an import cycle: %s" module-name)))
(if th " [TH]" ""))))
(haskell-mode-message-line msg)
(when haskell-interactive-mode-delete-superseded-errors
(haskell-interactive-mode-delete-compile-messages session file-name))
(when echo
(haskell-interactive-mode-echo session msg))))
;;;###autoload
(defun haskell-process-reload-devel-main ()
"Reload the module `DevelMain' and then run
`DevelMain.update'. This is for doing live update of the code of
servers or GUI applications. Put your development version of the
program in `DevelMain', and define `update' to auto-start the
program on a new thread, and use the `foreign-store' package to
access the running context across :load/:reloads in GHCi."
(interactive)
(with-current-buffer (or (get-buffer "DevelMain.hs")
(if (y-or-n-p "You need to open a buffer named DevelMain.hs. Find now?")
(ido-find-file)
(error "No DevelMain.hs buffer.")))
(let ((session (haskell-interactive-session)))
(let ((process (haskell-interactive-process)))
(haskell-process-queue-command
process
(make-haskell-command
:state (list :session session
:process process
:buffer (current-buffer))
:go (lambda (state)
(haskell-process-send-string (plist-get state ':process)
":l DevelMain"))
:live (lambda (state buffer)
(haskell-process-live-build (plist-get state ':process)
buffer
nil))
:complete (lambda (state response)
(haskell-process-load-complete
(plist-get state ':session)
(plist-get state ':process)
response
nil
(plist-get state ':buffer)
(lambda (ok)
(when ok
(haskell-process-queue-without-filters
(haskell-interactive-process)
"DevelMain.update")
(message "DevelMain updated.")))))))))))
(provide 'haskell-load)

159
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-menu.el

@ -0,0 +1,159 @@
;;; haskell-menu.el --- A Haskell sessions menu -*- lexical-binding: t -*-
;; Copyright (C) 2013 Chris Done
;; Author: Chris Done <chrisdone@gmail.com>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Todo:
;;; Code:
(require 'cl-lib)
(require 'haskell-compat)
(require 'haskell-session)
(require 'haskell-process)
(require 'haskell-interactive-mode)
;;;###autoload
(defcustom haskell-menu-buffer-name "*haskell-menu*"
"The name of the Haskell session menu buffer"
:group 'haskell-interactive
:type 'string)
;;;###autoload
(defun haskell-menu ()
"Launch the Haskell sessions menu."
(interactive)
(or (get-buffer haskell-menu-buffer-name)
(with-current-buffer (get-buffer-create haskell-menu-buffer-name)
(haskell-menu-mode)))
(switch-to-buffer-other-window (get-buffer haskell-menu-buffer-name))
(haskell-menu-revert-function nil nil))
(define-derived-mode haskell-menu-mode special-mode "Haskell Session Menu"
"Major mode for managing Haskell sessions.
Each line describes one session.
Letters do not insert themselves; instead, they are commands."
(setq buffer-read-only t)
(set (make-local-variable 'revert-buffer-function)
'haskell-menu-revert-function)
(setq truncate-lines t)
(haskell-menu-revert-function nil t))
(suppress-keymap haskell-menu-mode-map t)
(define-key haskell-menu-mode-map (kbd "n") 'next-line)
(define-key haskell-menu-mode-map (kbd "p") 'previous-line)
(define-key haskell-menu-mode-map (kbd "RET") 'haskell-menu-mode-ret)
(defun haskell-menu-revert-function (_arg1 _arg2)
"Function to refresh the display."
(let ((buffer-read-only nil)
(orig-line (line-number-at-pos))
(orig-col (current-column)))
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
(erase-buffer)
(haskell-menu-insert-menu)
(goto-char (point-min))
(forward-line (1- orig-line))
(forward-char orig-col)))
(defun haskell-menu-insert-menu ()
"Insert the Haskell sessions menu to the current buffer."
(if (null haskell-sessions)
(insert "No Haskell sessions.")
(haskell-menu-tabulate
(list "Name" "PID" "Time" "RSS" "Cabal directory" "Working directory" "Command")
(mapcar (lambda (session)
(let ((process (haskell-process-process (haskell-session-process session))))
(cond
(process
(let ((id (process-id process)))
(list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer)
(if (process-live-p process) (number-to-string id) "-")
(if (process-live-p process)
(format-time-string "%H:%M:%S"
(encode-time (cl-caddr (assoc 'etime (process-attributes id)))
0 0 0 0 0))
"-")
(if (process-live-p process)
(concat (number-to-string (/ (cdr (assoc 'rss (process-attributes id)))
1024))
"MB")
"-")
(haskell-session-cabal-dir session)
(haskell-session-current-dir session)
(mapconcat 'identity (process-command process) " "))))
(t (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer)
""
""
""
(haskell-session-cabal-dir session)
(haskell-session-current-dir session))))))
haskell-sessions))))
(defun haskell-menu-tabulate (headings rows)
"Prints a list of lists as a formatted table to the current buffer."
(let* ((columns (length headings))
(widths (make-list columns 0)))
;; Calculate column widths. This is kind of hideous.
(dolist (row rows)
(setq widths
(let ((list (list)))
(dotimes (i columns)
(setq list (cons (max (nth i widths)
(1+ (length (nth i row)))
(1+ (length (nth i headings))))
list)))
(reverse list))))
;; Print headings.
(let ((heading (propertize " " 'display '(space :align-to 0))))
(dotimes (i columns)
(setq heading (concat heading
(format (concat "%-" (number-to-string (nth i widths)) "s")
(nth i headings)))))
(setq header-line-format heading))
;; Print tabulated rows.
(dolist (row rows)
(dotimes (i columns)
(insert (format (concat "%-" (number-to-string (nth i widths)) "s")
(nth i row))))
(insert "\n"))))
(defun haskell-menu-mode-ret ()
"Handle RET key."
(interactive)
(let* ((name (save-excursion
(goto-char (line-beginning-position))
(buffer-substring-no-properties (point)
(progn (search-forward " ")
(forward-char -1)
(point)))))
(session (car (cl-remove-if-not (lambda (session)
(string= (haskell-session-name session)
name))
haskell-sessions))))
(switch-to-buffer (haskell-session-interactive-buffer session))))
(provide 'haskell-menu)
;;; haskell-menu.el ends here

1727
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode-autoloads.el

File diff suppressed because it is too large Load Diff

5
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode-pkg.el

@ -0,0 +1,5 @@
(define-package "haskell-mode" "20151022.340" "A Haskell editing mode"
'((cl-lib "0.5")))
;; Local Variables:
;; no-byte-compile: t
;; End:

1076
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode.el

File diff suppressed because it is too large Load Diff

658
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-mode.info

@ -0,0 +1,658 @@
This is haskell-mode.info, produced by makeinfo version 5.2 from
haskell-mode.texi.
This manual is for Haskell mode, version 13.15-git
Copyright © 2013 Haskell Mode contributors.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License
(http://www.gnu.org/licenses/fdl.html), Version 1.3 or any later
version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts and no Back-Cover Texts.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Haskell Mode: (haskell-mode). Haskell Development Environment for Emacs(en)
END-INFO-DIR-ENTRY

File: haskell-mode.info, Node: Top, Next: Introduction, Up: (dir)
Haskell Mode
************
Haskell Mode is an Haskell development Environment for GNU Emacs version
23 or later. It provides syntax-based indentation, font locking,
editing cabal files, and supports running an inferior Haskell
interpreter (e.g. GHCi).
* Menu:
* Introduction:: An introduction to Haskell Mode
* Getting Help and Reporting Bugs:: How to improve Haskell Mode
* Getting Started:: How to get started
* Editing Haskell Code:: How to edit code
* Unicode support:: How to use Unicode
* Indentation:: Notes about indentation
* Declaration scanning:: How to navigate in a source file
* Compilation:: How to compile
* Inferior Haskell interpreter:: How to interact with GHCi (1)
* Interactive Haskell:: How to interact with GHCi (2)
* Editing Cabal files:: Cabal support
* Changing REPL target:: Start REPL with selected target (i.e. test,bench,etc.)
* Concept index:: Index of Haskell Mode concepts
* Function index:: index of commands
* Variable index:: Index of options and types

File: haskell-mode.info, Node: Introduction, Next: Getting Help and Reporting Bugs, Prev: Top, Up: Top
1 Introduction
**************
"Haskell Mode" is a major mode providing a convenient environment for
editing Haskell (http://www.haskell.org) programs.
Some of its major features are:
• Syntax highlighting (font lock),
• automatic indentation,
• on-the-fly documentation,
• interaction with inferior GHCi/Hugs instance, and
• scanning declarations and placing them in a menu.

File: haskell-mode.info, Node: Getting Help and Reporting Bugs, Next: Getting Started, Prev: Introduction, Up: Top
2 Getting Help and Reporting Bugs
*********************************
This Info manual is work in progress and incomplete. However, you can
find more information at these locations in the meantime:
• Haskell Mode’s GitHub Home
(https://github.com/haskell/haskell-mode)
• Haskell Wiki Emacs Page
(http://www.haskell.org/haskellwiki/Haskell_mode_for_Emacs)
If you have any questions or like to discuss something regarding
Haskell Mode, please consider sending an email to the Haskellmode-emacs
mailing list
(http://projects.haskell.org/cgi-bin/mailman/listinfo/haskellmode-emacs).
The mailing list is also available on Gmane (http://gmane.org/) via the
gmane.comp.lang.haskell.emacs
(http://dir.gmane.org/gmane.comp.lang.haskell.emacs) newsgroup.
If you have discovered a bug or wish to request a new feature, you
can file a new issue
(https://github.com/haskell/haskell-mode/issues/new) with Haskell Mode’s
issue tracker. When filing a bug, please state your currently used
software version (‘M-x haskell-version’, ‘M-x version’) and what steps
to perform in order to reproduce the bug you’re experiencing. Finally,
if you happen to be proficient in *note Emacs Lisp: (elisp)Top. you are
welcome to submit patches via GitHub Pull Requests
(https://help.github.com/articles/using-pull-requests).

File: haskell-mode.info, Node: Getting Started, Next: Editing Haskell Code, Prev: Getting Help and Reporting Bugs, Up: Top
3 Getting Started
*****************
If you are reading this, you have most likely already managed to install
Haskell Mode in one way or another.
Most of Haskell Mode’s settings are configurable via customizable
variables (*note (emacs)Easy Customization::, for details). You can use
‘M-x customize-group <RET> haskell’ to browse the ‘haskell’
customization sub-tree.
One of the important setting you should customize is the
‘haskell-mode-hook’ variable (*note (emacs)Hooks::) which gets run right
after the ‘haskell-mode’ major mode is initialized for a buffer. You
can customize ‘haskell-mode-hook’ by ‘M-x customize-variable <RET>
haskell-mode-hook’. It’s highly recommended you set up indentation to
match your preferences; *Note Indentation::, for more details about the
indentation modes included with Haskell Mode.

File: haskell-mode.info, Node: Editing Haskell Code, Next: Unicode support, Prev: Getting Started, Up: Top
4 Editing Haskell Code
**********************
"Haskell Mode" is actually a collection of so-called major modes(1) one
of which is called ‘haskell-mode’. To avoid confusion, when referring
to this package the name “Haskell mode” is written in a normal font,
whereas when referring the major mode of the same name ‘haskell-mode’
written with a dash in-between in a typewriter font is used.
As one might guess, ‘haskell-mode’ is the (programming language(2))
major mode for editing (non-literate) Haskell source code.
‘haskell-mode’ is associated with the file extensions listed below by
default(3).
‘.hs’
official file extension for (non-literate) Haskell 98/2010 files
‘.hsc’
“almost-Haskell” input file for the hsc2hs
(http://www.haskell.org/ghc/docs/latest/html/users_guide/hsc2hs.html)
pre-processor
‘.cpphs’
input file for the cpphs (http://projects.haskell.org/cpphs/)
pre-processor
The major mode ‘literate-haskell-mode’ (which is derived from
‘haskell-mode’ and thus transitively from ‘prog-mode’) provides support
for literate Haskell programs
(http://www.haskell.org/haskellwiki/Literate_programming) and is
associated with the ‘.lhs’ file extension by default.
‘literate-haskell-mode’ supports Bird-style as well as TeX-style
literate Haskell files. The currently detected literate Haskell variant
is shown in the mode line (*note (emacs)Mode Line::) as either
‘LitHaskell/bird’ or ‘LitHaskell/tex’.
4.1 Font Lock Support
=====================
‘haskell-mode’ supports "syntax highlighting" via Emacs’ Font Lock minor
mode which should be enabled by default in current Emacsen. *Note
(emacs)Font Lock::, for more information on how to control
‘font-lock-mode’.
4.2 Completion support
======================
‘haskell-mode’ can complete symbols, pragma directives and language
extensions. This is part of ‘haskell-interactive-mode’.
If haskell-interactive-mode is enabled and working haskell mode
provides completions for import statements taking into account currently
loaded and available packages.
---------- Footnotes ----------
(1) for more information about the concept of "major modes" *note
(emacs)Major Modes::
(2) ‘haskell-mode’ is derived from ‘prog-mode’
(3) for more information about file associations, *note
(emacs)Choosing Modes::

File: haskell-mode.info, Node: Unicode support, Next: Indentation, Prev: Editing Haskell Code, Up: Top
5 Unicode support
*****************
See the Haskell Wiki’s entry on Unicode Symbols
(http://www.haskell.org/haskellwiki/Unicode-symbols) for general
information about Unicode support in Haskell.
As Emacs supports editing files containing Unicode out of the box, so
does Haskell Mode. As an add-on, Haskell Mode includes the
‘haskell-unicode’ input method which allows you to easily type a number
of Unicode symbols that are useful when writing Haskell code; *Note
(emacs)Input Methods::, for more details.
To automatically enable the ‘haskell-unicode’ input method in
haskell-mode buffers use ‘M-x customize-variable <RET>
haskell-mode-hook’ or put the following code in your ‘.emacs’ file:
(add-hook 'haskell-mode-hook 'turn-on-haskell-unicode-input-method)
To temporarily enable this input method for a single buffer you can use
‘M-x turn-on-haskell-unicode-input-method’.
When the ‘haskell-unicode’ input method is active, you can simply
type ‘->’ and it is immediately replaced with ‘→’. Use ‘C-\’ to toggle
the input method. To see a table of all key sequences use ‘M-x
describe-input-method <RET> haskell-unicode’. A sequence like ‘<=’ is
ambiguous and can mean either ‘⇐’ or ‘≤’. Typing it presents you with a
choice. Type ‘1’ or ‘2’ to select an option or keep typing to use the
default option.
If you don’t like the highlighting of partially matching tokens you
can turn it off by setting ‘input-method-highlight-flag’ to ‘nil’ via
‘M-x customize-variable’.

File: haskell-mode.info, Node: Indentation, Next: Declaration scanning, Prev: Unicode support, Up: Top
6 Indentation
*************
For general information about indentation support in GNU Emacs, *note
(emacs)Indentation::.
In Haskell, code indentation has semantic meaning as it defines the
block structure(1).
As GNU Emacs’ default indentation function (i.e. ‘indent-relative’)
is not designed for use with Haskell’s layout rule, Haskell mode
includes three different indentation minor modes with different
trade-offs:
‘haskell-simple-indent-mode’
A very simple indentation scheme; In this scheme, <TAB> will now
move the cursor to the next indent point in the previous non-blank
line. An indent point is a non-whitespace character following
whitespace.
‘haskell-indent-mode’
Intelligent semi-automatic indentation for Haskell’s layout rule.
The basic idea is to have <TAB> cycle through possibilities
indentation points based on some clever heuristics.
The rationale and the implementation principles are described in
more detail in the article ‘Dynamic tabbing for automatic
indentation with the layout rule’ published in the Journal of
Functional Programming 8.5 (1998).
‘haskell-indentation-mode’
Improved variation of ‘haskell-indent-mode’ indentation mode.
Rebinds <RET> and <DEL>, so that indentations can be set and
deleted as if they were real tabs.
To enable one of these three mutually exclusive indentation schemes,
you just need call one (and only one!) of the ‘*-mode’ commands while
in the buffer you want the indentation scheme to be activated for.
The recommended way is to add one of ‘*-mode’ commands to
‘haskell-mode-hook’. This can be done either by using ‘M-x
customize-variable <RET> haskell-mode-hook’ which provides a convenient
user interface or by adding _one_ of the following three lines to your
‘.emacs’ file:
(add-hook 'haskell-mode-hook 'haskell-simple-indent-mode)
(add-hook 'haskell-mode-hook 'haskell-indent-mode)
(add-hook 'haskell-mode-hook 'haskell-indentation-mode)
6.1 Interactive Block Indentation
=================================
By inserting the key bindings for ‘C-,’ and ‘C-.’ (these bindings are
convenient on keyboard layouts where <,> and <.> are adjacent keys) as
shown below you can interactively de/indent either the following nested
block or, if a region is active while in Transient Mark Mode (*note
(emacs)Disabled Transient Mark::), de/indent the active region.
By using a numeric prefix argument (*note (elisp)Prefix Command
Arguments::) you can modify the shift-amount; for instance, ‘C-u C-,’
increases indentation by 4 characters at once.
(eval-after-load "haskell-mode"
'(progn
(define-key haskell-mode-map (kbd "C-,") 'haskell-move-nested-left)
(define-key haskell-mode-map (kbd "C-.") 'haskell-move-nested-right)))
6.2 Rectangle Commands
======================
GNU Emacs provides so-called "rectangle commands" which operate on
rectangular areas of text, which are particularly useful for languages
with a layout rule such as Haskell. *Note (emacs)Rectangles::, to learn
more about rectangle commands.
Moreover, CUA mode (*note (emacs)CUA Bindings::) provides enhanced
rectangle support with visible rectangle highlighting. When CUA mode is
active, you can initiate a rectangle selection by ‘C-RET’ and extend it
simply by movement commands. You don’t have to enable full CUA mode to
benefit from these enhanced rectangle commands; you can activate CUA
selection mode (without redefining ‘C-x’,‘C-c’,‘C-v’, and ‘C-z’) by
calling ‘M-x cua-selection-mode’ (or adding ‘(cua-selection-mode nil)’
to your ‘haskell-mode-hook’).
---------- Footnotes ----------
(1) Haskell also supports braces and semicolons notation for
conveying the block structure. However, most Haskell programs written
by humans use indentation for block structuring.

File: haskell-mode.info, Node: Declaration scanning, Next: Compilation, Prev: Indentation, Up: Top
7 Declaration scannning
***********************
‘haskell-decl-scan-mode’ is a minor mode which performs declaration
scanning and provides ‘M-x imenu’ support (*note (emacs)Imenu:: for more
information).
For non-literate and TeX-style literate scripts, the common
convention that top-level declarations start at the first column is
assumed. For Bird-style literate scripts, the common convention that
top-level declarations start at the third column, ie. after ‘> ’, is
assumed.
When ‘haskell-decl-scan-mode’ is active, the standard Emacs top-level
definition movement commands (*note (emacs)Moving by Defuns::) are
enabled to operate on Haskell declarations:
‘C-M-a’
Move to beginning of current or preceding declaration
(‘beginning-of-defun’).
‘C-M-e’
Move to end of current or following declaration (‘end-of-defun’).
‘C-M-h’
Select whole current or following declaration (‘mark-defun’).
Moreover, if enabled via the option
‘haskell-decl-scan-add-to-menubar’, a menu item “Declarations” is added
to the menu bar listing the scanned declarations and allowing to jump to
declarations in the source buffer.
It’s recommended to have font lock mode enabled (*note (emacs)Font
Lock::) as ‘haskell-decl-scan-mode’ ignores text highlighted with
‘font-lock-comment-face’.
As usual, in order to activate ‘haskell-decl-scan-mode’ automatically
for Haskell buffers, add ‘haskell-decl-scan-mode’ to
‘haskell-mode-hook’:
(add-hook 'haskell-mode-hook 'haskell-decl-scan-mode)
‘haskell-decl-scan-mode’ enables the use of features that build upon
‘imenu’ support such as Speedbar Frames (*note (emacs)Speedbar::) or the
global “Which Function” minor mode (*note (emacs)Which Function::).
In order to enable ‘which-function-mode’ for Haskell buffers you need
to add the following to your Emacs initialization:
(eval-after-load "which-func"
'(add-to-list 'which-func-modes 'haskell-mode))

File: haskell-mode.info, Node: Compilation, Next: Inferior Haskell interpreter, Prev: Declaration scanning, Up: Top
8 Compilation
*************
Haskell mode comes equipped with a specialized "Compilation mode"
tailored to GHC’s compiler messages with optional support for Cabal
projects. *Note (emacs)Compilation Mode::, for more information about
the basic commands provided by the Compilation mode which are available
in the Haskell compilation sub-mode as well. The additional features
provided compared to Emacs’ basic Compilation mode are:
• DWIM-style auto-detection of compile command (including support for
CABAL projects)
• Support for GHC’s compile messages and recognizing error, warning
and info source locations (including ‘-ferror-spans’ syntax)
• Support for filtering out GHC’s uninteresting ‘Loading package...’
linker messages
In order to use it, invoke the ‘haskell-compile’ command instead of
‘compile’ as you would for the ordinary Compilation mode. It’s
recommended to bind ‘haskell-compile’ to a convenient key binding. For
instance, you can add the following to your Emacs initialization to bind
‘haskell-compile’ to ‘C-c C-c’.
(eval-after-load "haskell-mode"
'(define-key haskell-mode-map (kbd "C-c C-c") 'haskell-compile))
(eval-after-load "haskell-cabal"
'(define-key haskell-cabal-mode-map (kbd "C-c C-c") 'haskell-compile))
The following description assumes that ‘haskell-compile’ has been bound
to ‘C-c C-c’.
When invoked, ‘haskell-compile’ tries to guess how to compile the
Haskell program your currently visited buffer belongs to, by searching
for a ‘.cabal’ file in the current of enclosing parent folders. If a
‘.cabal’ file was found, the command defined in the
‘haskell-compile-cabal-build-command’ option is used. Moreover, when
requesting to compile a ‘.cabal’-file is detected and a negative prefix
argument (e.g. ‘C-- C-c C-c’) was given, the alternative
‘haskell-compile-cabal-build-command-alt’ is invoked. By default,
‘haskell-compile-cabal-build-command-alt’ contains a ‘cabal clean -s’
command in order to force a full rebuild.
Otherwise if no ‘.cabal’ could be found, a single-module compilation
is assumed and ‘haskell-compile-command’ is used (_if_ the currently
visited buffer contains Haskell source code).
You can also inspect and modify the compile command to be invoked
temporarily by invoking ‘haskell-compile’ with a prefix argument (e.g.
‘C-u C-c C-c’). If later-on you want to recompile using the same
customized compile command, invoke ‘recompile’ (bound to ‘g’) inside the
‘*haskell-compilation*’ buffer.

File: haskell-mode.info, Node: Inferior Haskell interpreter, Next: Interactive Haskell, Prev: Compilation, Up: Top
9 Inferior Haskell interpreter
******************************
The major mode ‘inferior-haskell-mode’ provides support for interacting
with an inferior Haskell process based on ‘comint-mode’.
By default the ‘haskell-mode-map’ keymap is setup to use this mode:
‘C-c C-z’
is bound to ‘switch-to-haskell’
‘C-c C-b’
is bound to ‘switch-to-haskell’
‘C-c C-l’
is bound to ‘inferior-haskell-load-file’
‘C-c C-t’
is bound to ‘inferior-haskell-type’
‘C-c C-i’
is bound to ‘inferior-haskell-info’
The Haskell interpreter used by the inferior Haskell mode is
auto-detected by default, but is customizable via the
‘haskell-program-name’ variable.
Currently, GHCi and Hugs are support as Haskell interpreter.
TODO/WRITEME

File: haskell-mode.info, Node: Interactive Haskell, Next: Editing Cabal files, Prev: Inferior Haskell interpreter, Up: Top
10 Interactive Haskell
**********************
An alternative mode providing a REPL (read–eval–print loop) via GHCi
sessions is called ‘haskell-interactive-mode’, which effectively
replaces ‘inferior-haskell-mode’, but comes with a different set of
features:
• Separate sessions per Cabal project ‘haskell-session.el’.
• A new inferior Haskell process handling code ‘haskell-process.el’.
• New REPL implementation similiar to SLIME/IELM
• Navigatable error overlays ‘haskell-interactive-mode.el’.
In order to use ‘haskell-interactive-mode’ instead of the default
‘inferior-haskell-mode’, you need to replace some of the default
keybindings in the ‘haskell-mode-map’ keymap with the respective
‘haskell-interactive-mode’ counterparts:
(eval-after-load "haskell-mode"
'(progn
(define-key haskell-mode-map (kbd "C-x C-d") nil)
(define-key haskell-mode-map (kbd "C-c C-z") 'haskell-interactive-switch)
(define-key haskell-mode-map (kbd "C-c C-l") 'haskell-process-load-file)
(define-key haskell-mode-map (kbd "C-c C-b") 'haskell-interactive-switch)
(define-key haskell-mode-map (kbd "C-c C-t") 'haskell-process-do-type)
(define-key haskell-mode-map (kbd "C-c C-i") 'haskell-process-do-info)
(define-key haskell-mode-map (kbd "C-c M-.") nil)
(define-key haskell-mode-map (kbd "C-c C-d") nil)))
With ‘haskell-interactive-mode’, each Haskell source buffer is
associated with at most one GHCi session, so when you call
‘haskell-process-load-file’ for a Haskell source buffer which has no
session associated yet, you’re asked which GHCi session to create or
associate with.
TODO/WRITEME

File: haskell-mode.info, Node: Editing Cabal files, Next: Changing REPL target, Prev: Interactive Haskell, Up: Top
11 Editing Cabal files
**********************
‘haskell-cabal-mode’ is a major mode for editing Cabal package
description files
(http://www.haskell.org/cabal/users-guide/developing-packages.html) and
is automatically associated with files having a ‘.cabal’ extension.
For quickly locating and jumping to the nearest ‘.cabal’ file from a
Haskell source buffer, you can use ‘M-x haskell-cabal-visit-file’; with
a prefix argument (i.e. ‘C-u’) ‘find-file-other-window’ is used to
visit the ‘.cabal’ file. If you wish, you can bind
‘haskell-cabal-visit-file’ to a convenient key sequence, e.g.
(eval-after-load "haskell-mode"
'(define-key haskell-mode-map (kbd "C-c v c") 'haskell-cabal-visit-file))
TODO/WRITEME

File: haskell-mode.info, Node: Changing REPL target, Next: Concept index, Prev: Editing Cabal files, Up: Top
12 Changing REPL target
***********************
With ‘haskell-session-change-target’ you can change the target for REPL
session.
After REPL session started, in ‘haskell-interactive-mode’ buffer
invoke the ‘haskell-session-change-target’ and select from available
targets for
- Testing
- Benchmark
- Executable
- Library
Answer “yes” to restart the session and run your tests, benchmarks,
executables.
TODO/WRITEME

File: haskell-mode.info, Node: Concept index, Next: Function index, Prev: Changing REPL target, Up: Top
Concept index
*************
[index]
* Menu:
* benchmarking: Changing REPL target. (line 15)
* CUA mode: Indentation. (line 76)
* customizing: Getting Started. (line 9)
* ‘haskell-mode’: Editing Haskell Code. (line 6)
* indentation: Indentation. (line 6)
* layout rule: Indentation. (line 6)
* literate programming: Editing Haskell Code. (line 27)
* off-side rule: Indentation. (line 6)
* rectangle: Indentation. (line 76)
* testing: Changing REPL target. (line 13)
* Unicode: Unicode support. (line 6)

File: haskell-mode.info, Node: Function index, Next: Variable index, Prev: Concept index, Up: Top
Function index
**************
[index]
* Menu:
* haskell-cabal-mode: Editing Cabal files. (line 6)
* haskell-cabal-visit-file: Editing Cabal files. (line 11)
* haskell-compile: Compilation. (line 6)
* haskell-decl-scan-mode: Declaration scanning. (line 6)
* haskell-indent-mode: Indentation. (line 24)
* haskell-indentation-mode: Indentation. (line 35)
* haskell-mode: Editing Haskell Code. (line 6)
* haskell-move-nested-left: Indentation. (line 68)
* haskell-move-nested-right: Indentation. (line 68)
* haskell-session-change-target: Changing REPL target. (line 6)
* haskell-simple-indent-mode: Indentation. (line 17)
* inferior-haskell-find-definition: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-find-haddock: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-info: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-load-and-run: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-load-file: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-mode: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-reload-file: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-start-process: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-type: Inferior Haskell interpreter.
(line 6)
* literate-haskell-mode: Editing Haskell Code. (line 27)

File: haskell-mode.info, Node: Variable index, Prev: Function index, Up: Top
Variable index
**************
[index]
* Menu:
* haskell-cabal-mode-hook: Editing Cabal files. (line 6)
* haskell-compile-cabal-build-command: Compilation. (line 35)
* haskell-compile-cabal-build-command-alt: Compilation. (line 35)
* haskell-compile-command: Compilation. (line 35)
* haskell-decl-scan-mode-hook: Declaration scanning. (line 6)
* haskell-interactive-mode-hook: Changing REPL target. (line 6)
* haskell-mode-hook: Getting Started. (line 15)
* haskell-program-name: Inferior Haskell interpreter.
(line 6)
* inferior-haskell-mode-hook: Inferior Haskell interpreter.
(line 6)

Tag Table:
Node: Top679
Node: Introduction1948
Node: Getting Help and Reporting Bugs2465
Node: Getting Started3927
Node: Editing Haskell Code4923
Ref: Editing Haskell Code-Footnote-17216
Ref: Editing Haskell Code-Footnote-27307
Ref: Editing Haskell Code-Footnote-37366
Node: Unicode support7450
Node: Indentation9140
Ref: Indentation-Footnote-113028
Node: Declaration scanning13213
Node: Compilation15350
Node: Inferior Haskell interpreter18120
Node: Interactive Haskell19050
Node: Editing Cabal files20927
Node: Changing REPL target21813
Node: Concept index22389
Node: Function index23358
Node: Variable index25688

End Tag Table

Local Variables:
coding: utf-8
End:

114
dotfiles/emacs.d/elpa/haskell-mode-20151022.340/haskell-modules.el

@ -0,0 +1,114 @@
;;; haskell-modules.el --- -*- lexical-binding: t -*-
;; Copyright (c) 2014 Chris Done. All rights reserved.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'haskell-sort-imports)
(require 'haskell-align-imports)
(require 'haskell-session)
(require 'haskell-navigate-imports)
(require 'haskell-complete-module)
(require 'haskell-sandbox)
(defun haskell-add-import (&optional module)
"Add an import to the import list."
(interactive)
(save-excursion
(goto-char (point-max))
(haskell-navigate-imports)
(insert (haskell-import-for-module
(or module
(haskell-complete-module-read
"Module: "
(haskell-session-all-modules (haskell-modules-session))))))
(haskell-sort-imports)
(haskell-align-imports)))
(defun haskell-import-for-module (module)
"Get import statements for the given module."
(let ((mapping (assoc module haskell-import-mapping)))
(if mapping
(cdr mapping)
(concat (read-from-minibuffer "Import line: "
(format "import %s" module))
"\n"))))
;;;###autoload
(defun haskell-session-installed-modules (_session &optional _dontcreate)
"Get the modules installed in the current package set."
;; TODO: Again, this makes HEAVY use of unix utilities. It'll work
;; fine in Linux, probably okay on OS X, and probably not at all on
;; Windows. Again, if someone wants to test on Windows and come up
;; with alternatives that's OK.
;;
;; Ideally all these package queries can be provided by a Haskell
;; program based on the Cabal API. Possibly as a nice service. Such
;; a service could cache and do nice things like that. For now, this
;; simple shell script takes us far.
;;
;; Probably also we can take the code from inferior-haskell-mode.
;;
;; Ugliness aside, if it saves us time to type it's a winner.
;;
;; FIXME/TODO: add support for (eq 'cabal-repl (haskell-process-type))
(let ((session (haskell-session-maybe)))
(when session
(let ((modules (shell-command-to-string
(format "%s | %s | %s"
(cond
((haskell-sandbox-exists-p session)
(concat "ghc-pkg dump -f "
(shell-quote-argument (haskell-sandbox-pkgdb session))))
(t "ghc-pkg dump"))
"egrep '^(exposed-modules: | )[A-Z]'"
"cut -c18-"))))
(split-string modules)))))
;;;###autoload
(defun haskell-session-all-modules (session &optional dontcreate)
"Get all modules -- installed or in the current project.
If DONTCREATE is non-nil don't create a new session."
(append (haskell-session-installed-modules session dontcreate)
(haskell-session-project-modules session dontcreate)))
;;;###autoload
(defun haskell-session-project-modules (session &optional dontcreate)
"Get the modules of the current project.
If DONTCREATE is non-nil don't create a new session."
(if (or (not dontcreate) (haskell-session-maybe))
(let* ((modules
(shell-command-to-string
(format "%s && %s"
(format "cd %s" (haskell-session-cabal-dir session))
;; TODO: Use a different, better source. Possibly hasktags or some such.
;; TODO: At least make it cross-platform. Linux
;; (and possibly OS X) have egrep, Windows
;; doesn't -- or does it via Cygwin or MinGW?
;; This also doesn't handle module\nName. But those gits can just cut it out!
"egrep '^module[\t\r ]+[^(\t\r ]+' . -r -I --include='*.*hs' --include='*.hsc' -s -o -h | sed 's/^module[\t\r ]*//' | sort | uniq"))))
(split-string modules))))
(defun haskell-modules-session ()
"Get the `haskell-session', throw an error if it's not
available."
(or (haskell-session-maybe)
(haskell-session-assign
(or (haskell-session-from-buffer)
(haskell-session-choose)
(error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug.")))))
(provide 'haskell-modules)

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save