org-roam/org-roam-completion.el
Jethro Kuan 7dd371c023
(fix?): use helm-make-source instead (#375)
Byte-compiled code should not contain macros.
2020-03-29 21:30:23 +08:00

119 lines
4.9 KiB
EmacsLisp

;;; org-roam-completion.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/jethrokuan/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 1.0.0-rc1
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite "1.0.0"))
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library provides completion for org-roam.
;;; Code:
;;;; Library Requires
(require 'cl-lib)
(require 's)
(defvar helm-pattern)
(declare-function helm "ext:helm")
(declare-function helm-make-source "ext:helm-source" (name class &rest args) t)
(defcustom org-roam-completion-system 'default
"The completion system to be used by `org-roam'."
:type '(radio
(const :tag "Default" default)
(const :tag "Ido" ido)
(const :tag "Ivy" ivy)
(const :tag "Helm" helm)
(function :tag "Custom function"))
:group 'org-roam)
(defcustom org-roam-completion-fuzzy-match nil
"Whether to fuzzy match Org-roam's completion candidates."
:type 'boolean
:group 'org-roam)
(defun org-roam-completion--helm-candidate-transformer (candidates _source)
"Transforms CANDIDATES for Helm-based completing read.
SOURCE is not used."
(let ((prefix (propertize "[?] "
'face 'helm-ff-prefix)))
(cons (propertize helm-pattern
'display (concat prefix helm-pattern))
candidates)))
(cl-defun org-roam-completion--completing-read (prompt choices &key
require-match initial-input
action)
"Present a PROMPT with CHOICES and optional INITIAL-INPUT.
If REQUIRE-MATCH is t, the user must select one of the CHOICES.
Return user choice."
(let (res)
(setq res
(cond
((eq org-roam-completion-system 'ido)
(let ((candidates (mapcar #'car choices)))
(ido-completing-read prompt candidates nil require-match initial-input)))
((eq org-roam-completion-system 'default)
(completing-read prompt choices nil require-match initial-input))
((eq org-roam-completion-system 'ivy)
(if (fboundp 'ivy-read)
(ivy-read prompt choices
:initial-input initial-input
:require-match require-match
:action (prog1 action
(setq action nil))
:caller 'org-roam--completing-read
:re-builder (if org-roam-completion-fuzzy-match 'ivy--regex-fuzzy
'regexp-quote))
(user-error "Please install ivy from \
https://github.com/abo-abo/swiper")))
((eq org-roam-completion-system 'helm)
(unless (and (fboundp 'helm)
(fboundp 'helm-make-source))
(user-error "Please install helm from \
https://github.com/emacs-helm/helm"))
(let ((source (helm-make-source prompt 'helm-source-sync
:candidates (mapcar #'car choices)
:filtered-candidate-transformer
(and (not require-match)
#'org-roam-completion--helm-candidate-transformer)
:fuzzy-match org-roam-completion-fuzzy-match))
(buf (concat "*org-roam "
(s-downcase (s-chop-suffix ":" (s-trim prompt)))
"*")))
(or (helm :sources source
:action (if action
(prog1 action
(setq action nil))
#'identity)
:prompt prompt
:input initial-input
:buffer buf)
(keyboard-quit))))))
(if action
(funcall action res)
res)))
(provide 'org-roam-completion)
;;; org-roam-completion.el ends here