ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-14 05:23:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

wip: still inoperative, but much better macros, support parent fields

Browse Source
This commit is contained in:
Joao Tavora 2013-10-12 15:47:43 +01:00
parent f00509a696
commit fc1c3632b6
1 changed files with 126 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
snippet.el
View File

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(cl-defstruct (snippet--field (:constructor snippet--make-field (name parent-field))) (cl-defstruct (snippet--field (:constructor snippet--make-field (name mirrors parent-field)))
name name
start end start end
parent-field parent-field
@ -35,7 +35,7 @@
next) next)
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror (source transform))) (cl-defstruct (snippet--mirror (:constructor snippet--make-mirror (source transform parent-field)))
source source
start end start end
(transform nil) (transform nil)
@ -53,55 +53,147 @@
(insert (funcall (snippet--mirror-transform mirror))) (insert (funcall (snippet--mirror-transform mirror)))
(setf (snippet--mirror-end mirror) (point))) (setf (snippet--mirror-end mirror) (point)))
(defun snippet--field-text (field)
(buffer-substring-no-properties (snippet--field-start field)
(snippet--field-end field)))
;;; the define-snippet macro and its helpers
;;;
(defun snippet--form-field-p (form)
(and (consp form) (eq (car form) 'field)))
(defun snippet--form-mirror-p (form)
(and (consp form) (eq (car form) 'mirror)))
(defun snippet--form-make-field-sym (field-name &optional parent-field-sym)
(make-symbol (format "field-%s%s" field-name
(if parent-field-sym
(format "-son-of-%s" parent-field-sym)
""))))
(defun snippet--form-make-mirror-sym (mirror-name source-field-name &optional parent-field-sym)
(make-symbol (format "mirror-%s-of-%s%s" mirror-name source-field-name
(if parent-field-sym
(format "-son-of-%s" parent-field-sym)
""))))
(defun snippet--form-make-field-form (field-name parent-field-sym mirrors)
`(snippet--make-field ,field-name ,parent-field-sym ,mirrors))
(defun snippet--form-make-mirror-form (source-field-sym transform)
`(snippet--make-mirror ,source-field-sym ,transform))
(defvar snippet--form-mirror-sym-idx nil)
(defun snippet--form-sym-tuples (forms &optional parent-field-sym)
(loop with snippet--form-mirror-sym-idx = (or snippet--form-mirror-sym-idx
0)
for form in forms
append (cond ((snippet--form-field-p form)
;;
;;
(let ((field-sym (snippet--form-make-field-sym (second form) parent-field-sym)))
`((,field-sym ,form ,parent-field-sym)
,@(when (listp (third form))
(snippet--form-sym-tuples (third form) field-sym)))))
((snippet--form-mirror-p form)
;;
;;
(incf snippet--form-mirror-sym-idx)
(let ((mirror-sym (snippet--form-make-mirror-sym snippet--form-mirror-sym-idx
(second form)
parent-field-sym)))
`((,mirror-sym ,form ,parent-field-sym))))
(t
;; it's a literal string, append a dummy tuple
`((string ,form))))))
(defun snippet--make-object-sym-tuples (tuples)
(let* ((field-mirrors (make-hash-table))
;; we first collect `snippet--make-mirror' forms. When
;; collecting them, we populate the `field-mirrors' table...
;;
(make-mirror-forms
(loop for (sym form parent-sym) in tuples
when (snippet--form-mirror-p form)
collect (let ((source-sym nil))
(loop for (sym-b form-b) in tuples
when (and
(snippet--form-field-p form-b)
(eq (second form)
(second form-b)))
do
(setq source-sym sym-b)
(puthash source-sym (cons sym (gethash source-sym field-mirrors)) field-mirrors))
(unless source-sym
(error "mirror definition %s mentions unknown field" form))
`(,sym (snippet--make-mirror ,source-sym
,(snippet--transform-lambda (third form) source-sym)
,parent-sym)))))
;; so that we can now create `snippet--make-field' forms with
;; complete lists of mirror symbols.
;;
(make-field-forms
(loop for (sym form parent-sym) in tuples
when (snippet--form-field-p form)
collect `(,sym (snippet--make-field ,(second form) (list ,@(gethash sym field-mirrors)) ,parent-sym)))))
(append make-field-forms
make-mirror-forms)))
(defun snippet--transform-lambda (transform-form source-sym)
`(lambda ()
(funcall
#'(lambda (field-text)
,(or transform-form
'field-text))
(snippet--field-text ,source-sym))))
(defmacro* define-snippet (name (&key obarray) &rest body) (defmacro* define-snippet (name (&key obarray) &rest body)
(cl-flet ((field-p (form) (and (consp form) (eq (car form) 'field))) (let* ((sym-tuples (snippet--form-sym-tuples body))
(mirror-p (form) (and (consp form) (eq (car form) 'mirror))) (make-object-forms (snippet--make-object-forms sym-tuples)))
(make-field-sym (field-name) (make-symbol (format "field-%s"
field-name)))
(make-mirror-sym (mirror-name field-name) (make-symbol (format "mirror-%s-of-%s"
mirror-name
field-name))))
`(defun ,name () `(defun ,name ()
(let* (,@(loop for form in (cl-remove-if-not #'field-p body) (let* (,@(remove 'string (mapcar #'car sym-tuples))
for field-sym = (make-field-sym (second form))
collect `(,field-sym
(snippet--make-field ,(second form) ,(third form))))
,@(loop for form in (cl-remove-if-not #'mirror-p body)
for mirror-sym = (make-mirror-sym i (second form))
for source-field-sym = (make-field-sym (second form))
for i from 1
collect `(,mirror-sym
(snippet--make-mirror ,source-field-sym
#'(lambda ()
(funcall
#'(lambda (field-text)
,(third form))
(snippet--field-text ,source-field-sym))))))
(start (point)) (start (point))
overlay) overlay)
,@(loop with mirror-idx = 1 ,@make-object-forms
for form in body
collect (cond ((field-p form)
`(snippet--insert-field ,(make-field-sym (second form)) ,@(loop for (sym form) in sym-tuples
,(third form))) collect (cond ((snippet--form-field-p form)
((mirror-p form) `(snippet--insert-field ,sym ,(third form)))
(prog1 `(snippet--insert-mirror ,(make-mirror-sym mirror-idx ((snippet--form-mirror-p form)
(second form))) `(snippet--insert-mirror ,sym))
(incf mirror-idx)))
(t (t
`(insert ,form)))) `(insert ,form))))
(setq overlay (make-overlay start (point))))))) (setq overlay (make-overlay start (point)))))))
(define-snippet printf () (define-snippet printf ()
"printf (\"" "printf (\""
(field 1 "%s") (field 1 "%s")
"\n"
(mirror 1 (if (string-match "%" field-text) "," "\);")) (mirror 1 (if (string-match "%" field-text) "," "\);"))
(field 2) (field 2)
(mirror 1 (if (string-match "%" field-text) "\);" ""))) (mirror 1 (if (string-match "%" field-text) "\);" "")))
(printf)
(ert-deftest snippet--test-form-sym-tuples ()
(let* ((test-tuples (snippet--form-sym-tuples '((field 1 "bla")
"ble"
(mirror 1)
(field 2
((field 3 "fonix")
"fotrix"
(mirror 1 "qqcoisa")))
"end")))
(symbols-declared (mapcar #'(lambda (sym) (intern (symbol-name sym)))
(remove 'string (mapcar #'car test-tuples)))))
(should
(equal '(field-1 mirror-1-of-1 field-2 field-3-son-of-field-2 mirror-2-of-1-son-of-field-2)
symbols-declared))))
(provide 'snippet) (provide 'snippet)