branch: externals/org-contacts
commit 8754afeb1410028d783bb111b36e364977d533b3
Author: stardiviner <numbch...@gmail.com>
Commit: stardiviner <numbch...@gmail.com>
refactor capf completion popup doc function
---
org-contacts.el | 71 ++++++++++++++++++++++++++++++++++++++-------------------
1 file changed, 47 insertions(+), 24 deletions(-)
diff --git a/org-contacts.el b/org-contacts.el
index 1ee8e0740b..dd99c4b39a 100644
--- a/org-contacts.el
+++ b/org-contacts.el
@@ -668,42 +668,67 @@ See (org) Matching tags and properties for a complete
description."
;; TODO
(ignore candidate))
-(defun org-contacts-org-complete--doc-function (candidate)
+(defun org-contacts--candidates-org-complete-get-doc (candidate)
"Return `org-contacts' content of contact CANDIDATE."
- (let* ((candidate (substring-no-properties candidate 1 nil))
- (contact (seq-find
- (lambda (contact) (string-equal (plist-get contact :name)
candidate))
+ (let* ((contact (seq-find
+ (lambda (contact) (string-equal (plist-get contact :name)
(get-text-property 0 'contact-name candidate)))
(org-contacts-all-contacts)))
(name (plist-get contact :name))
(file (plist-get contact :file))
(position (plist-get contact :position))
- (doc-buffer (get-buffer-create " *org-contact*"))
(org-contact-buffer (get-buffer (find-file-noselect file)))
;; get org-contact headline and property drawer.
- (contents (with-current-buffer org-contact-buffer
- (when (derived-mode-p 'org-mode)
- (save-excursion
- (goto-char position)
- (cond ((ignore-errors (org-edit-src-code))
- (delete-other-windows))
- ((org-at-block-p)
- (org-narrow-to-block))
- (t (org-narrow-to-subtree)))
- (let ((content (buffer-substring (point-min)
(point-max))))
- (when (buffer-narrowed-p) (widen))
- content))))))
- (ignore name)
+ (contact-content (with-current-buffer org-contact-buffer
+ (when (derived-mode-p 'org-mode)
+ (save-excursion
+ (goto-char position)
+ (cond
+ ((org-at-block-p)
+ (org-narrow-to-block))
+ (t (org-narrow-to-subtree)))
+ (let ((content (buffer-substring (point-min)
(point-max))))
+ (when (buffer-narrowed-p) (widen))
+ content))))))
+ contact-content))
+
+;; TEST:
+;; (setq org-contacts--candidates-complete-doc-cache nil)
+;; (org-contacts--candidates-complete-doc-cache-setting)
+
+(defvar org-contacts--candidates-complete-doc-cache nil
+ "A list of contact candidates completion doc cache.")
+
+(defun org-contacts--candidates-complete-doc-cache-setting ()
+ "Generate cache for contact candidates completion doc."
+ (if (null org-contacts--candidates-complete-doc-cache)
+ (let* ((candidates (org-contacts--candidates-cache-setting))
+ (candidates-complete-doc-list (mapcar
+ (lambda (candidate)
+ (cons candidate
(org-contacts--candidates-org-complete-get-doc candidate)))
+ candidates)))
+ (setq org-contacts--candidates-complete-doc-cache
candidates-complete-doc-list))
+ org-contacts--candidates-complete-doc-cache))
+
+(defun org-contacts-org-complete--doc-function (candidate)
+ "Populates *org-contact* with the documentation for the content of contact
CANDIDATE."
+ (let ((doc (alist-get candidate
(org-contacts--candidates-complete-doc-cache-setting)))
+ (doc-buffer (get-buffer-create " *org-contact*")))
(with-current-buffer doc-buffer
(read-only-mode 1)
(let ((inhibit-read-only t))
(erase-buffer)
- (insert contents)
+ (insert doc)
(org-mode)
(org-fold-show-all)
- (font-lock-ensure)))
- doc-buffer))
+ (font-lock-ensure))
+ (current-buffer))))
+
+;; TEST:
+;; (org-contacts-org-complete--doc-function (car
org-contacts--candidates-cache-list))
+;; (benchmark 1 '(alist-get (car org-contacts--candidates-cache-list)
(org-contacts--candidates-complete-doc-cache-setting)))
+;; (benchmark 1 '(org-contacts-org-complete--doc-function (nth 10
org-contacts--candidates-cache-list)))
-;;; display company-mode doc buffer bellow current window.
+;; display company-mode doc buffer bellow current window.
(add-to-list 'display-buffer-alist '("^ \\*org-contact\\*" .
(display-buffer-below-selected)))
(defun org-contacts-org-complete--location-function (candidate)
@@ -737,13 +762,11 @@ Usage: (add-hook \\='completion-at-point-functions
(mapcar
(lambda (contact) (concat "@" (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))))
