diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/company-20180913.805/company-template.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/company-20180913.805/company-template.el | 260 |
1 files changed, 0 insertions, 260 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/company-20180913.805/company-template.el b/configs/shared/emacs/.emacs.d/elpa/company-20180913.805/company-template.el deleted file mode 100644 index 930e638e9d09..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/company-20180913.805/company-template.el +++ /dev/null @@ -1,260 +0,0 @@ -;;; company-template.el --- utility library for template expansion - -;; Copyright (C) 2009, 2010, 2014-2017 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Code: - -(require 'cl-lib) - -(defface company-template-field - '((((background dark)) (:background "yellow" :foreground "black")) - (((background light)) (:background "orange" :foreground "black"))) - "Face used for editable text in template fields." - :group 'company) - -(defvar company-template-nav-map - (let ((keymap (make-sparse-keymap))) - (define-key keymap [tab] 'company-template-forward-field) - (define-key keymap (kbd "TAB") 'company-template-forward-field) - keymap)) - -(defvar company-template-field-map - (let ((keymap (make-sparse-keymap))) - (set-keymap-parent keymap company-template-nav-map) - (define-key keymap (kbd "C-d") 'company-template-clear-field) - keymap)) - -(defvar-local company-template--buffer-templates nil) - -;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun company-template-templates-at (pos) - (let (os) - (dolist (o (overlays-at pos)) - ;; FIXME: Always return the whole list of templates? - ;; We remove templates not at point after every command. - (when (memq o company-template--buffer-templates) - (push o os))) - os)) - -(defun company-template-move-to-first (templ) - (interactive) - (goto-char (overlay-start templ)) - (company-template-forward-field)) - -(defun company-template-forward-field () - (interactive) - (let ((start (point)) - (next-field-start (company-template-find-next-field))) - (push-mark) - (goto-char next-field-start) - (company-template-remove-field (company-template-field-at start)))) - -(defun company-template-clear-field () - "Clear the field at point." - (interactive) - (let ((ovl (company-template-field-at (point)))) - (when ovl - (company-template-remove-field ovl t) - (let ((after-clear-fn - (overlay-get ovl 'company-template-after-clear))) - (when (functionp after-clear-fn) - (funcall after-clear-fn)))))) - -(defun company-template--after-clear-c-like-field () - "Function that can be called after deleting a field of a c-like template. -For c-like templates it is set as `after-post-fn' property on fields in -`company-template-add-field'. If there is a next field, delete everything -from point to it. If there is no field after point, remove preceding comma -if present." - (let* ((pos (point)) - (next-field-start (company-template-find-next-field)) - (last-field-p (not (company-template-field-at next-field-start)))) - (cond ((and (not last-field-p) - (< pos next-field-start) - (string-match "^[ ]*,+[ ]*$" (buffer-substring-no-properties - pos next-field-start))) - (delete-region pos next-field-start)) - ((and last-field-p - (looking-back ",+[ ]*" (line-beginning-position))) - (delete-region (match-beginning 0) pos))))) - -(defun company-template-find-next-field () - (let* ((start (point)) - (templates (company-template-templates-at start)) - (minimum (apply 'max (mapcar 'overlay-end templates))) - (fields (cl-loop for templ in templates - append (overlay-get templ 'company-template-fields)))) - (dolist (pos (mapcar 'overlay-start fields) minimum) - (and pos - (> pos start) - (< pos minimum) - (setq minimum pos))))) - -(defun company-template-field-at (&optional point) - (cl-loop for ovl in (overlays-at (or point (point))) - when (overlay-get ovl 'company-template-parent) - return ovl)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun company-template-declare-template (beg end) - (let ((ov (make-overlay beg end))) - ;; (overlay-put ov 'face 'highlight) - (overlay-put ov 'keymap company-template-nav-map) - (overlay-put ov 'priority 101) - (overlay-put ov 'evaporate t) - (push ov company-template--buffer-templates) - (add-hook 'post-command-hook 'company-template-post-command nil t) - ov)) - -(defun company-template-remove-template (templ) - (mapc 'company-template-remove-field - (overlay-get templ 'company-template-fields)) - (setq company-template--buffer-templates - (delq templ company-template--buffer-templates)) - (delete-overlay templ)) - -(defun company-template-add-field (templ beg end &optional display after-clear-fn) - "Add new field to template TEMPL spanning from BEG to END. -When DISPLAY is non-nil, set the respective property on the overlay. -Leave point at the end of the field. -AFTER-CLEAR-FN is a function that can be used to apply custom behavior -after deleting a field in `company-template-remove-field'." - (cl-assert templ) - (when (> end (overlay-end templ)) - (move-overlay templ (overlay-start templ) end)) - (let ((ov (make-overlay beg end)) - (siblings (overlay-get templ 'company-template-fields))) - ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'intangible t) - (overlay-put ov 'face 'company-template-field) - (when display - (overlay-put ov 'display display)) - (overlay-put ov 'company-template-parent templ) - (overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook)) - (when after-clear-fn - (overlay-put ov 'company-template-after-clear after-clear-fn)) - (overlay-put ov 'keymap company-template-field-map) - (overlay-put ov 'priority 101) - (push ov siblings) - (overlay-put templ 'company-template-fields siblings))) - -(defun company-template-remove-field (ovl &optional clear) - (when (overlayp ovl) - (when (overlay-buffer ovl) - (when clear - (delete-region (overlay-start ovl) (overlay-end ovl))) - (delete-overlay ovl)) - (let* ((templ (overlay-get ovl 'company-template-parent)) - (siblings (overlay-get templ 'company-template-fields))) - (setq siblings (delq ovl siblings)) - (overlay-put templ 'company-template-fields siblings)))) - -(defun company-template-clean-up (&optional pos) - "Clean up all templates that don't contain POS." - (let ((local-ovs (overlays-at (or pos (point))))) - (dolist (templ company-template--buffer-templates) - (unless (memq templ local-ovs) - (company-template-remove-template templ))))) - -;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun company-template-insert-hook (ovl after-p &rest _ignore) - "Called when a snippet input prompt is modified." - (unless after-p - (company-template-remove-field ovl t))) - -(defun company-template-post-command () - (company-template-clean-up) - (unless company-template--buffer-templates - (remove-hook 'post-command-hook 'company-template-post-command t))) - -;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun company-template-c-like-templatify (call) - (let* ((end (point-marker)) - (beg (- (point) (length call))) - (templ (company-template-declare-template beg end)) - paren-open paren-close) - (with-syntax-table (make-syntax-table (syntax-table)) - (modify-syntax-entry ?< "(") - (modify-syntax-entry ?> ")") - (when (search-backward ")" beg t) - (setq paren-close (point-marker)) - (forward-char 1) - (delete-region (point) end) - (backward-sexp) - (forward-char 1) - (setq paren-open (point-marker))) - (when (search-backward ">" beg t) - (let ((angle-close (point-marker))) - (forward-char 1) - (backward-sexp) - (forward-char) - (company-template--c-like-args templ angle-close))) - (when (looking-back "\\((\\*)\\)(" (line-beginning-position)) - (delete-region (match-beginning 1) (match-end 1))) - (when paren-open - (goto-char paren-open) - (company-template--c-like-args templ paren-close))) - (if (overlay-get templ 'company-template-fields) - (company-template-move-to-first templ) - (company-template-remove-template templ) - (goto-char end)))) - -(defun company-template--c-like-args (templ end) - (let ((last-pos (point))) - (while (re-search-forward "\\([^,]+\\),?" end 'move) - (when (zerop (car (parse-partial-sexp last-pos (point)))) - (company-template-add-field templ last-pos (match-end 1) nil - #'company-template--after-clear-c-like-field) - (skip-chars-forward " ") - (setq last-pos (point)))))) - -;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun company-template-objc-templatify (selector) - (let* ((end (point-marker)) - (beg (- (point) (length selector) 1)) - (templ (company-template-declare-template beg end)) - (cnt 0)) - (save-excursion - (goto-char beg) - (catch 'stop - (while (search-forward ":" end t) - (if (looking-at "\\(([^)]*)\\) ?") - (company-template-add-field templ (point) (match-end 1)) - ;; Not sure which conditions this case manifests under, but - ;; apparently it did before, when I wrote the first test for this - ;; function. FIXME: Revisit it. - (company-template-add-field templ (point) - (progn - (insert (format "arg%d" cnt)) - (point))) - (when (< (point) end) - (insert " ")) - (cl-incf cnt)) - (when (>= (point) end) - (throw 'stop t))))) - (company-template-move-to-first templ))) - -(provide 'company-template) -;;; company-template.el ends here |