Add sly stuff to my/diagnostic-at-point

This commit is contained in:
Alexander Rosenberg 2024-11-05 21:20:57 -08:00
parent 04fa288627
commit 222fcacfeb
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730

47
init.el
View File

@ -943,18 +943,35 @@ to `posframe-show' if the display is graphical."
(setq flycheck-display-errors-function nil)) (setq flycheck-display-errors-function nil))
(use-package consult-flycheck) (use-package consult-flycheck)
(defun my/sly-notes-at-point (&optional pos buffer)
"Return the sly notes at POS in BUFFER.
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(unless pos
(setq pos (point)))
(cl-loop for overlay in (overlays-at pos)
for note = (overlay-get overlay 'sly-note)
when note
collect note)))
(defun my/diagnostic-at-point () (defun my/diagnostic-at-point ()
"Show the diagnostics under point." "Show the diagnostics under point."
(interactive) (interactive)
(let ((message)) (let ((message))
(when-let ((flymake-mode) (when-let (((bound-and-true-p flymake-mode))
(diag (get-char-property (point) 'flymake-diagnostic))) (diag (get-char-property (point) 'flymake-diagnostic)))
(cl-callf nconc message (string-split (flymake--diag-text diag) "\n" t))) (cl-callf nconc message (string-split (flymake--diag-text diag) "\n" t)))
(when flycheck-mode (when (bound-and-true-p flycheck-mode)
(cl-callf nconc message (cl-callf nconc message
(mapcar 'flycheck-error-message (flycheck-overlay-errors-at (point))))) (mapcar 'flycheck-error-message (flycheck-overlay-errors-at (point)))))
;; sly (lazy-loaded)
(when (featurep 'sly)
(cl-callf nconc message (mapcar (lambda (note)
(plist-get note :message))
(my/sly-notes-at-point))))
;; jinx ;; jinx
(when-let ((jinx-msg (jinx--get-overlays (point) (1+ (point))))) (when-let (((bound-and-true-p jinx-mode))
(jinx-msg (jinx--get-overlays (point) (1+ (point)))))
(push "misspelled word" message)) (push "misspelled word" message))
(when message (when message
(my/floating-tooltip " *my-diagnostic-posframe*" (my/floating-tooltip " *my-diagnostic-posframe*"
@ -1661,31 +1678,17 @@ line in the block and manually deal with indentation."
(use-package sly (use-package sly
;; :hook (lisp-mode . my/-lisp-mode-autoconnect-sly) ;; :hook (lisp-mode . my/-lisp-mode-autoconnect-sly)
:bind (:map sly-mode-map :bind (:map sly-mode-map
("C-c e" . my/sly-show-notes-at-point)) ("C-c e" . my/diagnostic-at-point))
:autoload sly-connected-p :autoload sly-connected-p
:init :init
(defun my/-lisp-mode-autoconnect-sly () (defun my/-lisp-mode-autoconnect-sly ()
(unless (sly-connected-p) (unless (sly-connected-p)
(sly))) (sly)))
(defun my/sly-notes-at-point (pos &optional buffer)
"Returns the sly notes at POS in BUFFER.
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(cl-loop for overlay in (overlays-at pos)
for note = (overlay-get overlay 'sly-note)
when note
collect note)))
(defun my/sly-show-notes-at-point ()
"Show all sly notes at point in a floating window."
(interactive)
(my/floating-tooltip " *sly-note-posframe*"
(with-output-to-string
(dolist (note (my/sly-notes-at-point (point)))
(when-let (msg (plist-get note :message))
(princ "·")
(princ msg)
(terpri))))))
(setq inferior-lisp-program "/usr/bin/sbcl") (setq inferior-lisp-program "/usr/bin/sbcl")
(defun my/-sly-fix-special-buffers ()
(when (string-match-p (rx bos "*" (* any) "*" eos) (buffer-name))
(setq-local show-trailing-whitespace nil)))
(add-hook 'lisp-mode-hook 'my/-sly-fix-special-buffers)
:config :config
(sly-symbol-completion-mode -1)) (sly-symbol-completion-mode -1))