code.delx.au - gnu-emacs-elpa/blob - company-math.el

   1 ;;; company-math.el --- Completion backends for unicode math symbols and latex tags
   2 ;;
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4 ;; Author: Vitalie Spinu
   5 ;; URL: https://github.com/vspinu/company-math
   6 ;; Keywords:  Unicode, symbols, completion
   7 ;; Version: 1.0.1
   8 ;; Package-Requires: ((company "0.8.0") (math-symbol-lists "1.0"))
   9 ;;
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11 ;;
  12 ;; This file is part of GNU Emacs.
  13 ;;
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 3, or
  17 ;; (at your option) any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  27 ;; Floor, Boston, MA 02110-1301, USA.
  28 ;;
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;
  31 ;;; Code:
  32
  33 (require 'math-symbol-lists)
  34 (require 'company)
  35 (require 'cl-lib)
  36
  37 (defgroup company-math nil
  38   "Completion back-ends for math symbols Unicode symbols and LaTeX tags."
  39   :group 'company
  40   :prefix "company-math-")
  41
  42 (defcustom company-math-prefix-regexp "\\\\\\([^ \t]+\\)"
  43   "Regexp matching the prefix of the company-math symbol.
  44 First subgroup must match the actual symbol to be used in the
  45 completion."
  46   :group 'company-math
  47   :type 'string)
  48
  49 (defcustom company-math-allow-unicode-symbols-in-faces t
  50   "List of faces to allow the insertion of Unicode symbols.
  51 When set to special value t, allow on all faces except those in
  52 `company-math-disallow-unicode-symbols-in-faces'."
  53   :group 'company-math
  54   :type '(choice (const t)
  55                  (repeat :tag "Faces" symbol)))
  56
  57 (defcustom company-math-allow-latex-symbols-in-faces '(font-latex-math-face)
  58   "List of faces to disallow the insertion of latex mathematical symbols.
  59 When set to special value t, allow on all faces except those in
  60 `company-math-disallow-latex-symbols-in-faces'."
  61   :group 'company-math
  62   :type '(choice (const t)
  63                  (repeat :tag "Faces" symbol)))
  64
  65 (defcustom company-math-disallow-unicode-symbols-in-faces '(font-latex-math-face)
  66   "List of faces to disallow the insertion of Unicode symbols."
  67   :group 'company-math
  68   :type '(repeat symbol))
  69
  70 (defcustom company-math-disallow-latex-symbols-in-faces '()
  71   "List of faces to disallow the insertion of latex mathematical symbols."
  72   :group 'company-math
  73   :type '(repeat symbol))
  74
  75 \f
  76 ;;; INTERNALS
  77
  78 (defun company-math--make-candidates (alist)
  79   "Build a list of math symbols ready to be used in ac source.
  80 ALIST is one of the defined alist in package `symbols'. Return a
  81 list of LaTeX symbols with text property :symbol being the
  82 corresponding unicode symbol."
  83   (delq nil
  84         (mapcar
  85          #'(lambda (el)
  86              (let* ((tex (substring (nth 1 el) 1))
  87                     (ch (and (nth 2 el) (decode-char 'ucs (nth 2 el))))
  88                     (symb (and ch (char-to-string ch))))
  89                (propertize tex :symbol symb)))
  90          alist)))
  91
  92 (defconst company-math--symbols
  93   (delete-dups
  94    (append (company-math--make-candidates math-symbol-list-basic)
  95            (company-math--make-candidates math-symbol-list-extended)))
  96   "List of math completion candidates.")
  97
  98 (defun company-math--prefix (allow-faces disallow-faces)
  99   (let* ((face (get-text-property (point) 'face))
 100          (face (or (car-safe face) face))
 101          (insertp (and (not (memq face disallow-faces))
 102                        (or (eq t allow-faces)
 103                            (memq face allow-faces)))))
 104     (when insertp
 105       (save-excursion
 106         (when (looking-back company-math-prefix-regexp (point-at-bol))
 107           (match-string 1))))))
 108
 109 (defun company-math--substitute-unicode (symbol)
 110   "Substitute preceding latex command with with SYMBOL."
 111   (let ((pos (point))
 112         (inhibit-point-motion-hooks t))
 113     (when (re-search-backward company-math-prefix-regexp)
 114       (delete-region (match-beginning 0) pos)
 115       (insert symbol))))
 116
 117 \f
 118 ;;; BACKENDS
 119
 120 ;;;###autoload
 121 (defun company-latex-commands (command &optional arg &rest ignored)
 122   "Company backend for latex commands."
 123   (interactive (list 'interactive))
 124   (cl-case command
 125     (interactive (company-begin-backend 'company-latex-commands))
 126     (prefix (unless (company-in-string-or-comment)
 127               (company-math--prefix t '())))
 128     (candidates (all-completions arg math-symbol-list-latex-commands))
 129     (sorted t)))
 130
 131 ;;;###autoload
 132 (defun company-math-symbols-latex (command &optional arg &rest ignored)
 133   "Company backend for LaTeX mathematical symbols."
 134   (interactive (list 'interactive))
 135   (cl-case command
 136     (interactive (company-begin-backend 'company-math-symbols-latex))
 137     (prefix (unless (company-in-string-or-comment)
 138               (company-math--prefix company-math-allow-latex-symbols-in-faces
 139                                     company-math-disallow-latex-symbols-in-faces)))
 140     (annotation (concat " " (get-text-property 0 :symbol arg)))
 141     (candidates (all-completions arg company-math--symbols))))
 142
 143 ;;;###autoload
 144 (defun company-math-symbols-unicode (command &optional arg &rest ignored)
 145   "Company backend for LaTeX mathematical symbols."
 146   (interactive (list 'interactive))
 147   (cl-case command
 148     (interactive (company-begin-backend 'company-math-symbols-unicode))
 149     (prefix (company-math--prefix company-math-allow-unicode-symbols-in-faces
 150                                   company-math-disallow-unicode-symbols-in-faces))
 151     (annotation (concat " " (get-text-property 0 :symbol arg)))
 152     (candidates (all-completions arg company-math--symbols))
 153     (post-completion (company-math--substitute-unicode
 154                       (get-text-property 0 :symbol arg)))))
 155
 156
 157 (provide 'company-math)
 158
 159 ;;; company-math.el ends here