[elpa] externals/org-contacts 478dfcc9b7 096/154: org-contacts.el: Add new link type "contact:"

[ELPA Syncer]

branch: externals/org-contacts
commit 478dfcc9b72fcfd363176ea5c15b1d9295d35afb
Author: stardiviner <numbchild@gmail.com>
Commit: Bastien <bzg@gnu.org>

    org-contacts.el: Add new link type "contact:"
    
    * contrib/lisp/org-contacts.el (org-contacts-link-store): Store a link
    of org-contacts in Org file.
    
    * contrib/lisp/org-contacts.el (org-contacts-link-open): Open contact:
    link in Org file.
    
    * contrib/lisp/org-contacts.el (org-contacts-link-complete): Insert a
    contact: link with completion of contacts.
    
    * contrib/lisp/org-contacts.el (org-contacts-link-face): Set different
    face for contact: link.
---
 org-contacts.el | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 75 insertions(+)

diff --git a/org-contacts.el b/org-contacts.el
index 4b3693a0ea..d8d4984258 100644
--- a/org-contacts.el
+++ b/org-contacts.el
@@ -1146,6 +1146,81 @@ are effectively trimmed).  If nil, all zero-length 
substrings are retained."
         (setq proplist (cons bufferstring proplist))))
     (cdr (reverse proplist))))
 
+;;; Add an Org link type `org-contact:' for easy jump to or searching 
org-contacts headline.
+;;; link spec: [[org-contact:query][desc]]
+(org-link-set-parameters "org-contact"
+                        :follow 'org-contacts-link-open
+                        :complete 'org-contacts-link-complete
+                        :store 'org-contacts-link-store
+                        :face 'org-contacts-link-face)
+
+(defun org-contacts-link-store ()
+  "Store the contact in `org-contacts-files' with a link."
+  (when (eq major-mode 'org-mode)
+    ;; (member (buffer-file-name) (mapcar 'expand-file-name 
org-contacts-files))
+    (let ((headline-str (substring-no-properties (org-get-heading t t t t))))
+      (org-store-link-props
+       :type "org-contact"
+       :link headline-str
+       :description headline-str))))
+
+(defun org-contacts--all-contacts ()
+  "Return an alist (name . (file . position)) of all contacts in 
`org-contacts-files'."
+  (car (mapcar
+       (lambda (file)
+         (unless (buffer-live-p (get-buffer (file-name-nondirectory file)))
+           (find-file file))
+         (with-current-buffer (get-buffer (file-name-nondirectory file))
+           (org-map-entries
+            (lambda ()
+              (let ((name (substring-no-properties (org-get-heading t t t t)))
+                    (file (buffer-file-name))
+                    (position (point)))
+                `(:name ,name :file ,file :position ,position))))))
+       org-contacts-files)))
+
+(defun org-contacts-link-open (path)
+  "Open contacts: link type with jumping or searching."
+  (let ((query path))
+    (cond
+     ((string-match "/.*/" query)
+      (let* ((f (car org-contacts-files))
+            (buf (get-buffer (file-name-nondirectory f))))
+       (unless (buffer-live-p buf) (find-file f))
+       (with-current-buffer buf
+         (string-match "/\\(.*\\)/" query)
+         (occur (match-string 1 query)))))
+     (t
+      (let* ((f (car org-contacts-files))
+            (buf (get-buffer (file-name-nondirectory f))))
+       (unless (buffer-live-p buf) (find-file f))
+       (with-current-buffer buf
+         (goto-char (marker-position (org-find-exact-headline-in-buffer 
query)))))
+      ;; FIXME
+      ;; (let* ((contact-entry (plist-get (org-contacts--all-contacts) query))
+      ;;            (contact-name (plist-get contact-entry :name))
+      ;;            (file (plist-get contact-entry :file))
+      ;;            (position (plist-get contact-entry :position))
+      ;;            (buf (get-buffer (file-name-nondirectory file))))
+      ;;       (unless (buffer-live-p buf) (find-file file))
+      ;;       (with-current-buffer buf (goto-char position)))
+      ))))
+
+(defun org-contacts-link-complete (&optional arg)
+  "Create a org-contacts link using completion."
+  (let ((name (completing-read "org-contact Name: "
+                              (mapcar
+                               (lambda (plist) (plist-get plist :name))
+                               (org-contacts--all-contacts)))))
+    (concat "org-contact:" name)))
+
+(defun org-contacts-link-face (path)
+  "Different face color for different org-contacts link query."
+  (cond
+   ((string-match "/.*/" path)
+    '(:background "sky blue" :overline t :slant 'italic))
+   (t '(:background "green yellow" :underline t))))
+
 (provide 'org-contacts)
 
 ;;; org-contacts.el ends here