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