summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRonan Waide <waider@waider.ie>2001-01-24 21:19:08 +0000
committerRonan Waide <waider@waider.ie>2001-01-24 21:19:08 +0000
commita779e08d440884a3fa5f84d2a80e5bb4f56fed2e (patch)
treec44135fc6f5dd6801a9f3dfb9da1ac28b7faa382
parent2db0393fd72a03bf6f52d9ed0d9d250ee142e770 (diff)
Add-ons that didn't make it to the current release.
-rw-r--r--bits/bbdb-edit.el135
-rw-r--r--bits/bbdb-pgp.el161
-rw-r--r--bits/bbdb-sort-mailrc.el323
-rw-r--r--bits/bbdb-to-outlook.el252
4 files changed, 871 insertions, 0 deletions
diff --git a/bits/bbdb-edit.el b/bits/bbdb-edit.el
new file mode 100644
index 0000000..f0cdd45
--- /dev/null
+++ b/bits/bbdb-edit.el
@@ -0,0 +1,135 @@
+;;; bbdb-edit.el --- BBDB field edit
+;; Copyright (C) 1999, 2000 Shenghuo ZHU
+
+;; Author: Shenghuo ZHU <zsh@cs.rochester.edu>
+;; Created: Fri Aug 27 17:45:25 EDT 1999
+;; Keywords: BBDB field edit
+
+;; This file is not a part of GNU Emacs.
+;;
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+;;
+;; This file is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; bbdb-field-edit-add (`insert') and bbdb-field-edit-del (`delete')
+;; add/del a item to/from a certain field of the bbdb record. These
+;; keys also support `*'.
+
+;;; Code:
+
+(require 'bbdb)
+
+(defun bbdb-field-edit-get-values (record field)
+ (cond
+ ((eq field 'net) (bbdb-record-net record))
+ ((eq field 'AKA) (bbdb-record-aka record))
+ ((eq field 'address) (bbdb-record-addresses record))
+ ((eq field 'phone) (bbdb-record-phones record))
+ (t (bbdb-split (or (bbdb-record-getprop record field) "") ","))))
+
+(defun bbdb-field-edit-put-values (record field values)
+ (if values
+ (cond
+ ((eq field 'net) (bbdb-record-set-net record values))
+ ((eq field 'AKA) (bbdb-record-set-aka record values))
+ ((eq field 'address) (bbdb-record-set-addresses record values))
+ ((eq field 'phone) (bbdb-record-set-phones record values))
+ (t (bbdb-record-putprop record field
+ (mapconcat 'identity values ","))))
+ (if (memq field '(net AKA address))
+ (bbdb-record-store-field-internal record field nil)
+ (bbdb-record-putprop record field nil)))
+ (bbdb-change-record record t)
+ (bbdb-redisplay-one-record record))
+
+;;;###autoload
+(defun bbdb-field-edit-add (bbdb-record field value)
+ "Add VALUE to FIELD of bbdb-record(s)."
+ (interactive (list (if (bbdb-do-all-records-p)
+ (mapcar 'car bbdb-records)
+ (list (bbdb-current-record)))
+ (completing-read
+ "Field: "
+ (append '(("net")("notes")("AKA"))
+ (bbdb-propnames))
+ nil nil
+ (symbol-name
+ (let ((on-field (bbdb-current-field t)))
+ (cond ((null on-field) 'mail-alias)
+ ((eq (car on-field) 'property)
+ (car (nth 1 on-field)))
+ (t (car on-field))))))
+ (bbdb-read-string "Value: ")))
+ (if (stringp field) (setq field (intern field)))
+ (if (memq field '(name address phone))
+ (error "Use `e' to edit this field."))
+ (while bbdb-record
+ (let ((values (bbdb-field-edit-get-values (car bbdb-record) field)))
+ (if (member value values) nil
+ (bbdb-field-edit-put-values (car bbdb-record) field
+ (cons value values))))
+ (setq bbdb-record (cdr bbdb-record))))
+
+;;;###autoload
+(defun bbdb-field-edit-del (bbdb-record field value)
+ "Delete VALUE to FIELD of bbdb-record(s).
+If prefix arg exists, delete all existing field values matching VALUE(regexp)."
+ (interactive (list (if (bbdb-do-all-records-p)
+ (mapcar 'car bbdb-records)
+ (list (bbdb-current-record)))
+ (completing-read
+ "Field: "
+ (append '(("net")("notes")("AKA"))
+ (bbdb-propnames))
+ nil nil (symbol-name
+ (let ((on-field (bbdb-current-field t)))
+ (cond ((null on-field) 'mail-alias)
+ ((eq (car on-field) 'property)
+ (car (nth 1 on-field)))
+ (t (car on-field))))))
+ (bbdb-read-string (if current-prefix-arg
+ "Regexp: "
+ "Value: "))))
+ (if (stringp field) (setq field (intern field)))
+ (if (memq field '(name address phone))
+ (error "Use `e' to edit this field."))
+ (while bbdb-record
+ (let ((values (bbdb-field-edit-get-values (car bbdb-record) field)))
+ (cond
+ (current-prefix-arg
+ (let (nvalues found)
+ (while values
+ (if (string-match value (car values))
+ (setq found t)
+ (setq nvalues (cons (car values) nvalues)))
+ (setq values (cdr values)))
+ (if found
+ (bbdb-field-edit-put-values (car bbdb-record) field
+ (nreverse nvalues)))))
+ (t
+ (if (member value values)
+ (bbdb-field-edit-put-values (car bbdb-record) field
+ (delete value values))))))
+ (setq bbdb-record (cdr bbdb-record))))
+
+;;; The key binding might be moved to somewhere else.
+
+(define-key bbdb-mode-map [(insert)] 'bbdb-field-edit-add)
+(define-key bbdb-mode-map [(delete)] 'bbdb-field-edit-del)
+
+(provide 'bbdb-edit)
+
+;; bbdb-edit.el ends here
diff --git a/bits/bbdb-pgp.el b/bits/bbdb-pgp.el
new file mode 100644
index 0000000..bbacb50
--- /dev/null
+++ b/bits/bbdb-pgp.el
@@ -0,0 +1,161 @@
+;;; BBDB-PGP.EL --- use BBDB to store PGP preferences
+
+;; Copyright (C) 1997,1999 Kevin Davidson
+
+;; Author: Kevin Davidson tkld@quadstone.com
+;; Maintainer: Kevin Davidson tkld@quadstone.com
+;; Created: 10 Nov 1997
+;; Version: $Revision$
+;; Keywords: PGP BBDB message mailcrypt
+
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; A copy of the GNU General Public License can be obtained from this
+;; program's author (send electronic mail to tkld@quadstone.com) or
+;; from the Free Software Foundation, Inc.,59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; LCD Archive Entry:
+;; bbdb-pgp|Kevin Davidson|tkld@quadstone.com
+;; |Use BBDB to store PGP preferences
+;; |$Date$|$Revision$|~/packages/bbdb-pgp.el
+
+;;; Commentary:
+;;
+;; It is believed that encrypted mail works best if all mail between
+;; individuals is encrypted - even concerning matters that are not
+;; confidential. The reasoning is that confidential messages cannot
+;; then be easily spotted and decryption efforts concentrated on them.
+;; Some people therefore prefer to have all their email encrypted.
+;; This package allows you to mark the BBDB entries for those
+;; individuals so that messages will be encrypted when they are sent.
+;;
+;; These packages are required: BBDB, mailcrypt, message
+;;
+;; message.el is included with recent versions of Emacs.
+;; You can use mail-mode as well as message-mode to send mail.
+
+;;; Usage:
+;; (require 'bbdb-pgp)
+;;
+;; Then for all users who you want to send encrypted mail to, add the field
+;; pgp-mail with the value `encrypt'. Alternatively you can add the value
+;; `sign' if you just want to send signed messages.
+;;
+;; and possibly (if you do not want the PGP field printed out)
+;; (add-hook 'bbdb-print-elide bbdb-pgp-field)
+;;
+;; The variable bbdb/pgp-default-action defines what to do if the recipient
+;; is not in the BBDB.
+
+;;; TODO
+;; Spot incoming PGP mail by hooking into mc-verify/decrypt and adding pgp-mail
+;; field to BBDB entry (creating one if necessary); like bbdb-sc.el maintains
+;; attribution prefs.
+
+;;; PGP Public Key
+;; The author's public key is available from any public PGP keyserver
+;; eg http://www.pgp.net/pgpnet/
+;; Fingerprint: 1F A9 3F 3E 90 F7 85 64 55 35 32 C8 75 91 3A E3
+
+;;; Change log:
+;; $Log$
+;; Revision 1.1 2001/01/24 21:19:08 waider
+;; Add-ons that didn't make it to the current release.
+;;
+;; Revision 1.4 1999/01/05 13:17:00 tkld
+;; Update GPL version number and FSF snail mail address.
+;;
+;; Revision 1.3 1997/11/10 15:20:29 tkld
+;; Expand commentary. Support encrypt/sign. Support mail-mode
+;; (sendmail.el).
+;;
+;; Revision 1.3 1997/11/10 15:10:19 tkld
+;; Update commentary. Support sendmail.el. Support signing or encrypting.
+;;
+;; Revision 1.2 1997/11/10 14:27:07 tkld
+;; Remembered to widen buffer before encrypting.
+;;
+;; Revision 1.1 1997/11/10 14:22:06 tkld
+;; Initial revision
+;;
+
+;;; Code:
+
+(require 'message)
+(require 'bbdb)
+(require 'mailcrypt)
+
+(defconst bbdb/pgp-version (substring "$Revision$" 11 -2)
+ "$Id$
+
+Report bugs to: Kevin Davidson tkld@quadstone.com")
+
+(defvar bbdb/pgp-field 'pgp-mail
+ "*Field to use in BBDB to store PGP preferences.
+If this field's value in a record is \"encrypt\" then messages are
+encrypted. If it is \"sign\" then messages are signed.")
+
+(defvar bbdb/pgp-default-action nil
+ "*Default action when sending a message and the recipient is not in BBDB.
+nil means do nothing.
+'encrypt means encrypt message.
+'sign means sign message.")
+
+(defun bbdb/pgp-get-pgp (name address)
+ "Look up user NAME and ADDRESS in BBDB and return the PGP preference."
+ (let* ((record (bbdb-search-simple name address))
+ (pgp (and record
+ (bbdb-record-getprop record bbdb/pgp-field))))
+ pgp))
+
+(defun bbdb/pgp-hook-fun ()
+ "Function to be added to message-send-hook
+Uses PGP to encrypt messages to users marked in the BBDB with the
+field `bbdb/pgp-field'.
+The user is prompted before encryption or signing."
+ (save-restriction
+ (save-excursion
+ (message-narrow-to-headers)
+ (and (featurep 'mailalias)
+ (not (featurep 'mailabbrev))
+ mail-aliases
+ (expand-mail-aliases (point-min) (point-max)))
+ (let* ((to-field (mail-fetch-field "To" nil t))
+ (address (mail-extract-address-components (or to-field ""))))
+ (widen)
+ (if (not (equal address '(nil nil)))
+ (let ((pgp-p (bbdb/pgp-get-pgp (car address) (car (cdr address)))))
+ (cond
+ ((string= "encrypt" pgp-p)
+ (and (y-or-n-p "Encrypt message ? ")
+ (mc-encrypt 0)))
+ ((string= "sign" pgp-p)
+ (and (y-or-n-p "Sign message ? ")
+ (mc-sign 0)))
+ (t
+ (cond
+ ((eq bbdb/pgp-default-action 'encrypt)
+ (and (y-or-n-p "Encrypt message ? ")
+ (mc-encrypt 0)))
+ ((eq bbdb/pgp-default-action 'sign)
+ (and (y-or-n-p "Sign message ? ")
+ (mc-sign 0)))
+ (t
+ nil))))))))))
+
+(add-hook 'message-send-hook 'bbdb/pgp-hook-fun)
+(add-hook 'mail-send-hook 'bbdb/pgp-hook-fun)
+
+(provide 'bbdb-pgp)
+
+;;; BBDB-PGP.EL ends here
diff --git a/bits/bbdb-sort-mailrc.el b/bits/bbdb-sort-mailrc.el
new file mode 100644
index 0000000..f1d0f05
--- /dev/null
+++ b/bits/bbdb-sort-mailrc.el
@@ -0,0 +1,323 @@
+>>>>> Ronan Waide writes:
+
+>> * birthdays/anniversaries
+
+RW> This /is/ venturing into calendar land. Still, go to yer bbdb buffer
+RW> and create a field with C-o. Again, I prefer not to add baggage to the
+RW> file format unless it's absolutely necessary. Also, you should be able
+RW> to attach bbdb to calendar.el using the bbdb record-dinking hooks so
+RW> that it auto-fills your calendar with goop for you. And maybe get
+RW> working on calendar-pilot.el...
+
+Well, this isn't really release-ready -- but since someone asks, it
+could be a good starting point for someone. Feel free to
+redistribute, or chop up and use the useful bits.
+
+Bng
+
+
+;;; BBDB-BNG
+;;; Various functions I have added to enhance the big brother database.
+;;; Boris Goldowsky, <boris@cs.rochester.edu>
+;;; $Revision$ $Date$
+;;;
+;;; This file allows you to do the following things:
+;;; * Sort by firstname or company rather than last name.
+;;; * Mark people's birthdays in emacs's calendar and diary displays.
+;;; * Maintains a file of mail aliases, for use by other mailers,
+;;; automatically updated when the information changes in your database.
+;;; * Make sure that everyone has their username defined as an alias
+;;; for their complete net addresses.
+;;;
+;;; INSTALLATION:
+;;; Put this file in emacs's load-path, and make sure it gets loaded whenever
+;;; you load BBDB.
+;;; * To use alternate sorting, evaluate (bbdb-sort-by ...) whenever you load
+;;; bbdb. YOU MUST EITHER ALWAYS DO THIS, OR NEVER DO IT. When you switch
+;;; over, evaluate (bbdb-resort-database).
+;;; * To make a file of mail-aliases, set bbdb-mail-alias-file to a filename,
+;;; and source that file from your .mailrc.
+;;; * Username-aliases are enabled by default. Set
+;;; `bbdb-auto-username-alias' to nil if you don't want them.
+;;; You can also use the function `bbdb-add-user-name-as-alias' to
+;;; add such aliases manually.
+;;; * The bbdb/calendar stuff is under development, and may not work.
+;;;
+;;; EXAMPLE:
+;;; The following code could go in your .emacs:
+;;; (add-hook 'bbdb-load-hook
+;;; (function (lambda ()
+;;; (setq bbdb-mail-alias-file
+;;; (expand-file-name "~/.mail_aliases")
+;;; (require 'bbdb-bng)
+;;; (bbdb-sort-by 'firstname))))
+
+;;; USE:
+;;; If installed as above, these functions operate automatically.
+
+;;; DEPENDENCIES:
+;;; BBDB, of course.
+;;; calendar.el and diary-lib.el are built into recent emacs versions.
+;;; dates.el is available from me.
+
+(provide 'bbdb-bng)
+
+;;;
+;;; New birthday stuff.
+;;;
+
+(require 'calendar)
+(require 'dates)
+
+(if (not (featurep 'diary)) ; the library of many names.
+ (or (load "diary-lib" t)
+ (load "diary")))
+
+(defvar bbdb/calendar-marker
+ (if (not window-system)
+ "^"
+ (require 'faces)
+ 'bold-italic)
+ "*How to mark birthdays in calendar.
+Can be either a single-character string or a face.")
+
+(add-hook 'list-diary-entries-hook 'bbdb/calendar-list-entries)
+(add-hook 'mark-diary-entries-hook 'bbdb/calendar-mark-entries)
+
+(defun bbdb/calendar-mark-entries ()
+ (save-excursion
+ (set-buffer calendar-buffer)
+ (let ((month displayed-month)
+ (year displayed-year))
+ (bbdb/calendar-mark-month month year)
+ (increment-calendar-month month year -1)
+ (bbdb/calendar-mark-month month year)
+ (increment-calendar-month month year 2)
+ (bbdb/calendar-mark-month month year))))
+
+(defun bbdb/calendar-mark-month (month year)
+ (message "Marking birthdays..."
+ (let ((days (aref (bbdb/calendar-birthdays) month)))
+ (while days
+ (mark-visible-calendar-date (list month (car (car days)) year)
+ bbdb/calendar-marker)
+ (setq days (cdr days))))
+ (message nil)))
+
+(defun bbdb/calendar-list-entries ()
+ (message "Listing birthdays..."
+ (let* ((bdays (bbdb/calendar-birthdays))
+ (start-date (calendar-absolute-from-gregorian original-date))
+ (end-date (+ number start-date)))
+ (calendar-for-loop abs-date from start-date to end-date do
+ (let* ((date (calendar-gregorian-from-absolute abs-date))
+ (entries (cdr (assoc (extract-calendar-day date)
+ (aref bdays
+ (extract-calendar-month date))))))
+ (while entries
+ (add-to-diary-list date (car entries))
+ (setq entries (cdr entries))))))
+ (message nil)))
+
+(defvar bbdb/calendar-birthdays nil
+ "Used by function of the same name, which see.")
+
+(defun bbdb/calendar-birthdays ()
+ "Returns a vector containing the birthdays in your BBDB.
+This is a vector with one element per month:
+ [birthdays ; identifier in spot 0
+ ((4 \"Isaac Newton's birthday\")) ; Newton's birthday is Jan 4.
+ ((11 \"Thomas Edison's birthday\") ; Edison's is Feb 11.
+ (15 \"Galileo's birthday\" \"Susan B. Anthony's birthday\")) ; Both Feb 15.
+ ...march through dec...
+ ]"
+ (or bbdb/calendar-birthdays
+ (setq bbdb/calendar-birthdays
+ (let ((cal (make-vector 13 nil))
+ (recs (bbdb-records))
+ birthday-string)
+ (aset cal 0 'birthdays)
+ (while recs
+ (if (setq birthday-string
+ (bbdb-record-getprop (car recs) 'birthday))
+ (let ((events (bbdb-split birthday-string ","))
+ (name (bbdb-record-name (car recs))))
+ (while events
+ (let ((bday (date-parse (car events))))
+ (if (null bday)
+ (message "Unparsable birthday: %s" (car events))
+ (let* ((date-end (parse-string-end))
+ (eventname (if (eq t date-end)
+ "birthday"
+ (substring (car events)
+ date-end)))
+ (event (concat name "'s "
+ (if (equal "" eventname)
+ "birthday"
+ eventname)))
+ (month (extract-calendar-month bday))
+ (day (extract-calendar-day bday))
+ (monthlist (aref cal month))
+ (daylist (assoc day monthlist)))
+ (if daylist
+ (setcdr daylist (cons event (cdr daylist)))
+ (aset cal month (cons (list day event)
+ monthlist))))))
+ (setq events (cdr events)))))
+ (setq recs (cdr recs)))
+ cal))))
+
+;;;
+;;; Mail alias code
+;;;
+
+(defvar bbdb-mail-alias-file nil
+ "*File to save mail-aliases into.
+Aliases are also kept in the database proper; this is just for the convenience
+of other programs that are interested in mail aliases. For example, you can
+use your bbdb mail aliases with ucb mail by including the line
+source ~/.mail_aliases
+in your .mailrc file.
+Set this to nil to avoid storing mail aliases in a file.")
+
+(defvar bbdb-auto-username-alias t
+ "*If t, always have a person's username as a mail-alias for them.")
+
+(if bbdb-mail-alias-file
+ (add-hook 'bbdb-after-change-hook (function bbdb-check-mail-alias)))
+
+(defun bbdb-add-user-name-as-alias ()
+ (interactive)
+ (let ((bbdb-auto-username-alias t)
+ (this(bbdb-current-record)))
+ (bbdb-check-mail-alias this)
+ (bbdb-redisplay-one-record this)))
+
+(defun bbdb-record-username (record)
+ "Return just the username part of RECORD's first net address,
+if it looks like a well-formed internet address; nil otherwise."
+ (let ((addr (car (bbdb-record-net record))))
+ (if (and addr (string-match "^[a-zA-z0-9]+@" addr))
+ (substring addr 0 (1- (match-end 0))))))
+
+(defun bbdb-record-mail-aliases (record)
+ (let ((all (bbdb-record-getprop record bbdb-define-all-aliases-field)))
+ (if all (bbdb-split all ","))))
+
+(defun bbdb-check-mail-alias (record)
+ "Makes sure the person's username is defined as a mail abbrev
+for them, and makes sure all their mail abbreves are ready for use."
+ (let ((username (bbdb-record-username record))
+ (current (bbdb-record-getprop record bbdb-define-all-aliases-field)))
+ (if (and current (string-match "\\(,\\)? *\n" current))
+ (setq current (replace-match ", " nil nil current)))
+ (if (and bbdb-auto-username-alias
+ username
+ (not (and (boundp 'mail-abbrevs)
+ (intern-soft username mail-abbrevs)))
+ (not (member username (bbdb-record-mail-aliases record))))
+ (setq current
+ (if current (concat current ", " username)
+ username)))
+ (if current
+ (bbdb-record-putprop record bbdb-define-all-aliases-field current))
+
+ ;; And make sure aliases are all defined (if any are)
+ (if (boundp 'mail-abbrevs)
+ (mapcar (function
+ (lambda (alias)
+ (if (not (intern-soft alias mail-abbrevs))
+ (my-define-mail-abbrev
+ alias (bbdb-dwim-net-address record)))))
+ (bbdb-record-mail-aliases record)))))
+
+(defun my-define-mail-abbrev (abbrev address)
+ "Defines abbrev, and marks bbdb-mail-alias-file as modified."
+ (define-mail-abbrev abbrev address)
+ (save-excursion
+ (set-buffer (find-file-noselect bbdb-mail-alias-file))
+ (setq buffer-read-only t)
+ (set-buffer-modified-p t)
+ (make-variable-buffer-local 'local-write-file-hooks)
+ (if (not (memq 'bbdb-mail-alias-file-write-hook
+ local-write-file-hooks))
+ (setq local-write-file-hooks '(bbdb-mail-alias-file-write-hook)))))
+
+(defun bbdb-insert-mail-aliases ()
+ (let ((begin (point)))
+ (if (not (boundp 'mail-abbrevs))
+ (bbdb-define-all-aliases))
+ (insert-abbrev-table-description 'mail-abbrevs nil)
+ (goto-char begin)
+ (let ((abbrevs (nth 1 (nth 2 (read (current-buffer))))))
+ (setq abbrevs (sort abbrevs (function
+ (lambda (x y)
+ (string-lessp (car x) (car y))))))
+ (delete-region begin (point))
+ (mapcar (function
+ (lambda (abbrev)
+ (let ((alias (car abbrev))
+ (addr (mapconcat (function simplify-address)
+ (bbdb-split (nth 1 abbrev) ",") " ")))
+ (if (not (string-equal alias addr))
+ (insert (format "alias %s\t%s\n" alias addr))))))
+ abbrevs))))
+
+(defun simplify-address (addr)
+ (let ((addr (car (cdr (mail-extract-address-components addr)))))
+ (if (string-match (concat "@" (system-name) "$") addr)
+ (substring addr 0 (match-beginning 0))
+ addr)))
+
+(defun bbdb-mail-alias-file-write-hook ()
+ "Regenerate mail-aliases if necc.
+Call from local-write-file-hooks."
+ (let ((buffer-read-only nil))
+ (message "Writing aliases...")
+ (delete-region (point-min) (point-max))
+ (bbdb-insert-mail-aliases)
+ (message "Writing aliases...done")
+ nil))
+
+;;;
+;;; sorting frobnification.
+;;;
+
+(defun bbdb-sort-by (field)
+ "Tell BBDB which field is the primary sort key.
+Currently FIELD must be one of 'firstname 'lastname or 'company.
+The first time you use this, use bbdb-resort-database immediately
+afterwards. Then put \(bbdb-sort-by 'firstname), or whichever field is
+your choice, on your bbdb-after-load-db-hook."
+ (cond ((eq field 'lastname)
+ (defun bbdb-record-sortkey (record)
+ (or (bbdb-cache-sortkey (bbdb-record-cache record))
+ (bbdb-cache-set-sortkey
+ (bbdb-record-cache record)
+ (downcase
+ (concat (bbdb-record-lastname record)
+ (bbdb-record-firstname record)
+ (bbdb-record-company record)))))))
+ ((eq field 'firstname)
+ (defun bbdb-record-sortkey (record)
+ (or (bbdb-cache-sortkey (bbdb-record-cache record))
+ (bbdb-cache-set-sortkey
+ (bbdb-record-cache record)
+ (downcase
+ (concat (bbdb-record-firstname record)
+ (bbdb-record-lastname record)
+ (bbdb-record-company record)))))))
+ ((eq field 'company)
+ (defun bbdb-record-sortkey (record)
+ (or (bbdb-cache-sortkey (bbdb-record-cache record))
+ (bbdb-cache-set-sortkey
+ (bbdb-record-cache record)
+ (downcase
+ (concat (bbdb-record-company record)
+ (bbdb-record-lastname record)
+ (bbdb-record-firstname record)))))))
+ (t (error "Can only sort by firstname lastname or company!"))))
+
+;;; Local Variables:
+;;; eval:(put 'calendar-for-loop 'lisp-indent-hook 6)
+;;; End:
diff --git a/bits/bbdb-to-outlook.el b/bits/bbdb-to-outlook.el
new file mode 100644
index 0000000..7fdb7c6
--- /dev/null
+++ b/bits/bbdb-to-outlook.el
@@ -0,0 +1,252 @@
+;;; This is bbdb-to-outlook.el, version 0.1
+;;;
+;;; Author: Bin Mu <mubin@cs.uchicago.edu>
+;;; <http://www.cs.uchicago.edu/~mubin>
+;;; Created: 30 Oct 1997
+;;; Version: 0.1
+;;;
+;;; The Insidious Big Brother Database is free software; you can redistribute
+;;; it and/or modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 1, or (at your
+;;; option) any later version.
+;;;
+;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY
+;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+;;; details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING. If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; This module is for exporting BBDB databases into a comma delimited
+;;; text file, which can be imported into microsoft outlook contact forms and
+;;; ms address book.
+;;;
+;;; USE: In the *BBDB* buffer, type O to convert the listing to text format.
+;;; It will prompt you for a filename. And then you can import the file
+;;; into Microsoft outlook contacts and outlook express address boook
+;;; etc.
+;;;
+;;; INSTALLATION: Put this file somewhere on your load-path.
+;;; Put (require 'bbdb-to-outlook) in your .emacs, or autoload it.
+;;;
+;;;
+
+(require 'bbdb)
+(require 'bbdb-com)
+
+(define-key bbdb-mode-map "O" 'bbdb-to-outlook)
+
+;;;
+;;; Variables
+;;;
+
+(defvar bbdb-to-outlook-file-name "~/bbdb.txt"
+ "*Default file name for printouts of BBDB database.")
+
+(defvar bbdb-to-outlook-prolog
+ (concat "\"First Name\""
+ ",\"Last Name\""
+ ",\"Company\""
+
+ ;; phones
+ ",\"Business Phone\""
+ ",\"Home Phone\""
+ ",\"Business Fax\""
+ ",\"Car Phone\""
+ ",\"Pager\""
+
+ ;; EMAIL
+ ",\"E-mail Address\""
+ ",\"E-mail 2 Address\""
+ ",\"\"E-mail 3 Address\""
+
+ ;; addresses
+ ",\"Business Street\""
+ ",\"\"Business Street 2\""
+ ",\"\"Business Street 3\""
+ ",\"Business City\""
+ ",\"Business State\""
+ ",\"Business Postal Code\""
+
+ ",\"Home Street\""
+ ",\"\"Home Street 2\""
+ ",\"\"Home Street 3\""
+ ",\"Home City\""
+ ",\"Home State\""
+ ",\"Home Postal Code\""
+
+ ;; notes
+ ; ",\"Nickname\"" doesn't work
+ ",\"Notes\""
+
+ ;; end of prolog
+ "\n"
+ )
+ "*TeX statements to include at the beginning of the bbdb-to-outlook file.")
+
+(defvar bbdb-to-outlook-epilog ""
+ "*TeX statements to include at the end of the bbdb-to-outlook file.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun bbdb-to-outlook (to-file)
+ "Outlook the selected BBDB entries"
+ (interactive (list (read-file-name "To File: " bbdb-to-outlook-file-name)))
+ (setq bbdb-to-outlook-file-name (expand-file-name to-file))
+ (let ((current-letter t)
+ (records (progn (set-buffer bbdb-buffer-name)
+ bbdb-records)))
+ (find-file bbdb-to-outlook-file-name)
+ (delete-region (point-min) (point-max))
+ (while records
+ (setq current-letter
+ (bbdb-to-outlook-format-record (car (car records)) current-letter))
+ (setq records (cdr records)))
+ (goto-char (point-min)) (insert bbdb-to-outlook-prolog)
+ (goto-char (point-max)) (insert bbdb-to-outlook-epilog)
+ (goto-char (point-min))))
+
+(defun bbdb-to-outlook-format-record (record &optional current-letter brief)
+ "Insert the bbdb RECORD in TeX format.
+Optional CURRENT-LETTER is the section we're in -- if this is non-nil and
+the first letter of the sortkey of the record differs from it, a new section
+heading will be outlook \(an arg of t will always produce a heading).
+The new current-letter is the return value of this function.
+Someday, optional third arg BRIEF will produce one-line format."
+ (bbdb-debug (if (bbdb-record-deleted-p record)
+ (error "plus ungood: tex formatting deleted record")))
+
+ (let* ((first-letter
+ (substring (concat (bbdb-record-sortkey record) "?") 0 1))
+ (lname (and (bbdb-field-shown-p 'name)
+ (bbdb-record-lastname record)))
+ (fname (and (bbdb-field-shown-p 'name)
+ (bbdb-record-firstname record)))
+ (comp (and (bbdb-field-shown-p 'company)
+ (bbdb-record-company record)))
+ (net (and (bbdb-field-shown-p 'net)
+ (bbdb-record-net record)))
+ (phones (and (bbdb-field-shown-p 'phone)
+ (bbdb-record-phones record)))
+ (addrs (and (bbdb-field-shown-p 'address)
+ (bbdb-record-addresses record)))
+ (aka (and (bbdb-field-shown-p 'aka)
+ (bbdb-record-aka record)))
+ (notes (bbdb-record-raw-notes record))
+ (begin (point)))
+
+ ;; Section header, if neccessary.
+
+ ;; name
+ (insert (format "\"%s\"" (bbdb-to-outlook-if-not-blank fname)))
+ (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank lname)))
+ (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank comp)))
+
+ ;; Phone numbers
+ (insert (bbdb-to-outlook-phone phones "work\\|office"))
+ (insert (bbdb-to-outlook-phone phones "home"))
+ (insert (bbdb-to-outlook-phone phones "fax"))
+ (insert (bbdb-to-outlook-phone phones "car\\|mobile"))
+ (insert (bbdb-to-outlook-phone phones "page"))
+
+ ;; Email address
+ ;; at most three email address
+ (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net))))
+ (setq net (cdr net))
+ (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net))))
+ (setq net (cdr net))
+ (insert (format ",\"%s\"" (bbdb-to-outlook-if-not-blank (car net))))
+ (setq net (cdr net))
+
+ ;; Addresses
+ (insert (bbdb-to-outlook-address addrs "work\\|office"))
+ (insert (bbdb-to-outlook-address addrs "home"))
+
+ ;; Notes
+ (if (stringp notes)
+ (setq notes (list (cons 'notes notes))))
+
+; (if aka
+; (insert (format ",\"%s\""
+; (mapconcat (function identity) aka ", ")))
+; (insert ",\"\""))
+;
+ (insert ",\"")
+ (while notes
+ (let ((thisnote (car notes)))
+ (if (bbdb-field-shown-p (car thisnote))
+ (progn
+ (if (eq 'notes (car thisnote))
+ (insert (format "Note: %s\n"
+ (bbdb-print-outlook-quote (cdr thisnote))))
+ (if (not (eq 'mail-folders (car thisnote)))
+ (insert (format "%s: %s\n"
+ (bbdb-print-outlook-quote
+ (symbol-name (car thisnote)))
+ (bbdb-print-outlook-quote
+ (cdr thisnote))))))
+ (setq notes (cdr notes))))))
+
+ (if aka (insert (format "AKA: %s\n"
+ (mapconcat (function identity) aka ", "))))
+
+ (insert "\"")
+
+ ;; end of everything
+ (insert "\n")
+ ;; If record is bare, delete anything we may have inserted.
+ ;; otherwise, mark the end of this record.
+ current-letter))
+
+(defun bbdb-to-outlook-if-not-blank (string &rest more)
+ "If STRING is not null, then return it concatenated
+with rest of arguments. If it is null, then all arguments are
+ignored and the null string is returned."
+ (if (or (null string) (equal "" string))
+ ""
+ (apply 'concat string more)))
+
+(defun bbdb-print-outlook-quote (string)
+ "replace \" with \' in the string"
+ (let (i)
+ (while (setq i (string-match "\"" string i))
+ (setq string (concat (substring string 0 i) "\'" (substring string (1+ i))))))
+ string)
+
+(defun bbdb-to-outlook-phone (phones pattern)
+ (let ((found nil)
+ (result ",\"\""))
+ (while (and phones (not found))
+ (let ((place (downcase (aref (car phones) 0)))
+ (number (bbdb-phone-string (car phones))))
+ (if (setq found (string-match pattern place))
+ (setq result (format ",\"%s\"" number)))
+ (setq phones (cdr phones))))
+ result))
+
+
+(defun bbdb-to-outlook-address (addrs pattern)
+ (let ((found nil)
+ (result ",\"\",\"\",\"\",\"\",\"\",\"\""))
+ (while addrs
+ (let ((place (downcase (aref (car addrs) 0)))
+ (addr (car addrs)))
+ (if (setq found (string-match pattern place))
+ (setq result
+ (format
+ ",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\",\"%s\""
+ (bbdb-to-outlook-if-not-blank (bbdb-address-street1 addr))
+ (bbdb-to-outlook-if-not-blank (bbdb-address-street2 addr))
+ (bbdb-to-outlook-if-not-blank (bbdb-address-street3 addr))
+ (bbdb-to-outlook-if-not-blank (bbdb-address-city addr))
+ (bbdb-to-outlook-if-not-blank (bbdb-address-state addr))
+ (bbdb-to-outlook-if-not-blank (bbdb-address-zip-string addr))
+ )))
+ (setq addrs (cdr addrs))))
+ result))
+
+(provide 'bbdb-to-outlook)
+
+