Re: Improve `bbdb-auto-notes-alist'

Leo <sdl.web@xxxxxxxxx> writes:

Hi Leo,

> This kind of feature looks quite useful. if N is positive keep the
> newest N articles otherwise the oldest abs(N) articles.
>
> (setq bbdb-auto-notes-alist
>       (list
>        '("Subject" (".*" emails 0 N))
>        '("User-Agent"   (".*" mailer 0 t))
>        '("X-Mailer"     (".*" mailer 0 t))))
>
> What do you think of this?

Indeed, that is useful, and somebody has already implemented this.
That's what I have in my ~/.gnus.el.

--8<---------------cut here---------------start------------->8---
;; Automatisch Informationen sammeln für Leute in meinem BBDB.
(add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)
(setq bbdb-auto-notes-alist
      (list
       ;; Es werden immer die N letzten Subjects in der BBDB gehalten. Siehe
       ;; unten: 'ulmer:bbdb-trim-subjects'
       '("Subject"       (".*" subjects 0))
       '("User-Agent"    (".*" mailer 0))
       '("X-Mailer"      (".*" mailer 0))
       '("X-Newsreader"  (".*" mailer 0))))

;; Newline als field-separator für subjects
(put 'subjects 'field-separator "\n")

(add-hook 'bbdb-notice-hook 'ulmer:bbdb-trim-subjects)

;; Die N letzten Subjects in der BBDB halten
(defvar ulmer:bbdb-subject-limit 25
  "*Maximum number of subject records for
ulmer:bbdb-trim-subjects to retain.")

(defun ulmer:delete-duplicates (list)
  "Remove duplicate elements from a list."
  (let (result head)
    (while list
      (setq head (car list))
      (setq list (delete head list))
      (setq result (cons head result)))
    (nreverse result)))

(defun ulmer:bbdb-trim-subjects (record)
  "Remove all but the first ulmer:bbdb-subject-limit subject
 records from the subjects in the notes field of a BBDB record.
 Also squished duplicate subjects. Meant to be run from
 bbdb-change-hook."
  (let* ((sep (get 'subjects 'field-separator))
         (foo (reverse
               (split-string
                (or (bbdb-record-getprop record 'subjects) "")
                sep)))
         (num-to-keep ulmer:bbdb-subject-limit)
         (new-subj ""))
    (setq foo (ulmer:delete-duplicates foo))
    (while (and (> num-to-keep 0) (> (length foo) 0))
      (if (> (length (car foo)) 0)
          (setq new-subj (concat (car foo)
                                 (if (> (length new-subj) 0)
                                     (concat sep new-subj)
                                   ""))
                num-to-keep (- num-to-keep 1)))
      (setq foo (cdr foo)))
    (bbdb-record-putprop record 'subjects new-subj)))
--8<---------------cut here---------------end--------------->8---

Bye,
Tassilo

-------------------------------------------------------------------------
SF.Net email is sponsored by: The Future of Linux Business White Paper
from Novell.  From the desktop to the data center, Linux is going
mainstream.  Let it simplify your IT future.
http://altfarm.mediaplex.com/ad/ck/8857-50307-18918-4
_______________________________________________
bbdb-info@xxxxxxxxxxxxxxxxxxxxx
https://lists.sourceforge.net/lists/listinfo/bbdb-info
BBDB Home Page: http://bbdb.sourceforge.net/