mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-14 05:23:04 +00:00
wip: still inoperative, but much better macros, support parent fields
This commit is contained in:
Joao Tavora
parent
f00509a696
commit
fc1c3632b6
160
snippet.el
160
snippet.el
@ -25,7 +25,7 @@
|
||||
;;; 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
|
||||
start end
|
||||
parent-field
|
||||
@ -35,7 +35,7 @@
|
||||
next)
|
||||
|
||||
|
||||
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror (source transform)))
|
||||
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror (source transform parent-field)))
|
||||
source
|
||||
start end
|
||||
(transform nil)
|
||||
@ -53,55 +53,147 @@
|
||||
(insert (funcall (snippet--mirror-transform mirror)))
|
||||
(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)
|
||||
(cl-flet ((field-p (form) (and (consp form) (eq (car form) 'field)))
|
||||
(mirror-p (form) (and (consp form) (eq (car form) 'mirror)))
|
||||
(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))))
|
||||
(let* ((sym-tuples (snippet--form-sym-tuples body))
|
||||
(make-object-forms (snippet--make-object-forms sym-tuples)))
|
||||
`(defun ,name ()
|
||||
(let* (,@(loop for form in (cl-remove-if-not #'field-p body)
|
||||
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))))))
|
||||
(let* (,@(remove 'string (mapcar #'car sym-tuples))
|
||||
(start (point))
|
||||
overlay)
|
||||
,@(loop with mirror-idx = 1
|
||||
for form in body
|
||||
collect (cond ((field-p form)
|
||||
`(snippet--insert-field ,(make-field-sym (second form))
|
||||
,(third form)))
|
||||
((mirror-p form)
|
||||
(prog1 `(snippet--insert-mirror ,(make-mirror-sym mirror-idx
|
||||
(second form)))
|
||||
(incf mirror-idx)))
|
||||
,@make-object-forms
|
||||
|
||||
|
||||
,@(loop for (sym form) in sym-tuples
|
||||
collect (cond ((snippet--form-field-p form)
|
||||
`(snippet--insert-field ,sym ,(third form)))
|
||||
((snippet--form-mirror-p form)
|
||||
`(snippet--insert-mirror ,sym))
|
||||
(t
|
||||
`(insert ,form))))
|
||||
|
||||
(setq overlay (make-overlay start (point)))))))
|
||||
|
||||
(define-snippet printf ()
|
||||
"printf (\""
|
||||
(field 1 "%s")
|
||||
"\n"
|
||||
(mirror 1 (if (string-match "%" field-text) "," "\);"))
|
||||
(field 2)
|
||||
(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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user