Commits

Arne Babenhauserheide committed db8fc47

added some bbdb tricks from sacha chua

  • Participants
  • Parent commits eacf16a
  • Branches fluss

Comments (0)

Files changed (3)

File lisplets/activate-babenv.el

 ; Kanban for org-mode
 (require 'kanban)
 
+; phone book
+(require 'bbdb-phone-book)
+
+; timed notes in bbdb
+(require 'bbdb-timed-notes)
+
 ;;;;;;;;;;;;;
 ;;; Fixes ;;;
 ;;;;;;;;;;;;;

File lisplets/bbdb-phone-book.el

+; thanks to http://sachachua.com/blog/2008/02/bbdb-show-a-phone-list/
+(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")))
+
+; print via psprint thanks to http://www.emacswiki.org/emacs/BbdbMulePrinting
+
+(add-to-list 'bbdb-display-layout-alist
+             '(printable (order net icq aim irc-nick phones
+                                addresses notes www)
+                         (toggle . t)))
+
+(setq bbdb-print-require t
+      bbdb-print-net 'primary)
+
+;;;; FIXME: Breaks on Ambulantes Zentrum am Entenfang (maybe wissing name…)
+;; (defun bbdb-format-record-layout-printable (layout record field-list)
+;;   "Layout formatting function for the `printable' layout.
+;;     Takes `bbdb-print-require' and `bbdb-print-net' into account."
+;;   (let* ((name (bbdb-record-name record));; bind these for bbdb-print-require
+;;          (company (bbdb-record-company record))
+;;          (net (bbdb-record-net record))
+;;          (phone (bbdb-record-phones record))
+;;          (address (bbdb-record-addresses record))
+;;          (notes (bbdb-record-raw-notes record)))
+;;     (when (eval bbdb-print-require)
+;;       (bbdb-format-record-name-company record)
+;;       (insert "\n")
+;;       (let* ((notes (bbdb-record-raw-notes record))
+;;              (indent (or (bbdb-display-layout-get-option layout 'indentation) 6))
+;;              (fmt (format " %%%ds: " indent))
+;;              start field)
+;;         (if (stringp notes)
+;;             (setq notes (list (cons 'notes notes))))
+;;         (while field-list
+;;           (setq field (car field-list)
+;;                 start (point))
+;;           (cond ((eq field 'phones)
+;;                  (let ((phones (bbdb-record-phones record))
+;;                        loc phone)
+;;                    (while phones
+;;                      (setq phone (car phones)
+;;                            start (point))
+;;                      (setq loc (format fmt (bbdb-phone-location phone)))
+;;                      (insert loc)
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         (list 'phone phone 'field-name))
+;;                      (setq start (point))
+;;                      (insert (bbdb-phone-string phone) "\n")
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         (list 'phone phone
+;;                                               (bbdb-phone-location phone)))
+;;                      (setq phones (cdr phones))))
+;;                  (setq start nil))
+;;                 ((eq field 'addresses)
+;;                  (let ((addrs (bbdb-record-addresses record))
+;;                        loc addr)
+;;                    (while addrs
+;;                      (setq addr (car addrs)
+;;                            start (point))
+;;                      (setq loc (format fmt (bbdb-address-location addr)))
+;;                      (insert loc)
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         (list 'address addr 'field-name))
+;;                      (setq start (point))
+;;                      (bbdb-format-address addr nil indent)
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         (list 'address addr
+;;                                               (bbdb-address-location addr)))
+;;                      (setq addrs (cdr addrs))))
+;;                  (setq start nil))
+;;                 ((eq field 'net)
+;;                  (let ((net (bbdb-record-net record)))
+;;                    (setq net (cond ((eq bbdb-print-net 'primary)
+;;                                     (list (car net)))
+;;                                    ((eq bbdb-print-net 'all)
+;;                                     net)
+;;                                    (t nil)))
+;;                    (when net
+;;                      (insert (format fmt "net"))
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         '(net field-name))
+;;                      (setq start (point))
+;;                      (insert  (car net) "\n")
+;;                      (put-text-property start (point) 'bbdb-field '(net)))))
+;;                 ((eq field 'aka)
+;;                  (let ((aka (bbdb-record-aka record)))
+;;                    (when aka
+;;                      (insert (format fmt "AKA"))
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         '(aka field-name))
+;;                      (insert (mapconcat (function identity) aka ", ") "\n")
+;;                      (setq start (point))
+;;                      (put-text-property start (point) 'bbdb-field '(aka)))))
+;;                 (t
+;;                  (let ((note (assoc field notes))
+;;                        (indent (length (format fmt "")))
+;;                        p notefun)
+;;                    (when note
+;;                      (insert (format fmt field))
+;;                      (put-text-property start (point) 'bbdb-field
+;;                                         (list 'property note 'field-name))
+;;                      (setq start (point))
+;;                      (setq p (point)
+;;                            notefun (intern (format "bbdb-format-record-%s" field)))
+;;                      (if (fboundp notefun)
+;;                          (insert (funcall notefun (cdr note)))
+;;                        (insert (cdr note)))
+;;                      (save-excursion
+;;                        (save-restriction
+;;                          (narrow-to-region p (1- (point)))
+;;                          (goto-char (1+ p))
+;;                          (while (search-forward "\n" nil t)
+;;                            (insert (make-string indent ?\ )))))
+;;                      (insert "\n"))
+;;                    (put-text-property start (point) 'bbdb-field
+;;                                       (list 'property note)))))
+;;           (setq field-list (cdr field-list))))
+;;       (insert "\n"))))
+
+(provide 'bbdb-phone-book)

File lisplets/bbdb-timed-notes.el

+;; bbdb timed notes as contact info thanks to http://sachachua.com/blog/2008/02/wicked-cool-emacs-bbdb-keeping-track-of-contact-dates/
+
+(define-key bbdb-mode-map "z" 'wicked/bbdb-ping-bbdb-record)
+(defun wicked/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.
+BBDB-RECORD is the record to modify (default: current).
+TEXT is the note to add for DATE.
+If REGRIND is non-nil, redisplay the BBDB record."
+  (interactive (list (bbdb-current-record t)
+                     (read-string "Notes: ")
+                     ;; Reading date - more powerful with Planner, but we'll make do if necessary
+                     (if (featurep 'planner)
+                         (if current-prefix-arg (planner-read-date) (planner-today))
+                       (if current-prefix-arg
+                           (read-string "Date (YYYY.MM.DD): ")
+                         (format-time-string "%Y.%m.%d")))
+                     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)
+
+(provide 'bbdb-timed-notes)