prototype of org-contacts contact complete
This commit is contained in:
parent
f64d6edcd0
commit
c1d2b6dfbc
1 changed files with 96 additions and 0 deletions
|
@ -642,6 +642,102 @@ description."
|
||||||
(run-hook-with-args-until-success
|
(run-hook-with-args-until-success
|
||||||
'org-contacts-complete-functions string))))))))
|
'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 ()
|
(defun org-contacts-gnus-get-name-email ()
|
||||||
"Get name and email address from Gnus message."
|
"Get name and email address from Gnus message."
|
||||||
(if (gnus-alive-p)
|
(if (gnus-alive-p)
|
||||||
|
|
Loading…
Reference in a new issue