(defconst bbdb3-csv-import-outlook-web
- '(("firstname" "First Name")
+ '(("firstname" "Display Name" "First Name")
("lastname" "Last Name")
("middlename" "Middle Name")
("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
Based on 'Export for outlook.com and other services',
not the export for Outlook 2010 and 2013.")
+;(defconst bbdb3-csv-import-combined)
+
(defvar bbdb3-csv-import-mapping-table nil
"The table which maps bbdb3 fields to csv fields.
;; loop over the csv records
(while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents)))
(cl-flet*
- ((rd-assoc (list)
- ;; given LIST of fields, return a list of data, ignoring empty fields
- (rd (lambda (elem) (assoc-plus elem csv-record)) list))
+ ((expand-repeats (list)
+ ;; return new list where elements from LIST in form
+ ;; (repeat elem1 ...) become ((elem1 ...) [(elem2 ...)] ...)
+ ;; For as many repeating numbered fields exist in the csv fields.
+ ;; elem can be a string or a tree (a list with possibly lists inside it)
+ (--reduce-from (if (not (and (consp it) (eq (car it) 'repeat)))
+ (cons it acc)
+ (setq it (cdr it))
+ (let* ((i 1)
+ (first-field (car (flatten it))))
+ (setq acc (cons it acc))
+ ;; use first-field to test if there is another repetition.
+ (while (member (replace-num (setq i (1+ i)) first-field) csv-fields)
+ (cl-labels ((fun (cell)
+ (if (consp cell)
+ (mapcar #'fun cell)
+ (replace-num i cell))))
+ (setq acc (cons (fun it) acc))))
+ acc))
+ nil list))
+ (map-bbdb3 (root)
+ ;; ROOT = a root element from bbdb3-csv-import-mapping-table.
+ ;; Get the actual csv-fields, including variably repeated ones. flattened
+ ;; by one because repeated fields are put in sub-lists, but
+ ;; after expanding them, that extra depth is no longer
+ ;; useful. Small quirk: address mappings without 'repeat
+ ;; need to be grouped in a list because they contain sublists that we
+ ;; don't want flattened. Better this than more complex code.
+ (flatten1 (expand-repeats (cdr (assoc root bbdb3-csv-import-mapping-table)))))
+ (rd-assoc (root)
+ ;; given ROOT, return a list of data, ignoring empty fields
+ (rd (lambda (elem) (assoc-plus elem csv-record)) (map-bbdb3 root)))
(mapcar-assoc (list)
;; given LIST of fields,return a list of data with nil in place of an empty field
(mapcar (lambda (elem) (cdr (assoc elem csv-record))) list))
(replace-num (num string)
;; in STRING, replace all groups of numbers with NUM
(replace-regexp-in-string "[0-9]+" (number-to-string num) string))
- (expand-repeats (list)
- ;; return new list where elements from LIST in form
- ;; (repeat elem1 ...) become ((elem1 ...) [(elem2 ...)] ...)
- ;; For as many repeating numbered fields exist in the csv fields.
- ;; elem can be a string or a tree (a list with possibly lists inside it)
- (-reduce-from (lambda (acc arg)
- (if (not (and (consp arg) (eq (car arg) 'repeat)))
- (cons arg acc)
- (setq arg (cdr arg))
- (let* ((i 1)
- (first-field (car (flatten arg))))
- (setq acc (cons arg acc))
- ;; use first-field to test if there is another repetition.
- (while (member (replace-num (setq i (1+ i)) first-field) csv-fields)
- (cl-labels ((fun (cell)
- (if (consp cell)
- (mapcar #'fun cell)
- (replace-num i cell))))
- (setq acc (cons (fun arg) acc))))
- acc))) nil list))
-
- (map-bbdb3 (root-mapping)
- ;; ROOT-MAPPING = a root element from bbdb3-csv-import-mapping-table.
- ;;
- ;; Get the actual csv-fields, including variably repeated ones flattened
- ;; by one because potentially repeated fields are put in sub-lists so they
- ;; can be as one thing, but after they are, that extra depth is no longer
- ;; useful. This makes for a little quirk: address mappings without 'repeat
- ;; need to be grouped in a list because they contain sublists that we
- ;; don't want flattened. I've decided that is a better trade off than more
- ;; complex code.
- (flatten1 (expand-repeats (cdr (assoc root-mapping bbdb3-csv-import-mapping-table)))))
(map-assoc (field)
;; For mappings with just 1 simple csv-field, get it's data
- (assoc-plus (car (map-bbdb3 field)) csv-record)))
-
+ (car (rd-assoc field))))
(let ((name (let ((first (map-assoc "firstname"))
(middle (map-assoc "middlename"))
(concat (or first middle) " " (or middle last) (when (and first middle) (concat " " last) ))
(or name first middle last ""))))
(phone (rd 'vconcat (rd #'assoc-expand (map-bbdb3 "phone"))))
- (mail (rd-assoc (map-bbdb3 "mail")))
+ (mail (rd-assoc "mail"))
(xfields (rd (lambda (list)
(let ((e (car list)))
(while (string-match "-" e)
(cons e (cadr list)))) ;; change from (a b) to (a . b)
(rd #'assoc-expand (map-bbdb3 "xfields"))))
(address (rd (lambda (mapping-elem)
- (let ((address-lines (mapcar-assoc (caadr mapping-elem)))
+ (let ((address-lines (rd (lambda (elem)
+ (assoc-plus elem csv-record))
+ (caadr mapping-elem)))
(address-data (mapcar-assoc (cdadr mapping-elem)))
(elem-name (car mapping-elem)))
- ;; outlook-web has 1 address line, bbdb requires 2
(if (= (length address-lines) 1)
- (setq address-lines (append address-lines '(""))))
+ (setq address-lines (-snoc address-lines "")))
(when (consp elem-name)
(setq elem-name (cdr (assoc (car elem-name) csv-record))))
;; determine if non-nil and put together the minimum set
- (when (or (not (-all? '(lambda (arg) (zerop (length arg))) address-data))
- (not (-all? '(lambda (arg) (zerop (length arg))) address-lines)))
+ (when (or (not (--all? (zerop (length it)) address-data))
+ (not (--all? (zerop (length it)) address-lines)))
(when (> 2 (length address-lines))
- (setcdr (max 2 (nthcdr (-find-last-index (lambda (mapping-elem) (not (null mapping-elem)))
- address-lines)
+ (setcdr (max 2 (nthcdr (--find-last-index (not (null it))
+ address-lines)
address-lines)) nil))
(vconcat (list elem-name) (list address-lines) address-data))))
(map-bbdb3 "address")))
- (organization (rd-assoc (map-bbdb3 "organization")))
+ (organization (rd-assoc "organization"))
(affix (map-assoc "affix"))
- (aka (rd-assoc (map-bbdb3 "aka"))))
+ (aka (rd-assoc "aka")))
(bbdb-create-internal name affix aka organization mail phone address xfields t))))
(setq bbdb-allow-duplicates initial-duplicate-value)))
-
(defun bbdb3-csv-import-flatten1 (list)
"flatten LIST by 1 level."
- (-reduce-from (lambda (acc elem)
- (if (consp elem)
- (-concat acc elem)
- (-snoc acc elem)))
- nil list))
+ (--reduce-from (if (consp it)
+ (-concat acc it)
+ (-snoc acc it))
+ nil list))
;;;###autoload
(defun bbdb3-csv-import-rd (func list)
"like mapcar but don't build nil results into the resulting list"
- (-reduce-from (lambda (acc elem)
- (let ((funcreturn (funcall func elem)))
- (if funcreturn
- (cons funcreturn acc)
- acc)))
- nil list))
+ (--reduce-from (let ((funcreturn (funcall func it)))
+ (if funcreturn
+ (cons funcreturn acc)
+ acc))
+ nil list))
;;;###autoload
(defun bbdb3-csv-import-assoc-plus (key list)
iankelling.org / git / bbdb-csv-import / blobdiff