From c1d2b6dfbc9c8e7e0cc08f84f1635b776a738e07 Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 14:26:22 +0800 Subject: [PATCH 1/6] 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) From 1b028de47ceb15fba79132d5cb8f77b1d1b8dd49 Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 15:05:11 +0800 Subject: [PATCH 2/6] Fix contacts complete not working problem > I found ~org-contacts-org-complete-function~ returned a special value: > > #+begin_example > #f(compiled-function (string pred action) #) > #+end_example I can't see any way M-: (org-contacts-org-complete-function) RET can return the above value. So I suspect a "pilot error". This looks like the 3rd value in the returned list (i.e. the value returned by `completion-table-dynamic`). > #+begin_src emacs-lisp > (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 > (completion-table-dynamic > (lambda (_) > (mapcar > (lambda (contact) (plist-get contact :name)) > (org-contacts--all-contacts)))))))) > #+end_src This gives a `begin..end` region which presumably includes `@`. Does (plist-get contact :name) return names that start with `@`? If not, the completion will never match. > And test with execute following ~add-hook~ in org-mode buffer or > emacs-lisp-mode buffer: In emacs-lisp-mode, `@` has symbol syntax, so (bounds-of-thing-at-point 'symbol) will include `@` in the returned region, whereas in Org mode `@` seems to have punctuation syntax so the `@` will not be included in the returned region. Maybe instead of `bounds-of-thing-at-point` you want to use something less "magic", like (skip-chars-backward "[:alnum:]@"). > #+begin_src emacs-lisp > (add-hook 'completion-at-point-functions 'org-contacts-org-complete-function nil 'local) > #+end_src --- org-contacts.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-contacts.el b/org-contacts.el index 945435e..ec26017 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -698,7 +698,7 @@ description." (completion-table-dynamic (lambda (_) (mapcar - (lambda (contact) (plist-get contact :name)) + (lambda (contact) (concat "@" (plist-get contact :name))) (org-contacts--all-contacts)))) ;; :predicate 'stringp From f3fa9fc0b83b0ad3cd42cd73751e95950c49fe38 Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 15:06:23 +0800 Subject: [PATCH 3/6] use less magic symbol extract code > #+begin_src emacs-lisp > (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 > (completion-table-dynamic > (lambda (_) > (mapcar > (lambda (contact) (plist-get contact :name)) > (org-contacts--all-contacts)))))))) > #+end_src This gives a `begin..end` region which presumably includes `@`. Does (plist-get contact :name) return names that start with `@`? If not, the completion will never match. > And test with execute following ~add-hook~ in org-mode buffer or > emacs-lisp-mode buffer: In emacs-lisp-mode, `@` has symbol syntax, so (bounds-of-thing-at-point 'symbol) will include `@` in the returned region, whereas in Org mode `@` seems to have punctuation syntax so the `@` will not be included in the returned region. Maybe instead of `bounds-of-thing-at-point` you want to use something less "magic", like (skip-chars-backward "[:alnum:]@"). --- org-contacts.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/org-contacts.el b/org-contacts.el index ec26017..55054bd 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -677,9 +677,8 @@ description." (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)) + (when-let* ((end (point)) + (begin (save-excursion (skip-chars-backward "[:alnum:]@") (point))) (symbol (buffer-substring-no-properties begin end)) (org-contacts-prefix-p (string-prefix-p "@" symbol)) ;; (prefix (substring-no-properties symbol 1 nil)) From 85dd965906b91a4fa9e6450385be0c5535572dea Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 15:08:05 +0800 Subject: [PATCH 4/6] Remove testing code --- org-contacts.el | 29 ++--------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) diff --git a/org-contacts.el b/org-contacts.el index 55054bd..7f819df 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -676,7 +676,8 @@ description." (cons (current-buffer) position)))) (defun org-contacts-org-complete-function () - "Function used in `completion-at-point-functions' in `org-mode' to complete @name." + "Function used in `completion-at-point-functions' in `org-mode' to complete @name. +Usage: (add-hook 'completion-at-point-functions 'org-contacts-org-complete-function nil 'local)" (when-let* ((end (point)) (begin (save-excursion (skip-chars-backward "[:alnum:]@") (point))) (symbol (buffer-substring-no-properties begin end)) @@ -711,32 +712,6 @@ description." ;; :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) From 39c7aba7dc5abb8f5475d1f8ef45a797906cc78b Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 15:08:38 +0800 Subject: [PATCH 5/6] Remove all-completions code logic --- org-contacts.el | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/org-contacts.el b/org-contacts.el index 7f819df..7a4faaf 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -681,20 +681,10 @@ Usage: (add-hook 'completion-at-point-functions 'org-contacts-org-complete-funct (when-let* ((end (point)) (begin (save-excursion (skip-chars-backward "[:alnum:]@") (point))) (symbol (buffer-substring-no-properties begin end)) - (org-contacts-prefix-p (string-prefix-p "@" symbol)) - ;; (prefix (substring-no-properties symbol 1 nil)) - ) + (org-contacts-prefix-p (string-prefix-p "@" symbol))) (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 From aaf9ce8bd011c9e87a3cf1dd667351623a67078d Mon Sep 17 00:00:00 2001 From: stardiviner Date: Thu, 18 Nov 2021 15:09:58 +0800 Subject: [PATCH 6/6] Add capf completion properties --- org-contacts.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/org-contacts.el b/org-contacts.el index 7a4faaf..2103923 100644 --- a/org-contacts.el +++ b/org-contacts.el @@ -691,10 +691,10 @@ Usage: (add-hook 'completion-at-point-functions 'org-contacts-org-complete-funct (lambda (contact) (concat "@" (plist-get contact :name))) (org-contacts--all-contacts)))) - ;; :predicate 'stringp - ;; :exclusive 'no + :predicate 'stringp + :exclusive 'no ;; properties check out `completion-extra-properties' - ;; :annotation-function #'org-contacts-org-complete--annotation-function + :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