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