cape.el (54748B)
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: 20240926.918 9 ;; Package-Revision: 2734e4ea0631 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) &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 ;; The metadata will be overridden if the category is non-nil, if the table is 295 ;; a function table or if sorting should be disabled for a non-nil 296 ;; non-function table. 297 (if (or category (functionp table) (and (not sort) table)) 298 (let ((metadata `(metadata 299 ,@(and category `((category . ,category))) 300 ,@(and (not sort) '((display-sort-function . identity) 301 (cycle-sort-function . identity)))))) 302 (lambda (str pred action) 303 (if (eq action 'metadata) 304 metadata 305 (complete-with-action action table str pred)))) 306 table)) 307 308 (defun cape--dynamic-table (beg end fun) 309 "Create dynamic completion table from FUN with caching. 310 BEG and END are the input bounds. FUN is the function which 311 computes the candidates. FUN must return a pair of a predicate 312 function function and the list of candidates. The predicate is 313 passed new input and must return non-nil if the candidates are 314 still valid. 315 316 It is only necessary to use this function if the set of 317 candidates is computed dynamically based on the input and not 318 statically determined. The behavior is similar but slightly 319 different to `completion-table-dynamic'. 320 321 The difference to the builtins `completion-table-dynamic' and 322 `completion-table-with-cache' is that this function does not use 323 the prefix argument of the completion table to compute the 324 candidates. Instead it uses the input in the buffer between BEG 325 and END to FUN to compute the candidates. This way the dynamic 326 candidate computation is compatible with non-prefix completion 327 styles like `substring' or `orderless', which pass the empty 328 string as first argument to the completion table." 329 (let ((beg (copy-marker beg)) 330 (end (copy-marker end t)) 331 valid table) 332 (lambda (str pred action) 333 ;; Bail out early for `metadata' and `boundaries'. This is a pointless 334 ;; move because of caching, but we do it anyway in the hope that the 335 ;; profiler report looks less confusing, since the weight of the expensive 336 ;; FUN computation is moved to the `all-completions' action. Computing 337 ;; `all-completions' must surely be most expensive, so nobody will suspect 338 ;; a thing. 339 (unless (or (eq action 'metadata) (eq (car-safe action) 'boundaries)) 340 (let ((input (buffer-substring-no-properties beg end))) 341 (unless (and valid 342 (or (cape--separator-p input) 343 (funcall valid input))) 344 (let* (;; Reset in case `all-completions' is used inside FUN 345 completion-ignore-case completion-regexp-list 346 ;; Retrieve new state by calling FUN 347 (new (funcall fun input)) 348 ;; No interrupt during state update 349 throw-on-input) 350 (setq valid (car new) table (cdr new))))) 351 (complete-with-action action table str pred))))) 352 353 ;;;; Capfs 354 355 ;;;;; cape-history 356 357 (declare-function ring-elements "ring") 358 (declare-function eshell-bol "eshell") 359 (declare-function comint-line-beginning-position "comint") 360 (defvar eshell-history-ring) 361 (defvar comint-input-ring) 362 363 (defvar cape--history-properties 364 (list :company-kind (lambda (_) 'text) 365 :exclusive 'no) 366 "Completion extra properties for `cape-history'.") 367 368 ;;;###autoload 369 (defun cape-history (&optional interactive) 370 "Complete from Eshell, Comint or minibuffer history. 371 See also `consult-history' for a more flexible variant based on 372 `completing-read'. If INTERACTIVE is nil the function acts like a Capf." 373 (interactive (list t)) 374 (if interactive 375 (cape-interactive #'cape-history) 376 (let (history bol) 377 (cond 378 ((derived-mode-p 'eshell-mode) 379 (setq history eshell-history-ring 380 bol (static-if (< emacs-major-version 30) 381 (save-excursion (eshell-bol) (point)) 382 (line-beginning-position)))) 383 ((derived-mode-p 'comint-mode) 384 (setq history comint-input-ring 385 bol (comint-line-beginning-position))) 386 ((and (minibufferp) (not (eq minibuffer-history-variable t))) 387 (setq history (symbol-value minibuffer-history-variable) 388 bol (line-beginning-position)))) 389 (when (ring-p history) 390 (setq history (ring-elements history))) 391 (when history 392 `(,bol ,(point) 393 ,(cape--properties-table history :sort nil) 394 ,@cape--history-properties))))) 395 396 ;;;;; cape-file 397 398 (defvar comint-unquote-function) 399 (defvar comint-requote-function) 400 401 (defvar cape--file-properties 402 (list :annotation-function (lambda (s) (if (string-suffix-p "/" s) " Dir" " File")) 403 :company-kind (lambda (s) (if (string-suffix-p "/" s) 'folder 'file)) 404 :exclusive 'no) 405 "Completion extra properties for `cape-file'.") 406 407 ;;;###autoload 408 (defun cape-file (&optional interactive) 409 "Complete file name at point. 410 See the user option `cape-file-directory-must-exist'. 411 If INTERACTIVE is nil the function acts like a Capf." 412 (interactive (list t)) 413 (if interactive 414 (cape-interactive '(cape-file-directory-must-exist) #'cape-file) 415 (pcase-let* ((default-directory (pcase cape-file-directory 416 ('nil default-directory) 417 ((pred stringp) cape-file-directory) 418 (_ (funcall cape-file-directory)))) 419 (prefix (and cape-file-prefix 420 (looking-back 421 (concat 422 (regexp-opt (ensure-list cape-file-prefix) t) 423 "[^ \n\t]*") 424 (pos-bol)) 425 (match-end 1))) 426 (`(,beg . ,end) (if prefix 427 (cons prefix (point)) 428 (cape--bounds 'filename))) 429 (non-essential t) 430 (file (buffer-substring-no-properties beg end))) 431 (when (or prefix 432 (not cape-file-directory-must-exist) 433 (and (string-search "/" file) 434 (file-exists-p (file-name-directory file)))) 435 `(,beg ,end 436 ,(cape--nonessential-table 437 (if (or (derived-mode-p 'comint-mode) (derived-mode-p 'eshell-mode)) 438 (completion-table-with-quoting 439 #'read-file-name-internal 440 comint-unquote-function 441 comint-requote-function) 442 #'read-file-name-internal)) 443 ,@(when (or prefix (string-match-p "./" file)) 444 '(:company-prefix-length t)) 445 ,@cape--file-properties))))) 446 447 ;;;;; cape-elisp-symbol 448 449 (autoload 'elisp--company-kind "elisp-mode") 450 (autoload 'elisp--company-doc-buffer "elisp-mode") 451 (autoload 'elisp--company-doc-string "elisp-mode") 452 (autoload 'elisp--company-location "elisp-mode") 453 454 (defvar cape--elisp-symbol-properties 455 (list :annotation-function #'cape--elisp-symbol-annotation 456 :exit-function #'cape--elisp-symbol-exit 457 :predicate #'cape--elisp-symbol-predicate 458 :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 :exclusive 'no) 463 "Completion extra properties for `cape-elisp-symbol'.") 464 465 (defun cape--elisp-symbol-predicate (sym) 466 "Return t if SYM is bound, fbound or propertized." 467 (or (fboundp sym) (boundp sym) (symbol-plist sym))) 468 469 (defun cape--elisp-symbol-exit (sym status) 470 "Wrap symbol SYM with `cape-elisp-symbol-wrapper' buffers. 471 STATUS is the exit status." 472 (when-let (((not (eq status 'exact))) 473 (c (cl-loop for (m . c) in cape-elisp-symbol-wrapper 474 if (derived-mode-p m) return c)) 475 ((or (not (derived-mode-p 'emacs-lisp-mode)) 476 ;; Inside comment or string 477 (let ((s (syntax-ppss))) (or (nth 3 s) (nth 4 s))))) 478 (x (if (stringp (car c)) (car c) (string (car c)))) 479 (y (if (stringp (cadr c)) (cadr c) (string (cadr c))))) 480 (save-excursion 481 (backward-char (length sym)) 482 (unless (save-excursion 483 (and (ignore-errors (or (backward-char (length x)) t)) 484 (looking-at-p (regexp-quote x)))) 485 (insert x))) 486 (unless (looking-at-p (regexp-quote y)) 487 (insert y)))) 488 489 (defun cape--elisp-symbol-annotation (sym) 490 "Return kind of SYM." 491 (setq sym (intern-soft sym)) 492 (cond 493 ((special-form-p sym) " Special") 494 ((macrop sym) " Macro") 495 ((commandp sym) " Command") 496 ((fboundp sym) " Function") 497 ((custom-variable-p sym) " Custom") 498 ((boundp sym) " Variable") 499 ((featurep sym) " Feature") 500 ((facep sym) " Face") 501 (t " Symbol"))) 502 503 ;;;###autoload 504 (defun cape-elisp-symbol (&optional interactive) 505 "Complete Elisp symbol at point. 506 If INTERACTIVE is nil the function acts like a Capf." 507 (interactive (list t)) 508 (if interactive 509 ;; No cycling since it breaks the :exit-function. 510 (let (completion-cycle-threshold) 511 (cape-interactive #'cape-elisp-symbol)) 512 (pcase-let ((`(,beg . ,end) (cape--bounds 'symbol))) 513 (when (eq (char-after beg) ?') 514 (setq beg (1+ beg) end (max beg end))) 515 `(,beg ,end 516 ,(cape--properties-table obarray :category 'symbol) 517 ,@cape--elisp-symbol-properties)))) 518 519 ;;;;; cape-elisp-block 520 521 (declare-function org-element-context "org-element") 522 (declare-function markdown-code-block-lang "ext:markdown-mode") 523 524 (defun cape--inside-block-p (&rest langs) 525 "Return non-nil if inside LANGS code block." 526 (when-let ((face (get-text-property (point) 'face)) 527 (lang (or (and (if (listp face) 528 (memq 'org-block face) 529 (eq 'org-block face)) 530 (plist-get (cadr (org-element-context)) :language)) 531 (and (if (listp face) 532 (memq 'markdown-code-face face) 533 (eq 'markdown-code-face face)) 534 (save-excursion 535 (markdown-code-block-lang)))))) 536 (member lang langs))) 537 538 ;;;###autoload 539 (defun cape-elisp-block (&optional interactive) 540 "Complete Elisp in Org or Markdown code block. 541 This Capf is particularly useful for literate Emacs configurations. 542 If INTERACTIVE is nil the function acts like a Capf." 543 (interactive (list t)) 544 (cond 545 (interactive 546 ;; No code block check. Always complete Elisp when command was 547 ;; explicitly invoked interactively. 548 (cape-interactive #'elisp-completion-at-point)) 549 ((cape--inside-block-p "elisp" "emacs-lisp") 550 (elisp-completion-at-point)))) 551 552 ;;;;; cape-dabbrev 553 554 (defvar cape--dabbrev-properties 555 (list :annotation-function (lambda (_) " Dabbrev") 556 :company-kind (lambda (_) 'text) 557 :exclusive 'no) 558 "Completion extra properties for `cape-dabbrev'.") 559 560 (defvar dabbrev-case-replace) 561 (defvar dabbrev-case-fold-search) 562 (defvar dabbrev-abbrev-char-regexp) 563 (defvar dabbrev-abbrev-skip-leading-regexp) 564 (declare-function dabbrev--find-all-expansions "dabbrev") 565 (declare-function dabbrev--reset-global-variables "dabbrev") 566 567 (defun cape--dabbrev-list (input) 568 "Find all Dabbrev expansions for INPUT." 569 (cape--silent 570 (let* ((chk cape-dabbrev-check-other-buffers) 571 (funp (and (not (memq chk '(nil t some))) (functionp chk)))) 572 (dlet ((dabbrev-check-other-buffers (and chk (not funp))) 573 (dabbrev-check-all-buffers (eq chk t)) 574 (dabbrev-search-these-buffers-only (and funp (funcall chk)))) 575 (dabbrev--reset-global-variables) 576 (cons 577 (apply-partially #'string-prefix-p input) 578 (cl-loop with min-len = (+ cape-dabbrev-min-length (length input)) 579 with ic = (cape--case-fold-p dabbrev-case-fold-search) 580 for w in (dabbrev--find-all-expansions input ic) 581 if (>= (length w) min-len) collect 582 (cape--case-replace (and ic dabbrev-case-replace) input w))))))) 583 584 (defun cape--dabbrev-bounds () 585 "Return bounds of abbreviation." 586 (unless (boundp 'dabbrev-abbrev-char-regexp) 587 (require 'dabbrev)) 588 (let ((re (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_")) 589 (limit (minibuffer-prompt-end))) 590 (when (or (looking-at re) 591 (and (> (point) limit) 592 (save-excursion (forward-char -1) (looking-at re)))) 593 (cons (save-excursion 594 (while (and (> (point) limit) 595 (save-excursion (forward-char -1) (looking-at re))) 596 (forward-char -1)) 597 (when dabbrev-abbrev-skip-leading-regexp 598 (while (looking-at dabbrev-abbrev-skip-leading-regexp) 599 (forward-char 1))) 600 (point)) 601 (save-excursion 602 (while (looking-at re) 603 (forward-char 1)) 604 (point)))))) 605 606 ;;;###autoload 607 (defun cape-dabbrev (&optional interactive) 608 "Complete with Dabbrev at point. 609 610 If INTERACTIVE is nil the function acts like a Capf. In case you 611 observe a performance issue with auto-completion and `cape-dabbrev' 612 it is strongly recommended to disable scanning in other buffers. 613 See the user options `cape-dabbrev-min-length' and 614 `cape-dabbrev-check-other-buffers'." 615 (interactive (list t)) 616 (if interactive 617 (cape-interactive '((cape-dabbrev-min-length 0)) #'cape-dabbrev) 618 (when-let ((bounds (cape--dabbrev-bounds))) 619 `(,(car bounds) ,(cdr bounds) 620 ,(cape--properties-table 621 (completion-table-case-fold 622 (cape--dynamic-table (car bounds) (cdr bounds) #'cape--dabbrev-list) 623 (not (cape--case-fold-p dabbrev-case-fold-search))) 624 :category 'cape-dabbrev) 625 ,@cape--dabbrev-properties)))) 626 627 ;;;;; cape-dict 628 629 (defvar cape--dict-properties 630 (list :annotation-function (lambda (_) " Dict") 631 :company-kind (lambda (_) 'text) 632 :exclusive 'no) 633 "Completion extra properties for `cape-dict'.") 634 635 (defun cape--dict-list (input) 636 "Return all words from `cape-dict-file' matching INPUT." 637 (unless (equal input "") 638 (let* ((inhibit-message t) 639 (message-log-max nil) 640 (default-directory 641 (if (and (not (file-remote-p default-directory)) 642 (file-directory-p default-directory)) 643 default-directory 644 user-emacs-directory)) 645 (files (mapcar #'expand-file-name 646 (ensure-list 647 (if (functionp cape-dict-file) 648 (funcall cape-dict-file) 649 cape-dict-file)))) 650 (words 651 (apply #'process-lines-ignore-status 652 "grep" 653 (concat "-Fh" 654 (and (cape--case-fold-p cape-dict-case-fold) "i") 655 (and cape-dict-limit (format "m%d" cape-dict-limit))) 656 input files))) 657 (cons 658 (apply-partially 659 (if (and cape-dict-limit (length= words cape-dict-limit)) 660 #'equal #'string-search) 661 input) 662 (cape--case-replace-list cape-dict-case-replace input words))))) 663 664 ;;;###autoload 665 (defun cape-dict (&optional interactive) 666 "Complete word from dictionary at point. 667 This completion function works best if the dictionary is sorted 668 by frequency. See the custom option `cape-dict-file'. If 669 INTERACTIVE is nil the function acts like a Capf." 670 (interactive (list t)) 671 (if interactive 672 (cape-interactive #'cape-dict) 673 (pcase-let ((`(,beg . ,end) (cape--bounds 'word))) 674 `(,beg ,end 675 ,(cape--properties-table 676 (completion-table-case-fold 677 (cape--dynamic-table beg end #'cape--dict-list) 678 (not (cape--case-fold-p cape-dict-case-fold))) 679 :sort nil ;; Presorted word list (by frequency) 680 :category 'cape-dict) 681 ,@cape--dict-properties)))) 682 683 ;;;;; cape-abbrev 684 685 (defun cape--abbrev-list () 686 "Abbreviation list." 687 (delete "" (cl-loop for x in (abbrev--suggest-get-active-tables-including-parents) 688 nconc (all-completions "" x)))) 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 x in (abbrev--suggest-get-active-tables-including-parents) 698 thereis (abbrev--symbol abbrev x)))) 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, unless the UI guarantees 850 ;; this itself, like Corfu. 851 (unless (bound-and-true-p corfu-mode) 852 (setq restore-props cands)) 853 (cons (apply-partially valid input) cands)))) 854 :category backend 855 :sort (not (cape--company-call backend 'sorted)))) 856 :exclusive 'no 857 :company-prefix-length (cdr-safe prefix) 858 :company-doc-buffer (lambda (x) (cape--company-call backend 'doc-buffer x)) 859 :company-location (lambda (x) (cape--company-call backend 'location x)) 860 :company-docsig (lambda (x) (cape--company-call backend 'meta x)) 861 :company-deprecated (lambda (x) (cape--company-call backend 'deprecated x)) 862 :company-kind (lambda (x) (cape--company-call backend 'kind x)) 863 :annotation-function (lambda (x) 864 (when-let (ann (cape--company-call backend 'annotation x)) 865 (concat " " (string-trim ann)))) 866 :exit-function (lambda (x _status) 867 ;; Restore the candidate string including 868 ;; properties if restore-props is non-nil. See 869 ;; the comment above. 870 (setq x (or (car (member x restore-props)) x)) 871 (cape--company-call backend 'post-completion x))))))) 872 873 ;;;###autoload 874 (defun cape-interactive (&rest capfs) 875 "Complete interactively with the given CAPFS." 876 (let* ((ctx (and (consp (car capfs)) (car capfs))) 877 (capfs (if ctx (cdr capfs) capfs)) 878 (completion-at-point-functions 879 (if ctx 880 (mapcar (lambda (f) `(lambda () (let ,ctx (funcall ',f)))) capfs) 881 capfs))) 882 (unless (completion-at-point) 883 (user-error "%s: No completions" 884 (mapconcat (lambda (fun) 885 (if (symbolp fun) 886 (symbol-name fun) 887 "anonymous-capf")) 888 capfs ", "))))) 889 890 ;;;###autoload 891 (defun cape-capf-interactive (capf) 892 "Create interactive completion function from CAPF." 893 (lambda (&optional interactive) 894 (interactive (list t)) 895 (if interactive (cape-interactive capf) (funcall capf)))) 896 897 ;;;###autoload 898 (defun cape-wrap-super (&rest capfs) 899 "Call CAPFS and return merged completion result. 900 The CAPFS list can contain the keyword `:with' to mark the Capfs 901 afterwards as auxiliary One of the non-auxiliary Capfs before 902 `:with' must return non-nil for the super Capf to set in and 903 return a non-nil result. Such behavior is useful when listing 904 multiple super Capfs in the `completion-at-point-functions': 905 906 (setq completion-at-point-functions 907 (list (cape-capf-super \\='eglot-completion-at-point 908 :with \\='tempel-complete) 909 (cape-capf-super \\='cape-dabbrev 910 :with \\='tempel-complete)))" 911 (when-let ((results (cl-loop for capf in capfs until (eq capf :with) 912 for res = (funcall capf) 913 if res collect (cons t res)))) 914 (pcase-let* ((results (nconc results 915 (cl-loop for capf in (cdr (memq :with capfs)) 916 for res = (funcall capf) 917 if res collect (cons nil res)))) 918 (`((,_main ,beg ,end . ,_)) results) 919 (cand-ht nil) 920 (tables nil) 921 (exclusive nil) 922 (prefix-len nil) 923 (cand-functions 924 '(:company-docsig :company-location :company-kind 925 :company-doc-buffer :company-deprecated 926 :annotation-function :exit-function))) 927 (cl-loop for (main beg2 end2 table . plist) in results do 928 ;; Note: `cape-capf-super' currently cannot merge Capfs which 929 ;; trigger at different beginning positions. In order to support 930 ;; this, take the smallest BEG value and then normalize all 931 ;; candidates by prefixing them such that they all start at the 932 ;; smallest BEG position. 933 (when (= beg beg2) 934 (push (list main (plist-get plist :predicate) table 935 ;; Plist attached to the candidates 936 (mapcan (lambda (f) 937 (when-let ((v (plist-get plist f))) 938 (list f v))) 939 cand-functions)) 940 tables) 941 ;; The resulting merged Capf is exclusive if one of the main 942 ;; Capfs is exclusive. 943 (when (and main (not (eq (plist-get plist :exclusive) 'no))) 944 (setq exclusive t)) 945 (setq end (max end end2)) 946 (let ((plen (plist-get plist :company-prefix-length))) 947 (cond 948 ((eq plen t) 949 (setq prefix-len t)) 950 ((and (not prefix-len) (integerp plen)) 951 (setq prefix-len plen)) 952 ((and (integerp prefix-len) (integerp plen)) 953 (setq prefix-len (max prefix-len plen))))))) 954 (setq tables (nreverse tables)) 955 `(,beg ,end 956 ,(lambda (str pred action) 957 (pcase action 958 (`(boundaries . ,_) nil) 959 ('metadata 960 '(metadata (category . cape-super) 961 (display-sort-function . identity) 962 (cycle-sort-function . identity))) 963 ('t ;; all-completions 964 (let ((ht (make-hash-table :test #'equal)) 965 (candidates nil)) 966 (cl-loop for (main table-pred table cand-plist) in tables do 967 (let* ((pr (if (and table-pred pred) 968 (lambda (x) (and (funcall table-pred x) (funcall pred x))) 969 (or table-pred pred))) 970 (md (completion-metadata "" table pr)) 971 (sort (or (completion-metadata-get md 'display-sort-function) 972 #'identity)) 973 ;; Always compute candidates of the main Capf 974 ;; tables, which come first in the tables 975 ;; list. For the :with Capfs only compute 976 ;; candidates if we've already determined that 977 ;; main candidates are available. 978 (cands (when (or main (or exclusive cand-ht candidates)) 979 (funcall sort (all-completions str table pr))))) 980 ;; Handle duplicates with a hash table. 981 (cl-loop 982 for cand in-ref cands 983 for dup = (gethash cand ht t) do 984 (cond 985 ((eq dup t) 986 ;; Candidate does not yet exist. 987 (puthash cand cand-plist ht)) 988 ((not (equal dup cand-plist)) 989 ;; Duplicate candidate. Candidate plist is 990 ;; different, therefore disambiguate the 991 ;; candidates. 992 (setf cand (propertize cand 'cape-capf-super 993 (cons cand cand-plist)))))) 994 (when cands (push cands candidates)))) 995 (when (or cand-ht candidates) 996 (setq candidates (apply #'nconc (nreverse candidates)) 997 cand-ht ht) 998 candidates))) 999 (_ ;; try-completion and test-completion 1000 (cl-loop for (_main table-pred table _cand-plist) in tables thereis 1001 (complete-with-action 1002 action table str 1003 (if (and table-pred pred) 1004 (lambda (x) (and (funcall table-pred x) (funcall pred x))) 1005 (or table-pred pred))))))) 1006 :company-prefix-length ,prefix-len 1007 ,@(and (not exclusive) '(:exclusive no)) 1008 ,@(mapcan 1009 (lambda (prop) 1010 (list prop 1011 (lambda (cand &rest args) 1012 (if-let ((ref (get-text-property 0 'cape-capf-super cand))) 1013 (when-let ((fun (plist-get (cdr ref) prop))) 1014 (apply fun (car ref) args)) 1015 (when-let ((plist (and cand-ht (gethash cand cand-ht))) 1016 (fun (plist-get plist prop))) 1017 (apply fun cand args)))))) 1018 cand-functions))))) 1019 1020 ;;;###autoload 1021 (defun cape-wrap-debug (capf &optional name) 1022 "Call CAPF and return a completion table which prints trace messages. 1023 If CAPF is an anonymous lambda, pass the Capf NAME explicitly for 1024 meaningful debugging output." 1025 (unless name 1026 (setq name (if (symbolp capf) capf "capf"))) 1027 (setq name (format "%s@%s" name (cl-incf cape--debug-id))) 1028 (pcase (funcall capf) 1029 (`(,beg ,end ,table . ,plist) 1030 (let* ((limit (1+ cape--debug-length)) 1031 (pred (plist-get plist :predicate)) 1032 (cands 1033 ;; Reset regexps for `all-completions' 1034 (let (completion-ignore-case completion-regexp-list) 1035 (all-completions 1036 "" table 1037 (lambda (&rest args) 1038 (and (or (not pred) (apply pred args)) (>= (cl-decf limit) 0)))))) 1039 (plist-str "") 1040 (plist-elt plist)) 1041 (while (cdr plist-elt) 1042 (setq plist-str (format "%s %s=%s" plist-str 1043 (substring (symbol-name (car plist-elt)) 1) 1044 (cape--debug-print (cadr plist-elt))) 1045 plist-elt (cddr plist-elt))) 1046 (cape--debug-message 1047 "%s => input=%s:%s:%S table=%s%s" 1048 name (+ beg 0) (+ end 0) (buffer-substring-no-properties beg end) 1049 (cape--debug-print cands) 1050 plist-str)) 1051 `(,beg ,end ,(cape--debug-table 1052 table name (copy-marker beg) (copy-marker end t)) 1053 ,@(when-let ((exit (plist-get plist :exit-function))) 1054 (list :exit-function 1055 (lambda (cand status) 1056 (cape--debug-message "%s:exit(candidate=%S status=%s)" 1057 name cand status) 1058 (funcall exit cand status)))) 1059 . ,plist)) 1060 (result 1061 (cape--debug-message "%s() => %s (No completion)" 1062 name (cape--debug-print result))))) 1063 1064 ;;;###autoload 1065 (defun cape-wrap-buster (capf &optional valid) 1066 "Call CAPF and return a completion table with cache busting. 1067 This function can be used as an advice around an existing Capf. 1068 The cache is busted when the input changes. The argument VALID 1069 can be a function taking the old and new input string. It should 1070 return nil if the new input requires that the completion table is 1071 refreshed. The default value for VALID is `equal', such that the 1072 completion table is refreshed on every input change." 1073 (setq valid (or valid #'equal)) 1074 (pcase (funcall capf) 1075 (`(,beg ,end ,table . ,plist) 1076 (setq plist `(:cape--buster t . ,plist)) 1077 `(,beg ,end 1078 ,(let* ((beg (copy-marker beg)) 1079 (end (copy-marker end t)) 1080 (input (buffer-substring-no-properties beg end))) 1081 (lambda (str pred action) 1082 (let ((new-input (buffer-substring-no-properties beg end))) 1083 (unless (or (not (eq action t)) 1084 (cape--separator-p new-input) 1085 (funcall valid input new-input)) 1086 (pcase 1087 ;; Reset in case `all-completions' is used inside CAPF 1088 (let (completion-ignore-case completion-regexp-list) 1089 (funcall capf)) 1090 ((and `(,new-beg ,new-end ,new-table . ,new-plist) 1091 (guard (and (= beg new-beg) (= end new-end)))) 1092 (let (throw-on-input) ;; No interrupt during state update 1093 (setf table new-table 1094 input new-input 1095 (cddr plist) new-plist)))))) 1096 (complete-with-action action table str pred))) 1097 ,@plist)))) 1098 1099 ;;;###autoload 1100 (defun cape-wrap-passthrough (capf) 1101 "Call CAPF and make sure that no completion style filtering takes place." 1102 (pcase (funcall capf) 1103 (`(,beg ,end ,table . ,plist) 1104 `(,beg ,end ,(cape--passthrough-table table) ,@plist)))) 1105 1106 ;;;###autoload 1107 (defun cape-wrap-properties (capf &rest properties) 1108 "Call CAPF and add additional completion PROPERTIES. 1109 Completion properties include for example :exclusive, :annotation-function and 1110 the various :company-* extensions. Furthermore a boolean :sort flag and a 1111 completion :category symbol can be specified." 1112 (pcase (funcall capf) 1113 (`(,beg ,end ,table . ,plist) 1114 `(,beg ,end 1115 ,(apply #'cape--properties-table table properties) 1116 ,@properties ,@plist)))) 1117 1118 ;;;###autoload 1119 (defun cape-wrap-nonexclusive (capf) 1120 "Call CAPF and ensure that it is marked as non-exclusive. 1121 This function can be used as an advice around an existing Capf." 1122 (cape-wrap-properties capf :exclusive 'no)) 1123 1124 ;;;###autoload 1125 (defun cape-wrap-predicate (capf predicate) 1126 "Call CAPF and add an additional candidate PREDICATE. 1127 The PREDICATE is passed the candidate symbol or string." 1128 (pcase (funcall capf) 1129 (`(,beg ,end ,table . ,plist) 1130 `(,beg ,end ,table 1131 :predicate 1132 ,(if-let (pred (plist-get plist :predicate)) 1133 ;; First argument is key, second is value for hash tables. 1134 ;; The first argument can be a cons cell for alists. Then 1135 ;; the candidate itself is either a string or a symbol. We 1136 ;; normalize the calling convention here such that PREDICATE 1137 ;; always receives a string or a symbol. 1138 (lambda (&rest args) 1139 (when (apply pred args) 1140 (setq args (car args)) 1141 (funcall predicate (if (consp args) (car args) args)))) 1142 (lambda (key &optional _val) 1143 (funcall predicate (if (consp key) (car key) key)))) 1144 ,@plist)))) 1145 1146 ;;;###autoload 1147 (defun cape-wrap-silent (capf) 1148 "Call CAPF and silence it (no messages, no errors). 1149 This function can be used as an advice around an existing Capf." 1150 (pcase (cape--silent (funcall capf)) 1151 (`(,beg ,end ,table . ,plist) 1152 `(,beg ,end ,(cape--silent-table table) ,@plist)))) 1153 1154 ;;;###autoload 1155 (defun cape-wrap-case-fold (capf &optional nofold) 1156 "Call CAPF and return a case-insensitive completion table. 1157 If NOFOLD is non-nil return a case sensitive table instead. This 1158 function can be used as an advice around an existing Capf." 1159 (pcase (funcall capf) 1160 (`(,beg ,end ,table . ,plist) 1161 `(,beg ,end ,(completion-table-case-fold table nofold) ,@plist)))) 1162 1163 ;;;###autoload 1164 (defun cape-wrap-noninterruptible (capf) 1165 "Call CAPF and return a non-interruptible completion table. 1166 This function can be used as an advice around an existing Capf." 1167 (pcase (let (throw-on-input) (funcall capf)) 1168 (`(,beg ,end ,table . ,plist) 1169 `(,beg ,end ,(cape--noninterruptible-table table) ,@plist)))) 1170 1171 ;;;###autoload 1172 (defun cape-wrap-prefix-length (capf length) 1173 "Call CAPF and ensure that prefix length is greater or equal than LENGTH. 1174 If the prefix is long enough, enforce auto completion." 1175 (pcase (funcall capf) 1176 (`(,beg ,end ,table . ,plist) 1177 (when (>= (- end beg) length) 1178 `(,beg ,end ,table 1179 :company-prefix-length t 1180 ,@plist))))) 1181 1182 ;;;###autoload 1183 (defun cape-wrap-inside-faces (capf &rest faces) 1184 "Call CAPF only if inside FACES. 1185 This function can be used as an advice around an existing Capf." 1186 (when-let (((> (point) (point-min))) 1187 (fs (get-text-property (1- (point)) 'face)) 1188 ((if (listp fs) 1189 (cl-loop for f in fs thereis (memq f faces)) 1190 (memq fs faces)))) 1191 (funcall capf))) 1192 1193 ;;;###autoload 1194 (defun cape-wrap-inside-code (capf) 1195 "Call CAPF only if inside code, not inside a comment or string. 1196 This function can be used as an advice around an existing Capf." 1197 (let ((s (syntax-ppss))) 1198 (and (not (nth 3 s)) (not (nth 4 s)) (funcall capf)))) 1199 1200 ;;;###autoload 1201 (defun cape-wrap-inside-comment (capf) 1202 "Call CAPF only if inside comment. 1203 This function can be used as an advice around an existing Capf." 1204 (and (nth 4 (syntax-ppss)) (funcall capf))) 1205 1206 ;;;###autoload 1207 (defun cape-wrap-inside-string (capf) 1208 "Call CAPF only if inside string. 1209 This function can be used as an advice around an existing Capf." 1210 (and (nth 3 (syntax-ppss)) (funcall capf))) 1211 1212 ;;;###autoload 1213 (defun cape-wrap-purify (capf) 1214 "Call CAPF and ensure that it does not illegally modify the buffer. 1215 This function can be used as an advice around an existing 1216 Capf. It has been introduced mainly to fix the broken 1217 `pcomplete-completions-at-point' function in Emacs versions < 29." 1218 ;; bug#50470: Fix Capfs which illegally modify the buffer or which illegally 1219 ;; call `completion-in-region'. The workaround here was proposed by 1220 ;; @jakanakaevangeli and is used in his capf-autosuggest package. In Emacs 29 1221 ;; the purity bug of Pcomplete has been fixed, such that make 1222 ;; `cape-wrap-purify' is not necessary anymore. 1223 (catch 'cape--illegal-completion-in-region 1224 (condition-case nil 1225 (let ((buffer-read-only t) 1226 (inhibit-read-only nil) 1227 (completion-in-region-function 1228 (lambda (beg end coll pred) 1229 (throw 'cape--illegal-completion-in-region 1230 (list beg end coll :predicate pred))))) 1231 (funcall capf)) 1232 (buffer-read-only nil)))) 1233 1234 ;;;###autoload 1235 (defun cape-wrap-accept-all (capf) 1236 "Call CAPF and return a completion table which accepts every input. 1237 This function can be used as an advice around an existing Capf." 1238 (pcase (funcall capf) 1239 (`(,beg ,end ,table . ,plist) 1240 `(,beg ,end ,(cape--accept-all-table table) . ,plist)))) 1241 1242 ;;;###autoload (autoload 'cape-capf-accept-all "cape") 1243 ;;;###autoload (autoload 'cape-capf-buster "cape") 1244 ;;;###autoload (autoload 'cape-capf-case-fold "cape") 1245 ;;;###autoload (autoload 'cape-capf-debug "cape") 1246 ;;;###autoload (autoload 'cape-capf-inside-code "cape") 1247 ;;;###autoload (autoload 'cape-capf-inside-comment "cape") 1248 ;;;###autoload (autoload 'cape-capf-inside-faces "cape") 1249 ;;;###autoload (autoload 'cape-capf-inside-string "cape") 1250 ;;;###autoload (autoload 'cape-capf-nonexclusive "cape") 1251 ;;;###autoload (autoload 'cape-capf-noninterruptible "cape") 1252 ;;;###autoload (autoload 'cape-capf-passthrough "cape") 1253 ;;;###autoload (autoload 'cape-capf-predicate "cape") 1254 ;;;###autoload (autoload 'cape-capf-prefix-length "cape") 1255 ;;;###autoload (autoload 'cape-capf-properties "cape") 1256 ;;;###autoload (autoload 'cape-capf-purify "cape") 1257 ;;;###autoload (autoload 'cape-capf-silent "cape") 1258 ;;;###autoload (autoload 'cape-capf-super "cape") 1259 1260 (dolist (wrapper (list #'cape-wrap-accept-all #'cape-wrap-buster 1261 #'cape-wrap-case-fold #'cape-wrap-debug 1262 #'cape-wrap-inside-code #'cape-wrap-inside-comment 1263 #'cape-wrap-inside-faces #'cape-wrap-inside-string 1264 #'cape-wrap-nonexclusive #'cape-wrap-noninterruptible 1265 #'cape-wrap-passthrough #'cape-wrap-predicate 1266 #'cape-wrap-prefix-length #'cape-wrap-properties 1267 #'cape-wrap-purify #'cape-wrap-silent #'cape-wrap-super)) 1268 (let ((name (string-remove-prefix "cape-wrap-" (symbol-name wrapper)))) 1269 (defalias (intern (format "cape-capf-%s" name)) 1270 (lambda (capf &rest args) (lambda () (apply wrapper capf args))) 1271 (format "Create a %s Capf from CAPF. 1272 The Capf calls `%s' with CAPF and ARGS as arguments." name wrapper)))) 1273 1274 (defvar-keymap cape-prefix-map 1275 :doc "Keymap used as completion entry point. 1276 The keymap should be installed globally under a prefix." 1277 "p" #'completion-at-point 1278 "t" #'complete-tag 1279 "d" #'cape-dabbrev 1280 "h" #'cape-history 1281 "f" #'cape-file 1282 "s" #'cape-elisp-symbol 1283 "e" #'cape-elisp-block 1284 "a" #'cape-abbrev 1285 "l" #'cape-line 1286 "w" #'cape-dict 1287 "k" 'cape-keyword 1288 ":" 'cape-emoji 1289 "\\" 'cape-tex 1290 "_" 'cape-tex 1291 "^" 'cape-tex 1292 "&" 'cape-sgml 1293 "r" 'cape-rfc1345) 1294 1295 ;;;###autoload (autoload 'cape-prefix-map "cape" nil t 'keymap) 1296 (defalias 'cape-prefix-map cape-prefix-map) 1297 1298 (provide 'cape) 1299 ;;; cape.el ends here