From mboxrd@z Thu Jan  1 00:00:00 1970
From: Feng Shu <tumashu@gmail.com>
Subject: An org-contacts merge function, may be it is useful to someone
Date: Fri, 06 Sep 2013 09:49:27 +0800
Message-ID: <87eh92ra6w.fsf@news.tumashu-localhost.org>
Mime-Version: 1.0
Content-Type: text/plain
Return-path: <emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org>
Received: from eggs.gnu.org ([2001:4830:134:3::10]:49068)
	by lists.gnu.org with esmtp (Exim 4.71)
	(envelope-from <tumashu@gmail.com>) id 1VHlDM-0003AF-Os
	for emacs-orgmode@gnu.org; Thu, 05 Sep 2013 21:52:09 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
	(envelope-from <tumashu@gmail.com>) id 1VHlDE-0000Qu-B7
	for emacs-orgmode@gnu.org; Thu, 05 Sep 2013 21:52:00 -0400
Received: from mail-pd0-x22e.google.com ([2607:f8b0:400e:c02::22e]:51284)
	by eggs.gnu.org with esmtp (Exim 4.71)
	(envelope-from <tumashu@gmail.com>) id 1VHlDE-0000Qk-3l
	for emacs-orgmode@gnu.org; Thu, 05 Sep 2013 21:51:52 -0400
Received: by mail-pd0-f174.google.com with SMTP id y13so2579989pdi.5
	for <emacs-orgmode@gnu.org>; Thu, 05 Sep 2013 18:51:50 -0700 (PDT)
Received: from feng by tumashu with local (Exim 4.80)
	(envelope-from <tumashu@gmail.com>) id 1VHlAt-0003Ao-Ox
	for emacs-orgmode@gnu.org; Fri, 06 Sep 2013 09:49:27 +0800
List-Id: "General discussions about Org-mode." <emacs-orgmode.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/emacs-orgmode>,
	<mailto:emacs-orgmode-request@gnu.org?subject=unsubscribe>
List-Archive: <http://lists.gnu.org/archive/html/emacs-orgmode>
List-Post: <mailto:emacs-orgmode@gnu.org>
List-Help: <mailto:emacs-orgmode-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/emacs-orgmode>,
	<mailto:emacs-orgmode-request@gnu.org?subject=subscribe>
Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org
Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org
To: orgmode <emacs-orgmode@gnu.org>


This is a contacts merge function, you can use it to merge duplicate
contacts

-----------------------------------------------------------------------

(defun eh-org-contacts-merge-contacts ()
  "Merge duplicate contacts"
  (interactive)
  (dolist (name (let ((contact-list (org-contacts-filter nil nil)))
                  (delete-dups
                   (loop for contact in contact-list
                         collect (substring-no-properties
                                  (org-contacts-vcard-escape (car contact)))))))
    ;; let UPDATE be the first contact matching NAME
    (let* ((contacts (org-contacts-filter (concat "\\b" name "\\b")))
           (update (first contacts)))
      (save-excursion
        (with-current-buffer (marker-buffer (second update))
          (goto-char (marker-position (second update)))
          ;; for all other contacts matching NAME as CONTACT
          (dolist (contact (rest contacts))
            ;; add all properties to UPDATE
            (loop with special-properties = (mapcar 'first (org-entry-properties nil 'special))
                  for (property . value) in (third contact)
                  unless (member property special-properties)
                  do (if (or (string= property "TAGS") (string= property "ALLTAGS"))
                         (org-set-tags-to (delete-dups
                                           (nconc (org-get-tags-at)
                                                  (split-string (if value value "") ":" t))))
                       (let ((second-value (org-entry-get nil property)))
                         (unless (string= (org-contacts-strip-link (if second-value second-value ""))
                                          (org-contacts-strip-link (if value value "")))
                           (org-entry-put nil property
                                          (concat (org-entry-get nil property)
                                                  " " value))))))
            ;; delete CONTACT
            (save-excursion
              (with-current-buffer (marker-buffer (second contact))
                (goto-char (marker-position (second contact)))
                (let ((plist (second (org-element-at-point))))
                  (delete-region (plist-get plist :begin)
                                 (plist-get plist :end)))))))))))