Function: gnus-dependencies-add-header

gnus-dependencies-add-header is a byte-compiled function defined in gnus-sum.el.gz.

Signature

(gnus-dependencies-add-header HEADER DEPENDENCIES FORCE-NEW)

Documentation

Enter HEADER into the DEPENDENCIES table if it is not already there.

If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even if it was already present.

If gnus-summary-ignore-duplicates is non-nil then duplicate Message-IDs will not be entered in the DEPENDENCIES table. Otherwise duplicate Message-IDs will be renamed to a unique Message-ID before being entered.

Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-sum.el.gz
;; Build the thread tree.
(defsubst gnus-dependencies-add-header (header dependencies force-new)
  "Enter HEADER into the DEPENDENCIES table if it is not already there.
If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
if it was already present.

If `gnus-summary-ignore-duplicates' is non-nil then duplicate
Message-IDs will not be entered in the DEPENDENCIES table.
Otherwise duplicate Message-IDs will be renamed to a unique
Message-ID before being entered.

Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
  (let* ((id (mail-header-id header))
	 ;; An "id-dep" is a list holding the vector headers of this
	 ;; message, plus equivalent "id-deps" for each immediate
	 ;; child message.
	 (id-dep (and id (gethash id dependencies)))
	 parent-id ref ref-dep ref-header replaced)
    ;; Enter this `header' in the `dependencies' table.
    (cond
     ((null id)
      ;; Omit this article altogether if there is no Message-ID.
      (setq header nil))
     ;; Enter a new id and `header' in the `dependencies' table.
     ((null id-dep)
      (setq id-dep (puthash id (list header) dependencies)))
     ;; A child message has already added this id, just insert the header.
     ((null (car id-dep))
      (setcar (gethash id dependencies) header)
      (setq id-dep (gethash id dependencies)))
     ;; From here the `header' was already present in the
     ;; `dependencies' table.
     (force-new
      ;; Overrides an existing entry;
      ;; just set the header part of the entry.
      (setcar (gethash id dependencies) header)
      (setq replaced t))

     ;; Renames the existing `header' to a unique Message-ID.
     ((not gnus-summary-ignore-duplicates)
      ;; An article with this Message-ID has already been seen.
      ;; We rename the Message-ID.
      (setq id-dep (puthash (setq id (nnmail-message-id))
			    (list header)
			    dependencies))
      (setf (mail-header-id header) id))

     ;; The last case ignores an existing entry, except it adds any
     ;; additional Xrefs (in case the two articles came from different
     ;; servers.
     ;; Also sets `header' to nil meaning that the `dependencies'
     ;; table was *not* modified.
     (t
      (setf (mail-header-xref (car id-dep))
            (concat (or (mail-header-xref (car id-dep))
                        "")
                    (or (mail-header-xref header) "")))
      (setq header nil)))

    (when (and header (not replaced))
      ;; First check that we are not creating a References loop.
      (setq parent-id (gnus-parent-id (mail-header-references header)))
      (setq ref parent-id)
      (while (and ref
		  (setq ref-dep (gethash ref dependencies))
		  (setq ref-header (car-safe ref-dep)))
	(if (string= id ref)
	    ;; Yuk!  This is a reference loop.  Make the article be a
	    ;; root article.
	    (progn
	      (setf (mail-header-references (car id-dep)) "none")
	      (setq ref nil)
	      (setq parent-id nil))
	  (setq ref (gnus-parent-id (mail-header-references ref-header)))))
      (setq ref (or parent-id "none")
	    ref-dep (gethash ref dependencies))
      ;; Add `header' to its parent's list of children, creating that
      ;; list if the parent isn't yet registered in the dependency
      ;; table.
      (if ref-dep
	  (setcdr (gethash ref dependencies)
		  (nconc (cdr ref-dep)
			 (list id-dep)))
	(puthash ref (list nil id-dep)
		 dependencies)))
    header))