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 regels
6.1 KiB
166 regels
6.1 KiB
;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*-
|
|
|
|
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
|
|
;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors
|
|
;;
|
|
;; Author: Tim King <kingtim@gmail.com>
|
|
;; Phil Hagelberg <technomancy@gmail.com>
|
|
;; Bozhidar Batsov <bozhidar@batsov.com>
|
|
;; Artur Malabarba <bruce.connor.am@gmail.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-eval)
|
|
(require 'cider-scratch)
|
|
(require 'cider-profile)
|
|
|
|
(defconst cider-selector-help-buffer "*CIDER 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'.
|
|
Not meant to be set by users. It's used internally
|
|
by `cider-selector'.")
|
|
|
|
(defun cider-selector--recently-visited-buffer (mode)
|
|
"Return the most recently visited buffer, deriving its `major-mode' from MODE.
|
|
Only considers buffers that are not already visible."
|
|
(cl-loop for buffer in (buffer-list)
|
|
when (and (with-current-buffer buffer
|
|
(derived-mode-p mode))
|
|
;; names starting with space are considered hidden by Emacs
|
|
(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 the
|
|
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-selector--recently-visited-buffer 'clojure-mode))
|
|
|
|
(def-cider-selector-method ?e
|
|
"Most recently visited emacs-lisp-mode buffer."
|
|
(cider-selector--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))
|
|
|
|
(def-cider-selector-method ?m
|
|
"Current connection's *nrepl-messages* buffer."
|
|
(nrepl-messages-buffer (cider-current-repl)))
|
|
|
|
(def-cider-selector-method ?x
|
|
"*cider-error* buffer."
|
|
cider-error-buffer)
|
|
|
|
(def-cider-selector-method ?p
|
|
"CIDER profiler buffer."
|
|
cider-profile-buffer)
|
|
|
|
(def-cider-selector-method ?d
|
|
"*cider-doc* buffer."
|
|
cider-doc-buffer)
|
|
|
|
(def-cider-selector-method ?s
|
|
"*cider-scratch* buffer."
|
|
(cider-scratch-find-or-create-buffer))
|
|
|
|
(provide 'cider-selector)
|
|
|
|
;;; cider-selector.el ends here
|