;;; cape.el --- Completion At Point Extensions -*- lexical-binding: t -*- ;; Author: Daniel Mendler ;; Created: 2021 ;; License: GPL-3.0-or-later ;; Version: 0.3 ;; Package-Requires: ((emacs "27.1")) ;; Homepage: https://github.com/minad/cape ;; 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 of the License, 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 this program. If not, see . ;;; Commentary: ;; Let your completions fly! This package provides additional completion ;; backends in the form of capfs. ;;; Code: (eval-when-compile (require 'cl-lib)) ;;;; Customization (defgroup cape nil "Completion At Point Extensions." :group 'convenience :prefix "cape-") (defcustom cape-dict-file "/etc/dictionaries-common/words" "Dictionary word list file." :type 'string) (defcustom cape-async-timeout 5.0 "Asynchronous timeout." :type '(choice nil float)) (defcustom cape-dabbrev-min-length 4 "Minimum length of dabbrev expansions." :type 'integer) (defcustom cape-dabbrev-check-other-buffers t "Buffers to check for dabbrev." :type 'boolean) (defcustom cape-file-directory-must-exist t "The parent directory must exist for file completion." :type 'integer) (defcustom cape-keywords ;; This variable was taken from company-keywords.el. ;; Please contribute corrections or additions to both Cape and Company. '((c++-mode ;; https://en.cppreference.com/w/cpp/keyword "alignas" "alignof" "and" "and_eq" "asm" "atomic_cancel" "atomic_commit" "atomic_noexcept" "auto" "bitand" "bitor" "bool" "break" "case" "catch" "char" "char16_t" "char32_t" "char8_t" "class" "co_await" "co_return" "co_yield" "compl" "concept" "const" "const_cast" "consteval" "constexpr" "constinit" "continue" "decltype" "default" "delete" "do" "double" "dynamic_cast" "else" "enum" "explicit" "export" "extern" "false" "final" "float" "for" "friend" "goto" "if" "import" "inline" "int" "long" "module" "mutable" "namespace" "new" "noexcept" "not" "not_eq" "nullptr" "operator" "or" "or_eq" "override" "private" "protected" "public" "reflexpr" "register" "reinterpret_cast" "requires" "return" "short" "signed" "sizeof" "static" "static_assert" "static_cast" "struct" "switch" "synchronized" "template" "this" "thread_local" "throw" "true" "try" "typedef" "typeid" "typename" "union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while" "xor" "xor_eq") (c-mode ;; https://en.cppreference.com/w/c/keyword "_Alignas" "_Alignof" "_Atomic" "_Bool" "_Complex" "_Generic" "_Imaginary" "_Noreturn" "_Static_assert" "_Thread_local" "auto" "break" "case" "char" "const" "continue" "default" "do" "double" "else" "enum" "extern" "float" "for" "goto" "if" "inline" "int" "long" "register" "restrict" "return" "short" "signed" "sizeof" "static" "struct" "switch" "typedef" "union" "unsigned" "void" "volatile" "while") (csharp-mode "abstract" "add" "alias" "as" "base" "bool" "break" "byte" "case" "catch" "char" "checked" "class" "const" "continue" "decimal" "default" "delegate" "do" "double" "else" "enum" "event" "explicit" "extern" "false" "finally" "fixed" "float" "for" "foreach" "get" "global" "goto" "if" "implicit" "in" "int" "interface" "internal" "is" "lock" "long" "namespace" "new" "null" "object" "operator" "out" "override" "params" "partial" "private" "protected" "public" "readonly" "ref" "remove" "return" "sbyte" "sealed" "set" "short" "sizeof" "stackalloc" "static" "string" "struct" "switch" "this" "throw" "true" "try" "typeof" "uint" "ulong" "unchecked" "unsafe" "ushort" "using" "value" "var" "virtual" "void" "volatile" "where" "while" "yield") (d-mode ;; http://www.digitalmars.com/d/2.0/lex.html "abstract" "alias" "align" "asm" "assert" "auto" "body" "bool" "break" "byte" "case" "cast" "catch" "cdouble" "cent" "cfloat" "char" "class" "const" "continue" "creal" "dchar" "debug" "default" "delegate" "delete" "deprecated" "do" "double" "else" "enum" "export" "extern" "false" "final" "finally" "float" "for" "foreach" "foreach_reverse" "function" "goto" "idouble" "if" "ifloat" "import" "in" "inout" "int" "interface" "invariant" "ireal" "is" "lazy" "long" "macro" "mixin" "module" "new" "nothrow" "null" "out" "override" "package" "pragma" "private" "protected" "public" "pure" "real" "ref" "return" "scope" "short" "static" "struct" "super" "switch" "synchronized" "template" "this" "throw" "true" "try" "typedef" "typeid" "typeof" "ubyte" "ucent" "uint" "ulong" "union" "unittest" "ushort" "version" "void" "volatile" "wchar" "while" "with") (f90-mode ;; f90.el "abs" "abstract" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "align" "all" "all_prefix" "all_scatter" "all_suffix" "allocatable" "allocate" "allocated" "and" "anint" "any" "any_prefix" "any_scatter" "any_suffix" "asin" "assign" "assignment" "associate" "associated" "asynchronous" "atan" "atan2" "backspace" "bind" "bit_size" "block" "btest" "c_alert" "c_associated" "c_backspace" "c_bool" "c_carriage_return" "c_char" "c_double" "c_double_complex" "c_f_pointer" "c_f_procpointer" "c_float" "c_float_complex" "c_form_feed" "c_funloc" "c_funptr" "c_horizontal_tab" "c_int" "c_int16_t" "c_int32_t" "c_int64_t" "c_int8_t" "c_int_fast16_t" "c_int_fast32_t" "c_int_fast64_t" "c_int_fast8_t" "c_int_least16_t" "c_int_least32_t" "c_int_least64_t" "c_int_least8_t" "c_intmax_t" "c_intptr_t" "c_loc" "c_long" "c_long_double" "c_long_double_complex" "c_long_long" "c_new_line" "c_null_char" "c_null_funptr" "c_null_ptr" "c_ptr" "c_short" "c_signed_char" "c_size_t" "c_vertical_tab" "call" "case" "ceiling" "char" "character" "character_storage_size" "class" "close" "cmplx" "command_argument_count" "common" "complex" "conjg" "contains" "continue" "copy_prefix" "copy_scatter" "copy_suffix" "cos" "cosh" "count" "count_prefix" "count_scatter" "count_suffix" "cpu_time" "cshift" "cycle" "cyclic" "data" "date_and_time" "dble" "deallocate" "deferred" "digits" "dim" "dimension" "distribute" "do" "dot_product" "double" "dprod" "dynamic" "elemental" "else" "elseif" "elsewhere" "end" "enddo" "endfile" "endif" "entry" "enum" "enumerator" "eoshift" "epsilon" "eq" "equivalence" "eqv" "error_unit" "exit" "exp" "exponent" "extends" "extends_type_of" "external" "extrinsic" "false" "file_storage_size" "final" "floor" "flush" "forall" "format" "fraction" "function" "ge" "generic" "get_command" "get_command_argument" "get_environment_variable" "goto" "grade_down" "grade_up" "gt" "hpf_alignment" "hpf_distribution" "hpf_template" "huge" "iachar" "iall" "iall_prefix" "iall_scatter" "iall_suffix" "iand" "iany" "iany_prefix" "iany_scatter" "iany_suffix" "ibclr" "ibits" "ibset" "ichar" "ieee_arithmetic" "ieee_exceptions" "ieee_features" "ieee_get_underflow_mode" "ieee_set_underflow_mode" "ieee_support_underflow_control" "ieor" "if" "ilen" "implicit" "import" "include" "independent" "index" "inherit" "input_unit" "inquire" "int" "integer" "intent" "interface" "intrinsic" "ior" "iostat_end" "iostat_eor" "iparity" "iparity_prefix" "iparity_scatter" "iparity_suffix" "ishft" "ishftc" "iso_c_binding" "iso_fortran_env" "kind" "lbound" "le" "leadz" "len" "len_trim" "lge" "lgt" "lle" "llt" "log" "log10" "logical" "lt" "matmul" "max" "maxexponent" "maxloc" "maxval" "maxval_prefix" "maxval_scatter" "maxval_suffix" "merge" "min" "minexponent" "minloc" "minval" "minval_prefix" "minval_scatter" "minval_suffix" "mod" "module" "modulo" "move_alloc" "mvbits" "namelist" "ne" "nearest" "neqv" "new" "new_line" "nint" "non_intrinsic" "non_overridable" "none" "nopass" "not" "null" "nullify" "number_of_processors" "numeric_storage_size" "only" "onto" "open" "operator" "optional" "or" "output_unit" "pack" "parameter" "parity" "parity_prefix" "parity_scatter" "parity_suffix" "pass" "pause" "pointer" "popcnt" "poppar" "precision" "present" "print" "private" "procedure" "processors" "processors_shape" "product" "product_prefix" "product_scatter" "product_suffix" "program" "protected" "public" "pure" "radix" "random_number" "random_seed" "range" "read" "real" "realign" "recursive" "redistribute" "repeat" "reshape" "result" "return" "rewind" "rrspacing" "same_type_as" "save" "scale" "scan" "select" "selected_char_kind" "selected_int_kind" "selected_real_kind" "sequence" "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt" "stop" "subroutine" "sum" "sum_prefix" "sum_scatter" "sum_suffix" "system_clock" "tan" "tanh" "target" "template" "then" "tiny" "transfer" "transpose" "trim" "true" "type" "ubound" "unpack" "use" "value" "verify" "volatile" "wait" "where" "while" "with" "write") (go-mode ;; https://golang.org/ref/spec#Keywords, https://golang.org/pkg/builtin/ "append" "bool" "break" "byte" "cap" "case" "chan" "close" "complex" "complex128" "complex64" "const" "continue" "copy" "default" "defer" "delete" "else" "error" "fallthrough" "false" "float32" "float64" "for" "func" "go" "goto" "if" "imag" "import" "int" "int16" "int32" "int64" "int8" "interface" "len" "make" "map" "new" "nil" "package" "panic" "print" "println" "range" "real" "recover" "return" "rune" "select" "string" "struct" "switch" "true" "type" "uint" "uint16" "uint32" "uint64" "uint8" "uintptr" "var") (java-mode "abstract" "assert" "boolean" "break" "byte" "case" "catch" "char" "class" "continue" "default" "do" "double" "else" "enum" "extends" "final" "finally" "float" "for" "if" "implements" "import" "instanceof" "int" "interface" "long" "native" "new" "package" "private" "protected" "public" "return" "short" "static" "strictfp" "super" "switch" "synchronized" "this" "throw" "throws" "transient" "try" "void" "volatile" "while") (javascript-mode ;; https://tc39.github.io/ecma262/ "async" "await" "break" "case" "catch" "class" "const" "continue" "debugger" "default" "delete" "do" "else" "enum" "export" "extends" "false" "finally" "for" "function" "if" "import" "in" "instanceof" "let" "new" "null" "return" "static" "super" "switch" "this" "throw" "true" "try" "typeof" "undefined" "var" "void" "while" "with" "yield") (kotlin-mode "abstract" "annotation" "as" "break" "by" "catch" "class" "companion" "const" "constructor" "continue" "data" "do" "else" "enum" "false" "final" "finally" "for" "fun" "if" "import" "in" "init" "inner" "interface" "internal" "is" "lateinit" "nested" "null" "object" "open" "out" "override" "package" "private" "protected" "public" "return" "super" "this" "throw" "trait" "true" "try" "typealias" "val" "var" "when" "while") (lua-mode ;; https://www.lua.org/manual/5.3/manual.html "and" "break" "do" "else" "elseif" "end" "false" "for" "function" "goto" "if" "in" "local" "nil" "not" "or" "repeat" "return" "then" "true" "until" "while") (objc-mode "@catch" "@class" "@encode" "@end" "@finally" "@implementation" "@interface" "@private" "@protected" "@protocol" "@public" "@selector" "@synchronized" "@throw" "@try" "alloc" "autorelease" "bycopy" "byref" "in" "inout" "oneway" "out" "release" "retain") (perl-mode ;; cperl.el "AUTOLOAD" "BEGIN" "CHECK" "CORE" "DESTROY" "END" "INIT" "__END__" "__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2" "bind" "binmode" "bless" "caller" "chdir" "chmod" "chomp" "chop" "chown" "chr" "chroot" "close" "closedir" "cmp" "connect" "continue" "cos" "crypt" "dbmclose" "dbmopen" "defined" "delete" "die" "do" "dump" "each" "else" "elsif" "endgrent" "endhostent" "endnetent" "endprotoent" "endpwent" "endservent" "eof" "eq" "eval" "exec" "exists" "exit" "exp" "fcntl" "fileno" "flock" "for" "foreach" "fork" "format" "formline" "ge" "getc" "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" "gethostbyname" "gethostent" "getlogin" "getnetbyaddr" "getnetbyname" "getnetent" "getpeername" "getpgrp" "getppid" "getpriority" "getprotobyname" "getprotobynumber" "getprotoent" "getpwent" "getpwnam" "getpwuid" "getservbyname" "getservbyport" "getservent" "getsockname" "getsockopt" "glob" "gmtime" "goto" "grep" "gt" "hex" "if" "index" "int" "ioctl" "join" "keys" "kill" "last" "lc" "lcfirst" "le" "length" "link" "listen" "local" "localtime" "lock" "log" "lstat" "lt" "map" "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "my" "ne" "next" "no" "not" "oct" "open" "opendir" "or" "ord" "our" "pack" "package" "pipe" "pop" "pos" "print" "printf" "push" "q" "qq" "quotemeta" "qw" "qx" "rand" "read" "readdir" "readline" "readlink" "readpipe" "recv" "redo" "ref" "rename" "require" "reset" "return" "reverse" "rewinddir" "rindex" "rmdir" "scalar" "seek" "seekdir" "select" "semctl" "semget" "semop" "send" "setgrent" "sethostent" "setnetent" "setpgrp" "setpriority" "setprotoent" "setpwent" "setservent" "setsockopt" "shift" "shmctl" "shmget" "shmread" "shmwrite" "shutdown" "sin" "sleep" "socket" "socketpair" "sort" "splice" "split" "sprintf" "sqrt" "srand" "stat" "study" "sub" "substr" "symlink" "syscall" "sysopen" "sysread" "system" "syswrite" "tell" "telldir" "tie" "time" "times" "tr" "truncate" "uc" "ucfirst" "umask" "undef" "unless" "unlink" "unpack" "unshift" "untie" "until" "use" "utime" "values" "vec" "wait" "waitpid" "wantarray" "warn" "while" "write" "x" "xor" "y") (php-mode "__CLASS__" "__DIR__" "__FILE__" "__FUNCTION__" "__LINE__" "__METHOD__" "__NAMESPACE__" "_once" "abstract" "and" "array" "as" "break" "case" "catch" "cfunction" "class" "clone" "const" "continue" "declare" "default" "die" "do" "echo" "else" "elseif" "empty" "enddeclare" "endfor" "endforeach" "endif" "endswitch" "endwhile" "eval" "exception" "exit" "extends" "final" "for" "foreach" "function" "global" "goto" "if" "implements" "include" "instanceof" "interface" "isset" "list" "namespace" "new" "old_function" "or" "php_user_filter" "print" "private" "protected" "public" "require" "require_once" "return" "static" "switch" "this" "throw" "try" "unset" "use" "var" "while" "xor") (python-mode ;; https://docs.python.org/3/reference/lexical_analysis.html#keywords "False" "None" "True" "and" "as" "assert" "break" "class" "continue" "def" "del" "elif" "else" "except" "exec" "finally" "for" "from" "global" "if" "import" "in" "is" "lambda" "nonlocal" "not" "or" "pass" "print" "raise" "return" "try" "while" "with" "yield") (ruby-mode "BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?" "do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module" "next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super" "then" "true" "undef" "unless" "until" "when" "while" "yield") (rust-mode ;; https://doc.rust-lang.org/grammar.html#keywords "Self" "as" "box" "break" "const" "continue" "crate" "else" "enum" "extern" "false" "fn" "for" "if" "impl" "in" "let" "loop" "macro" "match" "mod" "move" "mut" "pub" "ref" "return" "self" "static" "struct" "super" "trait" "true" "type" "unsafe" "use" "where" "while") (scala-mode "abstract" "case" "catch" "class" "def" "do" "else" "extends" "false" "final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match" "new" "null" "object" "override" "package" "private" "protected" "return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val" "var" "while" "with" "yield") (swift-mode "Protocol" "Self" "Type" "and" "as" "assignment" "associatedtype" "associativity" "available" "break" "case" "catch" "class" "column" "continue" "convenience" "default" "defer" "deinit" "didSet" "do" "dynamic" "dynamicType" "else" "elseif" "endif" "enum" "extension" "fallthrough" "false" "file" "fileprivate" "final" "for" "func" "function" "get" "guard" "higherThan" "if" "import" "in" "indirect" "infix" "init" "inout" "internal" "is" "lazy" "left" "let" "line" "lowerThan" "mutating" "nil" "none" "nonmutating" "open" "operator" "optional" "override" "postfix" "precedence" "precedencegroup" "prefix" "private" "protocol" "public" "repeat" "required" "rethrows" "return" "right" "selector" "self" "set" "static" "struct" "subscript" "super" "switch" "throw" "throws" "true" "try" "typealias" "unowned" "var" "weak" "where" "while" "willSet") (julia-mode "abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif" "end" "eval" "export" "false" "finally" "for" "function" "global" "if" "ifelse" "immutable" "import" "importall" "in" "let" "macro" "module" "otherwise" "quote" "return" "switch" "throw" "true" "try" "type" "typealias" "using" "while") (thrift-mode ;; https://github.com/apache/thrift/blob/master/contrib/thrift.el "binary" "bool" "byte" "const" "double" "enum" "exception" "extends" "i16" "i32" "i64" "include" "list" "map" "oneway" "optional" "required" "service" "set" "string" "struct" "throws" "typedef" "void") ;; Aliases (js2-mode javascript-mode) (js2-jsx-mode javascript-mode) (espresso-mode javascript-mode) (js-mode javascript-mode) (js-jsx-mode javascript-mode) (rjsx-mode javascript-mode) (cperl-mode perl-mode) (jde-mode java-mode) (ess-julia-mode julia-mode) (enh-ruby-mode ruby-mode)) "Alist of major modes and keywords." :type 'alist) ;;;; Helpers (defmacro cape--silent (&rest body) "Silence BODY." (declare (indent 0)) `(cl-letf ((inhibit-message t) (message-log-max nil) ((symbol-function #'minibuffer-message) #'ignore)) (ignore-errors ,@body))) (defun cape--bounds (thing) "Return bounds of THING." (or (bounds-of-thing-at-point thing) (cons (point) (point)))) (defun cape--interactive (capf) "Complete with CAPF." (pcase (funcall capf) (`(,beg ,end ,table . ,extra) (let ((completion-extra-properties extra)) (completion-in-region beg end table (plist-get extra :predicate)))) (_ (user-error "%s: No completions" capf)))) (defun cape--noninterruptible-table (table) "Create non-interruptible completion TABLE." (lambda (str pred action) (let (throw-on-input) (complete-with-action action table str pred)))) (defun cape--silent-table (table) "Create a new completion TABLE which is silent (no messages, no errors)." (lambda (str pred action) (cape--silent (complete-with-action action table str pred)))) (cl-defun cape--table-with-properties (table &key category (sort t) &allow-other-keys) "Create completion TABLE with properties. CATEGORY is the optional completion category. SORT should be nil to disable sorting." (if (or (not table) (and (not category) sort)) table (let ((metadata `(metadata ,@(and category `((category . ,category))) ,@(and (not sort) '((display-sort-function . identity) (cycle-sort-function . identity)))))) (lambda (str pred action) (if (eq action 'metadata) metadata (complete-with-action action table str pred)))))) (cl-defun cape--async-table-with-properties (table &key category (sort t) &allow-other-keys) "Create asynchronous completion TABLE with properties. CATEGORY is the optional completion category. SORT should be nil to disable sorting." (if (or (not table) (and (not category) sort)) table (let ((metadata `(metadata ,@(and category `((category . ,category))) ,@(and (not sort) '((display-sort-function . identity) (cycle-sort-function . identity)))))) (lambda (action filter) (if (eq action 'metadata) metadata (cape--async-complete-with-action table action filter)))))) (defun cape--async-table-case-fold (table &optional dont-fold) (lambda (action filter) (cape--async-complete-with-action table action `(:ignore-case ,(not dont-fold) ,@filter)))) (defun cape--input-valid-p (old-input new-input cmp) "Return non-nil if the NEW-INPUT is valid in comparison to OLD-INPUT. The CMP argument determines how the new input is compared to the old input. - never: Never treat the input as valid. - prefix/nil: The old input is a prefix of the new input. - equal: The old input is equal to the new input. - substring: The old input is a substring of the new input." ;; Treat input as not changed if it contains space to allow ;; Orderless completion style filtering. (or (string-match-p "\\s-" new-input) (pcase-exhaustive cmp ('never nil) ((or 'prefix 'nil) (string-prefix-p old-input new-input)) ('equal (equal old-input new-input)) ('substring (string-match-p (regexp-quote old-input) new-input))))) (defun cape--cached-table (beg end fun valid) "Create caching completion table. BEG and END are the input bounds. FUN is the function which computes the candidates. VALID is the input comparator, see `cape--input-valid-p'." (let ((input 'init) (beg (copy-marker beg)) (end (copy-marker end t)) (table nil)) (lambda (str pred action) (let ((new-input (buffer-substring-no-properties beg end))) (when (or (eq input 'init) (not (cape--input-valid-p input new-input valid))) (setq table (funcall fun new-input) input new-input))) (complete-with-action action table str pred)))) (defun cape--async-cached-table (beg end fun valid) "Create caching asynchronous completion table. BEG and END are the input bounds. FUN is the function which computes the candidates. VALID is the input comparator, see `cape--input-valid-p'." (let ((input 'init) (beg (copy-marker beg)) (end (copy-marker end t)) (table nil)) (lambda (action filter) (let ((new-input (buffer-substring-no-properties beg end))) (when (or (eq input 'init) (not (cape--input-valid-p input new-input valid))) (setq table (funcall fun new-input) input new-input))) (cape--async-map (lambda (tab) (setq table tab) (cape--async-complete-with-action table action filter)) table)))) (defun cape--async-complete-with-action (table action filter) (cond ((functionp table) (funcall table action filter)) ((eq action 'metadata) nil) ((eq (car-safe action) 'boundaries) nil) (t (let ((completion-ignore-case (plist-get filter :ignore-case)) (completion-regexp-list (plist-get filter :regexp-list))) (funcall action (plist-get filter :prefix) table (plist-gt filter :predicate)))))) ;;;; Capfs ;;;;; cape-file (defvar cape--file-properties (list :annotation-function (lambda (s) (if (string-suffix-p "/" s) " Folder" " File")) :company-kind (lambda (s) (if (string-suffix-p "/" s) 'folder 'file))) "Completion extra properties for `cape-file'.") ;;;###autoload (defun cape-file (&optional interactive) "Complete file name at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (let (cape-file-directory-must-exist) (cape--interactive #'cape-file)) (let* ((bounds (cape--bounds 'filename)) (file (buffer-substring (car bounds) (cdr bounds)))) (when (or (not cape-file-directory-must-exist) (and (string-match-p "/" file) (file-exists-p (file-name-directory file)))) `(,(car bounds) ,(cdr bounds) ,#'read-file-name-internal :company-prefix-length ,(and (not (equal file "/")) (string-suffix-p "/" file)) :exclusive no ,@cape--file-properties))))) ;;;;; cape-symbol (defvar cape--symbol-properties (list :annotation-function #'cape--symbol-annotation :company-kind #'cape--symbol-kind) "Completion extra properties for `cape-symbol'.") (defun cape--symbol-kind (sym) "Return kind of SYM." (setq sym (intern-soft sym)) (cond ((or (macrop sym) (special-form-p sym)) 'keyword) ((fboundp sym) 'function) ((boundp sym) 'variable) ((featurep sym) 'module) ((facep sym) 'color) (t 'text))) (defun cape--symbol-annotation (sym) "Return kind of SYM." (setq sym (intern-soft sym)) (cond ((or (macrop sym) (special-form-p sym)) " Macro") ((fboundp sym) " Function") ((boundp sym) " Variable") ((featurep sym) " Feature") ((facep sym) " Face") (t " Symbol"))) ;;;###autoload (defun cape-symbol (&optional interactive) "Complete symbol at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-symbol) (let ((bounds (cape--bounds 'symbol))) `(,(car bounds) ,(cdr bounds) ,(cape--table-with-properties obarray :category 'symbol) :exclusive no ,@cape--symbol-properties)))) ;;;;; cape-dabbrev (defvar cape--dabbrev-properties (list :annotation-function (lambda (_) " Dabbrev") :company-kind (lambda (_) 'text)) "Completion extra properties for `cape-dabbrev'.") (defvar dabbrev-check-all-buffers) (defvar dabbrev-check-other-buffers) (declare-function dabbrev--ignore-case-p "dabbrev") (declare-function dabbrev--find-all-expansions "dabbrev") (declare-function dabbrev--reset-global-variables "dabbrev") (declare-function dabbrev--abbrev-at-point "dabbrev") ;;;###autoload (defun cape-dabbrev (&optional interactive) "Complete with Dabbrev at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (let ((cape-dabbrev-min-length 0)) (cape--interactive #'cape-dabbrev)) (require 'dabbrev) (cape--dabbrev-reset) (let ((abbrev (ignore-errors (dabbrev--abbrev-at-point))) beg end) (when (and abbrev (not (string-match-p "\\s-" abbrev))) (save-excursion (search-backward abbrev) (setq beg (point)) (search-forward abbrev) (setq end (point))) `(,beg ,end ,(cape--table-with-properties ;; Use equal, if candidates must be longer than cape-dabbrev-min-length. (cape--cached-table beg end #'cape--dabbrev-list (if (> cape-dabbrev-min-length 0) 'equal 'prefix)) :category 'cape-dabbrev) :exclusive no ,@cape--dabbrev-properties))))) (defun cape--dabbrev-reset () "Reset dabbrev state." (let ((dabbrev-check-all-buffers cape-dabbrev-check-other-buffers) (dabbrev-check-other-buffers cape-dabbrev-check-other-buffers)) (dabbrev--reset-global-variables))) (defun cape--dabbrev-list (word) "Find all dabbrev expansions for WORD." (cape--silent (cape--dabbrev-reset) (cl-loop with min-len = (+ cape-dabbrev-min-length (length word)) for w in (dabbrev--find-all-expansions word (dabbrev--ignore-case-p word)) if (>= (length w) min-len) collect w))) ;;;;; cape-ispell (defvar cape--ispell-properties (list :annotation-function (lambda (_) " Ispell") :company-kind (lambda (_) 'text)) "Completion extra properties for `cape-ispell'.") (declare-function ispell-lookup-words "ispell") (defun cape--ispell-words (str) "Return all words from Ispell matching STR." (with-demoted-errors "Ispell Error: %S" (require 'ispell) (cape--silent (ispell-lookup-words (format "*%s*" str))))) ;;;###autoload (defun cape-ispell (&optional interactive) "Complete with Ispell at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-ispell) (let ((bounds (cape--bounds 'word))) `(,(car bounds) ,(cdr bounds) ,(cape--table-with-properties (cape--cached-table (car bounds) (cdr bounds) #'cape--ispell-words 'substring) :category 'cape-ispell) :exclusive no ,@cape--ispell-properties)))) ;;;;; cape-dict (defvar cape--dict-properties (list :annotation-function (lambda (_) " Dict") :company-kind (lambda (_) 'text)) "Completion extra properties for `cape-dict'.") (defvar cape--dict-words nil) (defun cape--dict-words () "Dictionary words." (or cape--dict-words (setq cape--dict-words (split-string (with-temp-buffer (insert-file-contents-literally cape-dict-file) (buffer-string)) "\n" 'omit-nulls)))) ;;;###autoload (defun cape-dict (&optional interactive) "Complete word at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-dict) (let ((bounds (cape--bounds 'word))) `(,(car bounds) ,(cdr bounds) ,(cape--table-with-properties (cape--dict-words) :category 'cape-dict) :exclusive no ,@cape--dict-properties)))) ;;;;; cape-abbrev (defun cape--abbrev-list () "Abbreviation list." (delete "" (nconc (all-completions "" global-abbrev-table) (all-completions "" local-abbrev-table)))) (defun cape--abbrev-annotation (abbrev) "Annotate ABBREV with expansion." (concat " " (truncate-string-to-width (symbol-value (or (abbrev--symbol abbrev local-abbrev-table) (abbrev--symbol abbrev global-abbrev-table))) 30 0 nil t))) (defvar cape--abbrev-properties (list :annotation-function #'cape--abbrev-annotation :exit-function (lambda (&rest _) (expand-abbrev)) :company-kind (lambda (_) 'snippet)) "Completion extra properties for `cape-abbrev'.") ;;;###autoload (defun cape-abbrev (&optional interactive) "Complete abbreviation at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-abbrev) (when-let (abbrevs (cape--abbrev-list)) (let ((bounds (cape--bounds 'symbol))) `(,(car bounds) ,(cdr bounds) ,(cape--table-with-properties abbrevs :category 'cape-abbrev) :exclusive no ,@cape--abbrev-properties))))) ;;;;; cape-keyword (defun cape--keyword-list () "Return keywords for current major mode." (when-let (kw (alist-get major-mode cape-keywords)) (if (symbolp (cadr kw)) (alist-get (cadr kw) cape-keywords) kw))) (defvar cape--keyword-properties (list :annotation-function (lambda (_) " Keyword") :company-kind (lambda (_) 'keyword)) "Completion extra properties for `cape-keyword'.") ;;;###autoload (defun cape-keyword (&optional interactive) "Complete word at point. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-keyword) (when-let (keywords (cape--keyword-list)) (let ((bounds (cape--bounds 'symbol))) `(,(car bounds) ,(cdr bounds) ,(cape--table-with-properties keywords :category 'cape-keyword) :exclusive no ,@cape--keyword-properties))))) ;;;;; cape-line (defvar cape--line-properties nil "Completion extra properties for `cape-line'.") (defun cape--line-list () "Return all lines from buffer." (let ((beg (point-min)) (max (point-max)) (pt (point)) (ht (make-hash-table :test #'equal)) end lines) (save-excursion (while (< beg max) (goto-char beg) (setq end (line-end-position)) (unless (<= beg pt end) (let ((line (buffer-substring-no-properties beg end))) (unless (or (string-blank-p line) (gethash line ht)) (puthash line t ht) (push line lines)))) (setq beg (1+ end)))) (nreverse lines))) ;;;###autoload (defun cape-line (&optional interactive) "Complete current line from other lines in buffer. If INTERACTIVE is nil the function acts like a capf." (interactive (list t)) (if interactive (cape--interactive #'cape-line) `(,(line-beginning-position) ,(point) ,(cape--table-with-properties (cape--line-list) :sort nil) ,@cape--line-properties))) ;;;; Capf combinators ;;;###autoload (defun cape-super-capf (&rest capfs) "Merge CAPFS and return new Capf which includes all candidates." (lambda () (when-let (results (delq nil (mapcar #'funcall capfs))) (pcase-let* ((`((,beg ,end . ,_)) results) (cache-candidates nil) (cache-str nil) (cache-ht (make-hash-table :test #'equal)) (extra-fun (lambda (prop) (lambda (x) (when-let (fun (plist-get (gethash x cache-ht) prop)) (funcall fun x))))) (tables nil) (prefix-len nil)) (cl-loop for (beg2 end2 . rest) in results do (when (and (= beg beg2) (= end end2)) (push rest tables) (let ((plen (plist-get (cdr rest) :company-prefix-length))) (cond ((eq plen t) (setq prefix-len t)) ((and (not prefix-len) (integerp plen)) (setq prefix-len plen)) ((and (integerp prefix-len) (integerp plen)) (setq prefix-len (max prefix-len plen))))))) (setq tables (nreverse tables)) (list beg end (lambda (str pred action) (pcase action (`(boundaries . ,_) nil) ('metadata '(metadata (category . cape-super) (display-sort-function . identity) (cycle-sort-function . identity))) ('t (unless (equal str cache-str) (let ((ht (make-hash-table :test #'equal)) (candidates nil)) (cl-loop for (table . plist) in tables do (let* ((pr (plist-get plist :predicate)) (md (completion-metadata "" table pr)) (sort (or (completion-metadata-get md 'display-sort-function) #'identity)) (cands (funcall sort (all-completions str table pr)))) (cl-loop for cell on cands for cand = (car cell) do (if (and (eq (gethash cand ht t) t) (or (not pred) (funcall pred cand))) (puthash cand plist ht) (setcar cell nil))) (setq candidates (nconc candidates cands)))) (setq cache-str str cache-candidates (delq nil candidates) cache-ht ht))) (copy-sequence cache-candidates)) (_ (completion--some (lambda (table) (complete-with-action action table str pred)) tables)))) :exclusive 'no :company-prefix-length prefix-len :company-doc-buffer (funcall extra-fun :company-doc-buffer) :company-location (funcall extra-fun :company-location) :company-docsig (funcall extra-fun :company-docsig) :company-deprecated (funcall extra-fun :company-deprecated) :company-kind (funcall extra-fun :company-kind) :annotation-function (funcall extra-fun :annotation-function) :exit-function (lambda (x _status) (funcall (funcall extra-fun :exit-function) x))))))) (defvar cape-async-throw-on-input nil "If set to a symbol throw on input from async capf.") (defun cape--async-call (&rest app) "Apply APP and handle future return values." ;; Backends are non-interruptible. Disable interrupts! (let ((toi (or cape-async-throw-on-input throw-on-input)) (throw-on-input nil)) (pcase (apply app) ;; Handle async future return values. (`(:async . ,fetch) (let ((res 'cape--waiting) (start (time-to-seconds)) cancel) (unwind-protect (progn (setq cancel (funcall fetch (lambda (arg) (when (eq res 'cape--waiting) (push 'cape--done unread-command-events)) (setq res arg)))) ;; Force synchronization. (while (eq res 'cape--waiting) ;; When we've got input, interrupt the computation. (when (and unread-command-events toi) (throw toi nil)) (when (and cape-async-timeout (> (- (time-to-seconds) start) cape-async-timeout)) (error "Cape async timeout")) (sit-for 0.1 'noredisplay))) ;; Cancel the future if it didn't finish. (when (and (eq res 'cape--waiting) (functionp cancel)) (ignore-errors (funcall cancel))) ;; Remove cape--done introduced by future callback (setq unread-command-events (delq 'cape--done unread-command-events))) res)) ;; Plain old synchronous return value. (res res)))) (defun cape--async-function (fun) "Convert asynchronous FUN to interruptible function." (lambda (&rest args) (apply #'cape--async-call fun args))) (defun cape--async-map (fun future) "Map FUN over FUTURE." (pcase future (`(:async . ,fetch) (cons :async (lambda (callback) (funcall fetch (lambda (res) (funcall callback (funcall fun res))))))) (res (funcall fun res)))) (defun cape--async-table (table) "Convert asynchronous TABLE to interruptible TABLE." (lambda (str pred action) (let ((result (cape--async-call table (pcase-exhaustive action ('nil #'try-completion) ('t #'all-completions) ('lambda #'test-completion) ((or 'metadata `(boundaries . ,_)) action)) (list :prefix str :predicate pred :regexp-list completion-regexp-list :ignore-case completion-ignore-case)))) (if (eq action 'metadata) (cape--async-map (lambda (md) (setq md (cdr md)) (when md `(metadata ,@(when-let (fun (cdr (assq 'annotation-function md))) `((annotation-function . ,(cape--async-function fun)))) ,@(when-let (fun (cdr (assq 'affixation-function md))) `((affixation-function . ,(cape--async-function fun)))) ,@md))) result) result)))) ;;;###autoload (defun cape-async-capf (capf) "Convert asynchronous CAPF to interruptible capf. Every function of the CAPF is allowed to return an async future." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(cape--async-table table) ,@(mapcar (lambda (prop) (cape--async-function (plist-get plist prop))) (list :annotation-function :affixation-function :company-doc-buffer :company-location :company-docsig :company-deprecated :company-kind)) ,@plist))))) (defun cape--company-call (&rest app) "Apply APP and handle Company future return values." (apply #'cape--async-call #'cape--company-convert app)) (defun cape--company-convert (&rest app) "Return a future, apply APP in the Company calling convention." (pcase (apply app) (`(:async . ,fetch) ;; NOTE: Company futures are currently not cancellable. Maybe Company ;; should adjust their calling convention, in order to harmonize this. In ;; cape--async-call the return value is checked with functionp, so the two ;; calling conventions should be mostly compatible. (cons :async (lambda (cb) (or (funcall fetch cb) nil)))) (res res))) ;;;###autoload (defun cape-company-to-async-capf (backend &optional valid) "Convert Company BACKEND function to Capf. VALID is the input comparator, see `cape--input-valid-p'. This feature is experimental." (unless (symbolp backend) (error "Backend must be a symbol")) (let ((init (intern (format "cape--company-init:%s" backend)))) (lambda () (unless (boundp init) (make-variable-buffer-local init)) (unless (symbol-value init) (cape--company-call backend 'init) (set init t)) (when-let* ((prefix (cape--company-call backend 'prefix)) (initial-input (if (stringp prefix) prefix (car-safe prefix)))) (let* ((end (point)) (beg (- end (length initial-input)))) (list beg end (funcall (if (cape--company-call backend 'ignore-case) #'cape--async-table-case-fold #'identity) (cape--async-table-with-properties (cape--async-cached-table beg end (if (cape--company-call backend 'duplicates) (lambda (input) (cape--async-map #'delete-dups (cape--company-convert backend 'candidates input))) (apply-partially #'cape--company-convert backend 'candidates)) (if (cape--company-call backend 'no-cache initial-input) 'never valid)) :category backend :sort (not (cape--company-call backend 'sorted)))) :exclusive 'no :company-prefix-length (cdr-safe prefix) :company-doc-buffer (lambda (x) (cape--company-convert backend 'doc-buffer x)) :company-location (lambda (x) (cape--company-convert backend 'location x)) :company-docsig (lambda (x) (cape--company-convert backend 'meta x)) :company-deprecated (lambda (x) (cape--company-convert backend 'deprecated x)) :company-kind (lambda (x) (cape--company-convert backend 'kind x)) :annotation-function (lambda (x) (cape--company-convert backend 'annotation x)) :exit-function (lambda (x _status) (cape--company-convert backend 'post-completion x)))))))) ;;;###autoload (defun cape-capf-buster (capf &optional valid) "Return transformed CAPF where the cache is busted on input change. VALID is the input comparator, see `cape--input-valid-p'." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(let* ((beg (copy-marker beg)) (end (copy-marker end t)) (input (buffer-substring-no-properties beg end))) (lambda (str pred action) (let ((new-input (buffer-substring-no-properties beg end))) (unless (cape--input-valid-p input new-input valid) (pcase (funcall capf) (`(,_beg ,_end ,new-table . ,_plist) ;; NOTE: We have to make sure that the completion table is interruptible. ;; An interruption should not happen between the setqs. (setq table new-table input new-input))))) (complete-with-action action table str pred))) ,@plist))))) ;;;###autoload (defun cape-capf-with-properties (capf &rest properties) "Return a new CAPF with additional completion PROPERTIES. Completion properties include for example :exclusive, :annotation-function and the various :company-* extensions. Furthermore a boolean :sort flag and a completion :category symbol can be specified." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(apply #'cape--table-with-properties table properties) ,@properties ,@plist))))) ;;;###autoload (defun cape-capf-with-predicate (capf predicate) "Return a new CAPF with an additional candidate PREDICATE. The PREDICATE is passed the candidate symbol or string." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,table :predicate ,(if-let (pred (plist-get plist :predicate)) ;; First argument is key, second is value for hash tables. ;; The first argument can be a cons cell for alists. Then ;; the candidate itself is either a string or a symbol. We ;; normalize the calling convention here such that PREDICATE ;; always receives a string or a symbol. (lambda (&rest args) (when (apply pred args) (setq args (car args)) (funcall predicate (if (consp args) (car args) args)))) (lambda (key &optional _val) (funcall predicate (if (consp key) (car key) key)))) ,@plist))))) ;;;###autoload (defun cape-silent-capf (capf) "Create a new CAPF which is silent (no messages, no errors)." (lambda () (pcase (cape--silent (funcall capf)) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(cape--silent-table table) ,@plist))))) ;;;###autoload (defun cape-capf-case-fold (capf &optional dont-fold) "Create a new CAPF which is case insensitive. If DONT-FOLD is non-nil, return a completion table that is case sensitive instead." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(completion-table-case-fold table dont-fold) ,@plist))))) ;;;###autoload (defun cape-noninterruptible-capf (capf) "Create a new CAPF which is non-interruptible silent by input." (lambda () (pcase (funcall capf) (`(,beg ,end ,table . ,plist) `(,beg ,end ,(cape--noninterruptible-table table) ,@plist))))) ;;;###autoload (defun cape-interactive-capf (capf) "Create interactive completion function from CAPF." (lambda (&optional interactive) (interactive (list t)) (if interactive (cape--interactive capf) (funcall capf)))) (provide 'cape) ;;; cape.el ends here