dotemacs

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

commit 458b2933ab44e96f9fb0a910fd2bdc518ba99174
parent 6162ef85c535ea9ee913dc743db53045be3a4c06
Author: Lukas Henkel <lh@entf.net>
Date:   Sat, 11 Dec 2021 19:38:49 +0100

Emacs config redone once again

Simple config using customize and package.el, no straight, no
use-package.

Diffstat:
M.gitignore | 5+++--
DREADME | 2--
Dconfig.org | 472-------------------------------------------------------------------------------
Mearly-init.el | 1-
Minit.el | 193++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
Alisp/consult-eglot.el | 208+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
6 files changed, 403 insertions(+), 478 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -15,4 +15,6 @@ straight tramp transient url -var -\ No newline at end of file +var +/games/ +*~ diff --git a/README b/README @@ -1 +0,0 @@ -config.org -\ No newline at end of file diff --git a/config.org b/config.org @@ -1,472 +0,0 @@ -#+TITLE: Emacs config -#+AUTHOR: Lukas Henkel - -This is my personal Emacs configuration. It's made to be reproducable on Linux and Windows, however just like any personal config, it does make some assumptions ;) - -I use the [[https://blog.golang.org/go-fonts][Go]] and [[https://github.com/IBM/plex][IBM Plex]] fonts, which probably need to be installed for this to work. - -* Setup -** load path -Add a local directory to the load path to be able to load custom local libraries. -#+begin_src emacs-lisp - (push - (let ((lisp-path (expand-file-name "lisp" user-emacs-directory))) - (unless (file-exists-p lisp-path) - (make-directory lisp-path)) - lisp-path) - load-path) -#+end_src -** straight.el -#+begin_src emacs-lisp - (setq straight-use-package-by-default t) - (defvar bootstrap-version) - (let ((bootstrap-file - (expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory)) - (bootstrap-version 5)) - (unless (file-exists-p bootstrap-file) - (with-current-buffer - (url-retrieve-synchronously - "https://raw.githubusercontent.com/raxod502/straight.el/develop/install.el" - 'silent 'inhibit-cookies) - (goto-char (point-max)) - (eval-print-last-sexp))) - (load bootstrap-file nil 'nomessage)) -#+end_src -** use-package -#+begin_src emacs-lisp - (straight-use-package 'use-package) -#+end_src -** diminish -diminish removes modes from the modeline, to make it a bit more clean. It's called via use-packages =diminish=. -#+begin_src emacs-lisp - (use-package diminish - :straight t) -#+end_src -** System independent directories -Here we figure out some directories later used in this config in a (hopefully) system independent way. -#+begin_src emacs-lisp - (defun lh/xdg-dir (name default) - (let ((v (string-trim (shell-command-to-string "xdg-user-dir DOCUMENTS")))) - (if (null v) - default - v))) - - (setq lh/dir-documents (expand-file-name - (cond ((eq system-type 'gnu/linux) (lh/xdg-dir "XDG_DOCUMENTS_DIR" "~/Documents")) - ((eq system-type 'windows-nt) "~/Documents")))) - - (setq lh/dir-data-home (expand-file-name - (cond ((eq system-type 'gnu/linux) (or (getenv "XDG_DATA_HOME") "~/.local/share")) - ((eq system-type 'windows-nt) (getenv "APPDATA"))))) -#+end_src -** Shell on windows -Shell on windows is cmd.exe. Who needs that? -#+begin_src emacs-lisp - (when (eq system-type 'windows-nt) - (setq shell-file-name "sh.exe")) -#+end_src -* Basic settings -** Cursor -I prefer the bar cursor. -#+begin_src emacs-lisp - (setq-default cursor-type 'bar) -#+end_src -** Fonts -#+begin_src emacs-lisp - (set-face-attribute 'default nil - :font "Go Mono" - :height 110) - (set-face-attribute 'fixed-pitch nil - :height 110) - (set-face-attribute 'variable-pitch nil - :font "IBM Plex Serif" - :height 120) -#+end_src -** Scrolling -Scrolling in Emacs is weird, this fixes it. -#+begin_src emacs-lisp - (setq scroll-conservatively 100 - mouse-wheel-progressive-speed nil) -#+end_src -** Disable the bell -Begone! -#+begin_src emacs-lisp - (setq ring-bell-function 'ignore) -#+end_src -** Consistent yes/no prompts -Sometimes Emacs asks you to enter y/n, other times yes/no. Why? -#+begin_src emacs-lisp - (defalias 'yes-or-no-p 'y-or-n-p) -#+end_src -** Focus newly created windows -#+begin_src emacs-lisp - (defadvice split-window-below (after lh/split-window-below activate) - (other-window 1)) - (defadvice split-window-right (after lh/split-window-right activate) - (other-window 1)) -#+end_src -** Delete the selection when you type -By default Emacs does not delete the current selection when you type. I like this, saves me one keypress. -#+begin_src emacs-lisp - (delete-selection-mode 1) -#+end_src -** Backup files -Who likes to have backup files scattered around all over your file system? A lot of people seem to disable these, but I think they are very useful and have saved me a couple of times in the past. We just need to move them to some place where we don't constantly see them. -#+begin_src emacs-lisp - (let ((backup-dir (concat user-emacs-directory "backup"))) - (unless (file-exists-p backup-dir) - (make-directory backup-dir t)) - (setq backup-directory-alist `(("." . ,backup-dir)))) - (setq backup-by-copying t - version-control t - delete-old-versions t - kept-new-versions 10 - kept-old-versions 5) -#+end_src -** Fullscreen -On fullscreen I want to hide all UI elements (toolbar and menu bar) and reenable them when I leave fullscreen. -#+begin_src emacs-lisp - (defadvice toggle-frame-fullscreen (before lh/toggle-frame-fullscreen-bars activate) - (menu-bar-mode (if menu-bar-mode -1 1)) - (tool-bar-mode (if tool-bar-mode -1 1)) - (scroll-bar-mode (if scroll-bar-mode -1 1))) -#+end_src -** transpose regions -Doesn't have a default keybinding. -#+begin_src emacs-lisp - (global-set-key (kbd "C-x C-M-t") #'transpose-regions) -#+end_src -** Killing the current buffer -There is a button in the toolbar to kill the current buffer, but there is no default keybinding. Also, I'd like for it to confirm if I have any unsaved changes. -#+begin_src emacs-lisp - (require 'seq) - - (defun lh/kill-this-buffer () - "Kills the current buffer, asks for confirmation if there are any unsaved changes" - (interactive) - (when (if (and (buffer-modified-p) (not (buffer-file-name))) - (y-or-n-p "Buffer has unsaved changes, are you sure? ") - t) - (kill-this-buffer))) - - (global-set-key (kbd "C-x K") #'lh/kill-this-buffer) - - ; Not sure if there is a better way to do this... - (let ((kill-menu (car (seq-filter (lambda (x) - (eq (cadddr x) #'kill-this-buffer)) - (cdr tool-bar-map))))) - (unless (null kill-menu) - (setf (cadddr kill-menu) #'lh/kill-this-buffer))) -#+end_src -* Dependencies -** request -#+begin_src emacs-lisp - (use-package request - :straight t) -#+end_src -** uuidgen -#+begin_src emacs-lisp - (use-package uuidgen - :straight t) -#+end_src -* Basic QOL Packages -** which-key -Shows the possible keybindings in a neat menu. -#+begin_src emacs-lisp - (use-package which-key - :straight t - :diminish which-key-mode - :config (which-key-mode 1)) -#+end_src -** Selectrum -Selectrum replaces Emacs default =completing-read=, which is a bit cumbersome to use. We also enable prescient for smart recommendations. -#+begin_src emacs-lisp - (use-package selectrum - :straight t - :config (selectrum-mode 1)) - (use-package selectrum-prescient - :straight t - :after selectrum - :config - (selectrum-prescient-mode 1) - (prescient-persist-mode 1)) -#+end_src -** Marginalia -Marginalia adds additional information to =M-x=, such as keybindings and command descriptions. -#+begin_src emacs-lisp - (use-package marginalia - :straight t - :init - (setq marginalia-annotators '(marginalia-annotators-heavy)) - :config - (marginalia-mode 1)) -#+end_src -** Consult -Consult improves on a lot of default Emacs functionality and adds a lot more. I use the keybindings from the Consult Readme. -#+begin_src emacs-lisp - (use-package consult - :straight t - :bind (;; C-c bindings (mode-specific-map) - ("C-c h" . consult-history) - ("C-c m" . consult-mode-command) - ("C-c b" . consult-bookmark) - ("C-c k" . consult-kmacro) - ;; C-x bindings (ctl-x-map) - ("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command - ("C-x b" . consult-buffer) ;; orig. switch-to-buffer - ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window - ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame - ;; Custom M-# bindings for fast register access - ("M-#" . consult-register-load) - ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) - ("C-M-#" . consult-register) - ;; Other custom bindings' - ("M-y" . consult-yank-pop) ;; orig. yank-pop - ("<help> a" . consult-apropos) ;; orig. apropos-command - ;; M-g bindings (goto-map) - ("M-g e" . consult-compile-error) - ("M-g f" . consult-flymake) ;; Alternative: consult-flycheck - ("M-g g" . consult-goto-line) ;; orig. goto-line - ("M-g M-g" . consult-goto-line) ;; orig. goto-line - ("M-g o" . consult-outline) ;; Alternative: consult-org-heading - ("M-g m" . consult-mark) - ("M-g k" . consult-global-mark) - ("M-g i" . consult-imenu) - ("M-g I" . consult-project-imenu) - ;; M-s bindings (search-map) - ("M-s f" . consult-find) - ("M-s L" . consult-locate) - ("M-s g" . consult-grep) - ("M-s G" . consult-git-grep) - ("M-s r" . consult-ripgrep) - ("M-s l" . consult-line) - ("M-s m" . consult-multi-occur) - ("M-s k" . consult-keep-lines) - ("M-s u" . consult-focus-lines) - ;; Isearch integration - ("M-s e" . consult-isearch) - :map isearch-mode-map - ("M-e" . consult-isearch) ;; orig. isearch-edit-string - ("M-s e" . consult-isearch) ;; orig. isearch-edit-string - ("M-s l" . consult-line)) ;; needed by consult-line to detect isearch - :config - (setq consult-project-root-function - (lambda () - (when-let (project (project-current)) - (car (project-roots project)))))) -#+end_src -** COMMENT project-x -Improves on the inbuilt project.el, also needed by popper. -#+begin_src emacs-lisp - (use-package project-x - :straight (project-x :type git :host github :repo "karthink/project-x")) -#+end_src -** COMMENT popper -Popper turns chosen buffers into popups, which can be shown or hidden quickly. -#+begin_src emacs-lisp - (use-package popper - :straight t - :bind - ("C-." . popper-toggle-latest) - ("M-." . popper-cycle) - ("C-M-." . popper-toggle-type) - :init - (setq popper-group-function #'popper-group-by-project) - (setq popper-reference-buffers - '("\\*Messages\\*" - "\\*scratch\\*" - "^\\*straight-")) - :config (popper-mode 1)) -#+end_src -** expand-region -Smart expand selection with one keypress. -#+begin_src emacs-lisp - (use-package expand-region - :straight t - :bind ("C-+" . er/expand-region)) -#+end_src -** ace-window -Makes it easy to switch windows. -#+begin_src emacs-lisp - (use-package ace-window - :straight t - :bind ("M-o" . ace-window) - :init - (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) - aw-scope 'frame - aw-dispatch-always t)) -#+end_src -* Org -#+begin_src emacs-lisp - (use-package org - :straight t - :hook - (org-mode . visual-line-mode) - (org-mode . org-indent-mode) - :init - (setq org-startup-indented nil - org-src-window-setup 'current-window - org-support-shift-select t) - (let ((orgdir (expand-file-name "org" lh/dir-documents))) - (unless (file-exists-p orgdir) - (make-directory orgdir)) - (setq org-directory orgdir - org-agenda-files orgdir)) - :config - (setq org-babel-lisp-eval-fn #'sly-eval) - (org-babel-do-load-languages - 'org-babel-load-languages - '((awk . t) - (lisp . t) - (shell . t)))) -#+end_src -** Roam -#+begin_src emacs-lisp - (use-package org-roam - :straight t - :after org - :bind (("C-c n l" . org-roam-buffer-toggle) - ("C-c n f" . org-roam-node-find) - ("C-c n i" . org-roam-node-insert)) - :init - (setq org-roam-v2-ack t - org-roam-directory - (let ((dir (expand-file-name "notes" org-directory))) - (unless (file-exists-p dir) - (make-directory dir)) - dir)) - :config - (org-roam-setup)) -#+end_src -* Code -** Autocomplete -#+begin_src emacs-lisp - (use-package company - :straight t - :diminish company-mode - :init (setq company-idle-delay 0) - :config (global-company-mode 1)) -#+end_src -Company prescient for smart completions. -#+begin_src emacs-lisp - (use-package company-prescient - :straight t - :config - (company-prescient-mode 1)) -#+end_src -** Lisp -Sly for Common Lisp. -#+begin_src emacs-lisp - (use-package sly - :straight t - :init (setq inferior-lisp-program "sbcl")) -#+end_src - -Geiser for Scheme. -#+begin_src emacs-lisp - (use-package geiser - :straight t) - (use-package geiser-guile - :straight t) -#+end_src - -Disable tabs for indenting in any lisps, I really hate this. -#+begin_src emacs-lisp - (let ((d (lambda () - (setq indent-tabs-mode nil)))) - (add-hook 'emacs-lisp-mode-hook d) - (add-hook 'sly-mode-hook d) - (add-hook 'geiser-mode-hook d) - (add-hook 'scheme-mode-hook d)) -#+end_src -** Go -#+begin_src emacs-lisp - (use-package go-mode - :straight t) -#+end_src -** C# -#+begin_src emacs-lisp - (use-package csharp-mode - :straight t) -#+end_src -** Lua -#+begin_src emacs-lisp - (use-package lua-mode - :straight t) -#+end_src -** LSP -Using the language server protocol, we can support a lot of different programming languages -#+begin_src emacs-lisp - (use-package eglot - :straight t - :hook ((go-mode . eglot-ensure) - (c-mode . eglot-ensure) - (csharp-mode . eglot-ensure)) - :bind (:map eglot-mode-map - ("C-c r" . eglot-rename) - ("C-c h" . eldoc) - ("C-c f" . eglot-format) - ("C-c F" . eglot-format-buffer)) - :config - (add-to-list 'eglot-server-programs - '(csharp-mode . ("omnisharp" "-lsp")))) -#+end_src -** JSON -#+begin_src emacs-lisp - (use-package json-mode - :straight t - :hook (json-mode . flymake-json-load)) - (use-package flymake-json - :straight t) -#+end_src -** YAML -#+begin_src emacs-lisp - (use-package yaml-mode - :straight t) -#+end_src -* Other packages -** Magit -Magit is a git UI for Emacs. -#+begin_src emacs-lisp - (use-package magit - :straight t) -#+end_src -** nhexl -nhexl is a hex editor. It can be activated with =M-x nhexl-mode= -#+begin_src emacs-lisp - (use-package nhexl-mode - :straight t) -#+end_src -** elfeed -A tag based news reader for emacs. -#+begin_src emacs-lisp - (use-package elfeed - :straight t - :config - (setq elfeed-db-directory (let ((data-dir (expand-file-name "elfeed" lh/dir-data-home))) - (unless (file-exists-p data-dir) - (make-directory data-dir)) - data-dir)) - (let ((feeds (expand-file-name "feeds.el" user-emacs-directory))) - (when (file-exists-p feeds) - (load feeds)))) -#+end_src - -** nov.el -Emacs EPub reader. -#+begin_src emacs-lisp - (use-package nov - :straight t - :mode ("\\.epub\\'" . nov-mode)) -#+end_src -** utils -#+begin_src emacs-lisp - (require 'utils) -#+end_src -* Private stuff -#+begin_src emacs-lisp - (let ((path (expand-file-name "private.el" user-emacs-directory))) - (when (file-exists-p path) - (load path))) -#+end_src - diff --git a/early-init.el b/early-init.el @@ -4,4 +4,3 @@ (defun startup/reset-gc () (setq gc-cons-threshold startup/gc-cons-threshold)) (add-hook 'emacs-startup-hook 'startup/reset-gc) -(setq package-enable-at-startup nil) diff --git a/init.el b/init.el @@ -1 +1,192 @@ -(org-babel-load-file (expand-file-name "config.org" user-emacs-directory)) +(require 'seq) +(require 'xdg) + +(package-initialize) + +(push + (let ((lisp-path (expand-file-name "lisp" user-emacs-directory))) + (unless (file-exists-p lisp-path) + (make-directory lisp-path)) + lisp-path) + load-path) + +(require 'utils) +(require 'consult-eglot) + +(setq org-roam-v2-ack t) + +(setq lh/dir-documents + (expand-file-name + (cond ((eq system-type 'gnu/linux) (or (xdg-user-dir "DOCUMENTS") "~/Documents")) + ((eq system-type 'windows-nt) "~/Documents")))) +(setq lh/dir-data-home + (expand-file-name + (cond ((eq system-type 'gnu/linux) (or (xdg-data-home) "~/.local/share")) + ((eq system-type 'windows-nt) (getenv "APPDATA"))))) + +(defalias 'yes-or-no-p 'y-or-n-p) +(defadvice split-window-below (after lh/split-window-below activate) + (other-window 1)) +(defadvice split-window-right (after lh/split-window-right activate) + (other-window 1)) +(defadvice toggle-frame-fullscreen (before lh/toggle-frame-fullscreen-bars activate) + (menu-bar-mode (if menu-bar-mode -1 1)) + (tool-bar-mode (if tool-bar-mode -1 1)) + (scroll-bar-mode (if scroll-bar-mode -1 1))) + +(let ((path (expand-file-name "private.el" user-emacs-directory))) + (when (file-exists-p path) + (load path))) + +(delete-selection-mode 1) +(which-key-mode 1) +(selectrum-mode 1) +(selectrum-prescient-mode 1) +(prescient-persist-mode 1) +(marginalia-mode 1) +(global-company-mode 1) +(global-aggressive-indent-mode 1) + +(diminish 'company-mode) +(diminish 'which-key-mode) +(diminish 'aggressive-indent-mode) + +(defmacro lh/global-set-keys (keys-alist) + `(progn + ,@(seq-map + (lambda (x) + `(global-set-key (kbd ,(car x)) #',(cdr x))) + keys-alist))) + +(lh/global-set-keys + (("C-x C-M-t" . transpose-regions) + ("C-x K" . kill-this-buffer) + + ;;;; Consult bindings + ;; C-c bindings (mode-specific-map) + ("C-c h" . consult-history) + ("C-c m" . consult-mode-command) + ("C-c b" . consult-bookmark) + ("C-c k" . consult-kmacro) + ;; C-x bindings (ctl-x-map) + ("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command + ("C-x b" . consult-buffer) ;; orig. switch-to-buffer + ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window + ("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame + ;; Custom M-# bindings for fast register access + ("M-#" . consult-register-load) + ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) + ("C-M-#" . consult-register) + ;; Other custom bindings' + ("M-y" . consult-yank-pop) ;; orig. yank-pop + ("<help> a" . consult-apropos) ;; orig. apropos-command + ;; M-g bindings (goto-map) + ("M-g e" . consult-compile-error) + ("M-g f" . consult-flymake) ;; Alternative: consult-flycheck + ("M-g g" . consult-goto-line) ;; orig. goto-line + ("M-g M-g" . consult-goto-line) ;; orig. goto-line + ("M-g o" . consult-outline) ;; Alternative: consult-org-heading + ("M-g m" . consult-mark) + ("M-g k" . consult-global-mark) + ("M-g i" . consult-imenu) + ("M-g I" . consult-imenu-multi) + ;; M-s bindings (search-map) + ("M-s f" . consult-find) + ("M-s L" . consult-locate) + ("M-s g" . consult-grep) + ("M-s G" . consult-git-grep) + ("M-s r" . consult-ripgrep) + ("M-s l" . consult-line) + ("M-s m" . consult-multi-occur) + ("M-s k" . consult-keep-lines) + ("M-s u" . consult-focus-lines) + ("M-s s" . consult-eglot-symbols) + ;; Isearch integration + ("M-s e" . consult-isearch) + + ("C-+" . er/expand-region) + + ("M-o" . ace-window) + + ("C-c n l" . org-roam-buffer-toggle) + ("C-c n f" . org-roam-node-find) + ("C-c n i" . org-roam-node-insert))) + +(define-key isearch-mode-map (kbd "M-e") #'consult-isearch) +(define-key isearch-mode-map (kbd "M-s e") #'consult-isearch) +(define-key isearch-mode-map (kbd "M-s l") #'consult-line) + +(add-hook 'elfeed-search-mode-hook + (lambda() + (define-key elfeed-search-mode-map (kbd "G") #'elfeed-update))) + +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(aw-dispatch-always t) + '(aw-keys '(97 115 100 102 103 104 106 107 108)) + '(aw-scope 'frame) + '(backup-by-copying t) + '(column-number-mode t) + '(company-idle-delay 0) + '(cursor-type 'bar) + '(delete-old-versions t) + '(global-company-mode t) + '(indent-tabs-mode nil) + '(inferior-lisp-program "sbcl") + '(kept-new-versions 10) + '(kept-old-versions 5) + '(mouse-wheel-progressive-speed nil) + '(org-src-window-setup 'other-window) + '(org-startup-indented t) + '(package-archives + '(("gnu" . "https://elpa.gnu.org/packages/") + ("nongnu" . "https://elpa.nongnu.org/nongnu/") + ("melpa-stable" . "https://stable.melpa.org/packages/") + ("melpa" . "https://melpa.org/packages/"))) + '(package-selected-packages + '(sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser company-prescient company org-roam org-contrib org ace-window expand-region selectrum-prescient consult marginalia selectrum uuidgen request diminish which-key)) + '(reb-re-syntax 'string) + '(ring-bell-function 'ignore) + '(scroll-conservatively 100)) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(default ((t (:inherit nil :extend nil :stipple nil :background "#dcdad5" :foreground "#000000" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 110 :width normal :foundry " " :family "Go Mono")))) + '(variable-pitch ((t (:family "IBM Plex Serif"))))) + +;; This is the place where I override all customize stuff + +(let ((feeds (expand-file-name "feeds.el" user-emacs-directory))) + (when (file-exists-p feeds) + (load feeds))) + +(customize-set-value + 'elfeed-db-directory + (let ((data-dir (expand-file-name "elfeed" lh/dir-data-home))) + (unless (file-exists-p data-dir) + (make-directory data-dir)) + data-dir)) + +(customize-set-value + 'backup-directory-alist + (let ((backup-dir (concat user-emacs-directory "backup"))) + (unless (file-exists-p backup-dir) + (make-directory backup-dir t)) + `(("." . ,backup-dir)))) + +(let ((dir (expand-file-name "org" lh/dir-documents))) + (unless (file-exists-p dir) + (make-directory dir t)) + (customize-set-value + 'org-directory + dir) + (customize-set-value + 'org-agenda-files + (list dir))) + +(server-start) diff --git a/lisp/consult-eglot.el b/lisp/consult-eglot.el @@ -0,0 +1,208 @@ +;;; consult-eglot.el --- A consulting-read interface for eglot -*- lexical-binding: t; -*- + +;; Licence: MIT +;; Keywords: tools, completion, lsp +;; Author: mohsin kaleem <mohkale@kisara.moe> +;; Maintainer: Mohsin Kaleem +;; Version: 0.1 +;; Package-Requires: ((emacs "27.1") (eglot "1.7") (consult "0.9")) +;; Homepage: https://github.com/mohkale/consult-eglot + +;; Copyright (c) 2021 Mohsin Kaleem + +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: + +;; The above copyright notice and this permission notice shall be included in all +;; copies or substantial portions of the Software. + +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +;; SOFTWARE. + +;;; Commentary: + +;; Query workspace symbol from eglot using consult. +;; +;; This package provides a single command `consult-eglot-symbols' that uses the +;; lsp workspace/symbol procedure to get a list of symbols exposed in the current +;; workspace. This differs from the default document/symbols call, that eglot +;; exposes through imenu, in that it can present symbols from multiple open files +;; or even files not indirectly loaded by an open file but still used by your +;; project. +;; +;; This code was partially adapted from the excellent consult-lsp package. + +;;; Code: + +(require 'eglot) +(require 'consult) + +(defgroup consult-eglot nil + "Consulting-read for eglot." + :prefix "consult-eglot" + :group 'completion + :group 'eglot + :group 'consult) + +(defcustom consult-eglot-narrow + '(;; Lowercase classes + (?c . "Class") + (?f . "Function") + (?e . "Enum") + (?i . "Interface") + (?m . "Module") + (?n . "Namespace") + (?p . "Package") + (?s . "Struct") + (?t . "Type Parameter") + (?v . "Variable") + + ;; Uppercase classes + (?A . "Array") + (?B . "Boolean") + (?C . "Constant") + (?E . "Enum Member") + (?F . "Field") + (?M . "Method") + (?N . "Number") + (?O . "Object") + (?P . "Property") + (?S . "String") + + ;; Other. Any which aren't above are taken from here + (?o . "Other")) + "Narrow key configuration used with `consult-eglot-symbols'. +For the format see `consult--read', for the value types see the +values in `eglot--symbol-kind-names'." + :type '(alist :key-type character :value-type string)) + +(defcustom consult-eglot-show-kind-name t + "When true prefix completion candidates with their type." + :type 'boolean) + +(defun consult-eglot--make-async-source (async server) + "Search for symbols in a consult ASYNC source. +Pipe a `consult--read' compatible async-source ASYNC to search for +symbols in the workspace tied to SERVER." + (lambda (action) + (pcase-exhaustive action + ((or 'setup (pred stringp)) + (let ((query (if (stringp action) action ""))) + (jsonrpc-async-request + server :workspace/symbol + `(:query ,query) + :success-fn + (lambda (resp) + (funcall async 'flush) + (funcall async (append resp nil))) + :error-fn + (eglot--lambda ((ResponseError) code message) + (message "%s: %s" code message)) + :timeout-fn + (lambda () + (message "error: request timed out"))) + (funcall async action))) + (_ (funcall async action))))) + +(defun consult-eglot--transformer (symbol-info) + "Default transformer to produce a completion candidate from SYMBOL-INFO. +The produced candidate follows the same form as `consult--grep' however it +contains the SYMBOL-INFO as the second field instead of the file URI." + (eglot--dbind ((SymbolInformation) name kind location) + symbol-info + (eglot--dbind ((Location) uri range) location + (let* ((line (1+ (plist-get (plist-get range :start) :line))) + (kind-name (alist-get kind eglot--symbol-kind-names)) + (uri-path (eglot--uri-to-path uri)) + (res (propertize + (concat + (when consult-eglot-show-kind-name + (format "%-7s " kind-name)) + name + " " + (string-remove-suffix ":" + (consult--format-location + ;; If the src is relative to our project directory then use + ;; the path from there, otherwise use the absolute file path. + (let ((relative-uri-path (file-relative-name uri-path))) + (if (string-prefix-p ".." relative-uri-path) + (abbreviate-file-name uri-path) + relative-uri-path)) + line))) + 'consult--type (or (car (rassoc kind-name consult-eglot-narrow)) + (car (rassoc "Other" consult-eglot-narrow))) + 'consult--candidate symbol-info))) + res)))) + +(defun consult-eglot--symbol-information-to-grep-params (symbol-info) + "Extract grep parameters from SYMBOL-INFO." + (eglot--dbind ((SymbolInformation) location) symbol-info + (eglot--dbind ((Location) uri range) location + (list + (eglot--uri-to-path uri) ; URI + (1+ (plist-get (plist-get range :start) :line)) ; Line number + 0 ; Column number + )))) + +(defun consult-eglot--state () + "State function for `consult-eglot-symbols' to preview candidates. +This is mostly just a copy-paste of `consult--grep-state' except it doesn't +rely on regexp matching to extract the relevent file and column fields." + (let ((open (consult--temporary-files)) + (jump (consult--jump-state))) + (lambda (cand restore) + (when restore + (funcall open)) + (funcall jump + (and cand + (pcase-let ((`(,file ,line ,col) + (consult-eglot--symbol-information-to-grep-params cand))) + (consult--position-marker (funcall open file) line col))) + restore)))) + +;;;###autoload +(defun consult-eglot-symbols () + "Interactively select a symbol from the current workspace." + (interactive) + ;; Set `default-directory' here so we can show file names + ;; relative to the project root. + (let* ((server (eglot--current-server-or-lose)) + (default-directory (or (project-root (project-current)) + default-directory))) + (if (eglot--server-capable :workspaceSymbolProvider) + (cl-destructuring-bind (path line _col) + (consult-eglot--symbol-information-to-grep-params + (consult--read + (thread-first + (consult--async-sink) + (consult--async-refresh-immediate) + (consult--async-map #'consult-eglot--transformer) + (consult-eglot--make-async-source server) + (consult--async-throttle) + (consult--async-split)) + :history t + :require-match t + :prompt "LSP Symbols: " + :initial (consult--async-split-initial nil) + :category 'consult-lsp-symbols + :lookup #'consult--lookup-candidate + :group (consult--type-group consult-eglot-narrow) + :narrow (consult--type-narrow consult-eglot-narrow) + :state (consult-eglot--state))) + (find-file path) + (goto-char (point-min)) + (forward-line (- line 1)) + (run-hooks 'consult-after-jump-hook)) + (user-error "Server doesn't support symbol search")))) + +(provide 'consult-eglot) +;;; consult-eglot.el ends here