code.delx.au - gnu-emacs-elpa/blob - packages/company-math/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 <spinuvit@gmail.com>
   5 ;; URL: https://github.com/vspinu/company-math
   6 ;; Keywords:  Unicode, symbols, completion
   7 ;; Version: 1.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 ;;; Commentary:
  32
  33 ;;; Code:
  34
  35 (require 'math-symbol-lists)
  36 (require 'company)
  37 (require 'cl-lib)
  38
  39 (defgroup company-math nil
  40   "Completion back-ends for math symbols Unicode symbols and LaTeX tags."
  41   :group 'company
  42   :prefix "company-math-")
  43
  44 (defcustom company-math-prefix-regexp "\\\\\\([^ \t]+\\)"
  45   "Regexp matching the prefix of the company-math symbol.
  46 First subgroup must match the actual symbol to be used in the
  47 completion."
  48   :group 'company-math
  49   :type 'string)
  50
  51 (defcustom company-math-allow-unicode-symbols-in-faces t
  52   "List of faces to allow the insertion of Unicode symbols.
  53 When set to special value t, allow on all faces except those in
  54 `company-math-disallow-unicode-symbols-in-faces'."
  55   :group 'company-math
  56   :type '(choice (const t)
  57                  (repeat :tag "Faces" symbol)))
  58
  59 (defcustom company-math-allow-latex-symbols-in-faces '(tex-math font-latex-math-face)
  60   "List of faces to disallow the insertion of latex mathematical symbols.
  61 When set to special value t, allow on all faces except those in
  62 `company-math-disallow-latex-symbols-in-faces'."
  63   :group 'company-math
  64   :type '(choice (const t)
  65                  (repeat :tag "Faces" symbol)))
  66
  67 (defcustom company-math-disallow-unicode-symbols-in-faces '(font-latex-math-face)
  68   "List of faces to disallow the insertion of Unicode symbols."
  69   :group 'company-math
  70   :type '(repeat symbol))
  71
  72 (defcustom company-math-disallow-latex-symbols-in-faces '()
  73   "List of faces to disallow the insertion of latex mathematical symbols."
  74   :group 'company-math
  75   :type '(repeat symbol))
  76
  77 \f
  78 ;;; INTERNALS
  79
  80 (defun company-math--make-candidates (alist)
  81   "Build a list of math symbols ready to be used in ac source.
  82 ALIST is one of the defined alist in package `symbols'.  Return a
  83 list of LaTeX symbols with text property :symbol being the
  84 corresponding unicode symbol."
  85   (delq nil
  86         (mapcar
  87          #'(lambda (el)
  88              (let* ((tex (substring (nth 1 el) 1))
  89                     (ch (and (nth 2 el) (decode-char 'ucs (nth 2 el))))
  90                     (symb (and ch (char-to-string ch))))
  91                (propertize tex :symbol symb)))
  92          alist)))
  93
  94 (defconst company-math--symbols
  95   (delete-dups
  96    (append (company-math--make-candidates math-symbol-list-basic)
  97            (company-math--make-candidates math-symbol-list-extended)))
  98   "List of math completion candidates.")
  99
 100 (defun company-math--prefix (allow-faces disallow-faces)
 101   (let* ((face (get-text-property (point) 'face))
 102          (face (or (car-safe face) face))
 103          (insertp (and (not (memq face disallow-faces))
 104                        (or (eq t allow-faces)
 105                            (memq face allow-faces)))))
 106     (when insertp
 107       (save-excursion
 108         (when (looking-back company-math-prefix-regexp (point-at-bol))
 109           (match-string 1))))))
 110
 111 (defun company-math--substitute-unicode (symbol)
 112   "Substitute preceding latex command with with SYMBOL."
 113   (let ((pos (point))
 114         (inhibit-point-motion-hooks t))
 115     (when (re-search-backward company-math-prefix-regexp)
 116       (delete-region (match-beginning 0) pos)
 117       (insert symbol))))
 118
 119 \f
 120 ;;; BACKENDS
 121
 122 ;;;###autoload
 123 (defun company-latex-commands (command &optional arg &rest ignored)
 124   "Company backend for latex commands."
 125   (interactive (list 'interactive))
 126   (cl-case command
 127     (interactive (company-begin-backend 'company-latex-commands))
 128     (prefix (unless (company-in-string-or-comment)
 129               (company-math--prefix t '())))
 130     (candidates (all-completions arg math-symbol-list-latex-commands))
 131     (sorted t)))
 132
 133 ;;;###autoload
 134 (defun company-math-symbols-latex (command &optional arg &rest ignored)
 135   "Company backend for LaTeX mathematical symbols."
 136   (interactive (list 'interactive))
 137   (cl-case command
 138     (interactive (company-begin-backend 'company-math-symbols-latex))
 139     (prefix (unless (company-in-string-or-comment)
 140               (company-math--prefix company-math-allow-latex-symbols-in-faces
 141                                     company-math-disallow-latex-symbols-in-faces)))
 142     (annotation (concat " " (get-text-property 0 :symbol arg)))
 143     (candidates (all-completions arg company-math--symbols))))
 144
 145 ;;;###autoload
 146 (defun company-math-symbols-unicode (command &optional arg &rest ignored)
 147   "Company backend for insertion of Unicode mathematical symbols.
 148 See the unicode-math page [1] for a list of fonts that have a
 149 good support for mathematical symbols.
 150
 151  [1] http://ftp.snt.utwente.nl/pub/software/tex/help/Catalogue/entries/unicode-math.html
 152 "
 153   (interactive (list 'interactive))
 154   (cl-case command
 155     (interactive (company-begin-backend 'company-math-symbols-unicode))
 156     (prefix (company-math--prefix company-math-allow-unicode-symbols-in-faces
 157                                   company-math-disallow-unicode-symbols-in-faces))
 158     (annotation (concat " " (get-text-property 0 :symbol arg)))
 159     ;; Space added to ensure that completions are never typed in full.
 160     ;; See https://github.com/company-mode/company-mode/issues/476
 161     (candidates (mapcar (lambda (candidate)
 162                           (concat candidate " "))
 163                         (all-completions arg company-math--symbols)))
 164     (post-completion (company-math--substitute-unicode
 165                       (get-text-property 0 :symbol arg)))))
 166
 167
 168 (provide 'company-math)
 169 ;;; company-math.el ends here