Add sly stuff to my/diagnostic-at-point
This commit is contained in:
		
							
								
								
									
										47
									
								
								init.el
									
									
									
									
									
								
							
							
						
						
									
										47
									
								
								init.el
									
									
									
									
									
								
							@ -943,18 +943,35 @@ to `posframe-show' if the display is graphical."
 | 
			
		||||
  (setq flycheck-display-errors-function nil))
 | 
			
		||||
(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 ()
 | 
			
		||||
  "Show the diagnostics under point."
 | 
			
		||||
  (interactive)
 | 
			
		||||
  (let ((message))
 | 
			
		||||
    (when-let ((flymake-mode)
 | 
			
		||||
    (when-let (((bound-and-true-p flymake-mode))
 | 
			
		||||
               (diag (get-char-property (point) 'flymake-diagnostic)))
 | 
			
		||||
      (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
 | 
			
		||||
        (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
 | 
			
		||||
    (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))
 | 
			
		||||
    (when message
 | 
			
		||||
      (my/floating-tooltip " *my-diagnostic-posframe*"
 | 
			
		||||
@ -1661,31 +1678,17 @@ line in the block and manually deal with indentation."
 | 
			
		||||
(use-package sly
 | 
			
		||||
  ;; :hook (lisp-mode . my/-lisp-mode-autoconnect-sly)
 | 
			
		||||
  :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
 | 
			
		||||
  :init
 | 
			
		||||
  (defun my/-lisp-mode-autoconnect-sly ()
 | 
			
		||||
    (unless (sly-connected-p)
 | 
			
		||||
      (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")
 | 
			
		||||
  (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
 | 
			
		||||
  (sly-symbol-completion-mode -1))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Reference in New Issue
	
	Block a user