diff options
Diffstat (limited to 'cape-char.el')
| -rw-r--r-- | cape-char.el | 138 |
1 files changed, 138 insertions, 0 deletions
diff --git a/cape-char.el b/cape-char.el new file mode 100644 index 0000000..4eb65fa --- /dev/null +++ b/cape-char.el @@ -0,0 +1,138 @@ +;;; cape-char.el --- Character completion functions -*- lexical-binding: t -*- + +;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package provides the `cape-tex', `cape-sgml' and `cape-rfc1345' +;; completion functions. + +;;; Code: + +(require 'cape) + +;; Declare as pure function which is evaluated at compile time. We don't use a +;; macro for this computation since packages like `helpful' will +;; `macroexpand-all' the expensive `cape-char--define' macro calls. +(eval-when-compile + (defun cape-char--translation (method regexp) + "Return character translation hash for METHOD. +REGEXP is the regular expression matching the names." + (declare (pure t)) + (save-window-excursion + (describe-input-method method) + (with-current-buffer "*Help*" + (let ((lines + (split-string + (replace-regexp-in-string + "\n\n\\(\n\\|.\\)*" "" + (replace-regexp-in-string + "\\`\\(\n\\|.\\)*?----\n" "" + (replace-regexp-in-string + "\\`\\(\n\\|.\\)*?KEY SEQUENCE\n-+\n" "" + (buffer-string)))) + "\n")) + (hash (make-hash-table :test #'equal))) + (dolist (line lines) + (let ((beg 0) (len (length line))) + (while (< beg len) + (let* ((ename (next-single-property-change beg 'face line len)) + (echar (next-single-property-change ename 'face line len))) + (when (and (get-text-property beg 'face line) (< ename len) (<= echar len)) + (let ((name (string-trim (substring-no-properties line beg ename))) + (char (string-trim (substring-no-properties line ename echar)))) + (when (and (string-match-p regexp name) (= (length char) 1)) + (puthash name (aref char 0) hash)))) + (setq beg echar))))) + (kill-buffer) + hash))))) + +(defmacro cape-char--define (name method &rest prefix) + "Define character translation capf. +NAME is the name of the capf. +METHOD is the input method. +PREFIX are the prefix characters." + (let ((capf (intern (format "cape-%s" name))) + (prefix-required (intern (format "cape-%s-prefix-required" name))) + (hash (intern (format "cape--%s-hash" name))) + (ann (intern (format "cape--%s-annotation" name))) + (docsig (intern (format "cape--%s-docsig" name))) + (exit (intern (format "cape--%s-exit" name))) + (properties (intern (format "cape--%s-properties" name)))) + `(progn + (defvar ,hash (cape-char--translation + ,method + ,(concat "\\`" (regexp-opt (mapcar #'char-to-string prefix))))) + (defcustom ,prefix-required t + ,(format "Initial prefix is required for `%s' to trigger." capf) + :type 'boolean + :group 'cape) + (defun ,ann (name) + (when-let (char (gethash name ,hash)) + (format " %c" char))) + (defun ,docsig (name) + (when-let (char (gethash name ,hash)) + (format "%s (%s)" + (get-char-code-property char 'name) + (char-code-property-description + 'general-category + (get-char-code-property char 'general-category))))) + (defun ,exit (name status) + (unless (eq status 'exact) + (when-let (char (gethash name ,hash)) + (delete-region (max (point-min) (- (point) (length name))) (point)) + (insert (char-to-string char))))) + (defvar ,properties + (list :annotation-function #',ann + :company-docsig #',docsig + :exit-function #',exit + :company-kind (lambda (_) 'text)) + ,(format "Completion extra properties for `%s'." name)) + (defun ,capf (&optional interactive) + ,(format "Complete unicode character at point. +Uses the same input format as the %s input method, +see (describe-input-method %S). If INTERACTIVE +is nil the function acts like a capf." method method) + (interactive (list t)) + (if interactive + ;; NOTE: Disable cycling since replacement breaks it. + (let (completion-cycle-threshold ,prefix-required) + (when (memq last-input-event ',prefix) + (self-insert-command 1 last-input-event)) + (cape--interactive #',capf)) + (when-let (bounds + (cond + ((thing-at-point-looking-at + ,(concat (regexp-opt (mapcar #'char-to-string prefix)) "[^ \n\t]*" )) + (cons (match-beginning 0) (match-end 0))) + ((not ,prefix-required) (cons (point) (point))))) + (append + (list (car bounds) (cdr bounds) + (cape--table-with-properties ,hash :category ',capf) + :exclusive 'no) + ,properties))))))) + +;;;###autoload (autoload 'cape-tex "cape-char" nil t) +;;;###autoload (autoload 'cape-sgml "cape-char" nil t) +;;;###autoload (autoload 'cape-rfc1345 "cape-char" nil t) +(cape-char--define tex "TeX" ?\\ ?^ ?_) +(cape-char--define sgml "sgml" ?&) +(cape-char--define rfc1345 "rfc1345" ?&) + +(provide 'cape-char) +;;; cape-char.el ends here |