summaryrefslogtreecommitdiff
path: root/bits/bbdb-ldif.el
diff options
context:
space:
mode:
authorBarak A. Pearlmutter <bap@debian.org>2010-04-20 15:18:13 -0400
committerBarak A. Pearlmutter <bap@debian.org>2010-04-20 15:18:13 -0400
commit0960d4900c9bc749cd72e3d928e8cfbe081712ea (patch)
treea9e6d9f90ba35dd7f1fdb68a96f08808380bfbbe /bits/bbdb-ldif.el
Import bbdb_2.36.orig.tar.gz
[dgit import orig bbdb_2.36.orig.tar.gz]
Diffstat (limited to 'bits/bbdb-ldif.el')
-rw-r--r--bits/bbdb-ldif.el821
1 files changed, 821 insertions, 0 deletions
diff --git a/bits/bbdb-ldif.el b/bits/bbdb-ldif.el
new file mode 100644
index 0000000..7f6df8c
--- /dev/null
+++ b/bits/bbdb-ldif.el
@@ -0,0 +1,821 @@
+;;; Copyright (C) 1998,2000 by Niels Elgaard Larsen <elgaard@diku.dk>
+
+;;; $Log: bbdb-ldif.el,v $
+;;; Revision 1.1 2006/02/04 15:35:15 joerg
+;;; Added
+;;;
+;;; Revision 1.1 2005/02/13 14:16:03 waider
+;;; * added new file, with minor abuse to make it work with current BBDB
+;;;
+;;; Revision 1.7 2000/03/15 14:16:44 elgaard
+;;; Fixed problem with concatenation of strings/integers
+;;; Changed mobiletelephonenumber to cellphone to follow Netscape :-(
+;;; Added support for pagerphone
+;;;
+;;; Revision 1.6 1998/09/08 12:35:27 elgaard
+;;; Works with xemacs, emacs, emacs-19.34, bbdb-2 and bbdb-1.51
+;;; Bugfixes
+;;;
+;; Rev 0.3
+;; Can export mail-alias'es and .mailrc aliases to Netscape Mailing List
+;;Bugfix.
+;;
+
+;; Rev. 0.2.1
+;; Compiles without MEL
+
+;; Rev. 0.2
+;; Notes work better now
+;; added 'bbdb-elided-export-ldif'
+;; Fixed base64 bug
+
+;; 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 of the License, 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Niels Elgaard Larsen, <URL:mailto:elgaard@diku.dk>
+;; July 18, 1998
+
+;; bbdb-import-ldif imports LDIF entries
+;; bbdb-to-ldif export bbdb to LDIF.
+
+;; Both functions are somewhat specialized for Netscape Communicator (and Mozilla)
+
+
+
+;;; Installation:
+
+;;; Put (add-hook 'bbdb-load-hook (function (lambda () (require 'bbdb-ldif))))
+;;; into your .emacs, or autoload it.
+
+
+;; If you use non-ASCII characters recode the output file from emacs:
+;; "recode ..UTF-8 output.ldif"
+;; and the input file from Netscape:
+;; "recode UTF-8.. i2.ldif "
+;;;;;; Does not work for base-64 encoded text.
+
+(require 'bbdb)
+
+;; WAIDER MOD FEB 2005
+;; deprecated functions. I should fix the code rather than do this, but.
+(defun bbdb-address-street1(addr)
+ (nth 0 (bbdb-address-streets addr)))
+(defun bbdb-address-street2(addr)
+ (nth 1 (bbdb-address-streets addr)))
+(defun bbdb-address-street3(addr)
+ (nth 2 (bbdb-address-streets addr)))
+
+(if (locate-library "mel") (require 'mel)
+ (message "We try without MEL (base64 operation), multiline fields will not work"
+ )
+ )
+
+(if (fboundp 'split-string) nil
+ (defun split-string (string &optional pattern)
+ "Return a list of substrings of STRING which are separated by PATTERN.
+If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+ (or pattern
+ (setq pattern "[ \f\t\n\r\v]+"))
+ ;; The FSF version of this function takes care not to cons in case
+ ;; of infloop. Maybe we should synch?
+ (let (parts (start 0))
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string start (match-beginning 0)) parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+ )
+
+(if (fboundp 'caadr) nil (defun caadr (foo) (car (car (cdr foo)))))
+
+
+
+(defvar bbdb-ldif-nsnil "?" "Null name for Netscape")
+
+(defun tnsnil (st)
+ (if (equal st bbdb-ldif-nsnil)
+ nil
+ st))
+
+(defvar bbdb-elided-export-ldif nil "Set this to a list of some
+of the symbols '(address phone net notes) to select those fields to be left
+out when exporting to LDIF format"
+)
+
+;(require 'bbdb-snarf)
+(require 'bbdb-com)
+
+
+(defvar bbdb-ldif-prefix "xbbdb")
+(defvar bbdb-ldif-prefixh "xhbbdb")
+
+;;;; From bbdb-snarf with bugfix:
+(defun bbdb-merge-internally-ldif (old-record new-record)
+ "Merge two records. NEW-RECORDS wins over OLD in cases of ties."
+ (if (and (null (bbdb-record-firstname new-record))
+ (bbdb-record-firstname old-record))
+ (bbdb-record-set-firstname new-record (bbdb-record-firstname old-record)))
+ (if (and (null (bbdb-record-lastname new-record))
+ (bbdb-record-lastname old-record))
+ (bbdb-record-set-lastname new-record (bbdb-record-lastname old-record)))
+ (if (and (null (bbdb-record-company new-record))
+ (bbdb-record-company old-record))
+ (bbdb-record-set-company new-record (bbdb-record-company old-record)))
+ ;; nets
+ (let ((old-nets (bbdb-record-net old-record))
+ (new-nets (bbdb-record-net new-record)))
+ (while old-nets
+ (if (not (member (car old-nets) new-nets))
+ (setq new-nets (append new-nets (list (car old-nets)))))
+ (setq old-nets (cdr old-nets)))
+ (bbdb-record-set-net new-record new-nets))
+ ;; addrs
+ (let ((old-addresses (bbdb-record-addresses old-record))
+ (new-addresses (bbdb-record-addresses new-record)))
+ (while old-addresses
+ (if (not (member (car old-addresses) new-addresses))
+ (setq new-addresses (append new-addresses (list (car old-addresses)))))
+ (setq old-addresses (cdr old-addresses)))
+ (bbdb-record-set-addresses new-record new-addresses))
+ ;; phones
+ (let ((old-phones (bbdb-record-phones old-record))
+ (new-phones (bbdb-record-phones new-record)))
+ (while old-phones
+ (if (not (member (car old-phones) new-phones))
+ (setq new-phones (append new-phones (list (car old-phones)))))
+ (setq old-phones (cdr old-phones)))
+ (bbdb-record-set-phones new-record new-phones))
+ ;; notes
+ (let ((old-notes (bbdb-ensure-list (bbdb-record-raw-notes old-record)))
+ (new-notes (bbdb-ensure-list (bbdb-record-raw-notes new-record))))
+ (while old-notes
+ (if (not (member (car old-notes) new-notes))
+ (setq new-notes (append new-notes (list (car old-notes)))))
+ (setq old-notes (cdr old-notes)))
+ (bbdb-record-set-raw-notes new-record new-notes))
+ ;; return
+ new-record)
+
+(defun bbdb-ensure-list (foo)
+ (if (lisp foo) foo
+ (list foo)
+ )
+ )
+
+(defun bbdb-zulu (date)
+ (if (fboundp 'bbdb-time-convert)
+ (bbdb-time-convert date "%Y%m%d%H%Mz")
+ date ;; bbdb1.51 does not use it anyway.
+ )
+)
+
+(defun bbdb-unzulu (date)
+ (if (eq (length date) 13)
+ (format "%s-%s-%s" (substring date 0 4) (substring date 4 6) (substring date 6 8))
+ date)
+)
+(defun bbdb-ldif-indent (str)
+ (if (> (length str) 70)
+ (concat (substring str 0 65) "\n " (bbdb-ldif-indent (substring str 65)))
+ str)
+)
+
+(defun addnote (nrec nname note)
+ (bbdb-record-set-raw-notes
+ nrec (cons (cons nname note) (bbdb-record-raw-notes nrec) )
+ )
+ )
+
+(defmacro alias-update ()
+ (if (fboundp 'bbdb-define-all-aliases) (list 'bbdb-define-all-aliases))
+)
+
+(defmacro alias-setup ()
+ (if (fboundp 'mail-aliases-setup) (list 'mail-aliases-setup))
+)
+
+(defmacro domailaliases ()
+ (fboundp 'mail-aliases-setup)
+)
+
+
+(defmacro dodenote (st)
+ (if (fboundp 'base64-decode-string)
+ (list 'base64-decode-string st)
+ "?"
+ )
+)
+
+(defun addtonote (ton str)
+ (cond
+ ((and ton str) (concat ton "\n" str))
+ (str (concat "--bbdb--\n" str))
+ (ton)
+ )
+ )
+
+(defun setaddr (nrec afun val)
+ (if (not (bbdb-record-addresses nrec))
+ (let ((addr(make-vector bbdb-address-length "")))
+ (bbdb-record-set-addresses nrec (list addr))
+ (bbdb-address-set-location addr "address")
+ )
+ )
+ (eval (list afun (car (bbdb-record-addresses nrec)) val))
+ )
+
+
+(defun setphone (nrec iloc pno np)
+ (let ((nov (bbdb-parse-phone-number pno))
+ (pv (make-vector bbdb-phone-length ""))
+ (ploc iloc)
+ )
+ (if (and np (equal (car np) (concat bbdb-ldif-prefixh "PhoneLoc")))
+ (setq ploc (cdr np))
+ )
+
+ (if (and nov bbdb-north-american-phone-numbers-p)
+ (progn
+ (bbdb-phone-set-location pv ploc)
+ (bbdb-phone-set-area pv (nth 0 nov))
+ (bbdb-phone-set-exchange pv (nth 1 nov))
+ (bbdb-phone-set-suffix pv (nth 2 nov))
+ (bbdb-phone-set-extension pv (or (nth 3 nov) 0))
+ )
+ (setq pv (vector ploc pno))
+ )
+ (bbdb-record-set-phones nrec(append (bbdb-record-phones nrec)(list pv)))
+ )
+ )
+
+(defun bbdb-string-fetch (key mls)
+ (let ((tmls (car mls)) res)
+ (while (and (not res) (car tmls))
+ (if (string-match (format "%s= *\\(.+\\)" key) (car tmls))
+ (setq res (match-string 1 (car tmls))))
+ (setq tmls (cdr tmls)))
+ res
+ )
+ )
+
+(defun bbdb-ldif-get-phone (atts df)
+ (if (and (cdr atts) (equal (concat bbdb-ldif-prefixh "phoneloc") (caadr atts)))
+ (cdr (cadr atts))
+ df)
+)
+
+(defun bbdb-import-ldif ()
+ "import LDIF entries for current buffer
+Mailinglists \(groupOfNames\) are imported as entries in bbdb mail-alias fields."
+ (interactive)
+; (message (concat (/(* 100 (point)) (point-max)) " pct\n"))
+;; (message (concat "\nnew rec at" (point)))
+ (let ((reclist (split-string (buffer-substring 1 (point-max)) "\n[ \t\r]*\n"))
+ (numr 0) maxr (opct 0) pct mailinglists (emptyrec (make-vector bbdb-record-length nil))
+ )
+ (setq maxr (length reclist))
+ (mapcar
+ (lambda (rec)
+ (if (not (equal "" rec))
+ (let (
+ (atts (mapcar (lambda (at)
+ (if (equal (string-to-char at) ?\ )
+ (cons 'continuation (substring at 1))
+ (let ( (cpos (string-match ":" at)))
+ (if cpos
+ (let ((cpos2 ( string-match "[^ \t]" at (1+ cpos))))
+ (if cpos2
+ (cons (substring at 0 cpos) (substring at cpos2))
+ )
+ )
+ )
+ )
+ )
+ )
+ (split-string rec "[\n\r]+"))
+ )
+ )
+ (setq pct (/ (* 100 numr) maxr))
+ (if (/= opct pct)
+ (progn
+ (setq opct pct)
+ (message (concat pct " pct"))
+ )
+ )
+ (setq numr (1+ numr))
+
+ (if (member '("objectclass" . "groupOfNames") atts)
+ (let (mlcn lmlist)
+ (while atts
+ (if (car atts)
+ (let ((attName (downcase (caar atts)))
+ (attVal (cdar atts))
+ )
+ (while (and (cdr atts) (equal (caadr atts) 'continuation))
+ (setq atts (cdr atts))
+ (setq attVal (concat attVal (cdar atts)))
+ )
+ (if (equal (string-to-char attVal) ?:)
+ (setq attVal (dodenote (substring attVal (string-match "[^: \t]" attVal)))))
+
+ (cond
+ ((or (equal attName "cn") (equal attName "commonname")) (setq mlcn attVal))
+ ((equal attName "member")
+ (setq lmlist (cons (bbdb-split attVal ",") lmlist))
+ )
+ )
+ )
+ )
+ (setq atts (cdr atts))
+ ) ; while
+ (setq mailinglists (cons (cons mlcn lmlist) mailinglists))
+ )
+ (let (
+ (new-record (make-vector bbdb-record-length nil)))
+ (while atts
+ (if (stringp (car-safe (car-safe atts)))
+ (let (
+ (attName (downcase (caar atts)))
+ (attVal (cdar atts))
+ (nextAtt (car-safe (cdr-safe atts)))
+ )
+
+ (while (and (cdr atts) (equal (caadr atts) 'continuation))
+ (setq atts (cdr atts))
+ (setq attVal (concat attVal (cdar atts)))
+ )
+ (if (equal (string-to-char attVal) ?:)
+ (setq attVal
+ (dodenote (substring attVal (string-match "[^: \t]" attVal))))
+ )
+ (cond
+ ;((or (equal attName "cn") (equal attName "commonname")) hmm)
+ ((or (equal attName "sn") (equal attName "surname")) (bbdb-record-set-lastname new-record attVal))
+ ((equal attName "givenname") (bbdb-record-set-firstname new-record attVal))
+ ((equal attName "o") (bbdb-record-set-company new-record attVal))
+ ((equal attName "locality") (setaddr new-record 'bbdb-address-set-city attVal))
+ ((equal attName "postalcode") (setaddr new-record 'bbdb-address-set-zip attVal))
+ ((equal attName "st") (setaddr new-record 'bbdb-address-set-state attVal))
+ ((equal attName (concat bbdb-ldif-prefixh "mainaddrloc"))
+ (setaddr new-record 'bbdb-address-set-location attVal))
+
+ ;; This is ugly. But is it the only way Netscape understands.
+ ((equal attName "postofficebox") (setaddr new-record 'bbdb-address-set-street1 attVal))
+ ((equal attName "streetaddress") (setaddr new-record 'bbdb-address-set-street2 attVal))
+
+ ((equal attName "mail")
+ (bbdb-record-set-net new-record (cons attVal (bbdb-record-net new-record))))
+
+ ((equal attName "mailalternateaddress")
+ (bbdb-record-set-net new-record (append (bbdb-record-net new-record)
+ (list attVal)))
+ )
+
+ ((equal attName "postaladdress")
+ (let (
+ (alines (split-string (concat (bbdb-ldif-renl attVal) "\n")"[\n\r]"))
+ (addr (make-vector bbdb-address-length "")))
+ (if (and (string-match "^bbdb=" (nth 0 alines ))
+ (> (length alines) 6))
+ (progn
+ (bbdb-address-set-location addr (substring (nth 0 alines) 5))
+ (bbdb-address-set-street1 addr (nth 1 alines))
+ (bbdb-address-set-street2 addr (nth 2 alines))
+ (bbdb-address-set-street3 addr (nth 3 alines))
+ (bbdb-address-set-zip addr (nth 4 alines))
+ (bbdb-address-set-city addr (nth 5 alines))
+ (bbdb-address-set-state addr (nth 6 alines))
+ (bbdb-record-set-addresses
+ new-record
+ (append (bbdb-record-addresses new-record) (list addr))
+ )
+ )
+ )
+ )
+ )
+
+
+ ((equal attName "homephone")
+ (setphone new-record (bbdb-ldif-get-phone atts "Private") attVal nextAtt) )
+ ((equal attName "facsimiletelephonenumber")
+ (setphone new-record (bbdb-ldif-get-phone atts "Fax") attVal nextAtt))
+ ((equal attName "pagerphone")
+ (setphone new-record (bbdb-ldif-get-phone atts "pagerphone") attVal nextAtt))
+ ((equal attName "cellphone")
+ (setphone new-record (bbdb-ldif-get-phone atts "cellphone") attVal nextAtt))
+ ((equal attName "mobiletelephonenumber")
+ (setphone new-record (bbdb-ldif-get-phone atts "cellphone") attVal nextAtt))
+ ((equal attName "telephonenumber")
+ (setphone new-record (bbdb-ldif-get-phone atts "Work") attVal nextAtt))
+ ((equal attName "xmozillanickname") (bbdb-record-set-aka new-record (list attVal)))
+ ((or (equal attName "description") (equal attName "multilinedescription"))
+ (if (equal attName "multilinedescription")
+ (setq attVal (bbdb-ldif-renl attVal)))
+ (let ((thenote (substring attVal 0 (string-match "\n?--bbdb--\n" attVal))))
+ (if (not (equal "" thenote))
+ (addnote new-record 'notes thenote)
+ )
+ )
+ )
+
+ ((equal attName "createTimestamp")
+ (addnote new-record 'creation-date (bbdb-unzulu attVal)))
+ ((equal attName "modifyTimestamp")
+ (addnote new-record 'timestamp (bbdb-unzulu attVal)))
+ ((eq (string-match bbdb-ldif-prefix attName) 0)
+ (let (
+ (bbdb-ldif-note (make-symbol (substring attName (length bbdb-ldif-prefix)))))
+ (bbdb-record-set-raw-notes new-record
+ (cons (cons bbdb-ldif-note attVal)
+ (bbdb-record-raw-notes new-record)))
+ )
+ )
+ )
+ )
+ )
+ (setq atts (cdr atts))
+ )
+ ; (print new-record)
+ (if (not (equal new-record emptyrec))
+ (progn
+ (bbdb-record-set-cache new-record (make-vector bbdb-cache-length nil))
+ (let ((old-record
+;; (and (bbdb-record-net new-record)
+ (bbdb-search-simple (tnsnil (bbdb-record-name new-record))
+ (car (bbdb-record-net new-record)))
+;; )
+ )
+ )
+ (if old-record
+ (progn
+ (setq new-record (bbdb-merge-internally-ldif old-record new-record))
+ (bbdb-delete-record-internal old-record)))
+ ;; create new record
+ (bbdb-invoke-hook 'bbdb-create-hook new-record)
+ (bbdb-change-record new-record t)
+ (bbdb-hash-record new-record)
+ )
+ )
+ )
+ )
+ )
+
+ )
+ ) ; if
+ ) ; lambda
+ reclist
+ )
+ (mapcar
+ (lambda (mlist)
+ (let (
+ (mlcn (car mlist)) (lmlist (cdr mlist)))
+ (if mlcn
+ (while lmlist
+ (let (
+ (mnet (bbdb-string-fetch"mail" lmlist))
+ (mname (bbdb-string-fetch"cn" lmlist))
+ (mcomp (bbdb-string-fetch"o" lmlist))
+;; (mou (bbdb-string-fetch"ou" lmlist))
+ (therecs (bbdb-records))
+ therec
+ mal
+ )
+ (if mnet (setq therecs (bbdb-search therecs nil nil mnet nil)))
+ (if mname (setq therecs (bbdb-search therecs mname nil nil nil )))
+ (if mcomp (setq therecs (bbdb-search therecs nil mcomp nil nil nil )))
+
+ (cond ((not therecs)
+ (message (concat "Mailing list member not found: " mname " " mnet)))
+ ((= (length therecs) 1)
+ (setq therec (car therecs))
+ (setq mal (assq 'mail-alias (bbdb-record-raw-notes therec)))
+ (if (not mal)
+ (progn
+ (setq mal (cons 'mail-alias ""))
+ (bbdb-record-set-raw-notes therec (cons mal (bbdb-record-raw-notes therec))))
+ (bbdb-change-record therec nil)
+ (bbdb-hash-record therec)
+ )
+ (if (not (member mlcn (split-string (cdr mal) "[, ]")))
+ (setcdr mal (concat mlcn (if (> (length (cdr-safe mal)) 0) "," "") (cdr mal) )))
+ )
+ (t (message "Mailing List member not unique %s, %s" mname mnet))
+ )
+ )
+ (setq lmlist (cdr lmlist))
+ )
+ ; (define-mail-alias cn lmlist)
+ )
+ )
+ )
+ mailinglists
+ )
+ )
+(message nil)
+)
+
+
+
+(defun rmspace (str)
+ (apply 'concat (bbdb-split str "\n\r")))
+
+(defun bbdb-ldif-replace-string (str frs tos)
+ (let ((start 0))
+ (while (string-match frs str start)
+ (setq str
+ (concat (substring str 0 (match-beginning 0))
+ tos
+ (substring str (match-end 0))))
+ (setq start (+ (length tos) (match-beginning 0))))
+ )
+str
+)
+
+
+(defun bbase64-encode-string (st)
+ (concat ":" (bbdb-ldif-indent (rmspace st))
+ )
+ )
+
+(defun bbdb-ldif-rmnl (str)
+ (bbdb-ldif-replace-string (bbdb-ldif-replace-string str "\\$" "\\24") "\n" "$")
+)
+
+(defun bbdb-ldif-renl (str)
+ (bbdb-ldif-replace-string (bbdb-ldif-replace-string str "\\$" "\n") "\\\\24" "$")
+)
+
+(defmacro donote (st)
+ (if (fboundp 'base64-encode-string)
+ (list 'bbase64-encode-string (list 'base64-encode-string st))
+ (list 'bbdb-ldif-rmnl st)
+ )
+)
+
+(defun base64IfMulti (st)
+ (if (string-match "\n" st)
+ (donote st)
+ (concat " " (bbdb-ldif-indent st))
+ )
+)
+
+(defun nsloc (pl) "Guess mapping from userdefined bbdb locations to NS Work/Home/Fax"
+ (let (
+ (pld (and pl (downcase pl)))
+ (fc (and pl (not (equal pl "")) (string-to-char (downcase pl))))
+ )
+ (cond ( (not fc) "telephonenumber")
+ ((or (= fc ?a) (= fc ?w)) "telephonenumber")
+ ( (= fc ?h) "homephone")
+;; ( (= fc ?m) "mobileTelephoneNumber")
+ ( (equal pld "private") "homephone")
+ ( (= fc ?m) "cellphone")
+ ( (and (= fc ?p) (> (length pld) 1) (= (aref pld 1) ?a)) "pagerphone")
+ ( (equal pld "fax") "facsimiletelephonenumber")
+ ( t "telephonenumber")
+ )
+ )
+)
+
+(defun tnil(tt)
+ (if tt tt "?"))
+
+(defvar ldifbuffer "*LDIF*" "Name of buffer for LDIF output")
+
+(defun bbdb-to-ldif (visible-records) "Converts BBDB to LDIF format. Can be used to export bbdb to Netscape
+Communicator Address book.\\<bbdb-mode-map>
+If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb2ldif]\" is \
+used instead of simply \"\\[bbdb2ldif]\", then includes only the
+people currently in the *BBDB* buffer.
+The result is placed in a buffer name \"*LDIF*\"
+If MEL is installed Multiline notes/descriptions work with Netscape address book.
+Mail-aliases from mailrc file or bbdb mail-aliases fields are exported as mainglists
+\(GroupOfNames\)
+"
+ (interactive (list
+ (bbdb-do-all-records-p)
+ )
+ )
+ (let* (
+ (target (cons bbdb-define-all-aliases-field "."))
+ (ldif-records
+ (bbdb-search
+ (if (not visible-records)
+ (bbdb-records)
+ (mapcar 'car bbdb-records)
+ )
+ nil nil nil target)
+ )
+ tmps
+ record
+ )
+
+
+ (setq ldif-records
+ (if (not visible-records)
+ (bbdb-records)
+ (mapcar 'car bbdb-records)
+ )
+ )
+
+ (set-buffer (get-buffer-create ldifbuffer))
+ (setq fill-column 1000)
+ (erase-buffer)
+
+ (while ldif-records
+ (setq record (car ldif-records))
+ (insert "\nxmozillausehtmlmail: FALSE\n")
+ (let (
+ (net (car (bbdb-record-net record)))
+ (rnet (bbdb-record-net record))
+ )
+ (insert (format "dn: cn=%s" (tnil (bbdb-record-name record))))
+ (if net
+ (insert (format ",mail=%s" net))
+ )
+ (insert "\n")
+
+ (setq tmps (bbdb-record-firstname record)) (insert "givenname: " (tnil tmps) "\n")
+ (setq tmps (bbdb-record-lastname record)) (if tmps (insert "sn: " tmps "\n"))
+ (insert "objectclass: top\nobjectclass: person\n")
+ (setq tmps (bbdb-record-company record)) (if tmps (insert "o: " tmps "\n"))
+ (setq tmps (bbdb-record-name record)) (if tmps (insert "cn: " tmps "\n"))
+
+ (if net (insert "mail: " net "\n"))
+ (while (cdr rnet)
+ (insert "mailAlternateAddress: " (cadr rnet) "\n")
+ (setq rnet (cdr rnet))
+ )
+ )
+ (let (
+ (phones (bbdb-record-phones record))
+ (addrs (bbdb-record-addresses record))
+ (aka (bbdb-record-aka record))
+ (firstaddr t)
+ tonote
+ phone
+ (elide nil)
+ )
+
+ (while phones
+ (setq phone (car phones))
+ (if (equal (nsloc (bbdb-phone-location phone))"cellphone")
+ (setq tonote (addtonote tonote (concat "M:" (bbdb-phone-string phone) )))
+ )
+ (if (equal (nsloc (bbdb-phone-location phone))"pagerphone")
+ (setq tonote (addtonote tonote (concat "P:" (bbdb-phone-string phone) )))
+ )
+ (insert (format "%s: " (nsloc (bbdb-phone-location phone))) (bbdb-phone-string phone) "\n")
+ (insert bbdb-ldif-prefixh "PhoneLoc:" (bbdb-phone-location phone)"\n")
+ (setq phones (cdr phones)))
+
+ (let (addr tmps)
+ (while addrs
+ (setq addr (car addrs))
+ (if firstaddr (progn
+ (if (= 0 (length (setq tmps (bbdb-address-street1 addr)))) nil (insert "postOfficeBox: " tmps "\n"))
+ (if (= 0 (length (setq tmps (bbdb-address-street2 addr)))) nil (insert "streetaddress: " tmps "\n"))
+ (if (= 0 (length (setq tmps (bbdb-address-street3 addr)))) nil (insert "streetaddress: " tmps "\n" ))
+
+ ; This does not work with Netscape
+ ; (if (= 0 (length (setq tmps (bbdb-address-street1 addr)))) nil (insert "homePostalAddress:" tmps ))
+ ; (if (= 0 (length (setq tmps (bbdb-address-street2 addr)))) nil (insert "$" tmps))
+ ; (if (= 0 (length (setq tmps (bbdb-address-street3 addr)))) nil (insert "$" tmps ))
+ ; (insert "\n")
+
+ (insert "locality:" (bbdb-address-city addr) "\n")
+ (setq tmps (bbdb-address-state addr))
+ (if (and tmps (not (equal tmps ""))) (insert "st:" tmps "\n"))
+ (if (bbdb-address-zip-string addr)
+ (insert "postalcode:" (bbdb-address-zip-string addr) "\n"))
+ (setq firstaddr nil)
+ )
+ (progn
+ (setq tonote (addtonote tonote (concat (bbdb-address-street1 addr))))
+ (setq tonote (addtonote tonote (concat (bbdb-address-street2 addr))))
+ (setq tonote (addtonote tonote (concat (bbdb-address-street3 addr))))
+ (setq tonote (addtonote tonote (concat (bbdb-address-zip-string addr) " " (bbdb-address-city addr) )))
+ (insert (concat "postalAddress: "
+ (base64IfMulti (concat "bbdb=" (bbdb-address-location addr) "\n"
+ (bbdb-address-street1 addr) "\n"
+ (bbdb-address-street2 addr) "\n"
+ (bbdb-address-street3 addr) "\n"
+ (bbdb-address-zip-string addr) "\n"
+ (bbdb-address-city addr) "\n"
+ (bbdb-address-state addr)
+ )
+ )
+ "\n"
+ )
+ )
+ )
+ )
+ (setq addrs (cdr addrs)))
+ )
+ (cond (aka
+ (insert (format "%s: %s\n" "xmozillanickname"
+ (mapconcat (function identity) aka ", ")))
+ ))
+ (let ((notes (bbdb-record-raw-notes record)))
+ (if (stringp notes)
+ (setq notes (list (cons 'notes notes))))
+ (while notes
+ (setq elide nil)
+ (cond
+ ((member (caar notes) bbdb-elided-export-ldif) (setq elide t))
+ ((eq (car (car notes)) 'creation-date)
+ (insert "createTimestamp: " (bbdb-zulu (cdar notes))"\n")
+ (setq elide t)
+ )
+ ((eq (car (car notes)) 'timestamp)
+ (setq elide t)
+ (insert "modifyTimestamp: "(bbdb-zulu (cdar notes))"\n")
+ )
+ ((eq (car (car notes)) 'notes) (setq elide t))
+ ((eq (car (car notes)) 'mail-alias) (setq elide t))
+ (t
+ ;; Netscape cannot display this. So we also put it in the notes field.
+ (setq tonote (addtonote tonote (format "%s:%s" (caar notes) (cdar notes))))
+ (insert (format "%s%s:" bbdb-ldif-prefix (car (car notes))))
+ )
+ )
+ (if (eq (caar notes) 'notes)
+ (if tonote
+ (setq tonote (concat (cdar notes) "\n" tonote))
+ (setq tonote (cdar notes)))
+ (if (not elide)
+ (insert (base64IfMulti (tnil (cdar notes))) "\n"))
+ )
+ (setq notes (cdr notes))
+ )
+ (if tonote
+ (if (and (string-match "\n" tonote) (not (fboundp 'base64-encode-string)))
+ (insert "multilineDescription:" (bbdb-ldif-rmnl tonote ) "\n")
+ (insert "description:" (base64IfMulti tonote ) "\n")
+ )
+ )
+ )
+ (if (bbdb-record-addresses record)
+ (insert bbdb-ldif-prefixh "mainAddrLoc:" (bbdb-address-location (car (bbdb-record-addresses record)))"\n")
+ )
+
+ )
+ (setq ldif-records (cdr ldif-records))
+ )
+ )
+ (if (and (not visible-records) (domailaliases))
+ (progn
+ (alias-update)
+ (alias-setup)
+ ;; (bbdb-define-all-aliases)
+ (let ((mai 0) mae alist (malen (length mail-aliases)
+ ))
+ (while (< mai malen)
+ (setq mae (aref mail-aliases mai) )
+ (if (and mae (symbolp mae ))
+ (progn
+ (insert (format "\ndn: cn=%s\n" mae))
+ (insert (format "cn: %s\n" mae))
+ (insert "objectclass: top\n")
+ (insert "objectclass: groupOfNames\n")
+ (setq alist (symbol-value mae ))
+ (if alist
+ (mapcar
+ (lambda (an)
+ (let ((trec (bbdb-search-simple nil an))
+ )
+ (if trec
+ (insert (format "member: cn=%s,mail=%s\n"
+ (tnil (bbdb-record-name trec))
+ (tnil (car (bbdb-record-net trec)))
+ )
+ )
+ )
+ )
+ )
+ (split-string alist ", ")
+ )
+ )
+ )
+ )
+ (setq mai (1+ mai))
+ )
+ )
+ )
+ (alias-update)
+ )
+ (set-window-buffer (get-lru-window) ldifbuffer )
+)
+;;(add-hook 'bbdb-load-hook (lambda () (define-key bbdb-mode-map "L" 'bbdb-to-ldif)))
+(define-key bbdb-mode-map "L" 'bbdb-to-ldif)
+(provide 'bbdb-ldif)