geiser-capf.el (3582B)
1 ;;; geiser-capf.el -- Setup for Geiser's CAPFs -*- lexical-binding: t; -*- 2 3 ;; Copyright (c) 2022 Jose Antonio Ortega Ruiz 4 5 ;; This program is free software; you can redistribute it and/or 6 ;; modify it under the terms of the Modified BSD License. You should 7 ;; have received a copy of the license along with this program. If 8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. 9 10 ;; Start date: Sat Apr 23, 2022 18:39 11 12 13 14 (require 'geiser-autodoc) 15 (require 'geiser-impl) 16 (require 'geiser-eval) 17 (require 'geiser-doc) 18 (require 'geiser-completion) 19 (require 'geiser-edit) 20 21 (defun geiser-capf--company-docsig (id) 22 (condition-case err 23 (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) 24 (let* ((id (substring-no-properties id)) 25 (help (geiser-autodoc--autodoc `((,id 0)) nil))) 26 (and help (substring-no-properties help)))) 27 (error (geiser-log--warn "Error computing docsig: %s" err)))) 28 29 (defun geiser-capf--company-doc-buffer (id) 30 (when geiser-impl--implementation 31 (let* ((module (geiser-eval--get-module)) 32 (symbol (make-symbol id)) 33 (ds (geiser-doc--get-docstring symbol module))) 34 (when (consp ds) 35 (with-current-buffer (get-buffer-create "*company-documentation*") 36 (geiser-doc--render-docstring ds symbol module) 37 (current-buffer)))))) 38 39 (defun geiser-capf--company-location (id) 40 (condition-case _err 41 (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) 42 (let ((id (make-symbol id))) 43 (condition-case nil 44 (geiser-edit-module id 'noselect) 45 (error (geiser-edit-symbol id 'noselect))))) 46 (error (message "Location not found for %s" id)))) 47 48 (defun geiser-capf--thing-at-point (module &optional _predicate) 49 (with-syntax-table scheme-mode-syntax-table 50 (let* ((beg (geiser-completion--symbol-begin module)) 51 (end (or (geiser-completion--prefix-end beg module) beg)) 52 (prefix (and (> end beg) (buffer-substring-no-properties beg end))) 53 (prefix (and prefix 54 (if (string-match "\\([^-]+\\)-" prefix) 55 (match-string 1 prefix) 56 prefix))) 57 (cmps (and prefix (geiser-completion--complete prefix module)))) 58 (when cmps 59 (list beg end cmps 60 :company-docsig 61 (and geiser-autodoc-use-docsig #'geiser-capf--company-docsig) 62 :company-doc-buffer #'geiser-capf--company-doc-buffer 63 :company-location #'geiser-capf--company-location))))) 64 65 (defun geiser-capf--for-symbol (&optional predicate) 66 (geiser-capf--thing-at-point nil predicate)) 67 68 (defun geiser-capf--for-module (&optional predicate) 69 (geiser-capf--thing-at-point t predicate)) 70 71 (defun geiser-capf--for-filename () 72 (when (geiser-syntax--in-string-p) 73 (let ((comint-completion-addsuffix "\"")) 74 (ignore-errors (comint-filename-completion))))) 75 76 (defconst geiser-capf--capfs 77 '(geiser-capf--for-filename geiser-capf--for-module geiser-capf--for-symbol)) 78 79 (defun geiser-capf-setup (enable) 80 (if enable 81 (dolist (f geiser-capf--capfs) 82 (add-hook 'completion-at-point-functions f nil t)) 83 (dolist (f geiser-capf--capfs) 84 (remove-hook 'completion-at-point-functions f t)))) 85 86 (defun geiser-capf-complete-module () 87 "Complete module name at point." 88 (interactive) 89 (let ((completion-at-point-functions '(geiser-capf--for-module))) 90 (call-interactively 'completion-at-point))) 91 92 93 94 (provide 'geiser-capf) 95 ;;; geiser-capf.el ends here