From 478dfcc9b72fcfd363176ea5c15b1d9295d35afb Mon Sep 17 00:00:00 2001 From: stardiviner Date: Fri, 30 Oct 2020 15:11:53 +0800 Subject: [PATCH] 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 4b3693a..d8d4984 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