Function: gnus-registry--split-fancy-with-parent-internal

gnus-registry--split-fancy-with-parent-internal is a byte-compiled function defined in gnus-registry.el.gz.

Signature

(gnus-registry--split-fancy-with-parent-internal &rest SPEC &key REFERENCES REFSTR SENDER SUBJECT RECIPIENTS LOG-AGENT &allow-other-keys)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-registry.el.gz
(cl-defun gnus-registry--split-fancy-with-parent-internal
    (&rest spec
           &key references refstr sender subject recipients log-agent
           &allow-other-keys)
  (gnus-message
   10
   "gnus-registry--split-fancy-with-parent-internal %S" spec)
  (let ((db gnus-registry-db)
        found)
    ;; this is a big chain of statements.  it uses
    ;; gnus-registry-post-process-groups to filter the results after
    ;; every step.
    ;; the references string must be valid and parse to valid references
    (when references
      (gnus-message
       9
       "%s is tracing references %s"
       log-agent refstr)
      (dolist (reference (nreverse references))
        (gnus-message 9 "%s is looking up %s" log-agent reference)
        (cl-loop for group in (gnus-registry-get-id-key reference 'group)
              when (gnus-registry-follow-group-p group)
              do
              (progn
                (gnus-message 7 "%s traced %s to %s" log-agent reference group)
                (push group found))))
      ;; filter the found groups and return them
      ;; the found groups are the full groups
      (setq found (gnus-registry-post-process-groups
                   "references" refstr found)))

     ;; else: there were no matches, now try the extra tracking by subject
     (when (and (null found)
                (memq 'subject gnus-registry-track-extra)
                subject
                (< gnus-registry-minimum-subject-length (length subject)))
       (let ((groups (apply
                      #'append
                      (mapcar
                       (lambda (reference)
                         (gnus-registry-get-id-key reference 'group))
                       (registry-lookup-secondary-value db 'subject subject)))))
         (setq found
               (cl-loop for group in groups
                     when (gnus-registry-follow-group-p group)
                     do (gnus-message
                         ;; warn more if gnus-registry-track-extra
                         (if gnus-registry-track-extra 7 9)
                         "%s (extra tracking) traced subject `%s' to %s"
                         log-agent subject group)
                    and collect group))
         ;; filter the found groups and return them
         ;; the found groups are NOT the full groups
         (setq found (gnus-registry-post-process-groups
                      "subject" subject found))))

     ;; else: there were no matches, try the extra tracking by sender
     (when (and (null found)
                (memq 'sender gnus-registry-track-extra)
                sender
                (not (gnus-grep-in-list
                      sender
                      gnus-registry-unfollowed-addresses)))
       (let ((groups (apply
                      #'append
                      (mapcar
                       (lambda (reference)
                         (gnus-registry-get-id-key reference 'group))
                       (registry-lookup-secondary-value db 'sender sender)))))
         (setq found
               (cl-loop for group in groups
                     when (gnus-registry-follow-group-p group)
                     do (gnus-message
                         ;; warn more if gnus-registry-track-extra
                         (if gnus-registry-track-extra 7 9)
                         "%s (extra tracking) traced sender `%s' to %s"
                         log-agent sender group)
                     and collect group)))

       ;; filter the found groups and return them
       ;; the found groups are NOT the full groups
       (setq found (gnus-registry-post-process-groups
                    "sender" sender found)))

     ;; else: there were no matches, try the extra tracking by recipient
     (when (and (null found)
                (memq 'recipient gnus-registry-track-extra)
                recipients)
       (dolist (recp recipients)
         (when (and (null found)
                    (not (gnus-grep-in-list
                          recp
                          gnus-registry-unfollowed-addresses)))
           (let ((groups (apply #'append
                                (mapcar
                                 (lambda (reference)
                                   (gnus-registry-get-id-key reference 'group))
                                 (registry-lookup-secondary-value
                                  db 'recipient recp)))))
             (setq found
                   (cl-loop for group in groups
                         when (gnus-registry-follow-group-p group)
                         do (gnus-message
                             ;; warn more if gnus-registry-track-extra
                             (if gnus-registry-track-extra 7 9)
                             "%s (extra tracking) traced recipient `%s' to %s"
                             log-agent recp group)
                        and collect group)))))

       ;; filter the found groups and return them
       ;; the found groups are NOT the full groups
       (setq found (gnus-registry-post-process-groups
                    "recipients" (mapconcat #'identity recipients ", ") found)))

     ;; after the (cond) we extract the actual value safely
     (car-safe found)))