;;;_+ 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)) '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))) ;;;_+ 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 (recs filter-function) (interactive (list (or bbdb-records (bbdb-records)) (read t))) (let (records) (setq records (delq nil (mapcar (lambda (rec) (when (funcall filter-function (if (arrayp rec) rec (car rec))) rec)) recs))) (if (interactive-p) (bbdb-display-records records)) records)) (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)) 'mail-alias) "") "[ \n\t,]+")) rec)) bbdb-records))) (if (interactive-p) (bbdb-display-records records)) records)) ;;;_+ Show only no contact since... ;; Goal: Filter displayed contacts to show only the people I haven't pinged in a while (require 'planner) (require 'bbdb) (defun sacha/bbdb-last-timestamp (rec) "Return the most recent timestamp for REC or nil if none. Assumes timestamps in the contact field are in reverse chronological order." (if (string-match planner-date-regexp (or (bbdb-record-getprop rec 'contact) "")) (match-string 0 (bbdb-record-getprop rec 'contact)) "0000.00.00")) (defun sacha/bbdb-show-only-no-contact-since (date &optional reverse) "Show only people who haven't been pinged since DATE or at all. If REVERSE is non-nil, show only the people you've contacted on or since DATE. Call with a prefix argument to show only people you've contacted on or since DATE." (interactive (list (planner-read-date) current-prefix-arg)) (let ((records bbdb-records) new-records last-match timestamp omit notes) (while records ;; Find the latest date mentioned in the entry (let ((timestamp (sacha/bbdb-last-timestamp (caar records)))) (if (if reverse ;; Keep if contact is >= date (null (string< timestamp date)) ;; Keep if date > contact (string> date timestamp)) (add-to-list 'new-records (caar records) t))) (setq records (cdr records))) (bbdb-display-records new-records))) (provide 'bbdb-filtering)