cape.el (55182B)
1 ;;; cape.el --- Completion At Point Extensions -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; Author: Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> 7 ;; Created: 2021 8 ;; Version: 1.6 9 ;; Package-Requires: ((emacs "27.1") (compat "30")) 10 ;; Homepage: https://github.com/minad/cape 11 ;; Keywords: abbrev, convenience, matching, completion, text 12 13 ;; This file is part of GNU Emacs. 14 15 ;; This program is free software: you can redistribute it and/or modify 16 ;; it under the terms of the GNU General Public License as published by 17 ;; the Free Software Foundation, either version 3 of the License, or 18 ;; (at your option) any later version. 19 20 ;; This program is distributed in the hope that it will be useful, 21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 ;; GNU General Public License for more details. 24 25 ;; You should have received a copy of the GNU General Public License 26 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 27 28 ;;; Commentary: 29 30 ;; Let your completions fly! This package provides additional completion 31 ;; backends in the form of Capfs (completion-at-point-functions). 32 ;; 33 ;; `cape-abbrev': Complete abbreviation (add-global-abbrev, add-mode-abbrev). 34 ;; `cape-dabbrev': Complete word from current buffers. 35 ;; `cape-dict': Complete word from dictionary file. 36 ;; `cape-elisp-block': Complete Elisp in Org or Markdown code block. 37 ;; `cape-elisp-symbol': Complete Elisp symbol. 38 ;; `cape-emoji': Complete Emoji. 39 ;; `cape-file': Complete file name. 40 ;; `cape-history': Complete from Eshell, Comint or minibuffer history. 41 ;; `cape-keyword': Complete programming language keyword. 42 ;; `cape-line': Complete entire line from file. 43 ;; `cape-rfc1345': Complete Unicode char using RFC 1345 mnemonics. 44 ;; `cape-sgml': Complete Unicode char from SGML entity, e.g., &alpha. 45 ;; `cape-tex': Complete Unicode char from TeX command, e.g. \hbar. 46 47 ;;; Code: 48 49 (require 'compat) 50 (eval-when-compile 51 (require 'cl-lib) 52 (require 'subr-x)) 53 54 ;;;; Customization 55 56 (defgroup cape nil 57 "Completion At Point Extensions." 58 :link '(info-link :tag "Info Manual" "(cape)") 59 :link '(url-link :tag "Homepage" "https://github.com/minad/cape") 60 :link '(emacs-library-link :tag "Library Source" "cape.el") 61 :group 'convenience 62 :group 'tools 63 :group 'matching 64 :prefix "cape-") 65 66 (defcustom cape-dict-limit 100 67 "Maximal number of completion candidates returned by `cape-dict'." 68 :type '(choice (const nil) natnum)) 69 70 (defcustom cape-dict-file "/usr/share/dict/words" 71 "Path to dictionary word list file. 72 This variable can also be a list of paths or 73 a function returning a single or more paths." 74 :type '(choice string (repeat string) function)) 75 76 (defcustom cape-dict-case-replace 'case-replace 77 "Preserve case of input. 78 See `dabbrev-case-replace' for details." 79 :type '(choice (const :tag "off" nil) 80 (const :tag "use `case-replace'" case-replace) 81 (other :tag "on" t))) 82 83 (defcustom cape-dict-case-fold 'case-fold-search 84 "Case fold search during search. 85 See `dabbrev-case-fold-search' for details." 86 :type '(choice (const :tag "off" nil) 87 (const :tag "use `case-fold-search'" case-fold-search) 88 (other :tag "on" t))) 89 90 (defcustom cape-dabbrev-min-length 4 91 "Minimum length of Dabbrev expansions. 92 This setting ensures that words which are too short 93 are not offered as completion candidates, such that 94 auto completion does not pop up too aggressively." 95 :type 'natnum) 96 97 (defcustom cape-dabbrev-check-other-buffers t 98 "Buffers to check for Dabbrev. 99 100 If t, check all other buffers, subject to Dabbrev ignore rules. 101 If a function, only search the buffers returned by this function. 102 Any other non-nil value only checks some other buffers, as per 103 `dabbrev-select-buffers-function'." 104 :type `(choice (const :tag "off" nil) 105 (const :tag "same-mode buffers" ,#'cape--buffers-major-mode) 106 (function :tag "function") 107 (const :tag "some" some) 108 (other :tag "all" t))) 109 110 (defcustom cape-file-directory nil 111 "Base directory used by `cape-file." 112 :type '(choice (const nil) string function)) 113 114 (defcustom cape-file-prefix "file:" 115 "File completion trigger prefixes. 116 The value can be a string or a list of strings. The default 117 `file:' is the prefix of Org file links which work in arbitrary 118 buffers via `org-open-at-point-global'." 119 :type '(choice string (repeat string))) 120 121 (defcustom cape-file-directory-must-exist t 122 "The parent directory must exist for file completion." 123 :type 'boolean) 124 125 (defcustom cape-line-buffer-function #'cape--buffers-major-mode 126 "Function which returns list of buffers. 127 The buffers are scanned for completion candidates by `cape-line'." 128 :type '(choice (const :tag "Current buffer" current-buffer) 129 (const :tag "All buffers" buffer-list) 130 (const :tag "Buffers with same major mode" cape--buffers-major-mode) 131 (function :tag "Custom function"))) 132 133 (defcustom cape-elisp-symbol-wrapper 134 '((org-mode ?~ ?~) 135 (markdown-mode ?` ?`) 136 (emacs-lisp-mode ?` ?') 137 (rst-mode "``" "``") 138 (log-edit-mode "`" "'") 139 (change-log-mode "`" "'") 140 (message-mode "`" "'") 141 (rcirc-mode "`" "'")) 142 "Wrapper characters for symbols." 143 :type '(alist :key-type symbol :value-type (list (choice character string) 144 (choice character string)))) 145 146 ;;;; Helpers 147 148 (defun cape--case-fold-p (fold) 149 "Return non-nil if case folding is enabled for FOLD." 150 (if (eq fold 'case-fold-search) case-fold-search fold)) 151 152 (defun cape--case-replace-list (flag input strs) 153 "Replace case of STRS depending on INPUT and FLAG." 154 (if (and (if (eq flag 'case-replace) case-replace flag) 155 (let (case-fold-search) (string-match-p "\\`[[:upper:]]" input))) 156 (mapcar (apply-partially #'cape--case-replace flag input) strs) 157 strs)) 158 159 (defun cape--case-replace (flag input str) 160 "Replace case of STR depending on INPUT and FLAG." 161 (or (and (if (eq flag 'case-replace) case-replace flag) 162 (string-prefix-p input str t) 163 (let (case-fold-search) (string-match-p "\\`[[:upper:]]" input)) 164 (save-match-data 165 ;; Ensure that single character uppercase input does not lead to an 166 ;; all uppercase result. 167 (when (and (= (length input) 1) (> (length str) 1)) 168 (setq input (concat input (substring str 1 2)))) 169 (and (string-match input input) 170 (replace-match str nil nil input)))) 171 str)) 172 173 (defun cape--separator-p (str) 174 "Return non-nil if input STR has a separator character. 175 Separator characters are used by completion styles like Orderless 176 to split filter words. In Corfu, the separator is configurable 177 via the variable `corfu-separator'." 178 (string-search (string ;; Support `corfu-separator' and Orderless 179 (or (and (bound-and-true-p corfu-mode) 180 (bound-and-true-p corfu-separator)) 181 ?\s)) 182 str)) 183 184 (defmacro cape--silent (&rest body) 185 "Silence BODY." 186 (declare (indent 0)) 187 `(cl-letf ((inhibit-message t) 188 (message-log-max nil) 189 ((symbol-function #'minibuffer-message) #'ignore)) 190 (ignore-errors ,@body))) 191 192 (defun cape--bounds (thing) 193 "Return bounds of THING." 194 (or (bounds-of-thing-at-point thing) (cons (point) (point)))) 195 196 (defmacro cape--wrapped-table (wrap body) 197 "Create wrapped completion table, handle `completion--unquote'. 198 WRAP is the wrapper function. 199 BODY is the wrapping expression." 200 (declare (indent 1)) 201 `(lambda (str pred action) 202 (,@body 203 (let ((result (complete-with-action action table str pred))) 204 (when (and (eq action 'completion--unquote) (functionp (cadr result))) 205 (cl-callf ,wrap (cadr result))) 206 result)))) 207 208 (defun cape--accept-all-table (table) 209 "Create completion TABLE which accepts all input." 210 (cape--wrapped-table cape--accept-all-table 211 (or (eq action 'lambda)))) 212 213 (defun cape--passthrough-table (table) 214 "Create completion TABLE disabling any filtering." 215 (cape--wrapped-table cape--passthrough-table 216 (let (completion-ignore-case completion-regexp-list (_ (setq str "")))))) 217 218 (defun cape--noninterruptible-table (table) 219 "Create non-interruptible completion TABLE." 220 (cape--wrapped-table cape--noninterruptible-table 221 (let (throw-on-input)))) 222 223 (defun cape--silent-table (table) 224 "Create a new completion TABLE which is silent (no messages, no errors)." 225 (cape--wrapped-table cape--silent-table 226 (cape--silent))) 227 228 (defun cape--nonessential-table (table) 229 "Mark completion TABLE as `non-essential'." 230 (let ((dir default-directory)) 231 (cape--wrapped-table cape--nonessential-table 232 (let ((default-directory dir) 233 (non-essential t)))))) 234 235 (defvar cape--debug-length 5 236 "Length of printed lists in `cape--debug-print'.") 237 238 (defvar cape--debug-id 0 239 "Completion table identifier.") 240 241 (defun cape--debug-message (&rest msg) 242 "Print debug MSG." 243 (let ((inhibit-message t)) 244 (apply #'message msg))) 245 246 (defun cape--debug-print (obj &optional full) 247 "Print OBJ as string, truncate lists if FULL is nil." 248 (cond 249 ((symbolp obj) (symbol-name obj)) 250 ((functionp obj) "#<function>") 251 ((proper-list-p obj) 252 (concat 253 "(" 254 (string-join 255 (mapcar #'cape--debug-print 256 (if full obj (take cape--debug-length obj))) 257 " ") 258 (if (and (not full) (length> obj cape--debug-length)) " ...)" ")"))) 259 (t (let ((print-level 2)) 260 (prin1-to-string obj))))) 261 262 (defun cape--debug-table (table name beg end) 263 "Create completion TABLE with debug messages. 264 NAME is the name of the Capf, BEG and END are the input markers." 265 (lambda (str pred action) 266 (let ((result (complete-with-action action table str pred))) 267 (if (and (eq action 'completion--unquote) (functionp (cadr result))) 268 ;; See `cape--wrapped-table' 269 (cl-callf cape--debug-table (cadr result) name beg end) 270 (cape--debug-message 271 "%s(action=%S input=%s:%s:%S prefix=%S ignore-case=%S%s%s) => %s" 272 name 273 (pcase action 274 ('nil 'try) 275 ('t 'all) 276 ('lambda 'test) 277 (_ action)) 278 (+ beg 0) (+ end 0) (buffer-substring-no-properties beg end) 279 str completion-ignore-case 280 (if completion-regexp-list 281 (format " regexp=%s" (cape--debug-print completion-regexp-list t)) 282 "") 283 (if pred 284 (format " predicate=%s" (cape--debug-print pred)) 285 "") 286 (cape--debug-print result))) 287 result))) 288 289 (cl-defun cape--properties-table (table &key category (sort t) &allow-other-keys) 290 "Create completion TABLE with properties. 291 CATEGORY is the optional completion category. 292 SORT should be nil to disable sorting." 293 ;; The metadata will be overridden if the category is non-nil, if the table is 294 ;; a function table or if sorting should be disabled for a non-nil 295 ;; non-function table. 296 (if (or category (functionp table) (and (not sort) table)) 297 (let ((metadata `(metadata 298 ,@(and category `((category . ,category))) 299 ,@(and (not sort) '((display-sort-function . identity) 300 (cycle-sort-function . identity)))))) 301 (lambda (str pred action) 302 (if (eq action 'metadata) 303 metadata 304 (complete-with-action action table str pred)))) 305 table)) 306 307 (defun cape--dynamic-table (beg end fun) 308 "Create dynamic completion table from FUN with caching. 309 BEG and END are the input bounds. FUN is the function which 310 computes the candidates. FUN must return a pair of a predicate 311 function function and the list of candidates. The predicate is 312 passed new input and must return non-nil if the candidates are 313 still valid. 314 315 It is only necessary to use this function if the set of 316 candidates is computed dynamically based on the input and not 317 statically determined. The behavior is similar but slightly 318 different to `completion-table-dynamic'. 319 320 The difference to the builtins `completion-table-dynamic' and 321 `completion-table-with-cache' is that this function does not use 322 the prefix argument of the completion table to compute the 323 candidates. Instead it uses the input in the buffer between BEG 324 and END to FUN to compute the candidates. This way the dynamic 325 candidate computation is compatible with non-prefix completion 326 styles like `substring' or `orderless', which pass the empty 327 string as first argument to the completion table." 328 (let ((beg (copy-marker beg)) 329 (end (copy-marker end t)) 330 valid table) 331 (lambda (str pred action) 332 ;; Bail out early for `metadata' and `boundaries'. This is a pointless 333 ;; move because of caching, but we do it anyway in the hope that the 334 ;; profiler report looks less confusing, since the weight of the expensive 335 ;; FUN computation is moved to the `all-completions' action. Computing 336 ;; `all-completions' must surely be most expensive, so nobody will suspect 337 ;; a thing. 338 (unless (or (eq action 'metadata) (eq (car-safe action) 'boundaries)) 339 (let ((input (buffer-substring-no-properties beg end))) 340 (unless (and valid 341 (or (cape--separator-p input) 342 (funcall valid input))) 343 (let* (;; Reset in case `all-completions' is used inside FUN 344 completion-ignore-case completion-regexp-list 345 ;; Retrieve new state by calling FUN 346 (new (funcall fun input)) 347 ;; No interrupt during state update 348 throw-on-input) 349 (setq valid (car new) table (cdr new))))) 350 (complete-with-action action table str pred))))) 351 352 ;;;; Capfs 353 354 ;;;;; cape-history 355 356 (declare-function ring-elements "ring") 357 (declare-function eshell-bol "eshell") 358 (declare-function comint-line-beginning-position "comint") 359 (defvar eshell-history-ring) 360 (defvar comint-input-ring) 361 362 (defvar cape--history-properties 363 (list :company-kind (lambda (_) 'text) 364 :exclusive 'no) 365 "Completion extra properties for `cape-history'.") 366 367 ;;;###autoload 368 (defun cape-history (&optional interactive) 369 "Complete from Eshell, Comint or minibuffer history. 370 See also `consult-history' for a more flexible variant based on 371 `completing-read'. If INTERACTIVE is nil the function acts like a Capf." 372 (interactive (list t)) 373 (if interactive 374 (cape-interactive #'cape-history) 375 (let (history bol) 376 (cond 377 ((derived-mode-p 'eshell-mode) 378 (setq history eshell-history-ring 379 bol (static-if (< emacs-major-version 30) 380 (save-excursion (eshell-bol) (point)) 381 (line-beginning-position)))) 382 ((derived-mode-p 'comint-mode) 383 (setq history comint-input-ring 384 bol (comint-line-beginning-position))) 385 ((and (minibufferp) (not (eq minibuffer-history-variable t))) 386 (setq history (symbol-value minibuffer-history-variable) 387 bol (line-beginning-position)))) 388 (when (ring-p history) 389 (setq history (ring-elements history))) 390 (when history 391 `(,bol ,(point) 392 ,(cape--properties-table history :sort nil) 393 ,@cape--history-properties))))) 394 395 ;;;;; cape-file 396 397 (defvar comint-unquote-function) 398 (defvar comint-requote-function) 399 400 (defvar cape--file-properties 401 (list :annotation-function (lambda (s) (if (string-suffix-p "/" s) " Dir" " File")) 402 :company-kind (lambda (s) (if (string-suffix-p "/" s) 'folder 'file)) 403 :exclusive 'no) 404 "Completion extra properties for `cape-file'.") 405 406 ;;;###autoload 407 (defun cape-file (&optional interactive) 408 "Complete file name at point. 409 See the user option `cape-file-directory-must-exist'. 410 If INTERACTIVE is nil the function acts like a Capf." 411 (interactive (list t)) 412 (if interactive 413 (cape-interactive '(cape-file-directory-must-exist) #'cape-file) 414 (pcase-let* ((default-directory (pcase cape-file-directory 415 ('nil default-directory) 416 ((pred stringp) cape-file-directory) 417 (_ (funcall cape-file-directory)))) 418 (prefix (and cape-file-prefix 419 (looking-back 420 (concat 421 (regexp-opt (ensure-list cape-file-prefix) t) 422 "[^ \n\t]*") 423 (pos-bol)) 424 (match-end 1))) 425 (`(,beg . ,end) (if prefix 426 (cons prefix (point)) 427 (cape--bounds 'filename))) 428 (non-essential t) 429 (file (buffer-substring-no-properties beg end))) 430 (when (or prefix 431 (not cape-file-directory-must-exist) 432 (and (string-search "/" file) 433 (file-exists-p (file-name-directory file)))) 434 `(,beg ,end 435 ,(cape--nonessential-table 436 (if (or (derived-mode-p 'comint-mode) (derived-mode-p 'eshell-mode)) 437 (completion-table-with-quoting 438 #'read-file-name-internal 439 comint-unquote-function 440 comint-requote-function) 441 #'read-file-name-internal)) 442 ,@(when (or prefix (string-match-p "./" file)) 443 '(:company-prefix-length t)) 444 ,@cape--file-properties))))) 445 446 ;;;;; cape-elisp-symbol 447 448 (defvar cape--symbol-properties 449 (append 450 (list :annotation-function #'cape--symbol-annotation 451 :exit-function #'cape--symbol-exit 452 :predicate #'cape--symbol-predicate 453 :exclusive 'no) 454 (when (eval-when-compile (>= emacs-major-version 28)) 455 (autoload 'elisp--company-kind "elisp-mode") 456 (autoload 'elisp--company-doc-buffer "elisp-mode") 457 (autoload 'elisp--company-doc-string "elisp-mode") 458 (autoload 'elisp--company-location "elisp-mode") 459 (list :company-kind 'elisp--company-kind 460 :company-doc-buffer 'elisp--company-doc-buffer 461 :company-docsig 'elisp--company-doc-string 462 :company-location 'elisp--company-location))) 463 "Completion extra properties for `cape-elisp-symbol'.") 464 465 (defun cape--symbol-predicate (sym) 466 "Return t if SYM is bound, fbound or propertized." 467 (or (fboundp sym) (boundp sym) (symbol-plist sym))) 468 469 (defun cape--symbol-exit (sym status) 470 "Wrap symbol SYM with `cape-elisp-symbol-wrapper' buffers. 471 STATUS is the exit status." 472 (when-let (((not (eq status 'exact))) 473 (c (cl-loop for (m . c) in cape-elisp-symbol-wrapper 474 if (derived-mode-p m) return c)) 475 ((or (not (derived-mode-p 'emacs-lisp-mode)) 476 ;; Inside comment or string 477 (let ((s (syntax-ppss))) (or (nth 3 s) (nth 4 s))))) 478 (x (if (stringp (car c)) (car c) (string (car c)))) 479 (y (if (stringp (cadr c)) (cadr c) (string (cadr c))))) 480 (save-excursion 481 (backward-char (length sym)) 482 (unless (save-excursion 483 (and (ignore-errors (or (backward-char (length x)) t)) 484 (looking-at-p (regexp-quote x)))) 485 (insert x))) 486 (unless (looking-at-p (regexp-quote y)) 487 (insert y)))) 488 489 (defun cape--symbol-annotation (sym) 490 "Return kind of SYM." 491 (setq sym (intern-soft sym)) 492 (cond 493 ((special-form-p sym) " Special") 494 ((macrop sym) " Macro") 495 ((commandp sym) " Command") 496 ((fboundp sym) " Function") 497 ((custom-variable-p sym) " Custom") 498 ((boundp sym) " Variable") 499 ((featurep sym) " Feature") 500 ((facep sym) " Face") 501 (t " Symbol"))) 502 503 ;;;###autoload 504 (defun cape-elisp-symbol (&optional interactive) 505 "Complete Elisp symbol at point. 506 If INTERACTIVE is nil the function acts like a Capf." 507 (interactive (list t)) 508 (if interactive 509 ;; No cycling since it breaks the :exit-function. 510 (let (completion-cycle-threshold) 511 (cape-interactive #'cape-elisp-symbol)) 512 (pcase-let ((`(,beg . ,end) (cape--bounds 'symbol))) 513 (when (eq (char-after beg) ?') 514 (setq beg (1+ beg) end (max beg end))) 515 `(,beg ,end 516 ,(cape--properties-table obarray :category 'symbol) 517 ,@cape--symbol-properties)))) 518 519 ;;;;; cape-elisp-block 520 521 (declare-function org-element-context "org-element") 522 (declare-function markdown-code-block-lang "ext:markdown-mode") 523 524 (defun cape--inside-block-p (&rest langs) 525 "Return non-nil if inside LANGS code block." 526 (when-let ((face (get-text-property (point) 'face)) 527 (lang (or (and (if (listp face) 528 (memq 'org-block face) 529 (eq 'org-block face)) 530 (plist-get (cadr (org-element-context)) :language)) 531 (and (if (listp face) 532 (memq 'markdown-code-face face) 533 (eq 'markdown-code-face face)) 534 (save-excursion 535 (markdown-code-block-lang)))))) 536 (member lang langs))) 537 538 ;;;###autoload 539 (defun cape-elisp-block (&optional interactive) 540 "Complete Elisp in Org or Markdown code block. 541 This Capf is particularly useful for literate Emacs configurations. 542 If INTERACTIVE is nil the function acts like a Capf." 543 (interactive (list t)) 544 (cond 545 (interactive 546 ;; No code block check. Always complete Elisp when command was 547 ;; explicitly invoked interactively. 548 (cape-interactive #'elisp-completion-at-point)) 549 ((cape--inside-block-p "elisp" "emacs-lisp") 550 (elisp-completion-at-point)))) 551 552 ;;;;; cape-dabbrev 553 554 (defvar cape--dabbrev-properties 555 (list :annotation-function (lambda (_) " Dabbrev") 556 :company-kind (lambda (_) 'text) 557 :exclusive 'no) 558 "Completion extra properties for `cape-dabbrev'.") 559 560 (defvar dabbrev-case-replace) 561 (defvar dabbrev-case-fold-search) 562 (defvar dabbrev-abbrev-char-regexp) 563 (defvar dabbrev-abbrev-skip-leading-regexp) 564 (declare-function dabbrev--find-all-expansions "dabbrev") 565 (declare-function dabbrev--reset-global-variables "dabbrev") 566 567 (defun cape--dabbrev-list (input) 568 "Find all Dabbrev expansions for INPUT." 569 (cape--silent 570 (let* ((chk cape-dabbrev-check-other-buffers) 571 (funp (and (not (memq chk '(nil t some))) (functionp chk)))) 572 (dlet ((dabbrev-check-other-buffers (and chk (not funp))) 573 (dabbrev-check-all-buffers (eq chk t)) 574 (dabbrev-search-these-buffers-only (and funp (funcall chk)))) 575 (dabbrev--reset-global-variables) 576 (cons 577 (apply-partially #'string-prefix-p input) 578 (cl-loop with min-len = (+ cape-dabbrev-min-length (length input)) 579 with ic = (cape--case-fold-p dabbrev-case-fold-search) 580 for w in (dabbrev--find-all-expansions input ic) 581 if (>= (length w) min-len) collect 582 (cape--case-replace (and ic dabbrev-case-replace) input w))))))) 583 584 (defun cape--dabbrev-bounds () 585 "Return bounds of abbreviation." 586 (unless (boundp 'dabbrev-abbrev-char-regexp) 587 (require 'dabbrev)) 588 (let ((re (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_")) 589 (limit (minibuffer-prompt-end))) 590 (when (or (looking-at re) 591 (and (> (point) limit) 592 (save-excursion (forward-char -1) (looking-at re)))) 593 (cons (save-excursion 594 (while (and (> (point) limit) 595 (save-excursion (forward-char -1) (looking-at re))) 596 (forward-char -1)) 597 (when dabbrev-abbrev-skip-leading-regexp 598 (while (looking-at dabbrev-abbrev-skip-leading-regexp) 599 (forward-char 1))) 600 (point)) 601 (save-excursion 602 (while (looking-at re) 603 (forward-char 1)) 604 (point)))))) 605 606 ;;;###autoload 607 (defun cape-dabbrev (&optional interactive) 608 "Complete with Dabbrev at point. 609 610 If INTERACTIVE is nil the function acts like a Capf. In case you 611 observe a performance issue with auto-completion and `cape-dabbrev' 612 it is strongly recommended to disable scanning in other buffers. 613 See the user options `cape-dabbrev-min-length' and 614 `cape-dabbrev-check-other-buffers'." 615 (interactive (list t)) 616 (if interactive 617 (cape-interactive '((cape-dabbrev-min-length 0)) #'cape-dabbrev) 618 (when-let ((bounds (cape--dabbrev-bounds))) 619 `(,(car bounds) ,(cdr bounds) 620 ,(cape--properties-table 621 (completion-table-case-fold 622 (cape--dynamic-table (car bounds) (cdr bounds) #'cape--dabbrev-list) 623 (not (cape--case-fold-p dabbrev-case-fold-search))) 624 :category 'cape-dabbrev) 625 ,@cape--dabbrev-properties)))) 626 627 ;;;;; cape-dict 628 629 (defvar cape--dict-properties 630 (list :annotation-function (lambda (_) " Dict") 631 :company-kind (lambda (_) 'text) 632 :exclusive 'no) 633 "Completion extra properties for `cape-dict'.") 634 635 (defun cape--dict-list (input) 636 "Return all words from `cape-dict-file' matching INPUT." 637 (unless (equal input "") 638 (let* ((inhibit-message t) 639 (message-log-max nil) 640 (default-directory 641 (if (and (not (file-remote-p default-directory)) 642 (file-directory-p default-directory)) 643 default-directory 644 user-emacs-directory)) 645 (files (mapcar #'expand-file-name 646 (ensure-list 647 (if (functionp cape-dict-file) 648 (funcall cape-dict-file) 649 cape-dict-file)))) 650 (words 651 (apply #'process-lines-ignore-status 652 "grep" 653 (concat "-Fh" 654 (and (cape--case-fold-p cape-dict-case-fold) "i") 655 (and cape-dict-limit (format "m%d" cape-dict-limit))) 656 input files))) 657 (cons 658 (apply-partially 659 (if (and cape-dict-limit (length= words cape-dict-limit)) 660 #'equal #'string-search) 661 input) 662 (cape--case-replace-list cape-dict-case-replace input words))))) 663 664 ;;;###autoload 665 (defun cape-dict (&optional interactive) 666 "Complete word from dictionary at point. 667 This completion function works best if the dictionary is sorted 668 by frequency. See the custom option `cape-dict-file'. If 669 INTERACTIVE is nil the function acts like a Capf." 670 (interactive (list t)) 671 (if interactive 672 (cape-interactive #'cape-dict) 673 (pcase-let ((`(,beg . ,end) (cape--bounds 'word))) 674 `(,beg ,end 675 ,(cape--properties-table 676 (completion-table-case-fold 677 (cape--dynamic-table beg end #'cape--dict-list) 678 (not (cape--case-fold-p cape-dict-case-fold))) 679 :sort nil ;; Presorted word list (by frequency) 680 :category 'cape-dict) 681 ,@cape--dict-properties)))) 682 683 ;;;;; cape-abbrev 684 685 (defun cape--abbrev-tables () 686 "Return list of all active abbrev tables, including parents." 687 ;; Emacs 28: See abbrev--suggest-get-active-tables-including-parents. 688 (let ((tables (abbrev--active-tables))) 689 (append tables (cl-loop for table in tables 690 append (abbrev-table-get table :parents))))) 691 692 (defun cape--abbrev-list () 693 "Abbreviation list." 694 (delete "" (cl-loop for table in (cape--abbrev-tables) 695 nconc (all-completions "" table)))) 696 697 (defun cape--abbrev-annotation (abbrev) 698 "Annotate ABBREV with expansion." 699 (concat " " 700 (truncate-string-to-width 701 (format 702 "%s" 703 (symbol-value 704 (cl-loop for table in (cape--abbrev-tables) 705 thereis (abbrev--symbol abbrev table)))) 706 30 0 nil t))) 707 708 (defun cape--abbrev-exit (_str status) 709 "Expand expansion if STATUS is not exact." 710 (unless (eq status 'exact) 711 (expand-abbrev))) 712 713 (defvar cape--abbrev-properties 714 (list :annotation-function #'cape--abbrev-annotation 715 :exit-function #'cape--abbrev-exit 716 :company-kind (lambda (_) 'snippet) 717 :exclusive 'no) 718 "Completion extra properties for `cape-abbrev'.") 719 720 ;;;###autoload 721 (defun cape-abbrev (&optional interactive) 722 "Complete abbreviation at point. 723 If INTERACTIVE is nil the function acts like a Capf." 724 (interactive (list t)) 725 (if interactive 726 ;; No cycling since it breaks the :exit-function. 727 (let (completion-cycle-threshold) 728 (cape-interactive #'cape-abbrev)) 729 (when-let (abbrevs (cape--abbrev-list)) 730 (let ((bounds (cape--bounds 'symbol))) 731 `(,(car bounds) ,(cdr bounds) 732 ,(cape--properties-table abbrevs :category 'cape-abbrev) 733 ,@cape--abbrev-properties))))) 734 735 ;;;;; cape-line 736 737 (defvar cape--line-properties nil 738 "Completion extra properties for `cape-line'.") 739 740 (defun cape--buffers-major-mode () 741 "Return buffers with same major mode as current buffer." 742 (cl-loop for buf in (buffer-list) 743 if (eq major-mode (buffer-local-value 'major-mode buf)) 744 collect buf)) 745 746 (defun cape--line-list () 747 "Return all lines from buffer." 748 (let ((ht (make-hash-table :test #'equal)) 749 (curr-buf (current-buffer)) 750 (buffers (funcall cape-line-buffer-function)) 751 lines) 752 (dolist (buf (ensure-list buffers)) 753 (with-current-buffer buf 754 (let ((beg (point-min)) 755 (max (point-max)) 756 (pt (if (eq curr-buf buf) (point) -1)) 757 end) 758 (save-excursion 759 (while (< beg max) 760 (goto-char beg) 761 (setq end (pos-eol)) 762 (unless (<= beg pt end) 763 (let ((line (buffer-substring-no-properties beg end))) 764 (unless (or (string-blank-p line) (gethash line ht)) 765 (puthash line t ht) 766 (push line lines)))) 767 (setq beg (1+ end))))))) 768 (nreverse lines))) 769 770 ;;;###autoload 771 (defun cape-line (&optional interactive) 772 "Complete current line from other lines. 773 The buffers returned by `cape-line-buffer-function' are scanned for lines. 774 If INTERACTIVE is nil the function acts like a Capf." 775 (interactive (list t)) 776 (if interactive 777 (cape-interactive #'cape-line) 778 `(,(pos-bol) ,(point) 779 ,(cape--properties-table (cape--line-list) :sort nil) 780 ,@cape--line-properties))) 781 782 ;;;; Capf combinators 783 784 (defun cape--company-call (&rest app) 785 "Apply APP and handle future return values." 786 ;; Backends are non-interruptible. Disable interrupts! 787 (let ((toi throw-on-input) 788 (throw-on-input nil)) 789 (pcase (apply app) 790 ;; Handle async future return values. 791 (`(:async . ,fetch) 792 (let ((res 'cape--waiting)) 793 (if toi 794 (unwind-protect 795 (progn 796 (funcall fetch 797 (lambda (arg) 798 (when (eq res 'cape--waiting) 799 (push 'cape--done unread-command-events) 800 (setq res arg)))) 801 (when (eq res 'cape--waiting) 802 (let ((ev (let ((input-method-function nil) 803 (echo-keystrokes 0)) 804 (read-event nil t)))) 805 (unless (eq ev 'cape--done) 806 (push (cons t ev) unread-command-events) 807 (setq res 'cape--cancelled) 808 (throw toi t))))) 809 (setq unread-command-events 810 (delq 'cape--done unread-command-events))) 811 (funcall fetch (lambda (arg) (setq res arg))) 812 ;; Force synchronization, not interruptible! We use polling 813 ;; here and ignore pending input since we don't use 814 ;; `sit-for'. This is the same method used by Company itself. 815 (while (eq res 'cape--waiting) 816 (sleep-for 0.01))) 817 res)) 818 ;; Plain old synchronous return value. 819 (res res)))) 820 821 (defvar-local cape--company-init nil) 822 823 ;;;###autoload 824 (defun cape-company-to-capf (backend &optional valid) 825 "Convert Company BACKEND function to Capf. 826 VALID is a function taking the old and new input string. It should 827 return nil if the cached candidates became invalid. The default value 828 for VALID is `string-prefix-p' such that the candidates are only fetched 829 again if the input prefix changed." 830 (lambda () 831 (when (and (symbolp backend) (not (fboundp backend))) 832 (ignore-errors (require backend nil t))) 833 (when (bound-and-true-p company-mode) 834 (error "`cape-company-to-capf' should not be used with `company-mode', use the Company backend directly instead")) 835 (when (and (symbolp backend) (not (alist-get backend cape--company-init))) 836 (funcall backend 'init) 837 (put backend 'company-init t) 838 (setf (alist-get backend cape--company-init) t)) 839 (when-let ((prefix (cape--company-call backend 'prefix)) 840 (initial-input (if (stringp prefix) prefix (car-safe prefix)))) 841 (let* ((end (point)) (beg (- end (length initial-input))) 842 (valid (if (cape--company-call backend 'no-cache initial-input) 843 #'equal (or valid #'string-prefix-p))) 844 restore-props) 845 (list beg end 846 (funcall 847 (if (cape--company-call backend 'ignore-case) 848 #'completion-table-case-fold 849 #'identity) 850 (cape--properties-table 851 (cape--dynamic-table 852 beg end 853 (lambda (input) 854 (let ((cands (cape--company-call backend 'candidates input))) 855 ;; The candidate string including text properties should be 856 ;; restored in the :exit-function, if the UI does not 857 ;; guarantee this itself. Restoration is not necessary for 858 ;; Corfu since the introduction of `corfu--exit-function'. 859 (unless (and (bound-and-true-p corfu-mode) (fboundp 'corfu--exit-function)) 860 (setq restore-props cands)) 861 (cons (apply-partially valid input) cands)))) 862 :category backend 863 :sort (not (cape--company-call backend 'sorted)))) 864 :exclusive 'no 865 :company-prefix-length (cdr-safe prefix) 866 :company-doc-buffer (lambda (x) (cape--company-call backend 'doc-buffer x)) 867 :company-location (lambda (x) (cape--company-call backend 'location x)) 868 :company-docsig (lambda (x) (cape--company-call backend 'meta x)) 869 :company-deprecated (lambda (x) (cape--company-call backend 'deprecated x)) 870 :company-kind (lambda (x) (cape--company-call backend 'kind x)) 871 :annotation-function (lambda (x) 872 (when-let (ann (cape--company-call backend 'annotation x)) 873 (concat " " (string-trim ann)))) 874 :exit-function (lambda (x _status) 875 ;; Restore the candidate string including 876 ;; properties if restore-props is non-nil. See 877 ;; the comment above. 878 (setq x (or (car (member x restore-props)) x)) 879 (cape--company-call backend 'post-completion x))))))) 880 881 ;;;###autoload 882 (defun cape-interactive (&rest capfs) 883 "Complete interactively with the given CAPFS." 884 (let* ((ctx (and (consp (car capfs)) (car capfs))) 885 (capfs (if ctx (cdr capfs) capfs)) 886 (completion-at-point-functions 887 (if ctx 888 (mapcar (lambda (f) `(lambda () (let ,ctx (funcall ',f)))) capfs) 889 capfs))) 890 (unless (completion-at-point) 891 (user-error "%s: No completions" 892 (mapconcat (lambda (fun) 893 (if (symbolp fun) 894 (symbol-name fun) 895 "anonymous-capf")) 896 capfs ", "))))) 897 898 ;;;###autoload 899 (defun cape-capf-interactive (capf) 900 "Create interactive completion function from CAPF." 901 (lambda (&optional interactive) 902 (interactive (list t)) 903 (if interactive (cape-interactive capf) (funcall capf)))) 904 905 ;;;###autoload 906 (defun cape-wrap-super (&rest capfs) 907 "Call CAPFS and return merged completion result. 908 The CAPFS list can contain the keyword `:with' to mark the Capfs 909 afterwards as auxiliary One of the non-auxiliary Capfs before 910 `:with' must return non-nil for the super Capf to set in and 911 return a non-nil result. Such behavior is useful when listing 912 multiple super Capfs in the `completion-at-point-functions': 913 914 (setq completion-at-point-functions 915 (list (cape-capf-super \\='eglot-completion-at-point 916 :with \\='tempel-complete) 917 (cape-capf-super \\='cape-dabbrev 918 :with \\='tempel-complete)))" 919 (when-let ((results (cl-loop for capf in capfs until (eq capf :with) 920 for res = (funcall capf) 921 if res collect (cons t res)))) 922 (pcase-let* ((results (nconc results 923 (cl-loop for capf in (cdr (memq :with capfs)) 924 for res = (funcall capf) 925 if res collect (cons nil res)))) 926 (`((,_main ,beg ,end . ,_)) results) 927 (cand-ht nil) 928 (tables nil) 929 (exclusive nil) 930 (prefix-len nil) 931 (cand-functions 932 '(:company-docsig :company-location :company-kind 933 :company-doc-buffer :company-deprecated 934 :annotation-function :exit-function))) 935 (cl-loop for (main beg2 end2 table . plist) in results do 936 ;; Note: `cape-capf-super' currently cannot merge Capfs which 937 ;; trigger at different beginning positions. In order to support 938 ;; this, take the smallest BEG value and then normalize all 939 ;; candidates by prefixing them such that they all start at the 940 ;; smallest BEG position. 941 (when (= beg beg2) 942 (push (list main (plist-get plist :predicate) table 943 ;; Plist attached to the candidates 944 (mapcan (lambda (f) 945 (when-let ((v (plist-get plist f))) 946 (list f v))) 947 cand-functions)) 948 tables) 949 ;; The resulting merged Capf is exclusive if one of the main 950 ;; Capfs is exclusive. 951 (when (and main (not (eq (plist-get plist :exclusive) 'no))) 952 (setq exclusive t)) 953 (setq end (max end end2)) 954 (let ((plen (plist-get plist :company-prefix-length))) 955 (cond 956 ((eq plen t) 957 (setq prefix-len t)) 958 ((and (not prefix-len) (integerp plen)) 959 (setq prefix-len plen)) 960 ((and (integerp prefix-len) (integerp plen)) 961 (setq prefix-len (max prefix-len plen))))))) 962 (setq tables (nreverse tables)) 963 `(,beg ,end 964 ,(lambda (str pred action) 965 (pcase action 966 (`(boundaries . ,_) nil) 967 ('metadata 968 '(metadata (category . cape-super) 969 (display-sort-function . identity) 970 (cycle-sort-function . identity))) 971 ('t ;; all-completions 972 (let ((ht (make-hash-table :test #'equal)) 973 (candidates nil)) 974 (cl-loop for (main table-pred table cand-plist) in tables do 975 (let* ((pr (if (and table-pred pred) 976 (lambda (x) (and (funcall table-pred x) (funcall pred x))) 977 (or table-pred pred))) 978 (md (completion-metadata "" table pr)) 979 (sort (or (completion-metadata-get md 'display-sort-function) 980 #'identity)) 981 ;; Always compute candidates of the main Capf 982 ;; tables, which come first in the tables 983 ;; list. For the :with Capfs only compute 984 ;; candidates if we've already determined that 985 ;; main candidates are available. 986 (cands (when (or main (or exclusive cand-ht candidates)) 987 (funcall sort (all-completions str table pr))))) 988 ;; Handle duplicates with a hash table. 989 (cl-loop 990 for cand in-ref cands 991 for dup = (gethash cand ht t) do 992 (cond 993 ((eq dup t) 994 ;; Candidate does not yet exist. 995 (puthash cand cand-plist ht)) 996 ((not (equal dup cand-plist)) 997 ;; Duplicate candidate. Candidate plist is 998 ;; different, therefore disambiguate the 999 ;; candidates. 1000 (setf cand (propertize cand 'cape-capf-super 1001 (cons cand cand-plist)))))) 1002 (when cands (push cands candidates)))) 1003 (when (or cand-ht candidates) 1004 (setq candidates (apply #'nconc (nreverse candidates)) 1005 cand-ht ht) 1006 candidates))) 1007 (_ ;; try-completion and test-completion 1008 (cl-loop for (_main table-pred table _cand-plist) in tables thereis 1009 (complete-with-action 1010 action table str 1011 (if (and table-pred pred) 1012 (lambda (x) (and (funcall table-pred x) (funcall pred x))) 1013 (or table-pred pred))))))) 1014 :company-prefix-length ,prefix-len 1015 ,@(and (not exclusive) '(:exclusive no)) 1016 ,@(mapcan 1017 (lambda (prop) 1018 (list prop 1019 (lambda (cand &rest args) 1020 (if-let ((ref (get-text-property 0 'cape-capf-super cand))) 1021 (when-let ((fun (plist-get (cdr ref) prop))) 1022 (apply fun (car ref) args)) 1023 (when-let ((plist (and cand-ht (gethash cand cand-ht))) 1024 (fun (plist-get plist prop))) 1025 (apply fun cand args)))))) 1026 cand-functions))))) 1027 1028 ;;;###autoload 1029 (defun cape-wrap-debug (capf &optional name) 1030 "Call CAPF and return a completion table which prints trace messages. 1031 If CAPF is an anonymous lambda, pass the Capf NAME explicitly for 1032 meaningful debugging output." 1033 (unless name 1034 (setq name (if (symbolp capf) capf "capf"))) 1035 (setq name (format "%s@%s" name (cl-incf cape--debug-id))) 1036 (pcase (funcall capf) 1037 (`(,beg ,end ,table . ,plist) 1038 (let* ((limit (1+ cape--debug-length)) 1039 (pred (plist-get plist :predicate)) 1040 (cands 1041 ;; Reset regexps for `all-completions' 1042 (let (completion-ignore-case completion-regexp-list) 1043 (all-completions 1044 "" table 1045 (lambda (&rest args) 1046 (and (or (not pred) (apply pred args)) (>= (cl-decf limit) 0)))))) 1047 (plist-str "") 1048 (plist-elt plist)) 1049 (while (cdr plist-elt) 1050 (setq plist-str (format "%s %s=%s" plist-str 1051 (substring (symbol-name (car plist-elt)) 1) 1052 (cape--debug-print (cadr plist-elt))) 1053 plist-elt (cddr plist-elt))) 1054 (cape--debug-message 1055 "%s => input=%s:%s:%S table=%s%s" 1056 name (+ beg 0) (+ end 0) (buffer-substring-no-properties beg end) 1057 (cape--debug-print cands) 1058 plist-str)) 1059 `(,beg ,end ,(cape--debug-table 1060 table name (copy-marker beg) (copy-marker end t)) 1061 ,@(when-let ((exit (plist-get plist :exit-function))) 1062 (list :exit-function 1063 (lambda (cand status) 1064 (cape--debug-message "%s:exit(candidate=%S status=%s)" 1065 name cand status) 1066 (funcall exit cand status)))) 1067 . ,plist)) 1068 (result 1069 (cape--debug-message "%s() => %s (No completion)" 1070 name (cape--debug-print result))))) 1071 1072 ;;;###autoload 1073 (defun cape-wrap-buster (capf &optional valid) 1074 "Call CAPF and return a completion table with cache busting. 1075 This function can be used as an advice around an existing Capf. 1076 The cache is busted when the input changes. The argument VALID 1077 can be a function taking the old and new input string. It should 1078 return nil if the new input requires that the completion table is 1079 refreshed. The default value for VALID is `equal', such that the 1080 completion table is refreshed on every input change." 1081 (setq valid (or valid #'equal)) 1082 (pcase (funcall capf) 1083 (`(,beg ,end ,table . ,plist) 1084 (setq plist `(:cape--buster t . ,plist)) 1085 `(,beg ,end 1086 ,(let* ((beg (copy-marker beg)) 1087 (end (copy-marker end t)) 1088 (input (buffer-substring-no-properties beg end))) 1089 (lambda (str pred action) 1090 (let ((new-input (buffer-substring-no-properties beg end))) 1091 (unless (or (not (eq action t)) 1092 (cape--separator-p new-input) 1093 (funcall valid input new-input)) 1094 (pcase 1095 ;; Reset in case `all-completions' is used inside CAPF 1096 (let (completion-ignore-case completion-regexp-list) 1097 (funcall capf)) 1098 ((and `(,new-beg ,new-end ,new-table . ,new-plist) 1099 (guard (and (= beg new-beg) (= end new-end)))) 1100 (let (throw-on-input) ;; No interrupt during state update 1101 (setf table new-table 1102 input new-input 1103 (cddr plist) new-plist)))))) 1104 (complete-with-action action table str pred))) 1105 ,@plist)))) 1106 1107 ;;;###autoload 1108 (defun cape-wrap-passthrough (capf) 1109 "Call CAPF and make sure that no completion style filtering takes place." 1110 (pcase (funcall capf) 1111 (`(,beg ,end ,table . ,plist) 1112 `(,beg ,end ,(cape--passthrough-table table) ,@plist)))) 1113 1114 ;;;###autoload 1115 (defun cape-wrap-properties (capf &rest properties) 1116 "Call CAPF and add additional completion PROPERTIES. 1117 Completion properties include for example :exclusive, :annotation-function and 1118 the various :company-* extensions. Furthermore a boolean :sort flag and a 1119 completion :category symbol can be specified." 1120 (pcase (funcall capf) 1121 (`(,beg ,end ,table . ,plist) 1122 `(,beg ,end 1123 ,(apply #'cape--properties-table table properties) 1124 ,@properties ,@plist)))) 1125 1126 ;;;###autoload 1127 (defun cape-wrap-nonexclusive (capf) 1128 "Call CAPF and ensure that it is marked as non-exclusive. 1129 This function can be used as an advice around an existing Capf." 1130 (cape-wrap-properties capf :exclusive 'no)) 1131 1132 ;;;###autoload 1133 (defun cape-wrap-predicate (capf predicate) 1134 "Call CAPF and add an additional candidate PREDICATE. 1135 The PREDICATE is passed the candidate symbol or string." 1136 (pcase (funcall capf) 1137 (`(,beg ,end ,table . ,plist) 1138 `(,beg ,end ,table 1139 :predicate 1140 ,(if-let (pred (plist-get plist :predicate)) 1141 ;; First argument is key, second is value for hash tables. 1142 ;; The first argument can be a cons cell for alists. Then 1143 ;; the candidate itself is either a string or a symbol. We 1144 ;; normalize the calling convention here such that PREDICATE 1145 ;; always receives a string or a symbol. 1146 (lambda (&rest args) 1147 (when (apply pred args) 1148 (setq args (car args)) 1149 (funcall predicate (if (consp args) (car args) args)))) 1150 (lambda (key &optional _val) 1151 (funcall predicate (if (consp key) (car key) key)))) 1152 ,@plist)))) 1153 1154 ;;;###autoload 1155 (defun cape-wrap-silent (capf) 1156 "Call CAPF and silence it (no messages, no errors). 1157 This function can be used as an advice around an existing Capf." 1158 (pcase (cape--silent (funcall capf)) 1159 (`(,beg ,end ,table . ,plist) 1160 `(,beg ,end ,(cape--silent-table table) ,@plist)))) 1161 1162 ;;;###autoload 1163 (defun cape-wrap-case-fold (capf &optional nofold) 1164 "Call CAPF and return a case-insensitive completion table. 1165 If NOFOLD is non-nil return a case sensitive table instead. This 1166 function can be used as an advice around an existing Capf." 1167 (pcase (funcall capf) 1168 (`(,beg ,end ,table . ,plist) 1169 `(,beg ,end ,(completion-table-case-fold table nofold) ,@plist)))) 1170 1171 ;;;###autoload 1172 (defun cape-wrap-noninterruptible (capf) 1173 "Call CAPF and return a non-interruptible completion table. 1174 This function can be used as an advice around an existing Capf." 1175 (pcase (let (throw-on-input) (funcall capf)) 1176 (`(,beg ,end ,table . ,plist) 1177 `(,beg ,end ,(cape--noninterruptible-table table) ,@plist)))) 1178 1179 ;;;###autoload 1180 (defun cape-wrap-prefix-length (capf length) 1181 "Call CAPF and ensure that prefix length is greater or equal than LENGTH. 1182 If the prefix is long enough, enforce auto completion." 1183 (pcase (funcall capf) 1184 (`(,beg ,end ,table . ,plist) 1185 (when (>= (- end beg) length) 1186 `(,beg ,end ,table 1187 :company-prefix-length t 1188 ,@plist))))) 1189 1190 ;;;###autoload 1191 (defun cape-wrap-inside-faces (capf &rest faces) 1192 "Call CAPF only if inside FACES. 1193 This function can be used as an advice around an existing Capf." 1194 (when-let (((> (point) (point-min))) 1195 (fs (get-text-property (1- (point)) 'face)) 1196 ((if (listp fs) 1197 (cl-loop for f in fs thereis (memq f faces)) 1198 (memq fs faces)))) 1199 (funcall capf))) 1200 1201 ;;;###autoload 1202 (defun cape-wrap-inside-code (capf) 1203 "Call CAPF only if inside code, not inside a comment or string. 1204 This function can be used as an advice around an existing Capf." 1205 (let ((s (syntax-ppss))) 1206 (and (not (nth 3 s)) (not (nth 4 s)) (funcall capf)))) 1207 1208 ;;;###autoload 1209 (defun cape-wrap-inside-comment (capf) 1210 "Call CAPF only if inside comment. 1211 This function can be used as an advice around an existing Capf." 1212 (and (nth 4 (syntax-ppss)) (funcall capf))) 1213 1214 ;;;###autoload 1215 (defun cape-wrap-inside-string (capf) 1216 "Call CAPF only if inside string. 1217 This function can be used as an advice around an existing Capf." 1218 (and (nth 3 (syntax-ppss)) (funcall capf))) 1219 1220 ;;;###autoload 1221 (defun cape-wrap-purify (capf) 1222 "Call CAPF and ensure that it does not illegally modify the buffer. 1223 This function can be used as an advice around an existing 1224 Capf. It has been introduced mainly to fix the broken 1225 `pcomplete-completions-at-point' function in Emacs versions < 29." 1226 ;; bug#50470: Fix Capfs which illegally modify the buffer or which illegally 1227 ;; call `completion-in-region'. The workaround here was proposed by 1228 ;; @jakanakaevangeli and is used in his capf-autosuggest package. In Emacs 29 1229 ;; the purity bug of Pcomplete has been fixed, such that make 1230 ;; `cape-wrap-purify' is not necessary anymore. 1231 (catch 'cape--illegal-completion-in-region 1232 (condition-case nil 1233 (let ((buffer-read-only t) 1234 (inhibit-read-only nil) 1235 (completion-in-region-function 1236 (lambda (beg end coll pred) 1237 (throw 'cape--illegal-completion-in-region 1238 (list beg end coll :predicate pred))))) 1239 (funcall capf)) 1240 (buffer-read-only nil)))) 1241 1242 ;;;###autoload 1243 (defun cape-wrap-accept-all (capf) 1244 "Call CAPF and return a completion table which accepts every input. 1245 This function can be used as an advice around an existing Capf." 1246 (pcase (funcall capf) 1247 (`(,beg ,end ,table . ,plist) 1248 `(,beg ,end ,(cape--accept-all-table table) . ,plist)))) 1249 1250 ;;;###autoload (autoload 'cape-capf-accept-all "cape") 1251 ;;;###autoload (autoload 'cape-capf-buster "cape") 1252 ;;;###autoload (autoload 'cape-capf-case-fold "cape") 1253 ;;;###autoload (autoload 'cape-capf-debug "cape") 1254 ;;;###autoload (autoload 'cape-capf-inside-code "cape") 1255 ;;;###autoload (autoload 'cape-capf-inside-comment "cape") 1256 ;;;###autoload (autoload 'cape-capf-inside-faces "cape") 1257 ;;;###autoload (autoload 'cape-capf-inside-string "cape") 1258 ;;;###autoload (autoload 'cape-capf-nonexclusive "cape") 1259 ;;;###autoload (autoload 'cape-capf-noninterruptible "cape") 1260 ;;;###autoload (autoload 'cape-capf-passthrough "cape") 1261 ;;;###autoload (autoload 'cape-capf-predicate "cape") 1262 ;;;###autoload (autoload 'cape-capf-prefix-length "cape") 1263 ;;;###autoload (autoload 'cape-capf-properties "cape") 1264 ;;;###autoload (autoload 'cape-capf-purify "cape") 1265 ;;;###autoload (autoload 'cape-capf-silent "cape") 1266 ;;;###autoload (autoload 'cape-capf-super "cape") 1267 1268 (dolist (wrapper (list #'cape-wrap-accept-all #'cape-wrap-buster 1269 #'cape-wrap-case-fold #'cape-wrap-debug 1270 #'cape-wrap-inside-code #'cape-wrap-inside-comment 1271 #'cape-wrap-inside-faces #'cape-wrap-inside-string 1272 #'cape-wrap-nonexclusive #'cape-wrap-noninterruptible 1273 #'cape-wrap-passthrough #'cape-wrap-predicate 1274 #'cape-wrap-prefix-length #'cape-wrap-properties 1275 #'cape-wrap-purify #'cape-wrap-silent #'cape-wrap-super)) 1276 (let ((name (string-remove-prefix "cape-wrap-" (symbol-name wrapper)))) 1277 (defalias (intern (format "cape-capf-%s" name)) 1278 (lambda (capf &rest args) (lambda () (apply wrapper capf args))) 1279 (format "Create a %s Capf from CAPF. 1280 The Capf calls `%s' with CAPF and ARGS as arguments." name wrapper)))) 1281 1282 (defvar-keymap cape-prefix-map 1283 :doc "Keymap used as completion entry point. 1284 The keymap should be installed globally under a prefix." 1285 "p" #'completion-at-point 1286 "t" #'complete-tag 1287 "d" #'cape-dabbrev 1288 "h" #'cape-history 1289 "f" #'cape-file 1290 "s" #'cape-elisp-symbol 1291 "e" #'cape-elisp-block 1292 "a" #'cape-abbrev 1293 "l" #'cape-line 1294 "w" #'cape-dict 1295 "k" 'cape-keyword 1296 ":" 'cape-emoji 1297 "\\" 'cape-tex 1298 "_" 'cape-tex 1299 "^" 'cape-tex 1300 "&" 'cape-sgml 1301 "r" 'cape-rfc1345) 1302 1303 ;;;###autoload (autoload 'cape-prefix-map "cape" nil t 'keymap) 1304 (defalias 'cape-prefix-map cape-prefix-map) 1305 1306 (provide 'cape) 1307 ;;; cape.el ends here