Function: logview--do-parse-filters

logview--do-parse-filters is a natively compiled function defined in logview.el.

Signature

(logview--do-parse-filters FILTERS &optional THREAD-NARROWING-FILTERS HEADER-FILTER-KEY TO-RESET-IN-MAIN-FILTERS)

Documentation

Parse given FILTERS and optional THREAD-NARROWING-FILTERS.

TO-RESET-IN-MAIN-FILTERS may be a list of strings like "a+" of filter types to discard.

Returns

    (((MAIN-FILTER-TEXT . THREAD-NARROWING-FILTER-TEXT) . KEY)
     . VALIDATOR-FN)

or nil if there are no filters.

Source Code

;; Defined in /nix/store/3zkn9hgpv447zb8nrg55d9x2ynmmrk40-emacs-packages-deps/share/emacs/site-lisp/elpa/logview-20260218.2013/logview.el
(defun logview--do-parse-filters (filters &optional thread-narrowing-filters header-filter-key to-reset-in-main-filters)
  "Parse given FILTERS and optional THREAD-NARROWING-FILTERS.
TO-RESET-IN-MAIN-FILTERS may be a list of strings like \"a+\" of
filter types to discard.

Returns

    (((MAIN-FILTER-TEXT . THREAD-NARROWING-FILTER-TEXT) . KEY)
     . VALIDATOR-FN)

or nil if there are no filters."
  (let (non-discarded-lines-main
        non-discarded-lines-narrowing
        min-shown-level
        min-always-shown-level
        include-name-regexps
        exclude-name-regexps
        include-thread-regexps
        exclude-thread-regexps
        include-thread-regexps-narrowing
        exclude-thread-regexps-narrowing
        include-message-regexps
        exclude-message-regexps)
    (dolist (main '(t nil))
      (let ((pass-filters (if main filters thread-narrowing-filters)))
        (when (> (length pass-filters) 0)
          (logview--iterate-filter-text-lines
           pass-filters
           (lambda (type line-begin begin end)
             (let ((filter-line       (not (member type '("#" "" nil))))
                   (reset-this-filter (and main (member type to-reset-in-main-filters))))
               (when reset-this-filter
                 (delete-region begin (point)))
               (when (and (not (and filter-line reset-this-filter)) (or (if main non-discarded-lines-main non-discarded-lines-narrowing) (not (equal type ""))))
                 (push (buffer-substring-no-properties line-begin (point)) (if main non-discarded-lines-main non-discarded-lines-narrowing)))
               (when (and filter-line (not reset-this-filter))
                 (cond ((string= type "lv")
                        (setq min-shown-level (buffer-substring-no-properties begin end)))
                       ((string= type "LV")
                        (setq min-always-shown-level (buffer-substring-no-properties begin end)))
                       (t
                        (let ((regexp (logview--filter-regexp begin end)))
                          (when (logview--valid-regexp-p regexp)
                            (if main
                                (pcase type
                                  ("a+" (push regexp include-name-regexps))
                                  ("a-" (push regexp exclude-name-regexps))
                                  ("t+" (push regexp include-thread-regexps))
                                  ("t-" (push regexp exclude-thread-regexps))
                                  ("m+" (push regexp include-message-regexps))
                                  ("m-" (push regexp exclude-message-regexps)))
                              (pcase type
                                ("t+" (push regexp include-thread-regexps-narrowing))
                                ("t-" (push regexp exclude-thread-regexps-narrowing)))))))))
               t))))))
    (setq min-shown-level                  (unless (equal min-shown-level (caar logview--submode-level-data))
                                             (cadr (assoc min-shown-level logview--submode-level-data)))
          min-always-shown-level           (cadr (assoc min-always-shown-level logview--submode-level-data))
          include-name-regexps             (logview--standardize-regexp-options include-name-regexps)
          exclude-name-regexps             (logview--standardize-regexp-options exclude-name-regexps)
          include-thread-regexps           (logview--standardize-regexp-options include-thread-regexps)
          exclude-thread-regexps           (logview--standardize-regexp-options exclude-thread-regexps)
          include-thread-regexps-narrowing (logview--standardize-regexp-options include-thread-regexps-narrowing)
          exclude-thread-regexps-narrowing (logview--standardize-regexp-options exclude-thread-regexps-narrowing)
          include-message-regexps          (logview--standardize-regexp-options include-message-regexps)
          exclude-message-regexps          (logview--standardize-regexp-options exclude-message-regexps))
    ;; Deliberately not checking `min-always-shown-level': it has no effect without other
    ;; filters.
    (when (or min-shown-level
              include-name-regexps exclude-name-regexps
              include-thread-regexps exclude-thread-regexps include-thread-regexps-narrowing exclude-thread-regexps-narrowing
              include-message-regexps exclude-message-regexps
              header-filter-key)
      (cons (list (cons (when non-discarded-lines-main      (apply #'concat (nreverse non-discarded-lines-main)))
                        (when non-discarded-lines-narrowing (apply #'concat (nreverse non-discarded-lines-narrowing))))
                  min-shown-level min-always-shown-level include-name-regexps exclude-name-regexps
                  include-thread-regexps exclude-thread-regexps include-thread-regexps-narrowing exclude-thread-regexps-narrowing
                  include-message-regexps exclude-message-regexps
                  header-filter-key)
            (let ((level-form (if (and min-shown-level min-always-shown-level) 'level '(logview--entry-level entry)))
                  clauses)
              (when min-shown-level
                (push `(<= ,level-form ,min-shown-level) clauses))
              ;; FIXME: Try to optimize for speed better.  Currently order is fixed like
              ;;        this: thread narrowing, name filters, normal thread filters,
              ;;        message filters.
              (push (logview--build-validator-regexp-clause include-thread-regexps-narrowing exclude-thread-regexps-narrowing logview--thread-group)  clauses)
              (push (logview--build-validator-regexp-clause include-name-regexps             exclude-name-regexps             logview--name-group)    clauses)
              (push (logview--build-validator-regexp-clause include-thread-regexps           exclude-thread-regexps           logview--thread-group)  clauses)
              (push (logview--build-validator-regexp-clause include-message-regexps          exclude-message-regexps          logview--message-group) clauses)
              (when (setf clauses (delq nil clauses))
                (let ((validator (if (cdr clauses) `(and ,@(nreverse clauses)) (car clauses))))
                  (when min-always-shown-level
                    (setq validator `(or (<= ,level-form ,min-always-shown-level) ,validator)))
                  (when (eq level-form 'level)
                    (setq validator `(let ((level (logview--entry-level entry))) ,validator)))
                  ;; Here `eval' is used to translate the lambda into a closure.
                  (byte-compile (eval `(lambda (entry start) (ignore start) ,validator) t)))))))))