From c1d2b6dfbc9c8e7e0cc08f84f1635b776a738e07 Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 14:26:22 +0800 Subject: [PATCH] prototype of org-contacts contact complete --- org-contacts.el | 96 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) diff --git a/org-contacts.el b/org-contacts.el index 8aed353..945435e 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -642,6 +642,102 @@ description." (run-hook-with-args-until-success 'org-contacts-complete-functions string)))))))) +(defun org-contacts-org-complete--annotation-function (candidate) + "Return org-contacts tags of contact candidate." + ;; TODO + "Tags: ") + +(defun org-contacts-org-complete--doc-function (candidate) + "Return org-contacts content of contact candidate." + (let ((name (plist-get candidate :name)) + (file (plist-get candidate :file)) + (position (plist-get candidate :position))) + (company-doc-buffer + ;; get org-contact headline and property drawer. + (with-current-buffer (find-file-noselect file) + (goto-char position) + (when (derived-mode-p 'org-mode) + ;; `org-edit-src-code' is not a real narrowing command. + ;; Remove this first conditional if you don't want it. + (cond ((ignore-errors (org-edit-src-code)) + (delete-other-windows)) + ((org-at-block-p) + (org-narrow-to-block)) + (t (org-narrow-to-subtree))) + (buffer-substring (point-min) (point-max))))))) + +(defun org-contacts-org-complete--location-function (candidate) + "Return org-contacts location of contact candidate." + (let ((name (plist-get candidate :name)) + (file (plist-get candidate :file)) + (position (plist-get candidate :position))) + (with-current-buffer (find-file-noselect file) + (goto-char position) + (cons (current-buffer) position)))) + +(defun org-contacts-org-complete-function () + "Function used in `completion-at-point-functions' in `org-mode' to complete @name." + (when-let* ((bounds (bounds-of-thing-at-point 'symbol)) + (begin (1- (car bounds))) + (end (cdr bounds)) + (symbol (buffer-substring-no-properties begin end)) + (org-contacts-prefix-p (string-prefix-p "@" symbol)) + ;; (prefix (substring-no-properties symbol 1 nil)) + ) + (when org-contacts-prefix-p + (list begin + end + + ;; (all-completions + ;; prefix + ;; (mapcar + ;; (lambda (contact) (plist-get contact :name)) + ;; (org-contacts--all-contacts)) + ;; 'stringp) + + (completion-table-dynamic + (lambda (_) + (mapcar + (lambda (contact) (plist-get contact :name)) + (org-contacts--all-contacts)))) + + ;; :predicate 'stringp + ;; :exclusive 'no + ;; properties check out `completion-extra-properties' + ;; :annotation-function #'org-contacts-org-complete--annotation-function + ;; :exit-function ; TODO change completion candidate inserted contact name into org-contact link?? + + ;; :company-docsig #'identity ; metadata + ;; :company-doc-buffer #'org-contacts-org-complete--doc-function ; doc popup + ;; :company-location #'org-contacts-org-complete--location-function + )))) + +(add-hook 'completion-at-point-functions 'org-contacts-org-complete-function nil 'local) + +(try-completion + "tri" + (mapcar + (lambda (contact) (plist-get contact :name)) + (org-contacts--all-contacts))) + +(all-completions "Chr" (nth 2 (org-contacts-org-complete-function))) + +;; @Chris + +;; (type-of +;; (all-completions +;; "tri" +;; (mapcar +;; (lambda (contact) (plist-get contact :name)) +;; (org-contacts--all-contacts)) +;; 'stringp)) + +;;; TEST +;;; @chris +;; (add-hook 'completion-at-point-functions 'org-contacts-org-complete-function nil 'local) +;; (remove-hook 'completion-at-point-functions 'org-contacts-completion-at-point 'local) +;; (add-to-list 'completion-at-point-functions 'org-contacts-org-complete-function) + (defun org-contacts-gnus-get-name-email () "Get name and email address from Gnus message." (if (gnus-alive-p)