[elpa] master 6ffd24c 22/34: Implement unicode sub(super)scripting

[Vitalie Spinu]

branch: master
commit 6ffd24c236d4ac8ee11ba577b10d3cc9702cef70
Author: Vitalie Spinu <address@hidden>
Commit: Vitalie Spinu <address@hidden>

    Implement unicode sub(super)scripting
    
      This commit deprecates company-math-prefix-regexp. Separate specialized
      prefixes are now used.
---
 company-math.el | 89 ++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 66 insertions(+), 23 deletions(-)

diff --git a/company-math.el b/company-math.el
index 8ba059a..0bcf409 100644
--- a/company-math.el
+++ b/company-math.el
@@ -39,13 +39,32 @@
   :group 'company
   :prefix "company-math-")
 
-(defcustom company-math-prefix-regexp "\\\\\\([^ \t]+\\)"
-  "Regexp matching the prefix of the company-math symbol.
-First subgroup must match the actual symbol to be used in the
-completion."
+(defcustom company-math-symbol-prefix "\\"
+  "Prefix to use for latex and unicode symbols."
   :group 'company-math
   :type 'string)
 
+(defcustom company-math-subscript-prefix "_"
+  "Prefix to use for unicode subscripts."
+  :group 'company-math
+  :type 'string)
+
+(defcustom company-math-superscript-prefix "^"
+  "Prefix to use for unicode subscripts."
+  :group 'company-math
+  :type 'string)
+
+;; no more custom since since v.1.3
+(when (boundp 'company-math-symbol-prefix)
+  (warn "`company-math-prefix-regexp' is deprecated, please remove from your 
custom settings."))
+
+(defvar company-math--latex-prefix-regexp (concat (regexp-quote 
company-math-symbol-prefix)
+                                                  "[^ \t\n]+"))
+(let ((psym (regexp-quote company-math-symbol-prefix))
+      (psub (regexp-quote company-math-subscript-prefix))
+      (psup (regexp-quote company-math-superscript-prefix)))
+  (setq company-math--unicode-prefix-regexp (concat "\\(" psym "\\|" psub 
"\\|" psup "\\)[^ \t\n]+")))
+
 (defcustom company-math-allow-unicode-symbols-in-faces t
   "List of faces to allow the insertion of Unicode symbols.
 When set to special value t, allow on all faces except those in
@@ -75,7 +94,7 @@ When set to special value t, allow on all faces except those 
in
 
 ;;; INTERNALS
 
-(defun company-math--make-candidates (alist)
+(defun company-math--make-candidates (alist prefix)
   "Build a list of math symbols ready to be used in ac source.
 ALIST is one of the defined alist in package `symbols'. Return a
 list of LaTeX symbols with text property :symbol being the
@@ -83,20 +102,34 @@ corresponding unicode symbol."
   (delq nil
         (mapcar
          (lambda (el)
-           (let* ((tex (substring (nth 1 el) 1))
+           (let* ((tex (concat prefix (substring (nth 1 el) 1)))
                   (ch (and (nth 2 el) (decode-char 'ucs (nth 2 el))))
                   (symb (and ch (char-to-string ch))))
              (propertize tex :symbol symb)))
          alist)))
 
+(defconst company-math--latex-commands
+  (mapcar (lambda (c) (concat company-math-symbol-prefix c)) 
math-symbol-list-latex-commands)
+  "List of LaTeX math completion candidates.")
+
 (defconst company-math--symbols
   (delete-dups
-   (append (company-math--make-candidates math-symbol-list-basic)
-           (company-math--make-candidates math-symbol-list-extended)))
-  "List of math completion candidates.
-This list is used by both LaTeX and Unicode company completion.")
-
-(defun company-math--prefix (allow-faces disallow-faces)
+   (append (company-math--make-candidates math-symbol-list-basic 
company-math-symbol-prefix)
+           (company-math--make-candidates math-symbol-list-extended 
company-math-symbol-prefix)))
+  "List of LaTeX math completion candidates.")
+
+(defconst company-math--unicode
+  (append
+   (append (company-math--make-candidates math-symbol-list-subscripts 
company-math-subscript-prefix)
+           (company-math--make-candidates math-symbol-list-subscripts (concat 
company-math-symbol-prefix
+                                                                              
company-math-subscript-prefix))
+           (company-math--make-candidates math-symbol-list-superscripts 
company-math-superscript-prefix)
+           (company-math--make-candidates math-symbol-list-superscripts 
(concat company-math-symbol-prefix
+                                                                               
 company-math-superscript-prefix)))
+   company-math--symbols)
+  "List of math completion candidates for unicode backend.")
+
+(defun company-math--prefix (regexp allow-faces disallow-faces)
   (let* ((face (get-text-property (point) 'face))
          (face (or (car-safe face) face))
          (insertp (and (not (memq face disallow-faces))
@@ -104,15 +137,21 @@ This list is used by both LaTeX and Unicode company 
completion.")
                            (memq face allow-faces)))))
     (when insertp
       (save-excursion
-        (when (looking-back company-math-prefix-regexp (point-at-bol))
-          (match-string 1))))))
+        (when (looking-back regexp (point-at-bol) 'greedy)
+          (match-string 0))))))
 
 (defun company-math--substitute-unicode (symbol)
   "Substitute preceding latex command with with SYMBOL."
   (let ((pos (point))
         (inhibit-point-motion-hooks t))
-    (when (re-search-backward company-math-prefix-regexp)
-      (delete-region (match-beginning 0) pos)
+    (when (re-search-backward company-math--unicode-prefix-regexp) ; should 
always match
+      (goto-char (match-beginning 0))
+      ;; allow subsups to start with \
+      (let ((start (max (point-min) (- (point) (length 
company-math-symbol-prefix)))))
+        (when (string= (buffer-substring-no-properties start (point))
+                       company-math-symbol-prefix)
+          (goto-char start)))
+      (delete-region (point) pos)
       (insert symbol))))
 
 
@@ -125,8 +164,8 @@ This list is used by both LaTeX and Unicode company 
completion.")
   (cl-case command
     (interactive (company-begin-backend 'company-latex-commands))
     (prefix (unless (company-in-string-or-comment)
-              (company-math--prefix t '())))
-    (candidates (all-completions arg math-symbol-list-latex-commands))
+              (company-math--prefix company-math--latex-prefix-regexp t '())))
+    (candidates (all-completions arg company-math--latex-commands))
     (sorted t)))
 
 ;;;###autoload
@@ -136,7 +175,8 @@ This list is used by both LaTeX and Unicode company 
completion.")
   (cl-case command
     (interactive (company-begin-backend 'company-math-symbols-latex))
     (prefix (unless (company-in-string-or-comment)
-              (company-math--prefix company-math-allow-latex-symbols-in-faces
+              (company-math--prefix company-math--latex-prefix-regexp
+                                    company-math-allow-latex-symbols-in-faces
                                     
company-math-disallow-latex-symbols-in-faces)))
     (annotation (concat " " (get-text-property 0 :symbol arg)))
     (candidates (all-completions arg company-math--symbols))))
@@ -145,14 +185,18 @@ This list is used by both LaTeX and Unicode company 
completion.")
 (defun company-math-symbols-unicode (command &optional arg &rest ignored)
   "Company backend for insertion of Unicode mathematical symbols.
 See the unicode-math page [1] for a list of fonts that have a
-good support for mathematical symbols.
+good support for mathematical symbols. Unicode provides only a
+limited range of sub(super)scripts; see the wikipedia page [2]
+for details.
 
  [1] 
http://ftp.snt.utwente.nl/pub/software/tex/help/Catalogue/entries/unicode-math.html
+ [2] https://en.wikipedia.org/wiki/Unicode_subscripts_and_superscripts
 "
   (interactive (list 'interactive))
   (cl-case command
     (interactive (company-begin-backend 'company-math-symbols-unicode))
-    (prefix (company-math--prefix company-math-allow-unicode-symbols-in-faces
+    (prefix (company-math--prefix company-math--unicode-prefix-regexp
+                                  company-math-allow-unicode-symbols-in-faces
                                   
company-math-disallow-unicode-symbols-in-faces))
     (annotation (concat " " (get-text-property 0 :symbol arg)))
     ;; Space added to ensure that completions are never typed in full.
@@ -161,10 +205,9 @@ good support for mathematical symbols.
                       (mapcar (lambda (candidate)
                                 (when (get-text-property 0 :symbol candidate)
                                   (concat candidate " ")))
-                              (all-completions arg company-math--symbols))))
+                              (all-completions arg company-math--unicode))))
     (post-completion (company-math--substitute-unicode
                       (get-text-property 0 :symbol arg)))))
 
-
 (provide 'company-math)
 ;;; company-math.el ends here