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