I like starting my e-mail with a short salutation such as “Hello, Mike!”, “Hello, Michael”, or “Hello, Mikong!”, but it can be hard to remember which nicknames people prefer to use, and calling someone by the wrong name is a bit of a faux pas. Sometimes people sign e-mail with their preferred name, but what if you haven’t sent e-mail to or received e-mail from someone in a while? In this project, you’ll learn how to set up my BBDB to remember people’s nicknames for you using a custom “nick” field, and to use those nicknames when replying to messages in Gnus or composing messages from my BBDB.

The nickname code worked so well that I started thinking of what else I could customize. It was easy to go from nicknames to personalized salutations. This hack started because one of my friends is from Romania, so I thought I’d greet her in Romanian with “Salut, Letitia!” instead of just “Hello, Letitia!”. The code in this project uses a “hello” field to store these salutations in your BBDB.

To set up personalized nicknames and salutations, add the following code to your ~/.emacs:

For BBDB v2

(defvar wicked/gnus-nick-threshold 5 "*Number of people to stop greeting individually. Nil means always greet individually.")  ;; (1)
(defvar wicked/bbdb-hello-string "Hello, %s!" "Format string for hello. Example: \"Hello, %s!\"")
(defvar wicked/bbdb-hello-all-string "Hello, all!" "String for hello when there are many people. Example: \"Hello, all!\"")
(defvar wicked/bbdb-nick-field 'nick "Symbol name for nickname field in BBDB.")
(defvar wicked/bbdb-salutation-field 'hello "Symbol name for salutation field in BBDB.")

(defun wicked/gnus-add-nick-to-message ()
  "Inserts \"Hello, NICK!\" in messages based on the recipient's nick field."
  (interactive)
  (save-excursion
    (let* ((bbdb-get-addresses-headers ;; (2)
            (list (assoc 'recipients bbdb-get-addresses-headers)))
           (recipients (bbdb-get-addresses
                        nil
                        gnus-ignored-from-addresses
                        'gnus-fetch-field))
           recipient nicks rec net salutations)
      (goto-char (point-min))
      (when (re-search-forward "--text follows this line--" nil t)
        (forward-line 1)
        (if (and wicked/gnus-nick-threshold 
                 (>= (length recipients) wicked/gnus-nick-threshold))
            (insert wicked/bbdb-hello-all-string "\n\n") ;; (3)
          (while recipients
            (setq recipient (car (cddr (car recipients))))
            (setq net (nth 1 recipient))
            (setq rec (car (bbdb-search (bbdb-records) nil nil net)))
            (cond
             ((null rec) ;; (4)
              (add-to-list 'nicks (car recipient))) 
             ((bbdb-record-getprop rec wicked/bbdb-salutation-field) ;; (5)
              (add-to-list 'salutations 
                           (bbdb-record-getprop rec wicked/bbdb-salutation-field))) 
             ((bbdb-record-getprop rec wicked/bbdb-nick-field) ;; (6)
              (add-to-list 'nicks 
                           (bbdb-record-getprop rec wicked/bbdb-nick-field)))
             (t (bbdb-record-name rec))) ;; (7) 
            (setq recipients (cdr recipients))))
        (when nicks ;; (8)
          (insert (format wicked/bbdb-hello-string 
                          (mapconcat 'identity (nreverse nicks) ", "))
                  " "))
        (when salutations ;; (9)
          (insert (mapconcat 'identity salutations " ")))
        (when (or nicks salutations)
          (insert "\n\n")))))
  (goto-char (point-min)))

(defadvice gnus-post-news (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

(defadvice gnus-msg-mail (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

(defadvice gnus-summary-reply (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

For BBDB v3

;; This version is for BBDBv3 - thanks, Thomas!

(defvar wicked/gnus-nick-threshold 5 "*Number of people to stop greeting individually. Nil means always greet individually.")  ;; (1)
(defvar wicked/bbdb-hello-string "Hello, %s!" "Format string for hello. Example: \"Hello, %s!\"")
(defvar wicked/bbdb-hello-all-string "Hello, all!" "String for hello when there are many people. Example: \"Hello, all!\"")
(defvar wicked/bbdb-nick-field 'nick "Symbol name for nickname field in BBDB.")
(defvar wicked/bbdb-salutation-field 'hello "Symbol name for salutation field in BBDB.")

(defun wicked/gnus-add-nick-to-message ()
  "Inserts \"Hello, NICK!\" in messages based on the recipient's nick field."
  (interactive)
  (let ((recipients (bbdb-get-address-components))
        recipient nicks rec net salutations)
    (goto-char (point-min))
    (when (re-search-forward "--text follows this line--" nil t)
      (forward-line 1)
      (if (and wicked/gnus-nick-threshold 
               (>= (length recipients) wicked/gnus-nick-threshold))
          (insert wicked/bbdb-hello-all-string "\n\n") ;; (3)
        (while recipients
          (setq recipient (car recipients))
          (setq net (nth 1 recipient))
          (setq rec (car (bbdb-search (bbdb-records) nil nil net)))
          (cond
           ((null rec) ;; (4)
            (add-to-list 'nicks (car recipient))) 
           ((bbdb-record-xfield rec wicked/bbdb-salutation-field) ;; (5)
            (add-to-list 'salutations 
                         (bbdb-record-xfield rec wicked/bbdb-salutation-field))) 
           ((bbdb-record-xfield rec wicked/bbdb-nick-field) ;; (6)
            (add-to-list 'nicks 
                         (bbdb-record-xfield rec wicked/bbdb-nick-field)))
           (t
            (add-to-list 'nicks
                         (car (split-string (bbdb-record-name rec)))))) ;; (7) 
          (setq recipients (cdr recipients))))
      (when nicks ;; (8)
        (insert (format wicked/bbdb-hello-string 
                        (mapconcat 'identity (nreverse nicks) ", "))
                " "))
      (when salutations ;; (9)
        (insert (mapconcat 'identity salutations " ")))
      (when (or nicks salutations)
        (insert "\n\n")))))

(defadvice gnus-post-news (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

(defadvice gnus-msg-mail (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

(defadvice gnus-summary-reply (after wicked/bbdb activate)
  "Insert nicknames or custom salutations."
  (wicked/gnus-add-nick-to-message))

After you add this code, you can store personalized nicknames and salutations in your BBDB. Nicknames and salutations will be looked up using people’s e-mail addresses. While in the *BBDB* buffer, you can type C-o (bbdb-insert-new-field) to add a field to the current record. Add a nick field with the person’s nickname, or a hello field with a custom salutation. When you compose a message to or reply to a message from that person, the salutation or nickname will be included. If no nickname can be found, the recipient’s name will be used instead.

A number of variables can be used to modify the behavior of this code(1). For example, you may or may not want to greet 20 people individually. The default value of wicked/gnus-nick-threshold is to greet up to four people individually, and greet more people collectively. If you always want to greet people individually, add (setq wicked/gnus-nick-threshold nil) to your ~/.emacs. If you want to change the strings used to greet people individually or collectively, change wicked/bbdb-hello-string and wicked/bbdb-hello-all-string. If you want to store the data into different fields, change wicked/bbdb-nick-field and wicked/bbdb-salutation-field, but note that old data will not be automatically copied to the new fields.

Here’s how the code works. First, it retrieves the list of addresses from the header(2). If there are more addresses than wicked/gnus-nick-threshold, then wicked/bbdb-hello-all-string is used to greet everyone. If not, each recipient address is looked up. If the recipient cannot be found in your BBDB, then the recipient’s name or e-mail address is used(4). If there is a personalized salutation, it is used(5). If there is a nickname, it is used(6). If the person has a record but neither salutation or nickname, then the name of the record is used(7). After all recipients have been processed, the names are added to the message(8), followed by the salutations(9). This function is added to the different Gnus message-posting functions, so it should be called whenever you compose or reply to messages.

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. I use mail aliases to tag or categorize my contacts (example: emacs, writing, etc.). The following functions can make it easy for you to filter displayed records using a combination of keywords:

Here’s the code:

(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))
                              'mail-alias) "")
                         "[ \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
    (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
    (or bbdb-records (bbdb-records))
    (if any
        'sacha/bbdb-filter-by-alias-match-any
      'sacha/bbdb-filter-by-alias-match-all)
    query
    t)))

This will be part of my book, Wicked Cool Emacs. Looking forward to putting it together!

When I find myself in an airport, I sometimes take a little time to say hi to a bunch of people who are suddenly just a local call a way. Or sometimes I’m thinking of going somewhere, and instead of flipping through my phone’s address book, I’ll check my computer to see who might be interested.

You can use this function to filter phone numbers in your BBDB based on a regular expression. As usual, leaving the regular expression blank means that all records with phone numbers will be displayed. By default, the function works on the currently displayed records, allowing you to apply multiple filters. You can call it with a universal prefix argument (C-u M-x sacha/bbdb-find-people-with-phones) to match against all contacts in your database.

Here’s the code:

(defun sacha/bbdb-find-people-with-phones (&optional regexp records)
  "Search for phone numbers that match REGEXP in BBDB RECORDS.
Without a prefix argument, filter the list of displayed records.
Call with a prefix argument to search the entire database.  This
works best if you use a consistent format to store your phone
numbers.  The search will strip out non-numeric characters. For
example, +1-888-123-4567 will be treated as +18001234567.

To search for all numbers in Toronto, search for
\"+1\\(416\\|647\\)\". If you search for certain areas
frequently, it might be a good idea to define a function for
them."
  (interactive (list (read-string "Regexp: ")
		     (if current-prefix-arg
			 (bbdb-records)
		       (or bbdb-records (bbdb-records)))))
  (let (filtered next)
    (while records
      (when
          (and (bbdb-record-get-field-internal
		(if (arrayp (car records))
		    (car records)
		  (caar records)) 'phone)
               (or
                (null regexp)
		(string= regexp "")
                (delq nil
                      (mapcar
                       (lambda (phone)
			 (when (string-match regexp (sacha/bbdb-phone-string phone))
			   (concat (bbdb-phone-location phone) ": " (bbdb-phone-string phone))))
                       (bbdb-record-get-field-internal
                        (if (arrayp (car records))
                            (car records)
                          (caar records)) 'phone)))))
        (setq filtered (cons (if (arrayp (car records))
                                 (car records)
                               (caar records)) filtered)))
      (setq records (cdr records)))
    (bbdb-display-records (nreverse filtered))))

(defun sacha/bbdb-phone-string (&optional phone)
  "Strip non-numeric characters from PHONE, except for +."
  (replace-regexp-in-string "[^+1234567890]" "" (bbdb-phone-string phone)))
   
(defun sacha/bbdb-yank-phones ()
  "Copy a phone list into the kill ring."
  (interactive)
  (kill-new
   (mapconcat
    (lambda (record)
      (mapconcat
       (lambda (phone)
	 (concat (bbdb-record-name (car record)) "\t" 
                 (bbdb-phone-location phone) "\t"
		 (bbdb-phone-string phone)))
        (bbdb-record-get-field-internal (car record) 'phone)
        "\n"))
    bbdb-records
    "\n")))

This snippet goes through all the records in my Big Brother Database,
prints out birthdate and a link to the record, and then sorts the
results.

(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.

I started tracking e-mail sent on 2006.09.01 with a
nifty piece of Emacs Lisp code I wrote just for the
purpose. Now I have two months of interesting data which include not
only e-mail but also the occasional in-person contact or phone call
that I remember to note. It's not complete – e-mail's the only thing
that gets automatically tracked – but it does give me interesting
information. Here's the contact report for your amusement:

Contact report

It's sorted by overall frequency and then by regular frequency.
Warning! Parentheses follow.

(defun sacha/count-matches (regexp string)
  (let ((count 0)
        (start 0))
    (while (string-match regexp string start)
      (setq start (match-end 0)
            count (1+ count)))
    count))

(defun sacha/bbdb-contact-report-as-alist (&rest regexps)
  "Creates a list of (name count-regexp1 count-regexp2 count-regexp3)..."
  (setq regexps (reverse regexps))
  (delq nil
        (mapcar
         (lambda (rec)
           (when (bbdb-record-name (car rec))
             (let ((reg regexps)
                   (notes (bbdb-record-notes (car rec)))
                   list)
               (while reg
                 (setq list (cons (sacha/count-matches (car reg) notes)
                                  list))
                 (setq reg (cdr reg)))
               (cons (sacha/planner-bbdb-annotation-from-bbdb rec)
                     list))))
         bbdb-records)))

(defun sacha/bbdb-alist-sort-by-total (alist)
  "Sort ALIST by total contact."
  (sort alist 'sacha/bbdb-contact-sort-predicate))

(defun sacha/bbdb-contact-sort-predicate (a b)
  (and a b
       (let ((count-a (apply '+ (cdr a)))
             (count-b (apply '+ (cdr b))))
         (or
          (> count-a count-b)
          (and (= count-a count-b)
               ;; If equal, look at the subtotal of the rest
               (sacha/bbdb-contact-sort-predicate (cdr a) (cdr b)))))))

(defun sacha/bbdb-kill-contact-barchart (alist)
  "Kill a barchart with the contact report for ALIST."
  (kill-new
   (mapconcat
    (lambda (entry)
      (concat
       (car entry)
       " | "
       (mapconcat (lambda (count)
                    (if (= count 0)
                        " "
                      (make-string count ?-)))
                  (cdr entry)
                  " | ")))
    alist
    "\n")))

;; Usage: (sacha/bbdb-kill-contact-barchart
;;         (sacha/bbdb-alist-sort-by-total
;;          (sacha/bbdb-contact-report-as-alist "2006.09" "2006.10")))
;; Then yank (paste) this into another buffer

Random Emacs symbol: standard-display-cyrillic-translit – Command: Display a cyrillic buffer using a transliteration.

Of course, that naturally leads to the crazy idea: “What if I can
personalize my signatures?” Knowing that Paul Lussier is an Emacs geek, I can reward him for reading all the way
to the bottom of my message… ;)

(defun sacha/gnus-personalize-signature ()
  "Personalizes signature based on BBDB signature field.
BBDB signature field should be a lambda expression.
First person with a custom signature field gets used."
  (let* ((bbdb-get-addresses-headers
          (list (assoc 'recipients bbdb-get-addresses-headers)))
         (records (bbdb-update-records
                   (bbdb-get-addresses
                    nil
                    gnus-ignored-from-addresses 'gnus-fetch-field)
                   nil
                   nil))
         signature)
    (while (and records (not signature))
      (when (bbdb-record-getprop (car records) 'signature)
        (setq signature
              (eval (read (bbdb-record-getprop (car records)
                                               'signature)))))
      (setq records (cdr records)))
    (or signature t)))
(setq-default message-signature 'sacha/gnus-personalize-signature)

So then all I have to do is add the following field to his record:

      signature: (concat "Sacha Chua - Emacs geek
                 What crazy idea can I help you hack next?
                 Random Emacs symbol: "
                 (sacha/random-tagline
                  "~/.taglines.random-emacs-symbols"))

Emacs. One crazy idea at a time. Now I can use this to select random
information, like my favorite networking books or a list of my
upcoming events…

Random Emacs symbol: sort-coding-systems-predicate – Variable: If non-nil, a predicate function to sort coding systems.

I often include people's names in my notes on other people, such as
when I'm tracking who introduced me to whom. The following code
modifies BBDB's behavior to put exact matches for name, company, or
network address above matches for notes.

(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)