Category Archives: pimpmyemacs

Crazy idea for Emacs: Random Emacs taglines

Would anyone happen to know of a way to select a random symbol with a
description?

Actually. Hmm.

(progn
  (apropos ".")
  (write-file "~/.taglines.random-emacs-symbols")
  (delete-matching-lines "Plist")
  (delete-matching-lines "not documented")
  (replace-regexp "\n  " " - " nil)
  (delete-non-matching-lines " - "))

Et voila! Random Emacs taglines together with the code:

(defun sacha/random-tagline (&optional file)
  "Return a random tagline and put it in the kill ring."
  (interactive)
  (with-current-buffer (find-file-noselect (or file "~/.taglines"))
    (goto-char (random (point-max)))
    (let ((string
           (buffer-substring (line-beginning-position)
                             (line-end-position))))
      (kill-new string)
      string)))

(defadvice remember (after sacha-tagline activate)
  "Add random tagline."
  (save-excursion
  (goto-char (point-max))
  (insert "\n\nRandom Emacs symbol: "
          (sacha/random-tagline "~/.taglines.random-emacs-symbols")
          "\n\n")))))

On Technorati: , ,

Random Emacs symbol: eshell-remove-entries – Function: From PATH, remove all of the given FILES, perhaps interactively.

Emacs BBDB: Prioritize exact matches

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)

On Technorati: , , , ,

Emacs BBDB: Filtering tags with the power of lambda expressions

What do you do when you’re into both Emacs geeks and social
networking? Well, you build a really really weird contact management
tool, that’s what!

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

On Technorati: , , , ,

Emacs: BBDB rapid serial visualization

And because it’s good to quickly flash through records once in a while
to refresh my memory…

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

On Technorati: , , , ,

Emacs: Show only people whom I haven’t pinged since…

One of the things I want in a contact management system is a quick way
to find out who I haven’t pinged in a while. The following code
filters currently-displayed contacts to show who I might want to get
back in touch with. Call it from a *BBDB* window and specify the date
(could be 2006.01.01 for annual, -7 for the last seven days, etc.).
This works incredibly well with the following hacks:

I should write a small book about how to build a contact management
system with Emacs. ;) It’s insanely powerful, you know.

(require 'planner)
(require 'bbdb)
(defun sacha/bbdb-show-only-no-contact-since (date)
  "Show only people who haven't been pinged since DATE or at all."
  (interactive (list (planner-read-date)))
  (let ((records bbdb-records)
        new-records
        last-match
        omit
        notes)
    (while records
      ;; Find the latest date mentioned in the entry
      (setq notes (or (bbdb-record-notes (caar records)) ""))
      (setq last-match nil omit nil)
      (while (string-match
              "[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]"
              notes
              (or last-match 0))
        (unless (string> date (match-string 0 notes))
          (setq omit t)
          (setq last-match (length notes)))
        (setq last-match (match-end 0)))
      (unless (and last-match omit)
        (add-to-list 'new-records (caar records) t))
      (setq records (cdr records)))
    (bbdb-display-records new-records)))

One of the other things I’d like to smooth over is keeping track of
who owes whom e-mail… <laugh>

On Technorati: , , , , , ,

Emacs + LinkedIn: Another totally idiosyncratic bit of code

The following code should not be run until you’ve backed up your Big
Brother Database and sacrificed a chicken. It goes through the list of
people in your exported LinkedIn CSV, creates BBDB records if
necessary, adds a linkedin mail alias, and notices new e-mail
addresses and job titles. Call sacha/linkedin-import from the CSV.
Needs csv.el
and
lookout.el,
which you should load before running this code.

If anyone else ever finds this useful, I’ll be quite surprised.

(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 "Noticed change from job title of "
                   (bbdb-record-company record)
           "\n"
           (bbdb-record-notes record)))
          (message "%s %s: Noticed change from job title of %s to %s"
                   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
                             (if (stringp oldaliases)
                                 (bbdb-split oldaliases ",")
                               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 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)))

On Technorati: , , ,