diff options
Diffstat (limited to 'bits')
| -rw-r--r-- | bits/bbdb-ldif.el | 818 |
1 files changed, 818 insertions, 0 deletions
diff --git a/bits/bbdb-ldif.el b/bits/bbdb-ldif.el new file mode 100644 index 0000000..4c2d63b --- /dev/null +++ b/bits/bbdb-ldif.el @@ -0,0 +1,818 @@ +;;; Copyright (C) 1998,2000 by Niels Elgaard Larsen <elgaard@diku.dk> + +;;; $Log$ +;;; 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) |