Re: [GNU ELPA] New package: flymake-harper

;;; flymake-straightforward.el --- Toy Flymake backend flagging "straight" -*- lexical-binding: t; -*-

;; This is a toy backend, modeled after the annotated example in the
;; Flymake Info manual, that shells out to ripgrep(1) to flag every
;; occurrence of the word "straight" in the current buffer.  It also
;; demonstrates how a backend can offer corrections for its own
;; diagnostics, following the pattern used by eglot.el: a diagnostic
;; category symbol with a `flymake-overlay-control' keymap, plus a
;; command that reads correction meta-info out of the diagnostic's
;; DATA slot (see `flymake-make-diagnostic').

(require 'cl-lib)
(require 'flymake)

(defvar-local flymake-straightforward--proc nil
  "Grep process for the current buffer, if any.")


;;; Diagnostic category and correction UI

(put 'flymake-straightforward-warning 'flymake-category 'flymake-warning)

(defvar flymake-straightforward-diagnostics-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-2] #'flymake-straightforward-correct-at-mouse)
    (define-key map [left-margin mouse-1] #'flymake-straightforward-correct-at-mouse)
    map)
  "Keymap active on flymake-straightforward's diagnostic overlays.")

(put 'flymake-straightforward-warning 'flymake-overlay-control
     `((mouse-face . highlight)
       (keymap . ,flymake-straightforward-diagnostics-map)))

(defun flymake-straightforward--diag-at (pos)
  "Return a flymake-straightforward diagnostic at POS, if any."
  (cl-find 'flymake-straightforward-warning (flymake-diagnostics pos)
           :key #'flymake-diagnostic-type))

(defun flymake-straightforward--apply (diag)
  "Apply DIAG's correction, replacing its text with its replacement."
  (let ((replacement (plist-get (flymake-diagnostic-data diag) :replacement)))
    (with-current-buffer (flymake-diagnostic-buffer diag)
      (goto-char (flymake-diagnostic-beg diag))
      (delete-region (flymake-diagnostic-beg diag) (flymake-diagnostic-end diag))
      (insert replacement))))

(defun flymake-straightforward-correct ()
  "Correct the flymake-straightforward diagnostic at point."
  (interactive)
  (if-let* ((diag (flymake-straightforward--diag-at (point))))
      (flymake-straightforward--apply diag)
    (user-error "No flymake-straightforward diagnostic here")))

(defun flymake-straightforward--mouse-call (what)
  "Make an interactive lambda for calling WHAT with the mouse."
  (lambda (event)
    (interactive "e")
    (let ((start (event-start event)))
      (with-selected-window (posn-window start)
        (save-excursion
          (goto-char (posn-point start))
          (call-interactively what))))))

(defalias 'flymake-straightforward-correct-at-mouse
  (flymake-straightforward--mouse-call #'flymake-straightforward-correct)
  "Like `flymake-straightforward-correct', but for mouse events.")

(defun flymake-straightforward-correct-all (beg end)
  "Correct every flymake-straightforward straight diagnostic between BEG and END."
  (interactive (if (region-active-p) (list (region-beginning) (region-end))
                 (list (point-min) (point-max))))
  (cl-loop for diag in (flymake-diagnostics beg end)
           when (eq (flymake-diagnostic-type diag) 'flymake-straightforward-warning)
           collect diag into diags
           finally (mapc #'flymake-straightforward--apply
                          (cl-sort diags #'> :key #'flymake-diagnostic-beg))))


;;; Backend proper

(defun flymake-straightforward-backend (report-fn &rest _ignored)
  "A Flymake backend flagging the word `straight' using ripgrep.
Calls REPORT-FN once the ripgrep process has finished."
  (when (process-live-p flymake-straightforward--proc)
    (kill-process flymake-straightforward--proc))
  (let ((source (current-buffer)))
    (save-restriction
      (widen)
      (setq flymake-straightforward--proc
            (make-process
             :name "flymake-straightforward" :noquery t :connection-type 'pipe
             :buffer (generate-new-buffer " *flymake-straightforward*")
             :command '("rg" "--no-heading" "-i" "--line-number" "--column" "-w" "straight")
             :sentinel
             (lambda (proc _event)
               (when (eq 'exit (process-status proc))
                 (unwind-protect
                     (if (with-current-buffer source (eq proc flymake-straightforward--proc))
                         (with-current-buffer (process-buffer proc)
                           (goto-char (point-min))
                           (cl-loop
                            while (search-forward-regexp
                                   "^\\([0-9]+\\):\\([0-9]+\\):" nil t)
                            for line = (string-to-number (match-string 1))
                            for col = (string-to-number (match-string 2))
                            for (beg . end) = (flymake-diag-region source line col)
                            collect (flymake-make-diagnostic
                                     source beg end 'flymake-straightforward-warning
                                     "Straight!" '(:replacement "str8"))
                            into diags
                            finally (funcall report-fn diags)))
                       (flymake-log :warning "Canceling obsolete check %s" proc))
                   (kill-buffer (process-buffer proc)))))))
      (process-send-region flymake-straightforward--proc (point-min) (point-max))
      (process-send-eof flymake-straightforward--proc))))

(defun flymake-straightforward-setup ()
  "Enable the flymake-straightforward backend in the current buffer."
  (interactive)
  (add-hook 'flymake-diagnostic-functions #'flymake-straightforward-backend nil t)
  (flymake-mode 1)
  (flymake-start nil t))

(provide 'flymake-straightforward)
;;; flymake-straightforward.el ends here