(add-to-list 'load-path "/usr/src/bbdb/lisp") (setq bbdb-file-coding-system 'utf-8) (require 'bbdb-autoloads) (require 'bbdb) (require 'bbdb-com) ;(load "bbdb-com" t) (bbdb-initialize 'gnus 'message) ;; (bbdb-insinuate-sc) ;; I want to see the BBDB buffer only when I ask for it. (setq bbdb-use-pop-up nil) ;; Sometimes people have work and personal e-mail addresses. (setq bbdb-complete-name-allow-cycling t) ;; Ignore subnets (setq bbdb-canonicalize-redundant-nets-p t) ;; Always save (setq bbdb-offer-save 1) ;; My screen is not that wide, so I need information displayed on multiple ;; lines (setq bbdb-display-layout 'multi-line) ;; The window should be as small as possible, though. (setq bbdb-pop-up-target-lines 1) ;; Who uses north American numbers, anyway? ;) (setq bbdb-north-american-phone-numbers-p nil) ;; I love my Gnus (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) (put 'subjects 'field-separator "\n") (defun sacha/bbdb-canonicalize-net-hook (addr) "Do not notice member@orkut.com or noreplyaddresses." (cond ((null addr) addr) ((string-match "member@orkut\\.com" addr) nil) ((string-match "noreply" addr) nil) ((string-match "info@evite.com" addr) nil) ((string-match "NO-REPLY" addr) nil) (t addr))) (setq bbdb-canonicalize-net-hook 'sacha/bbdb-canonicalize-net-hook) (setq bbdb-auto-notes-alist (quote (("Organization" (".*" company 0 nil)) ("To" ("w3o" . "w3o") ("plug" . "plug") ("linux" . "linux") ("emacs-commit" . "emacs commit") ("emacs" . "emacs") ("emacs-wiki-discuss" . "planner") ("pinoyjug" . "pinoyjug") ("digitalfilipino" . "digitalfilipino") ("sacha" . "personal mail") ("handhelds" . "handhelds") ("debian-edu" . "debian-edu") ("sigcse" . "sigcse") ("debian" . "debian")) ("Cc" ("w3o" . "w3o") ("plug" . "plug") ("linux" . "linux") ("emacs-commit" . "emacs commit") ("emacs" . "emacs") ("sigcse" . "sigcse") ("pinoyjug" . "pinoyjug") ("digitalfilipino" . "digitalfilipino") ("sacha" . "personal mail") ("debian-edu" . "debian-edu") ("debian" . "debian") ("handhelds" . "handhelds")) ("From" ("admu" company "Ateneo de Manila University") ("orkut" . "orkut"))))) (setq bbdb-auto-notes-ignore '((("Organization" . "^Gatewayed from\\\\|^Source only") ("Path" . "main\\.gmane\\.org") ("From" . "NO-REPLY")))) (setq bbdb-auto-notes-ignore-all nil) (setq bbdb-check-zip-codes-p nil) (setq bbdb-default-area-code nil) (setq bbdb-default-country "Canada") (setq bbdb-ignore-most-messages-alist (quote (("To" . "sacha") ("Cc" . "sacha") ("To" "emacs-wiki-discuss")))) (add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook) (setq bbdb-quiet-about-name-mismatches 0) (setq bbdb/mail-auto-create-p 'bbdb-ignore-most-messages) (setq bbdb/news-auto-create-p nil) (put 'notes 'field-separator "; ") (add-to-list 'bbdb-auto-notes-alist (list "x-face" (list (concat "[ \t\n]*\\([^ \t\n]*\\)" "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" "\\([ \t\n]+\\([^ \t\n]+\\)\\)?") 'face "\\1\\3\\5\\7"))) (defun sacha/bbdb-create-factoid (title &optional text) "Store a factoid named TITLE with associated TEXT into my BBDB. If PREFIX is non-nil, get TEXT from the buffer instead." (interactive (list (read-string "Title: ") (read-string "Text:"))) (unless text (setq text (read-string "Text: "))) (bbdb-create-internal title "factoid" nil nil nil text)) ;; Stolen from http://www.esperi.demon.co.uk/nix/xemacs/personal/dot-gnus-bbdb.html (defadvice bbdb/gnus-update-records (around nix-bbdb-use-summary-buffer-news-auto-create-p activate preactivate) "Propagate the value of news-auto-create-p from the Summary buffer. This allows it to be buffer-local there, so that we can have different values of this variable in different simultaneously active Summary buffers." (let ((bbdb/news-auto-create-p (with-current-buffer gnus-summary-buffer bbdb/news-auto-create-p)) (bbdb/mail-auto-create-p (with-current-buffer gnus-summary-buffer bbdb/mail-auto-create-p))) ad-do-it)) (defun sacha/bbdb-should-not-truncate () "Do not truncate lines in BBDB buffers." (setq truncate-lines nil)) (add-hook 'bbdb-list-hook 'sacha/bbdb-should-not-truncate) (defalias 'bbdb-vcard-export-record-insert-vcard 'sacha/bbdb-vcard-export-record-insert-vcard) (defun sacha/bbdb-vcard-export-record-insert-vcard (record) "Insert a vcard formatted version of RECORD into the current buffer" (let ((name (bbdb-record-name record)) (first-name (bbdb-record-firstname record)) (last-name (bbdb-record-lastname record)) (aka (bbdb-record-aka record)) (company (bbdb-record-company record)) (notes (bbdb-record-notes record)) (phones (bbdb-record-phones record)) (addresses (bbdb-record-addresses record)) (blog (bbdb-record-getprop record 'blog)) (web (bbdb-record-getprop record 'web)) (net (bbdb-record-net record)) (categories (bbdb-record-getprop record bbdb-define-all-aliases-field))) (insert "begin:vcard\n" "version:3.0\n") ;; Specify the formatted text corresponding to the name of the ;; object the vCard represents. The property MUST be present in ;; the vCard object. (insert "fn:" (bbdb-vcard-export-escape name) "\n") ;; Family Name, Given Name, Additional Names, Honorific ;; Prefixes, and Honorific Suffixes (when (or last-name first-name) (insert "n:" (bbdb-vcard-export-escape last-name) ";" (bbdb-vcard-export-escape first-name) ";;;\n")) ;; Nickname of the object the vCard represents. One or more text ;; values separated by a COMMA character (ASCII decimal 44). (when aka (insert "nickname:" (bbdb-vcard-export-several aka) "\n")) ;; FIXME: use face attribute for this one. ;; PHOTO;ENCODING=b;TYPE=JPEG:MIICajCCAdOgAwIBAgICBEUwDQYJKoZIhvcN ;; AQEEBQAwdzELMAkGA1UEBhMCVVMxLDAqBgNVBAoTI05ldHNjYXBlIENvbW11bm ;; ljYXRpb25zIENvcnBvcmF0aW9uMRwwGgYDVQQLExNJbmZvcm1hdGlvbiBTeXN0 ;; FIXME: use birthday attribute if there is one. ;; BDAY:1996-04-15 ;; BDAY:1953-10-15T23:10:00Z ;; BDAY:1987-09-27T08:30:00-06:00 ;; A single structured text value consisting of components ;; separated the SEMI-COLON character (ASCII decimal 59). But ;; BBDB doesn't use this. So there's just one level: (when company (insert "org:" (bbdb-vcard-export-escape company) "\n")) (when blog (insert "URL:" blog "\n")) (when web (insert "URL:" web "\n")) (when notes (insert "note:" (bbdb-vcard-export-escape notes) "\n")) (dolist (phone phones) (insert "tel;type=" (bbdb-vcard-export-escape (bbdb-phone-location phone)) ":" (bbdb-vcard-export-escape (bbdb-phone-string phone)) "\n")) (dolist (address addresses) (insert (bbdb-vcard-export-address-string address) "\n")) (dolist (mail net) (insert "email;type=internet:" (bbdb-vcard-export-escape mail) "\n")) ;; Use CATEGORIES based on mail-alias. One or more text values ;; separated by a COMMA character (ASCII decimal 44). (when categories (insert "categories:" (bbdb-join (mapcar 'bbdb-vcard-export-escape (bbdb-split categories ",")) ",") "\n")) (insert "end:vcard\n"))) (defun sacha/bbdb-records-postal () (sort (delq nil (mapcar (lambda (item) (and (car (bbdb-record-addresses item)) item)) (bbdb-records))) (lambda (a b) (string< (bbdb-address-country (car (bbdb-record-addresses a))) (bbdb-address-country (car (bbdb-record-addresses b))))))) ;(setq sacha/contact-list (sacha/bbdb-records-postal)) ; (bbdb-display-records sacha/contact-list) (defun sacha/bbdb-ping () (interactive) (cond ((eq major-mode 'bbdb-mode) (call-interactively 'sacha/bbdb-ping-bbdb-record)) ((eq major-mode 'gnus-article-mode) (call-interactively 'sacha/bbdb-gnus-ping)) ((eq major-mode 'message-mode) (call-interactively 'sacha/bbdb-gnus-ping)))) (global-set-key "\C-c\C-p" 'sacha/bbdb-ping) (defun sacha/bbdb-ping-bbdb-record (bbdb-record text &optional date regrind) "Adds a note for today to the current BBDB record. Call with a prefix to specify date." (interactive (list (bbdb-current-record t) (read-string "Notes: ") (if current-prefix-arg (planner-read-date) (planner-today)) t)) (bbdb-record-putprop bbdb-record 'contact (concat date ": " text "\n" (or (bbdb-record-getprop bbdb-record 'contact)))) (if regrind (save-excursion (set-buffer bbdb-buffer-name) (bbdb-redisplay-one-record bbdb-record))) nil) (defun sacha/bbdb-gnus-ping (text) "Add a ping for authors/recipients of this message. Call with a prefix to specify a manual note." (interactive (list (if current-prefix-arg (read-string "Notes: ")))) (let* ((from-me-p (string-match gnus-ignored-from-addresses (message-fetch-field "From"))) (bbdb-get-only-first-address-p nil) (bbdb-get-addresses-headers (list (assoc (if from-me-p 'recipients 'authors) bbdb-get-addresses-headers))) (bbdb/gnus-update-records-mode 'annotating) (bbdb-message-cache nil) (bbdb-user-mail-names nil) (gnus-ignored-from-addresses nil) records) (setq records (bbdb/gnus-update-records t)) (if records (bbdb-display-records records) (bbdb-undisplay-records)) (while records (sacha/bbdb-ping-bbdb-record (car records) (concat (if from-me-p "-> " "<- ") (or text (message-fetch-field "Subject"))) (planner-date-to-filename (date-to-time (message-fetch-field "Date")))) (setq records (cdr records))) (setq records (bbdb/gnus-update-records t)) (if records (bbdb-display-records records) (bbdb-undisplay-records)))) (defun sacha/bbdb-find-people-with-addresses (&optional regexp records) (interactive "MRegexp: ") (let ((records (or records bbdb-records)) filtered cons next) (while records (when (and (bbdb-record-get-field-internal (if (arrayp (car records)) (car records) (caar records)) 'address) (or (null regexp) (delq nil (mapcar (lambda (address) (string-match regexp (sacha/bbdb-address-string address))) (bbdb-record-get-field-internal (if (arrayp (car records)) (car records) (caar records)) 'address))))) (setq filtered (cons (if (arrayp (car records)) (car records) (caar records)) filtered))) (setq records (cdr records))) (setq records filtered) (bbdb-display-records filtered))) (defun sacha/bbdb-sort-by-country () (setq filtered (sort filtered (lambda (rec1 rec2) (cond ((string< (or (bbdb-address-country rec1) "") (or (bbdb-address-country rec2) "")) t) ((string< (or (bbdb-address-country rec2) "") (or (bbdb-address-country rec1) "")) nil) ((string< (or (bbdb-address-state rec1) "") (or (bbdb-address-state rec2) "")) t) ((string< (or (bbdb-address-state rec2) "") (or (bbdb-address-state rec1) "")) nil) (t (string< (sacha/bbdb-address-string rec1) (sacha/bbdb-address-string rec2)))))))) (defun sacha/bbdb-address-string (address) "Return ADDRESS as a string." (mapconcat 'identity (delq nil (list (mapconcat 'identity (bbdb-address-streets address) ", ") (bbdb-address-city address) (bbdb-address-state address) (bbdb-address-zip address) (bbdb-address-country address))) ", ")) (defun sacha/bbdb-yank-addresses () (interactive) (kill-new (mapconcat (lambda (record) (concat (bbdb-record-name (car record)) "\n" (mapconcat (lambda (address) (concat (bbdb-address-location address) ": " (sacha/bbdb-address-string address))) (bbdb-record-get-field-internal (car record) 'address) "\n"))) bbdb-records "\n\n"))) (defun sacha/planner-bbdb-annotation-from-bbdb (&optional record) "If called from a bbdb buffer, return an annotation. Suitable for use in `planner-annotation-functions'." (when (or record (eq major-mode 'bbdb-mode)) (setq record (if record (car record) (bbdb-current-record))) (or (bbdb-record-getprop record 'plan) ;; From a BBDB entry with a plan page; use that. Yay! (and (bbdb-record-name record) (planner-make-link (concat "bbdb://" (planner-replace-regexp-in-string " " "." (bbdb-record-name record))) (bbdb-record-name record)))))) (defalias 'planner-bbdb-annotation-from-bbdb 'sacha/planner-bbdb-annotation-from-bbdb) (defun sacha/bbdb-yank-list (&optional comma-separated) "Copy the list of people displayed in the buffer." (interactive "P") (kill-new (if comma-separated (mapconcat 'sacha/planner-bbdb-annotation-from-bbdb bbdb-records ", ") (mapconcat (lambda (entry) (if entry (concat " 1. " (sacha/planner-bbdb-annotation-from-bbdb entry) "\n") "")) bbdb-records "")))) (defun sacha/bbdb-grab-email-addresses () "Kill a list of names and e-mail addresses." (interactive) (let ((records bbdb-records) list) (while records (mapc (lambda (email) (setq list (cons (concat (bbdb-record-name (caar records)) "\t" email) list))) (bbdb-record-net (caar records))) (setq records (cdr records))) (kill-new (mapconcat 'identity list "\n")))) ;;;_+ 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." (let ((notes-date (or (and (string-match planner-date-regexp (or (bbdb-record-notes rec) "")) (match-string 0 (or (bbdb-record-notes rec) ""))) "0000.00.00")) (contact-date (or (and (string-match planner-date-regexp (or (bbdb-record-getprop rec 'contact) "")) (match-string 0 (or (bbdb-record-getprop rec 'contact) ""))) "0000.00.00"))) (or (if (string< notes-date contact-date) contact-date notes-date) "0000.00.00"))) (defun sacha/bbdb-show-only-no-contact-since (date &optional reverse records) "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 (or bbdb-records (bbdb-records)))) (let (new-records last-match timestamp omit notes) (while records ;; Find the latest date mentioned in the entry (let ((timestamp (sacha/bbdb-last-timestamp (if (vectorp (car records)) (car records) (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 (if (vectorp (car records)) (car records) (caar records)) t))) (setq records (cdr records))) (bbdb-display-records new-records))) ;;;_+ rapid serial visualization ;; Goal: Be reminded of people ;; Very quickly flash through displayed entries (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)))) ;;;_+ Prioritize exact matches (defun sacha/bbdb (string no-notes-search) "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* ((notes (cons '* string)) (records-top (bbdb-search (bbdb-records) string string string nil nil)) (records (unless no-notes-search (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) ;;;_+ LinkedIn import (require 'csv) (require 'lookout) (setq lookout-bbdb-mapping-table '(("lastname" "Last Name") ("firstname" "First Name") ("company" "Company") ("job" "Job Title") ("net" "E-mail Address"))) (defun sacha/lookout-bbdb-check-linkedin (line) (let* ((lastname (lookout-bbdb-get-value "lastname" line)) (firstname (lookout-bbdb-get-value "firstname" line)) (company (lookout-bbdb-get-value "company" line)) (job (lookout-bbdb-get-value "job" line)) (net (lookout-bbdb-get-value "net" line)) (addr1 (lookout-bbdb-get-value "addr1" line)) (addr2 (lookout-bbdb-get-value "addr2" line)) (addr3 (lookout-bbdb-get-value "addr3" line)) (phones (lookout-bbdb-get-value "phones" line t)) ;; ! (notes (lookout-bbdb-get-value "notes" line )) (j (concat job ", " company)) (otherfields (lookout-bbdb-get-value "otherfields" line t)) (addrs nil) (n (concat "^" firstname " " lastname)) (record (or (bbdb-search (bbdb-records) n) (bbdb-search (bbdb-records) nil nil net))) (message "")) (unless record (if (string= company "") (setq company nil)) (if (string= notes "") (setq notes nil)) (if (and addr1 (> (length addr1) 0)) (add-to-list 'addrs (vector "Address 1" (list addr1) "" "" "" ""))) (if (and addr2 (> (length addr2) 0)) (add-to-list 'addrs (vector "Address 2" (list addr2) "" "" "" ""))) (if (and addr3 (> (length addr3) 0)) (add-to-list 'addrs (vector "Address 3" (list addr3) "" "" "" ""))) (setq record (list (lookout-bbdb-create-entry (concat firstname " " lastname) (concat job ", " company) net addrs phones notes otherfields)))) ;; Check if net has changed (when record (setq record (car record)) (let ((nets (bbdb-record-net record))) (unless (member net nets) ;; New e-mail address noticed, add to front of list (add-to-list 'nets net) (bbdb-record-set-net record nets) (message "%s %s: New e-mail address noticed: %s" firstname lastname net))) ;; Check if job title and company have changed (when (or job company) (cond ((string= (or (bbdb-record-company record) "") "") (bbdb-record-set-company record j)) ((string= (bbdb-record-company record) j) nil) (t (bbdb-record-set-notes record (concat (planner-today) ": " "Noticed change from job title of " (bbdb-record-company record) "\n" (bbdb-record-notes record))) (message "%s %s %s: Noticed change from job title of %s to %s" (planner-today) firstname lastname (bbdb-record-company record) j) (bbdb-record-set-company record j)))) (let* ((propsym bbdb-define-all-aliases-field) (oldaliases (bbdb-record-getprop record propsym))) (if oldaliases (setq oldaliases (bbdb-split oldaliases ","))) (add-to-list 'oldaliases "linkedin") (setq oldaliases (bbdb-join oldaliases ", ")) (bbdb-record-putprop record propsym oldaliases))))) (defun lookout-bbdb-create-entry (name company net addrs phones notes &optional otherfields) (when (or t (y-or-n-p (format "Add %s to bbdb? " name))) ;;(message "Adding record to bbdb: %s" name) (let ((record (bbdb-create-internal name company net addrs phones notes))) (unless record (error "Error creating bbdb record")) (mapcar (lambda (i) (let ((field (make-symbol (aref i 0))) (value (aref i 1))) (when (and value (not (string= "" value))) (bbdb-insert-new-field record field value)))) otherfields) record))) (defun lookout-bbdb-get-value (key entry &optional as-vector-list) "Returns the value for a key from a lispified csv line, using the mapping table." (let* ((table (if (listp lookout-bbdb-mapping-table) lookout-bbdb-mapping-table (symbol-value lookout-bbdb-mapping-table))) (mapped-keys (cdr (assoc key table))) (result nil) (separator "")) ; (unless mapped-keys ; (error ; (format "Cannot find `%s' -- have you set `lookout-bbdb-mapping-table'?" ; key))) (unless as-vector-list (setq result "")) (when mapped-keys (if (stringp mapped-keys) (setq mapped-keys (list mapped-keys))) (mapcar (lambda (i) ;;(message "%s...%s" i (cdr (assoc i entry))) (let ((value (cdr (assoc i entry)))) (unless (string= "" value) (if as-vector-list (add-to-list 'result (vector i value)) (setq result (concat result separator value))) (setq separator " ")))) mapped-keys)) ;;(message "%s" result) result)) (defun sacha/linkedin-import () (interactive) (mapcar 'sacha/lookout-bbdb-check-linkedin (csv-parse-buffer))) (defun sacha/bbdb-clone-record (name net notes record) "Create a new record with the office details of the current record." (interactive (list (read-string "Name: ") (read-string "Net: ") (read-string "Notes: ") (bbdb-current-record))) (bbdb-create-internal name (bbdb-record-company record) net (bbdb-record-addresses record) (bbdb-record-phones record) notes)) ;;;_+ Contact report (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"))) ;;;_+ More reports: by last contact (defun sacha/bbdb-print-with-timestamp (records) (interactive (list (bbdb-records))) (while records (insert (sacha/bbdb-last-timestamp (car records)) " |\t" (or (sacha/planner-bbdb-annotation-from-bbdb records) "") "\n") (setq records (cdr records)))) ;; (assert (equal (sacha/extract-regexp "a." "ab ac bb") '("ab" "ac"))) (defun sacha/extract-regexp (regexp string &optional group) (let (result s (start 0)) (while (string-match regexp string start) (setq result (cons (match-string (or group 0) string) result)) (setq start (match-end 0))) (nreverse result))) (defun sacha/bbdb-timestamps (rec) "Return a list of timestamps found in the notes or contact field of REC." (sort (sacha/extract-regexp planner-date-regexp (bbdb-record-getprop rec 'contact)) (lambda (a b) (string< b a)))) ;;;_+ Faces ;; inspired by file:///mnt/media/sacha/static/BbdbFaces.html (add-hook 'bbdb-list-hook 'my-bbdb-display-pic) (defun my-bbdb-display-pic () "Search for face properties and display the faces." (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t); edit the BBDB buffer (default-enable-multibyte-characters nil) pic); prevents corruption (while (re-search-forward "^[ \t]+pic: \\(.*\\)" nil t) (setq pic (match-string 1)) (replace-match "" t t nil 1) (condition-case nil (insert-image (create-image pic)) (insert "Could not display " pic)) (insert " "))))) ;;;_+ BBDB and comments on my blog (defun sacha/bbdb-snarf-from-comment () "Grab the BBDB info from the comment box." (interactive) (let (date name net bbdb-record comment) (gnus-with-article-buffer (goto-char (point-min)) (forward-line 6) (setq date (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (forward-line 2) (setq name (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (forward-line 1) (setq net (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (forward-line 1) (setq comment (buffer-substring-no-properties (point) (point-max)))) ;; Create or find (setq record (or (bbdb-search (bbdb-records) name nil net nil nil) (list (bbdb-create-internal name nil net nil nil nil)))) (sacha/bbdb-ping-bbdb-record (car record) (concat "Commented on blog: " comment) date))) (defun sacha/bbdb-show-filter (filter) "Show all records matching FILTER, a lambda expression with a single argument." (interactive (list (read (read-string "Filter: ")))) (let ((records (bbdb-records)) matches) (while records (if (funcall filter (car records)) (setq matches (cons (car records) matches))) (setq records (cdr records))) (bbdb-display-records (nreverse matches)))) (defun sacha/bbdb-show-alias (alias) "Show all records matching ALIAS." (interactive (list (completing-read "Alias: " (bbdb-get-mail-aliases)))) (let ((records (bbdb-records)) matches) (while records (if (member alias (split-string (or (bbdb-record-getprop (car records) 'mail-alias) "") ", ")) (setq matches (cons (car records) matches))) (setq records (cdr records))) (bbdb-display-records (nreverse matches)))) (defun sacha/bbdb-dump-contact-csv (filename records) (interactive (list (read-file-name "File to write to: ") bbdb-records)) (with-current-buffer (find-file-noselect filename) (erase-buffer) (while records (let ((r (car records)) (standard-output (current-buffer))) (prin1 (or (planner-replace-regexp-in-string "\\." "/" (or (sacha/bbdb-last-timestamp r) "")))) (insert ",") (prin1 (or (bbdb-record-name r) "")) (insert ",") (prin1 (or (mapconcat 'identity (bbdb-record-net r) ", ") "")) (insert ",") (prin1 (or (mapconcat (lambda (x) (concat (elt x 0) ": " (if (numberp (elt x 1)) (format "%d%d%d" (elt x 1) (elt x 2) (elt x 3)) (elt x 1)))) (bbdb-record-phones r) ", ") "")) (insert ",") (prin1 (or (bbdb-record-getprop r 'mail-alias) "")) (insert "\n") (setq records (cdr records)))) (save-buffer))) (defun sacha/bbdb-zap-linkedin-updates () (let ((rec (bbdb-records))) (while rec (if (bbdb-record-notes (car rec)) (bbdb-record-set-notes (car rec) (planner-replace-regexp-in-string "[0-9]+\\.[0-9]+\\.[0-9]+: Noticed change.*" "" (bbdb-record-notes (car rec))))) (setq rec (cdr rec))))) (defun sacha/bbdb-dump-data-for-gnuplot (filename) "Dump days, date, count, and cumulative total into a text file." (interactive (list (read-filename "File: "))) (let* ((today (time-to-days (current-time))) (records (sort (delq nil (mapcar (lambda (x) (if (string= (sacha/bbdb-last-timestamp x) "0000.00.00") nil (- today (calendar-absolute-from-gregorian (planner-filename-to-calendar-date (sacha/bbdb-last-timestamp x)))))) (bbdb-records))) '<)) (counter 1) (total 1) (calendar-date-display-form '(year "/" month "/" day)) (last (car records))) (with-temp-buffer (setq records (cdr records)) (while records (unless (= (car records) last) (insert (format "%d %s %d %d\n" last (calendar-date-string (calendar-gregorian-from-absolute (- today last))) counter total)) (setq counter 0 last (car records))) (setq total (1+ total)) (setq counter (1+ counter)) (setq records (cdr records))) (insert (format "%d %s %d %d\n" last (calendar-date-string (calendar-gregorian-from-absolute (- today last))) counter total)) (write-file filename)))) ;; (sacha/bbdb-dump-data-for-gnuplot "~/notebook/proj/contacts/data") ;; Gnuplot commands ;; set xdata time ;; set timefmt "%Y/%m/%d" ;; set ylabel "Number of people" ;; set xlabel "Contacted since" ;; set format x "%m/%y" ;; set output "contacts.png" ;; set term png size 400, 300 ;; plot "data" u 2:4 title "Contacted since..." with lines (provide 'bbdb-config) ;;; (progn ;;; (setq contacted-records nil) ;;; (setq archived-records nil) ;;; (let ((all-records (bbdb-records))) ;;; (while all-records ;;; (let ((notes (bbdb-record-notes (car all-records)))) ;;; (if notes ;;; (bbdb-record-set-notes (car all-records) ;;; (planner-replace-regexp-in-string "[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]: Noticed.*\n" "" notes))) ;;; (if (string= (sacha/bbdb-last-timestamp (car all-records)) "0000.00.00") ;;; (setq archived-records (cons (car all-records) archived-records)) ;;; (setq contacted-records (cons (car all-records) contacted-records)))) ;;; (setq all-records (cdr all-records))))) ;;; (setq contacted-records (sort contacted-records (lambda (a b) (string< (or (bbdb-record-name a) "") (or (bbdb-record-name b) ""))))) ;;; (setq archived-records (sort archived-records ;;; (lambda (a b) (string< (or (bbdb-record-name a) "") (or (bbdb-record-name b) "")))) ;;; (let ((the-records contacted-records) ;;; (bbdb-file "~/.bbdb-contacted") ;;; (inside-bbdb-change-record t) ;;; (bbdb-buffer nil) ;;; (bbdb-records nil)) ;;; (if (file-exists-p bbdb-file) (delete-file bbdb-file)) ;;; (bbdb-records) ;;; (while the-records ;;; (bbdb-insert-record-internal (car the-records) nil) ;;; (setq the-records (cdr the-records))))