dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

cider-classpath.el (3635B)


      1 ;;; cider-classpath.el --- Basic Java classpath browser  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors
      4 
      5 ;; This program is free software: you can redistribute it and/or modify
      6 ;; it under the terms of the GNU General Public License as published by
      7 ;; the Free Software Foundation, either version 3 of the License, or
      8 ;; (at your option) any later version.
      9 
     10 ;; This program is distributed in the hope that it will be useful,
     11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13 ;; GNU General Public License for more details.
     14 
     15 ;; You should have received a copy of the GNU General Public License
     16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17 
     18 ;; This file is not part of GNU Emacs.
     19 
     20 ;;; Commentary:
     21 
     22 ;; Basic Java classpath browser for CIDER.
     23 
     24 ;;; Code:
     25 
     26 (require 'cider-client)
     27 (require 'cider-popup)
     28 (require 'subr-x)
     29 
     30 (defvar cider-classpath-buffer "*cider-classpath*")
     31 
     32 (defvar cider-classpath-mode-map
     33   (let ((map (make-sparse-keymap)))
     34     (set-keymap-parent map cider-popup-buffer-mode-map)
     35     (define-key map (kbd "RET") #'cider-classpath-operate-on-point)
     36     (define-key map "n" #'next-line)
     37     (define-key map "p" #'previous-line)
     38     map))
     39 
     40 (defvar cider-classpath-mouse-map
     41   (let ((map (make-sparse-keymap)))
     42     (define-key map [mouse-1] #'cider-classpath-handle-mouse)
     43     map))
     44 
     45 (define-derived-mode cider-classpath-mode special-mode "classpath"
     46   "Major mode for browsing the entries in Java's classpath.
     47 
     48 \\{cider-classpath-mode-map}"
     49   (setq-local electric-indent-chars nil)
     50   (setq-local sesman-system 'CIDER)
     51   (when cider-special-mode-truncate-lines
     52     (setq-local truncate-lines t)))
     53 
     54 (defun cider-classpath-list (buffer items)
     55   "Populate BUFFER with ITEMS."
     56   (with-current-buffer buffer
     57     (cider-classpath-mode)
     58     (let ((inhibit-read-only t))
     59       (erase-buffer)
     60       (dolist (item items)
     61         (insert item "\n"))
     62       (goto-char (point-min)))))
     63 
     64 (defun cider-classpath-properties (text)
     65   "Decorate TEXT with a clickable keymap and function face."
     66   (let ((face (cond
     67                ((not (file-exists-p text)) 'font-lock-warning-face)
     68                ((file-directory-p text) 'dired-directory)
     69                (t 'default))))
     70     (propertize text
     71                 'font-lock-face face
     72                 'mouse-face 'highlight
     73                 'keymap cider-classpath-mouse-map)))
     74 
     75 (defun cider-classpath-operate-on-point ()
     76   "Expand browser according to thing at current point."
     77   (interactive)
     78   (let* ((bol (line-beginning-position))
     79          (eol (line-end-position))
     80          (line (buffer-substring-no-properties bol eol)))
     81     (find-file-other-window line)))
     82 
     83 (defun cider-classpath-handle-mouse (_event)
     84   "Handle mouse click EVENT."
     85   (interactive "e")
     86   (cider-classpath-operate-on-point))
     87 
     88 ;;;###autoload
     89 (defun cider-classpath ()
     90   "List all classpath entries."
     91   (interactive)
     92   (cider-ensure-connected)
     93   (with-current-buffer (cider-popup-buffer cider-classpath-buffer 'select nil 'ancillary)
     94     (cider-classpath-list (current-buffer)
     95                           (mapcar (lambda (name)
     96                                     (cider-classpath-properties name))
     97                                   (cider-classpath-entries)))))
     98 
     99 ;;;###autoload
    100 (defun cider-open-classpath-entry ()
    101   "Open a classpath entry."
    102   (interactive)
    103   (cider-ensure-connected)
    104   (when-let* ((entry (completing-read "Classpath entries: " (cider-classpath-entries))))
    105     (find-file-other-window entry)))
    106 
    107 (provide 'cider-classpath)
    108 
    109 ;;; cider-classpath.el ends here