Function: flymake--tabulated-setup-1

flymake--tabulated-setup-1 is a byte-compiled function defined in flymake.el.gz.

Signature

(flymake--tabulated-setup-1 DIAGS PROJECT-ROOT)

Documentation

Helper for flymake--tabulated-setup.

Sets tabulated-list-format and tabulated-list-entries, dynamically resizing columns and omitting redundant columns.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/flymake.el.gz
(defun flymake--tabulated-setup-1 (diags project-root)
  "Helper for `flymake--tabulated-setup'.
Sets `tabulated-list-format' and `tabulated-list-entries', dynamically
resizing columns and omitting redundant columns."
  (cl-loop
   with fields = (copy-tree flymake--tabulated-list-format-base t)
   initially (cl-loop for y across fields do (setf (cadr y) nil))
   for diag in diags
   for locus = (flymake-diagnostic-buffer diag)
   for file = (if (bufferp locus)
                  (buffer-file-name locus)
                locus)
   for overlay = (flymake--diag-overlay diag)
   for (line . col) =
   (cond (;; has live overlay, use overlay for position
          (and overlay (overlay-buffer overlay))
          (with-current-buffer (overlay-buffer overlay)
            (save-excursion
              (goto-char (overlay-start overlay))
              (cons (line-number-at-pos)
                    (- (point)
                       (line-beginning-position))))))
         (;; diagnostic not annotated, maybe foreign, check for cons
          (consp (flymake--diag-beg diag))
          (flymake--diag-beg diag))
         (;; may still be a valid foreign diagnostic
          (consp (flymake--diag-orig-beg diag))
          (flymake--diag-orig-beg diag))
         (;; somehow dead annotated diagnostic, ignore/give up
          t nil))
   for type = (flymake-diagnostic-type diag)
   for data-line = `[,(and project-root
                           `(,(file-name-nondirectory file)
                             help-echo ,(file-relative-name file project-root)
                             face nil
                             mouse-face highlight
                             action flymake-goto-diagnostic
                             mouse-action flymake-goto-diagnostic ))
                     ,(format "%s" line)
                     ,(format "%s" col)
                     ,(propertize (format "%s"
                                          (flymake--lookup-type-property
                                           type 'flymake-type-name type))
                                  'face (flymake--lookup-type-property
                                         type 'mode-line-face 'flymake-error))
                     ,(flymake-diagnostic-origin diag)
                     ,(flymake-diagnostic-code diag)
                     (,(flymake-diagnostic-text diag '(oneliner))
                      mouse-face highlight
                      help-echo "mouse-2: visit this diagnostic"
                      face nil
                      action flymake-goto-diagnostic
                      mouse-action flymake-goto-diagnostic)]
   for meta = (and line col
                   (list :diagnostic diag
                         :line line
                         :severity (flymake--lookup-type-property
                                    type
                                    'severity (warning-numeric-level :error))))
   when meta
   do (cl-loop for x across data-line
               for y across fields
               for z across flymake--tabulated-list-format-base
               for xlen = (cond ((stringp x) (length x))
                                (t (length (car x))))
               when (cl-plusp xlen)
               do (setf (cadr y)
                        (max xlen
                             (or (cadr y) (cadr z)))))
   collect (list meta data-line) into data
   finally
   ;; `data' and `fields' now hold more or less suitable values for
   ;; `tabulated-list-entries' and `tabulated-list-format' respectively,
   ;; but we need to trim them, first removing the columns of data where
   ;; the corresponding field is known to be nil for every line, and
   ;; then removing the field description itself.
   (cl-loop
    for entry in data
    do (setf (cadr entry) (cl-loop for x across (cadr entry)
                                   for y across fields
                                   when (cadr y)
                                   vconcat (vector (or x "-")))))
   (setq tabulated-list-entries data
         tabulated-list-format
         (cl-loop for y across fields
                  when (cadr y) vconcat (vector y)))))