From: Nikolaj Schumacher <git@nschum.de>
Date: Fri, 19 Feb 2010 23:20:55 +0000 (+0100)
Subject: Added template insertion for ObjC selectors.
X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/d95de5f29b7ce8648854a00a5cb4dd6b7bbd5514?ds=sidebyside

Added template insertion for ObjC selectors.
---

diff --git a/company-clang.el b/company-clang.el
index 2cb2ce853..c38a04377 100644
--- a/company-clang.el
+++ b/company-clang.el
@@ -176,6 +176,19 @@ Prefix files (-include ...) can be selected with
     (when (re-search-forward "\\`clang version \\([0-9.]+\\)" nil t)
       (match-string-no-properties 1))))
 
+(defun company-clang-objc-templatify (selector)
+  (let* ((end (point))
+         (beg (- (point) (length selector)))
+         (templ (company-template-declare-template beg end)))
+    (save-excursion
+      (goto-char beg)
+      (while (search-forward ":" end t)
+        (replace-match ":  ")
+        (incf end 2)
+        (company-template-add-field templ (1- (match-end 0)) "<arg>"))
+      (delete-char -1))
+    (company-template-move-to-first templ)))
+
 (defun company-clang (command &optional arg &rest ignored)
   "A `company-mode' completion back-end for clang.
 Clang is a parser for C and ObjC.  The unreleased development version of
@@ -201,7 +214,10 @@ Completions only work correctly when the buffer has been saved.
                       company-clang-executable
                       (not (company-in-string-or-comment))
                       (or (company-grab-symbol) 'stop)))
-        ('candidates (company-clang--candidates arg))))
+        ('candidates (company-clang--candidates arg))
+        ('post-completion (and (derived-mode-p 'objc-mode)
+                               (string-match ":" arg)
+                               (company-clang-objc-templatify arg)))))
 
 (provide 'company-clang)
 ;;; company-clang.el ends here
diff --git a/company-template.el b/company-template.el
new file mode 100644
index 000000000..f9b0fcde1
--- /dev/null
+++ b/company-template.el
@@ -0,0 +1,114 @@
+(eval-when-compile (require 'cl))
+
+(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 [remap forward-word] 'company-template-forward-field)
+    (define-key keymap [remap subword-forward] 'company-template-forward-field)
+    ;; M-n
+    keymap))
+
+;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defsubst company-template-templates-at (pos)
+  (let (os)
+    (dolist (o (overlays-at pos))
+      (when (overlay-get o 'company-template-fields)
+        (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)))))
+
+(defun company-template-forward-field ()
+  (interactive)
+  (let* ((templates (company-template-templates-at (point)))
+         (minimum (apply 'max (mapcar 'overlay-end templates)))
+         (fields (apply 'append
+                        (mapcar (lambda (templ)
+                                  (overlay-get templ 'company-template-fields))
+                                templates))))
+    (dolist (pos (mapcar 'overlay-start fields))
+      (and pos
+           (> pos (point))
+           (< pos minimum)
+           (setq minimum pos)))
+    (push-mark)
+    (goto-char minimum)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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)))
+    ;; (overlay-put ov 'face 'highlight)
+    (overlay-put ov 'keymap company-template-nav-map)
+    (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 pos text)
+  (assert templ)
+  (save-excursion
+    ;; (goto-char pos)
+    (let ((ov (make-overlay pos pos))
+          (siblings (overlay-get templ 'company-template-fields))
+          (label (propertize text 'face 'company-template-field
+                             'company-template-parent templ)))
+      (overlay-put ov 'face 'highlight)
+      (add-text-properties 0 1 '(cursor t) label)
+      (overlay-put ov 'after-string label)
+      ;; (overlay-put ov 'evaporate t)
+      (overlay-put ov 'intangible t)
+      (overlay-put ov 'company-template-parent templ)
+      (overlay-put ov 'insert-in-front-hooks '(company-template-remove))
+      (push ov siblings)
+      (overlay-put templ 'company-template-fields siblings))))
+
+(defun company-template-remove-field (field)
+  (when (overlayp field)
+    ;; (delete-region (overlay-start field) (overlay-end field))
+    (delete-overlay field))
+  ;; TODO: unlink
+  )
+
+(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)))
+    (dolist (templ company-template--buffer-templates)
+      (unless (memq templ local-ovs)
+        (company-template-remove-template templ)))))
+
+;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun company-template-remove (overlay after-p beg end &optional r)
+  "Called when a snippet input prompt is modified."
+  (when after-p
+    (delete-overlay overlay)))
+
+(defun company-template-post-command ()
+  (company-template-clean-up)
+  (unless company-template--buffer-templates
+    (remove-hook 'post-command-hook 'company-template-post-command t)))
+
+(provide 'company-template)
+;;; company-template.el ends here
diff --git a/company.el b/company.el
index eddd4cbf8..bc296be73 100644
--- a/company.el
+++ b/company.el
@@ -68,6 +68,8 @@
 ;;    `company-ropemacs' now provides location and docs.  (Fernando H. Silva)
 ;;    Added `company-with-candidate-inserted' macro.
 ;;    Added `company-clang' back-end.
+;;    Added new mechanism for non-consecutive insertion.
+;;      (So far only used by clang for ObjC.)
 ;;    The semantic back-end now shows meta information for local symbols.
 ;;    Added compatibility for CEDET in Emacs 23.2.
 ;;
@@ -1978,5 +1980,9 @@ Returns a negative number if the tooltip should be displayed above point."
     ('post-command (company-echo-show-soon 'company-fetch-metadata))
     ('hide (company-echo-hide))))
 
+;; templates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(autoload 'company-template-declare-template "company-template")
+
 (provide 'company)
 ;;; company.el ends here