(defun sacha/bbdb-insert-birthdates ()
  "Insert a list of birthdates, sorted by month.
For best effect, dates should be of the form yyyy.mm.dd."
  (insert
   (with-temp-buffer
     (mapcar
      (lambda (rec)
        (when (bbdb-record-getprop rec 'birthdate)
          (insert
           (if (string-match "..\\...$" (bbdb-record-getprop rec 'birthdate))
               (match-string 0 (bbdb-record-getprop rec 'birthdate))
             (bbdb-record-getprop rec 'birthdate))
           " | "
           (planner-make-link
            (concat "bbdb://"
                    (planner-replace-regexp-in-string
                     " " "." (bbdb-record-name rec)))
            (bbdb-record-name rec))
           "\n")))
      (bbdb-records))
     (sort-lines nil (point-min) (point-max))
     (buffer-string)))
  nil)

Random Emacs symbol: find-tag-noselect – Command: Find tag (in current tags table) whose name contains TAGNAME.

You can e-mail me at sacha@sachachua.com.

(defun sacha/bbdb (string elidep)
  "Display all entries in the BBDB matching the regexp STRING
in either the name(s), company, network address, or notes.
Prioritize non-note matches."
  (interactive
   (list (bbdb-search-prompt "Search records %m regexp: ")
         current-prefix-arg))
  (let* ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))
         (notes (cons '* string))
         (records-top
          (bbdb-search (bbdb-records) string string string nil
                       nil))
         (records
          (bbdb-search (bbdb-records) string string string notes
                       nil))
         temp)
    (setq temp records-top)
    (while temp
      (setq records (delete (car temp) records))
      (setq temp (cdr temp)))
    (if (or records-top records)
        (bbdb-display-records (append
                               records-top
                               records))
      ;; we could use error here, but it's not really an error.
      (message "No records matching '%s'" string))))

(defalias 'bbdb 'sacha/bbdb)

You can e-mail me at sacha@sachachua.com.

One of the things I often need to do is filter my contacts for a
particular set of interests. I would have no idea how to do this in
Microsoft Outlook and other proprietary contact management systems.
Because Emacs is infinitely programmable, though, I can just hack it
in.

You'd expect the intersection of the set “emacs geek” and the set
“social networker” to be a null set or a singleton (me!). As it turns
out, there's at least one other geek in this space – hooray!

Paul Lussier's been bouncing all sorts of
crazy ideas off me, which explains all the weird
porridge-and-toe-nails posts of Emacs Lisp code on my blog lately.
He's responsible for my puttting together yesterday's LinkedIn
importer. Today, he wrote:

Then found your sacha/bbdb-search-tags stuff which
totally, completely rocks. I just wish I had the first inkling as to
how it worked :) Now, the question I have is: How can I use
sacha/bbdb-search-tags to search for entries which are tagged with one
label, but NOT with another? For example, I want to search on: (and
(taq eq “planner”) (not (tag eq “muse”)))

I'd completely forgotten about sacha/bbdb-search-tags! Anyway, I'd
been meaning to write a fancy alias management thing for a while now,
and this code does a reasonable job for me. I can now filter my
displayed records by arbitrary Lisp expressions, bringing me closer to
insane contact relationship management. I mean, c'mon…

;; M-x sacha/bbdb-filter-by-alias-function RET
;;     (lambda (aliases) (and (member "planner" aliases)
;;                       (not (member "muse" aliases))))) RET

If I do this often enough, I might make up an easier syntax, but
lisp expressions work fine for me.

MWAHAHAHAHA!

Here's the code:

;;;_+ Mail aliases

;; Code for working with aliases

;; You can use "a" (bbdb-add-or-remove-mail-alias) in BBDB buffers to add
;; a mail alias to the current entry, or "* a" to add a mail alias to
;; all displayed entries.

;; Goal: Be able to specify ALIAS and ALIAS
;; M-x sacha/bbdb-filter-displayed-records-by-alias RET alias alias
;; Goal: Be able to specify ALIAS or ALIAS
;; C-u M-x sacha/bbdb-filter-displayed-records-by-alias RET alias alias
;; Goal: Be able to specify not ...
;; M-x sacha/bbdb-omit-displayed-records-by-alias RET alias alias
;; C-u M-x sacha/bbdb-omit-displayed-records-by-alias RET alias alias

(defun sacha/bbdb-filter-by-alias-match-all (query-aliases record-aliases)
  "Return non-nil if all QUERY-ALIASES are in RECORD-ALIASES."
  (let ((result t))
    (while query-aliases
      (unless (member (car query-aliases) record-aliases)
        (setq query-aliases nil
              result nil))
      (setq query-aliases (cdr query-aliases)))
    result))

(defun sacha/bbdb-filter-by-alias-match-any (query-aliases record-aliases)
  "Return non-nil if any in QUERY-ALIASES can be found in RECORD-ALIASES."
  (let (result)
    (while query-aliases
      (when (member (car query-aliases) record-aliases)
        (setq query-aliases nil
              result t))
      (setq query-aliases (cdr query-aliases)))
    result))

;; Moved this to a convenience function so that we don't
;; have to deal with invert and property splitting.
(defun sacha/bbdb-filter-by-alias (bbdb-records
                                   alias-filter-function
                                   query
                                   &optional invert)
  "Return only the BBDB-RECORDS that match ALIAS-FILTER-FUNCTION.
ALIAS-FILTER-FUNCTION should accept two arguments:
 - QUERY, a list of keywords to search for
 - aliases, a list of keywords from the record
If INVERT is non-nil, return only the records that do
not match."
  (delq nil
        (mapcar
         (lambda (rec)
           (if (funcall alias-filter-function
                        query
                        (split-string
                         (or (bbdb-record-getprop
                              (if (vectorp rec)
                                  rec
                                (car rec))
                              propsym) "")
                         "[ \n\t,]+"))
               (when (null invert) rec)
             (when invert rec)))
         bbdb-records)))

;; Splitting this into two functions because of interactive calling.
(defun sacha/bbdb-filter-displayed-records-by-alias (query &optional any)
  "Display only records whose mail-aliases match QUERY.
If ANY is non-nil, match if any of the keywords in QUERY are
present.
See also `sacha/bbdb-omit-displayed-records-by-alias'."
  (interactive (list
                (let ((crm-separator " "))
                  (completing-read-multiple
                   "Mail aliases: "
                   (bbdb-get-mail-aliases)))
                current-prefix-arg))
  (when (stringp query)
    (setq query (split-string query "[ \n\t,]+")))
  (bbdb-display-records
   (sacha/bbdb-filter-by-alias-by-function
    (or bbdb-records (bbdb-records))
    (if any
        'sacha/bbdb-filter-by-alias-match-any
      'sacha/bbdb-filter-by-alias-match-all)
    query)))

;; Splitting this into two functions because of interactive calling.
(defun sacha/bbdb-omit-displayed-records-by-alias (query &optional any)
  "Display only records whose mail-aliases do not match QUERY.
If ANY is non-nil, match if any of the keywords in QUERY are
present.

See also `sacha/bbdb-filter-displayed-records-by-alias'."
  (interactive (list
                (let ((crm-separator " "))
                  (completing-read-multiple
                   "Mail aliases: "
                   (bbdb-get-mail-aliases))
                  current-prefix-arg)))
  (when (stringp query)
    (setq query (split-string query "[ \n\t,]+")))
  (bbdb-display-records
   (sacha/bbdb-filter-by-alias-by-function
    (or bbdb-records (bbdb-records))
    (if any
        'sacha/bbdb-filter-by-alias-match-any
      'sacha/bbdb-filter-by-alias-match-all)
    query
    t)))

;;;_+ Advanced mail alias queries

;; Goal: Use complicated lambda expressions to filter displayed records
;; M-x sacha/bbdb-filter-by-alias-function RET
;;     (lambda (aliases) (and (member "planner" aliases)
;;                       (not (member "muse" aliases))))) RET
;; Thanks to Paul Lussier for the suggestion!

(defun sacha/bbdb-filter-by-alias-function (bbdb-records
                                            alias-filter-function)
  "Return only the BBDB-RECORDS that match ALIAS-FILTER-FUNCTION.
ALIAS-FILTER-FUNCTION should accept one argument:
 - aliases, a list of keywords from the record."
  (interactive (list (or bbdb-records (bbdb-records))
                     (read t)))
  (let (records)
    (setq records
          (delq nil
                (mapcar
                 (lambda (rec)
                   (when (funcall alias-filter-function
                                  (split-string
                                   (or (bbdb-record-getprop
                                        (if (vectorp rec)
                                            rec
                                          (car rec))
                                        propsym) "")
                                   "[ \n\t,]+"))
                     rec))
                 bbdb-records)))
    (if (interactive-p) (bbdb-display-records records))
    records))

You can e-mail me at sacha@sachachua.com.

(defvar sacha/bbdb-rapid-serial-visualization-delay
 1
 "*Number of seconds to wait between records.
Set to 0 to wait for input.")

(defun sacha/bbdb-rapid-serial-visualization ()
  "Breeze through everyone's name and notes."
  (interactive)
  (window-configuration-to-register ?a)
  ;; Copy the currently visible records
  (let ((records bbdb-records)
        (default-size (face-attribute 'default :height))
        (new-size 400)
        (continue t))
    (set-face-attribute 'default nil :height new-size)
    (pop-to-buffer (get-buffer-create "BBDB-Serial"))
    (delete-other-windows)
    (while (and records continue)
      (insert (bbdb-record-name (caar records))
              "\n\n"
              (or (car (bbdb-record-net (caar records))) "No e-mail")
              "\n\n"
              (or (bbdb-record-notes (caar records)) "")
              (make-string 50 ?\n))
      (goto-char (point-min))
      (sit-for sacha/bbdb-rapid-serial-visualization-delay)
      (setq records (cdr records)))
    (set-face-attribute 'default nil :height default-size)
    (when continue
      (jump-to-register ?a))))

You can e-mail me at sacha@sachachua.com.

The first thing I needed to build, of course, was something that
removed my notes from outgoing messages. People really don't need to
see the kinds of notes I keep on them. ;) Well, they're fairly
innocuous notes: how we met and what they're interested in, usually,
although sometimes I'll have notes on people's food preferences or
shoe sizes. I've recently started keeping track of the subjects of
e-mail I send them, too.

(defun sacha/gnus-remove-notes ()
  "Remove everything from --- NOTES --- to the signature."
  (goto-char (point-min))
  (when (re-search-forward "^--- NOTES ---" nil t)
    (let ((start (match-beginning 0))
          (end (and (re-search-forward "^--- END NOTES ---") (match-end 0))))
      (delete-region start end))))
(add-hook 'message-send-hook 'sacha/gnus-remove-notes)

Then it was easy to write another function that composed individual
messages to all the people currently displayed in the BBDB buffer,
adding notes to each message.

(defun sacha/gnus-send-message-to-all (subject)
  "Compose message to everyone, with notes."
  (interactive "MSubject: ")
  (let ((records bbdb-records))
    (while records
      (when (bbdb-record-net (caar records))
        (bbdb-send-mail (caar records) subject)
        (when (bbdb-record-notes (caar records))
          (save-excursion
            (insert "\n--- NOTES ---\n"
                    (bbdb-record-notes (caar records))
                    "\n--- END NOTES ---\n"))))
      (setq records (cdr records)))))

I use BBDB to display only the people I want to e-mail, then I call
M-x sacha/gnus-send-message-to-all and specify a message subject. This
creates a gazillion message buffers which I can then edit. If I feel
particularly paranoid, I can remove the notes section myself with C-c
C-z (message-kill-to-signature), but sacha/gnus-remove-notes does it
as long as it's in message-send-hook.

This code works particularly well with these other customizations:

• Emacs BBDB magic: Greeting people with nicknames
• Emacs: Keep track of messages sent
• BBDB pinging code – for adding datestamped notes to people's entries; can be rewritten without the use of Planner

It supersedes More Emacs fun: Composing mail to everyone with notes.

../emacs/dotgnus.el

You can e-mail me at sacha@sachachua.com.