Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

166 lines
6.1 KiB

4 years ago
  1. ;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*-
  2. ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
  3. ;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors
  4. ;;
  5. ;; Author: Tim King <kingtim@gmail.com>
  6. ;; Phil Hagelberg <technomancy@gmail.com>
  7. ;; Bozhidar Batsov <bozhidar@batsov.com>
  8. ;; Artur Malabarba <bruce.connor.am@gmail.com>
  9. ;; Hugo Duncan <hugo@hugoduncan.org>
  10. ;; Steve Purcell <steve@sanityinc.com>
  11. ;; This program is free software: you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation, either version 3 of the License, or
  14. ;; (at your option) any later version.
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  21. ;; This file is not part of GNU Emacs.
  22. ;;; Commentary:
  23. ;; Buffer selection command inspired by SLIME's selector.
  24. ;;; Code:
  25. (require 'cider-client)
  26. (require 'cider-eval)
  27. (require 'cider-scratch)
  28. (require 'cider-profile)
  29. (defconst cider-selector-help-buffer "*CIDER Selector Help*"
  30. "The name of the selector's help buffer.")
  31. (defvar cider-selector-methods nil
  32. "List of buffer-selection methods for the `cider-selector' command.
  33. Each element is a list (KEY DESCRIPTION FUNCTION).
  34. DESCRIPTION is a one-line description of what the key selects.")
  35. (defvar cider-selector-other-window nil
  36. "If non-nil use `switch-to-buffer-other-window'.
  37. Not meant to be set by users. It's used internally
  38. by `cider-selector'.")
  39. (defun cider-selector--recently-visited-buffer (mode)
  40. "Return the most recently visited buffer, deriving its `major-mode' from MODE.
  41. Only considers buffers that are not already visible."
  42. (cl-loop for buffer in (buffer-list)
  43. when (and (with-current-buffer buffer
  44. (derived-mode-p mode))
  45. ;; names starting with space are considered hidden by Emacs
  46. (not (string-match-p "^ " (buffer-name buffer)))
  47. (null (get-buffer-window buffer 'visible)))
  48. return buffer
  49. finally (error "Can't find unshown buffer in %S" mode)))
  50. ;;;###autoload
  51. (defun cider-selector (&optional other-window)
  52. "Select a new buffer by type, indicated by a single character.
  53. The user is prompted for a single character indicating the method by
  54. which to choose a new buffer. The `?' character describes the
  55. available methods. OTHER-WINDOW provides an optional target.
  56. See `def-cider-selector-method' for defining new methods."
  57. (interactive)
  58. (message "Select [%s]: "
  59. (apply #'string (mapcar #'car cider-selector-methods)))
  60. (let* ((cider-selector-other-window other-window)
  61. (ch (save-window-excursion
  62. (select-window (minibuffer-window))
  63. (read-char)))
  64. (method (cl-find ch cider-selector-methods :key #'car)))
  65. (cond (method
  66. (funcall (cl-caddr method)))
  67. (t
  68. (message "No method for character: ?\\%c" ch)
  69. (ding)
  70. (sleep-for 1)
  71. (discard-input)
  72. (cider-selector)))))
  73. (defmacro def-cider-selector-method (key description &rest body)
  74. "Define a new `cider-select' buffer selection method.
  75. KEY is the key the user will enter to choose this method.
  76. DESCRIPTION is a one-line sentence describing how the method
  77. selects a buffer.
  78. BODY is a series of forms which are evaluated when the selector
  79. is chosen. The returned buffer is selected with
  80. `switch-to-buffer'."
  81. (let ((method `(lambda ()
  82. (let ((buffer (progn ,@body)))
  83. (cond ((not (get-buffer buffer))
  84. (message "No such buffer: %S" buffer)
  85. (ding))
  86. ((get-buffer-window buffer)
  87. (select-window (get-buffer-window buffer)))
  88. (cider-selector-other-window
  89. (switch-to-buffer-other-window buffer))
  90. (t
  91. (switch-to-buffer buffer)))))))
  92. `(setq cider-selector-methods
  93. (cl-sort (cons (list ,key ,description ,method)
  94. (cl-remove ,key cider-selector-methods :key #'car))
  95. #'< :key #'car))))
  96. (def-cider-selector-method ?? "Selector help buffer."
  97. (ignore-errors (kill-buffer cider-selector-help-buffer))
  98. (with-current-buffer (get-buffer-create cider-selector-help-buffer)
  99. (insert "CIDER Selector Methods:\n\n")
  100. (cl-loop for (key line nil) in cider-selector-methods
  101. do (insert (format "%c:\t%s\n" key line)))
  102. (goto-char (point-min))
  103. (help-mode)
  104. (display-buffer (current-buffer) t))
  105. (cider-selector)
  106. (current-buffer))
  107. (cl-pushnew (list ?4 "Select in other window" (lambda () (cider-selector t)))
  108. cider-selector-methods :key #'car)
  109. (def-cider-selector-method ?c
  110. "Most recently visited clojure-mode buffer."
  111. (cider-selector--recently-visited-buffer 'clojure-mode))
  112. (def-cider-selector-method ?e
  113. "Most recently visited emacs-lisp-mode buffer."
  114. (cider-selector--recently-visited-buffer 'emacs-lisp-mode))
  115. (def-cider-selector-method ?q "Abort."
  116. (top-level))
  117. (def-cider-selector-method ?r
  118. "Current REPL buffer."
  119. (cider-current-repl))
  120. (def-cider-selector-method ?m
  121. "Current connection's *nrepl-messages* buffer."
  122. (nrepl-messages-buffer (cider-current-repl)))
  123. (def-cider-selector-method ?x
  124. "*cider-error* buffer."
  125. cider-error-buffer)
  126. (def-cider-selector-method ?p
  127. "CIDER profiler buffer."
  128. cider-profile-buffer)
  129. (def-cider-selector-method ?d
  130. "*cider-doc* buffer."
  131. cider-doc-buffer)
  132. (def-cider-selector-method ?s
  133. "*cider-scratch* buffer."
  134. (cider-scratch-find-or-create-buffer))
  135. (provide 'cider-selector)
  136. ;;; cider-selector.el ends here