]> code.delx.au - gnu-emacs-elpa/blobdiff - company-template.el
* packages/company/company-cmake.el: Fix up copyright. Require CL.
[gnu-emacs-elpa] / company-template.el
index 05389acc7a51c093415fab69b9647b401c1027a6..ea1db86bca7a695711f62b51f0251fb7a7bf673f 100644 (file)
@@ -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
 
     (define-key keymap [tab] 'company-template-forward-field)
     keymap))
 
+(defvar company-template--buffer-templates nil)
+(make-variable-buffer-local 'company-template--buffer-templates)
+
 ;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun company-template-templates-at (pos)
   (let (os)
     (dolist (o (overlays-at pos))
-      (when (overlay-get o 'company-template-fields)
+      ;; 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)
-  (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)
            (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)
+  (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)))
         (delq templ company-template--buffer-templates))
   (delete-overlay templ))
 
-(defun company-template-add-field (templ pos text)
+(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."
   (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))))
+  (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)
 
 (defun company-template-clean-up (&optional pos)
   "Clean up all templates that don't contain POS."
-  (unless pos (setq pos (point)))
-  (let ((local-ovs (overlays-in (- pos 2) pos)))
+  (let ((local-ovs (overlays-at (or pos (point)))))
     (dolist (templ company-template--buffer-templates)
-      (unless (and (memq templ local-ovs)
-                   (overlay-get templ 'company-template-fields))
+      (unless (memq templ local-ovs)
         (company-template-remove-template templ)))))
 
 ;; 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)))
   (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))
+              (incf cnt)))
+          (company-template-move-to-first templ))))))
+
 (provide 'company-template)
 ;;; company-template.el ends here