emacs/code/elpa/lsp-ui-20230811.552/lsp-ui-imenu.el

435 lines
16 KiB
EmacsLisp
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; lsp-ui-imenu.el --- Lsp-Ui-Imenu -*- lexical-binding: t -*-
;; Copyright (C) 2018 Sebastien Chapuis
;; Author: Sebastien Chapuis <sebastien@chapu.is>
;; URL: https://github.com/emacs-lsp/lsp-ui
;; Keywords: languages, tools
;; Version: 6.3
;;; License
;;
;; 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, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;; Show imenu entries
;; Call the function `lsp-ui-imenu'
;;
;; (define-key lsp-ui-mode-map (kbd "C-c l") 'lsp-ui-imenu)
;;; Code:
(require 'lsp-mode)
(require 'dash)
(require 'lsp-ui-util)
(defgroup lsp-ui-imenu nil
"Display imenu entries."
:group 'tools
:group 'convenience
:group 'lsp-ui
:link '(custom-manual "(lsp-ui-imenu) Top")
:link '(info-link "(lsp-ui-imenu) Customizing"))
(defcustom lsp-ui-imenu-enable t
"Whether or not to enable lsp-ui-imenu."
:type 'boolean
:group 'lsp-ui)
(defcustom lsp-ui-imenu-kind-position 'top
"Where to show the entries kind."
:type '(choice (const :tag "Top" top)
(const :tag "Left" left))
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-buffer-position 'right
"Where to place the `lsp-ui-imenu' buffer."
:type '(choice (const :tag "Left" left)
(const :tag "Right" right))
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-colors '("deep sky blue" "green3")
"Color list to cycle through for entry groups."
:type '(repeat color)
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-window-width 0
"When not 0, don't fit window to buffer and use value as window-width."
:type 'number
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-window-fix-width nil
"If non-nil, the `lsp-ui-imenu' window will permanently maintain its width.
ie. it will not be affected by `balance-windows' etc."
:type 'boolean
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-auto-refresh nil
"Automatically refresh imenu when certain conditions meet."
:type '(choice (const :tag "Enable" t)
(const :tag "Active only when after save" after-save)
(const :tag "Disable" nil))
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu-auto-refresh-delay 1.0
"Delay time to refresh imenu."
:type 'float
:group 'lsp-ui-imenu)
(defcustom lsp-ui-imenu--custom-mode-line-format nil
"Custom mode line format to be used in `lsp-ui-menu-mode'."
:type 'sexp
:group 'lsp-ui-menu)
(defconst lsp-ui-imenu--max-bars 8)
(declare-function imenu--make-index-alist 'imenu)
(declare-function imenu--subalist-p 'imenu)
(defvar imenu--index-alist)
(defvar-local lsp-ui-imenu--refresh-timer nil
"Auto refresh timer for imenu.")
(defun lsp-ui-imenu--pad (s len bars depth color-index for-title is-last)
(let ((n (- len (length s))))
(apply #'concat
(make-string n ?\s)
(propertize s 'face `(:foreground ,(lsp-ui-imenu--get-color color-index)))
(let (bar-strings)
(dotimes (i depth)
(push
(propertize (lsp-ui-imenu--get-bar bars i depth for-title is-last)
'face `(:foreground
,(lsp-ui-imenu--get-color (+ color-index i))))
bar-strings))
(reverse bar-strings)))))
(defun lsp-ui-imenu--get-bar (bars index depth for-title is-last)
(cond
;; Exceeding maximum bars
((>= index lsp-ui-imenu--max-bars) " ")
;; No bar for this level
((not (aref bars index)) " ")
;; For the first level, the title is rendered differently, so leaf items are
;; decorated with the full height bar regardless if it's the last item or
;; not.
((and (= depth 1) (not for-title)) "")
;; Full height bar for levels other than the rightmost one.
((< (1+ index) depth) "")
;; The rightmost bar for the last item.
(is-last "" )
;; The rightmost bar for the title items other than the last one.
(for-title "")
;; The rightmost bar for the leaf items other than the last one.
(t "")))
(defun lsp-ui-imenu--get-color (index)
(nth (mod index (length lsp-ui-imenu-colors)) lsp-ui-imenu-colors))
(defun lsp-ui-imenu--make-line (title index entry padding bars depth color-index is-last)
(let* ((prefix (if (and (= index 0) (eq lsp-ui-imenu-kind-position 'left)) title " "))
(text (concat (lsp-ui-imenu--pad prefix padding bars depth color-index nil is-last)
(propertize (car entry) 'face 'default)
"\n"))
(len (length text)))
(add-text-properties 0 len `(index ,index title ,title marker ,(cdr entry)
padding ,padding depth, depth)
text)
text))
(defvar-local lsp-ui-imenu-ov nil
"Variable that holds overlay for imenu.")
(defun lsp-ui-imenu--make-ov nil
"Make imenu overlay."
(or (and (overlayp lsp-ui-imenu-ov) lsp-ui-imenu-ov)
(setq lsp-ui-imenu-ov (make-overlay 1 1))))
(defun lsp-ui-imenu--post-command nil
"Post command hook for imenu."
(when (eobp) (forward-line -1))
(lsp-ui-imenu--move-to-name-beginning)
(when (eq lsp-ui-imenu-kind-position 'left)
(save-excursion
(when (overlayp lsp-ui-imenu-ov)
(overlay-put lsp-ui-imenu-ov 'display nil))
(redisplay)
(goto-char (window-start))
(if (= (get-text-property (point) 'index) 0)
(when (overlayp lsp-ui-imenu-ov) (delete-overlay lsp-ui-imenu-ov))
(let* ((ov (lsp-ui-imenu--make-ov))
(padding (get-text-property (point) 'padding))
(title (get-text-property (point) 'title))
(text (buffer-substring (+ (line-beginning-position) padding) (line-end-position))))
(move-overlay ov (line-beginning-position) (line-end-position))
(overlay-put ov 'display `(string ,(concat (let ((n (- padding (length title))))
(propertize (concat (make-string n ?\s) title)))
text))))))))
(defun lsp-ui-imenu--move-to-name-beginning ()
(-when-let* ((padding (get-char-property (point) 'padding))
(depth (get-char-property (point) 'depth)))
(goto-char (+ (* depth 3) (line-beginning-position) padding))))
(defvar lsp-ui-imenu--origin nil)
(defun lsp-ui-imenu--put-separator nil
(let ((ov (make-overlay (point) (point))))
(overlay-put ov 'after-string (propertize "\n" 'face '(:height 0.6)))
(overlay-put ov 'priority 0)))
(defvar-local overlay-priority 0)
(defun lsp-ui-imenu--put-toplevel-title (title color-index)
(if (eq lsp-ui-imenu-kind-position 'top)
(let ((ov (make-overlay (point) (point)))
(color (lsp-ui-imenu--get-color color-index)))
(overlay-put
ov 'after-string
(concat (propertize "\n" 'face '(:height 0.6))
(propertize title 'face `(:foreground ,color))
"\n"
(propertize "\n" 'face '(:height 0.6))))
(overlay-put ov 'priority (setq overlay-priority (1- overlay-priority))))
;; Left placement, title is put with the first sub item. Only put a separator here.
(lsp-ui-imenu--put-separator)))
(defun lsp-ui-imenu--put-subtitle (title padding bars depth color-index is-last)
(let ((ov (make-overlay (point) (point)))
(title-color (lsp-ui-imenu--get-color (+ color-index depth))))
(overlay-put
ov 'after-string
(concat (lsp-ui-imenu--pad " " padding bars depth color-index t is-last)
(propertize title 'face `(:foreground ,title-color))
(propertize "\n" 'face '(:height 1))))
(overlay-put ov 'priority (setq overlay-priority (1- overlay-priority)))))
(defun lsp-ui-imenu--insert-items (title items padding bars depth color-index)
"Insert ITEMS for TITLE.
PADDING is the length of whitespaces to the left of the first bar.
BARS is a bool vector of length `lsp-ui-imenu--max-bars'. The ith
value indicates whether the ith bar from the left is visible.
DEPTH is the depth of the items in the index tree, starting from 0.
COLOR-INDEX is the index of the color of the leftmost bar.
Return the updated COLOR-INDEX."
(--each-indexed items
(let ((is-last (= (1+ it-index) (length items))))
(if (imenu--subalist-p it)
(-let* (((sub-title . entries) it))
(if (= depth 0)
(lsp-ui-imenu--put-toplevel-title sub-title color-index)
(lsp-ui-imenu--put-subtitle sub-title padding bars depth color-index is-last))
(when (and is-last (> depth 0))
(aset bars (1- depth) nil))
(let ((lsp-ui-imenu-kind-position (if (> depth 0) 'top
lsp-ui-imenu-kind-position)))
(lsp-ui-imenu--insert-items sub-title
entries
padding
bars
(1+ depth)
color-index))
(when (and is-last (> depth 0))
(aset bars (1- depth) t))
(when (= depth 0)
(setq color-index (1+ color-index))))
(insert (lsp-ui-imenu--make-line title it-index it
padding bars depth color-index
is-last)))))
color-index)
(defun lsp-ui-imenu--get-padding (items)
"Get imenu padding determined by `lsp-ui-imenu-kind-position'.
ITEMS are used when the kind position is 'left."
(cl-case lsp-ui-imenu-kind-position
(top 1)
(left (--> (-filter 'imenu--subalist-p items)
(--map (length (car it)) it)
(-max (or it '(1)))))
(t (user-error "Invalid value for imenu's kind position: %s" lsp-ui-imenu-kind-position))))
(defun lsp-ui-imenu--put-bit (bits offset)
(logior bits (lsh 1 offset)))
(defun lsp-ui-imenu--clear-bit (bits offset)
(logand bits (lognot (lsh 1 offset))))
(defvar lsp-ui-imenu-buffer-name "*lsp-ui-imenu*"
"Buffer name for imenu buffers.")
(defun lsp-ui-imenu--refresh-content ()
"Refresh imenu content menu"
(let ((imenu-auto-rescan t))
(setq lsp-ui-imenu--origin (current-buffer))
(imenu--make-index-alist)
(let ((imenu-buffer (get-buffer-create lsp-ui-imenu-buffer-name))
(list imenu--index-alist))
(with-current-buffer imenu-buffer
(let* ((padding (lsp-ui-imenu--get-padding list))
(grouped-by-subs (-partition-by 'imenu--subalist-p list))
(color-index 0)
(bars (make-bool-vector lsp-ui-imenu--max-bars t))
(inhibit-read-only t))
(remove-overlays)
(erase-buffer)
(dolist (group grouped-by-subs)
(if (imenu--subalist-p (car group))
(setq color-index (lsp-ui-imenu--insert-items "" group padding bars 0 color-index))
(lsp-ui-imenu--put-separator)
(lsp-ui-imenu--insert-items "" group padding bars 1 color-index)
(setq color-index (1+ color-index))))
(lsp-ui-imenu-mode)
(when lsp-ui-imenu--custom-mode-line-format
(setq mode-line-format lsp-ui-imenu--custom-mode-line-format))
(goto-char (point-min))
(add-hook 'post-command-hook 'lsp-ui-imenu--post-command nil t))))))
(defun lsp-ui-imenu nil
"Open ui-imenu in side window."
(interactive)
(lsp-ui-imenu-buffer-mode 1)
(setq lsp-ui-imenu--origin (current-buffer))
(imenu--make-index-alist)
(let ((imenu-buffer (get-buffer-create lsp-ui-imenu-buffer-name)))
(lsp-ui-imenu--refresh-content)
(let ((win (display-buffer-in-side-window imenu-buffer
`((side . ,(if (eq lsp-ui-imenu-buffer-position 'left)
'left
'right))))))
(set-window-margins win 1)
(select-window win)
(set-window-start win 1)
(lsp-ui-imenu--move-to-name-beginning)
(set-window-dedicated-p win t)
(let ((window-size-fixed)) ;; Temporarily set `window-size-fixed' to nil for resizing.
;; When `lsp-ui-imenu-window-width' is 0, fit window to buffer:
(if (= lsp-ui-imenu-window-width 0)
(let ((fit-window-to-buffer-horizontally 'only))
(fit-window-to-buffer win)
(window-resize win 3 t))
(let ((x (- lsp-ui-imenu-window-width (window-width))))
(window-resize (selected-window) x t))))
)))
(defun lsp-ui-imenu--kill nil
"Kill imenu window."
(interactive)
(lsp-ui-imenu-buffer-mode -1)
(kill-buffer-and-window))
(defun lsp-ui-imenu--jump (direction)
(let ((current (get-text-property (point) 'title)))
(forward-line direction)
(while (and current
(not (= (line-number-at-pos) 1))
(equal current (get-text-property (point) 'title)))
(forward-line direction))))
(defun lsp-ui-imenu--next-kind nil
"Jump to next kind of imenu."
(interactive)
(lsp-ui-imenu--jump 1))
(defun lsp-ui-imenu--prev-kind nil
"Jump to previous kind of imenu."
(interactive)
(lsp-ui-imenu--jump -1)
(while (not (= (get-text-property (point) 'index) 0))
(forward-line -1)))
(defun lsp-ui-imenu--visit nil
(interactive)
(let ((marker (get-text-property (point) 'marker)))
(select-window (get-buffer-window lsp-ui-imenu--origin))
(goto-char marker)
(pulse-momentary-highlight-one-line (point) 'next-error)))
(defun lsp-ui-imenu--view nil
(interactive)
(let ((marker (get-text-property (point) 'marker)))
(with-selected-window (get-buffer-window lsp-ui-imenu--origin)
(goto-char marker)
(recenter)
(pulse-momentary-highlight-one-line (point) 'next-error))))
(defvar lsp-ui-imenu-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") 'lsp-ui-imenu--kill)
(define-key map (kbd "r") 'lsp-ui-imenu--refresh)
(define-key map (kbd "<right>") 'lsp-ui-imenu--next-kind)
(define-key map (kbd "<left>") 'lsp-ui-imenu--prev-kind)
(define-key map (kbd "<return>") 'lsp-ui-imenu--view)
(define-key map (kbd "<M-return>") 'lsp-ui-imenu--visit)
(define-key map (kbd "RET") 'lsp-ui-imenu--view)
(define-key map (kbd "M-RET") 'lsp-ui-imenu--visit)
map)
"Keymap for lsp-ui-peek-mode.")
(define-derived-mode lsp-ui-imenu-mode special-mode "lsp-ui-imenu"
"Mode showing imenu entries."
(setq window-size-fixed (if lsp-ui-imenu-window-fix-width 'width nil)))
(defun lsp-ui-imenu--refresh ()
"Safe refresh imenu content."
(interactive)
(let ((imenu-buffer (get-buffer lsp-ui-imenu-buffer-name)))
(when imenu-buffer
(save-selected-window
(if (equal (current-buffer) imenu-buffer)
(select-window (get-buffer-window lsp-ui-imenu--origin))
(setq lsp-ui-imenu--origin (current-buffer)))
(lsp-ui-imenu--refresh-content)))))
(defun lsp-ui-imenu--start-refresh (&rest _)
"Starts the auto refresh timer."
(lsp-ui-util-safe-kill-timer lsp-ui-imenu--refresh-timer)
(setq lsp-ui-imenu--refresh-timer
(run-with-idle-timer lsp-ui-imenu-auto-refresh-delay nil #'lsp-ui-imenu--refresh)))
(defun lsp-ui-imenu-buffer--enable ()
"Enable `lsp-ui-imenu-buffer'."
(when lsp-ui-imenu-auto-refresh
(cl-case lsp-ui-imenu-auto-refresh
(after-save
(add-hook 'after-save-hook #'lsp-ui-imenu--start-refresh nil t))
(t
(add-hook 'after-change-functions #'lsp-ui-imenu--start-refresh nil t)
(add-hook 'after-save-hook #'lsp-ui-imenu--start-refresh nil t)))))
(defun lsp-ui-imenu-buffer--disable ()
"Disable `lsp-ui-imenu-buffer'."
(when lsp-ui-imenu-auto-refresh
(cl-case lsp-ui-imenu-auto-refresh
(after-save
(remove-hook 'after-save-hook #'lsp-ui-imenu--start-refresh t))
(t
(remove-hook 'after-change-functions #'lsp-ui-imenu--start-refresh t)
(remove-hook 'after-save-hook #'lsp-ui-imenu--start-refresh t)))))
(define-minor-mode lsp-ui-imenu-buffer-mode
"Minor mode 'lsp-ui-imenu-buffer-mode'."
:group lsp-ui-imenu
(if lsp-ui-imenu-buffer-mode (lsp-ui-imenu-buffer--enable) (lsp-ui-imenu-buffer--disable)))
(provide 'lsp-ui-imenu)
;;; lsp-ui-imenu.el ends here