Function: gnus-cite-match-attributions

gnus-cite-match-attributions is a byte-compiled function defined in gnus-cite.el.gz.

Signature

(gnus-cite-match-attributions SORT AFTER FUN)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-cite.el.gz
(defun gnus-cite-match-attributions (sort after fun)
  ;; Match all loose attributions and citations (SORT AFTER FUN) .
  ;;
  ;; If SORT is `small', the citation with the shortest prefix will be
  ;; used, if it is `first' the first prefix will be used, if it is
  ;; `small-if-unique' the shortest prefix will be used if the
  ;; attribution line does not share its own prefix with other
  ;; loose attribution lines, otherwise the first prefix will be used.
  ;;
  ;; If AFTER is non-nil, only citations after the attribution line
  ;; will be considered.
  ;;
  ;; If FUN is non-nil, it will be called with the arguments (WROTE
  ;; PREFIX TAG) and expected to return a regular expression.  Only
  ;; citations whose prefix matches the regular expression will be
  ;; considered.
  ;;
  ;; WROTE is the attribution line number.
  ;; PREFIX is the attribution line prefix.
  ;; TAG is the Supercite tag on the attribution line.
  (let ((atts gnus-cite-loose-attribution-alist)
	(case-fold-search t)
	att wrote in prefix tag regexp limit smallest best size)
    (while atts
      (setq att (car atts)
	    atts (cdr atts)
	    wrote (nth 0 att)
	    in (nth 1 att)
	    prefix (nth 2 att)
	    tag (nth 3 att)
	    regexp (if fun (funcall fun prefix tag) "")
	    size (cond ((eq sort 'small) t)
		       ((eq sort 'first) nil)
		       (t (< (length (gnus-cite-find-loose prefix)) 2)))
	    limit (if after wrote -1)
	    smallest 1000000
	    best nil)
      (let ((cites gnus-cite-loose-prefix-alist)
	    cite candidate numbers first compare)
	(while cites
	  (setq cite (car cites)
		cites (cdr cites)
		candidate (car cite)
		numbers (cdr cite)
		first (apply #'min numbers)
		compare (if size (length candidate) first))
	  (and (> first limit)
	       regexp
	       (string-match regexp candidate)
	       (< compare smallest)
	       (setq best cite
		     smallest compare))))
      (if (null best)
	  ()
	(setq gnus-cite-loose-attribution-alist
	      (delq att gnus-cite-loose-attribution-alist))
	(push (cons wrote (car best)) gnus-cite-attribution-alist)
	(when in
	  (push (cons in (car best)) gnus-cite-attribution-alist))
	(when (memq best gnus-cite-loose-prefix-alist)
	  (let ((loop gnus-cite-prefix-alist)
		(numbers (cdr best))
		current)
	    (setq gnus-cite-loose-prefix-alist
		  (delq best gnus-cite-loose-prefix-alist))
	    (while loop
	      (setq current (car loop)
		    loop (cdr loop))
	      (if (eq current best)
		  ()
		(setcdr current (gnus-set-difference (cdr current) numbers))
		(when (null (cdr current))
		  (setq gnus-cite-loose-prefix-alist
			(delq current gnus-cite-loose-prefix-alist)
			atts (delq current atts)))))))))))