aliens/org-contacts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

org-contacts.el: Add new link type "contact:"

Browse source 
* 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.
This commit is contained in:
stardiviner 2020-10-30 15:11:53 +08:00 committed by Bastien
parent 4e3f139857
commit 478dfcc9b7
1 changed files with 75 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
org-contacts.el
View file

@ -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