Refactor to anaphoric forms for cleaner code

[bbdb-csv-import] / bbdb3-csv-import.el

diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el
index b644e52426e49369531d2b74f0c88fc5d317af7b..35059e0c5144c7a9e14e3f3043cf64c25ee07228 100644 (file)
--- a/bbdb3-csv-import.el
+++ b/bbdb3-csv-import.el
@@ -46,6 +46,8 @@
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird)
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-gmail)
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-linkedin)
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird)
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-gmail)
 ;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-linkedin)

+;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-outlook-web)
+;; 

 ;;
 ;; Simply call `bbdb3-csv-import-buffer' or
 ;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use
 ;;
 ;; Simply call `bbdb3-csv-import-buffer' or
 ;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use


@@ -63,7 +65,9 @@
 ;;   do M-x bbdb then .* then C-u * d on the beginning of a record.
 ;; - After changing a mapping table, don't forget to re-execute
 ;;   (setq bbdb3-csv-import-mapping-table ...) so that it propagates.
 ;;   do M-x bbdb then .* then C-u * d on the beginning of a record.
 ;; - After changing a mapping table, don't forget to re-execute
 ;;   (setq bbdb3-csv-import-mapping-table ...) so that it propagates.

-;; 
+;;
+;; Todo: It would be nice if we would programatically or manually merge all the
+;; mapping tables, then we would not have to set one.

 
 (require 'pcsv)
 (require 'dash)
 
 (require 'pcsv)
 (require 'dash)


@@ -126,7 +130,8 @@
 
 
 ;; note. PO Box and Extended Address are added as additional address street lines if they exist.
 
 
 ;; note. PO Box and Extended Address are added as additional address street lines if they exist.

-;; If you don't like this, you can remove them. If you want some other special handling, it will need to be coded.
+;; If you don't like this, just delete them from this fiel.
+;; If you want some other special handling, it will need to be coded.

 (defconst bbdb3-csv-import-gmail
   '(("firstname" "Given Name")
     ("lastname" "Family Name")
 (defconst bbdb3-csv-import-gmail
   '(("firstname" "Given Name")
     ("lastname" "Family Name")


@@ -161,6 +166,7 @@
      (repeat ("Custom Field 1 - Type" "Custom Field 1 - Value"))))
   "Gmail csv export format")
 
      (repeat ("Custom Field 1 - Type" "Custom Field 1 - Value"))))
   "Gmail csv export format")
 

+

 (defconst bbdb3-csv-import-gmail-typed-email
   (append  (car (last bbdb3-csv-import-gmail)) '((repeat "E-mail 1 - Type")))
   "Like the first Gmail mapping, but use custom fields to store
 (defconst bbdb3-csv-import-gmail-typed-email
   (append  (car (last bbdb3-csv-import-gmail)) '((repeat "E-mail 1 - Type")))
   "Like the first Gmail mapping, but use custom fields to store


@@ -168,6 +174,47 @@
    people don't use those labels and using the default labels
    would create useless custom fields.")
 
    people don't use those labels and using the default labels
    would create useless custom fields.")
 

+(defconst bbdb3-csv-import-outlook-typed-email
+  (append  (car (last bbdb3-csv-import-outlook-web)) '((repeat "E-mail 1 - Type")))
+  "Like the previous var, but for outlook-web.
+Adds email labels as custom fields.")
+
+
+(defconst bbdb3-csv-import-outlook-web
+  '(("firstname" "First Name")
+    ("lastname" "Last Name")
+    ("middlename" "Middle Name")
+    ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
+    ("phone"
+     "Assistant's Phone" "Business Fax" "Business Phone"
+     "Business Phone 2" "Callback" "Car Phone"
+     "Company Main Phone" "Home Fax" "Home Phone"
+     "Home Phone 2" "ISDN" "Mobile Phone"
+     "Other Fax" "Other Phone" "Pager"
+     "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
+    ("address"
+     (("business address"
+       (("Business Street")
+        "Business City" "Business State"
+        "Business Postal Code" "Business Country"))
+      ("home address"
+       (("Home Street")
+        "Home City" "Home State"
+        "Home Postal Code" "Home Country"))
+      ("other address"
+       (("Other Street" "")
+        "Other City" "Other State"
+        "Other Postal Code" "Other Country"))))
+    ("organization" "Company")
+    ("xfields"
+     "Anniversary" "Family Name Yomi" "Given Name Yomi"
+     "Suffix" "Department" "Job Title" "Birthday" "Manager's Name" "Notes"
+     "Spouse" "Web Page"))
+  "Hotmail.com, outlook.com, live.com, etc.
+Based on 'Export for outlook.com and other services',
+not the export for Outlook 2010 and 2013.")
+
+

 (defvar bbdb3-csv-import-mapping-table nil
   "The table which maps bbdb3 fields to csv fields.
 Use the default as an example to map non-thunderbird data.
 (defvar bbdb3-csv-import-mapping-table nil
   "The table which maps bbdb3 fields to csv fields.
 Use the default as an example to map non-thunderbird data.


@@ -229,22 +276,21 @@ Defaults to current buffer."
                            ;; (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)
                            ;; (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))
-           
+                           (--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-mapping)
                       ;; ROOT-MAPPING = a root element from bbdb3-csv-import-mapping-table.
                       ;;
            (map-bbdb3 (root-mapping)
                       ;; ROOT-MAPPING = a root element from bbdb3-csv-import-mapping-table.
                       ;;


@@ -255,7 +301,7 @@ Defaults to current buffer."
                       ;; 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.
                       ;; 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 bbdb-arg bbdb3-csv-import-mapping-table)))))
+                      (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)))
            (map-assoc (field)
                       ;; For mappings with just 1 simple csv-field, get it's data
                       (assoc-plus (car (map-bbdb3 field)) csv-record)))


@@ -286,16 +332,18 @@ Defaults to current buffer."
                              (let ((address-lines (mapcar-assoc (caadr mapping-elem)))
                                    (address-data (mapcar-assoc (cdadr mapping-elem)))
                                    (elem-name (car mapping-elem)))
                              (let ((address-lines (mapcar-assoc (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 '(""))))

                                (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 (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))
                                  (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")))
                                                           address-lines)) nil))
                                  (vconcat (list elem-name) (list address-lines) address-data))))
                            (map-bbdb3 "address")))


@@ -308,21 +356,19 @@ Defaults to current buffer."
 
 (defun bbdb3-csv-import-flatten1 (list)
   "flatten LIST by 1 level."
 
 (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"
 
 ;;;###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)
 
 ;;;###autoload
 (defun bbdb3-csv-import-assoc-plus (key list)