X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/2c0f29abb2928f672043cf97d689770bd2265064..961b79aba3fe032584d43c5a83d8ad5951e721a6:/packages/company/company-template.el

diff --git a/packages/company/company-template.el b/packages/company/company-template.el
index ffceda16b..576b246ec 100644
--- a/packages/company/company-template.el
+++ b/packages/company/company-template.el
@@ -1,6 +1,6 @@
 ;;; company-template.el
 
-;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2013 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,26 @@
         (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 pos text &optional display)
+  "Add new field to template TEMPL at POS, inserting TEXT.
+When DISPLAY is non-nil, set the respective property on the overlay.
+Leave point at the end of the field."
+  (cl-assert templ)
+  (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)
+    (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 +134,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 +144,27 @@
   (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)))
+         (cnt 0))
+    (when (re-search-backward ")" beg t)
+      (delete-region (match-end 0) end))
+    (goto-char beg)
+    (when (search-forward "(" end 'move)
+      (if (eq (char-after) ?\))
+          (forward-char 1)
+        (let ((templ (company-template-declare-template beg end)))
+          (while (re-search-forward (concat " *\\([^,)]*\\)[,)]") end t)
+            (let ((sig (match-string 1)))
+              (delete-region (match-beginning 1) (match-end 1))
+              (save-excursion
+                (company-template-add-field templ (match-beginning 1)
+                                            (format "arg%d" cnt) sig))
+              (cl-incf cnt)))
+          (company-template-move-to-first templ))))))
+
 (provide 'company-template)
 ;;; company-template.el ends here