X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/35e38bb102b04fa59f64e9bfe7b693d2082d748a..900ae0d7a2270ea1d2ea00567e80a619333fd4e5:/company-template.el diff --git a/company-template.el b/company-template.el index ffceda16b..02065afaf 100644 --- a/company-template.el +++ b/company-template.el @@ -1,6 +1,6 @@ -;;; company-template.el +;;; company-template.el --- utility library for template expansion -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2014-2015 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -21,7 +21,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (defface company-template-field '((((background dark)) (:background "yellow" :foreground "black")) @@ -32,8 +32,11 @@ (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-local company-template--buffer-templates nil) + ;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun company-template-templates-at (pos) @@ -47,17 +50,16 @@ (defun company-template-move-to-first (templ) (interactive) - (let ((fields (overlay-get templ 'company-template-fields))) - (push-mark) - (goto-char (apply 'min (mapcar 'overlay-start fields))))) + (goto-char (overlay-start templ)) + (company-template-forward-field)) (defun company-template-forward-field () (interactive) (let* ((start (point)) (templates (company-template-templates-at (point))) (minimum (apply 'max (mapcar 'overlay-end templates))) - (fields (loop for templ in templates - append (overlay-get templ 'company-template-fields)))) + (fields (cl-loop for templ in templates + append (overlay-get templ 'company-template-fields)))) (dolist (pos (mapcar 'overlay-start fields)) (and pos (> pos (point)) @@ -65,15 +67,14 @@ (setq minimum pos))) (push-mark) (goto-char minimum) - (let ((field (loop for ovl in (overlays-at start) - when (overlay-get ovl 'company-template-parent) - return ovl))) - (company-template-remove-field field)))) + (company-template-remove-field (company-template-field-at start)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(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)) -(defvar company-template--buffer-templates nil) -(make-variable-buffer-local 'company-template--buffer-templates) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun company-template-declare-template (beg end) (let ((ov (make-overlay beg end))) @@ -92,23 +93,24 @@ (delq templ company-template--buffer-templates)) (delete-overlay templ)) -(defun company-template-add-field (templ pos text) - (assert templ) - (save-excursion - (save-excursion - (goto-char pos) - (insert text) - (when (> (point) (overlay-end templ)) - (move-overlay templ (overlay-start templ) (point)))) - (let ((ov (make-overlay pos (+ pos (length text)))) - (siblings (overlay-get templ 'company-template-fields))) - ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'intangible t) - (overlay-put ov 'face 'company-template-field) - (overlay-put ov 'company-template-parent templ) - (overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook)) - (push ov siblings) - (overlay-put templ 'company-template-fields siblings)))) +(defun company-template-add-field (templ beg end &optional display) + "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." + (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)) + (push ov siblings) + (overlay-put templ 'company-template-fields siblings))) (defun company-template-remove-field (ovl &optional clear) (when (overlayp ovl) @@ -130,7 +132,7 @@ ;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun company-template-insert-hook (ovl after-p &rest ignore) +(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))) @@ -140,5 +142,73 @@ (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)) + (skip-chars-forward " ") + (setq last-pos (point)))))) + +;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun company-clang-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