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

refactor: do away with snippet--form-[mirror/field]-p, use pcase and cleaner loops

Browse Source
This commit is contained in:
Joao Tavora 2013-10-18 14:40:01 +01:00
parent 9927e08d89
commit c5276642b8
1 changed files with 41 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
snippet.el
View File

@ -17,7 +17,6 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary: ;;; Commentary:
;; ;;
@ -29,12 +28,6 @@
;;; the define-snippet macro and its helpers ;;; 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) (defun snippet--form-make-field-sym (field-name &optional parent-field-sym)
(make-symbol (format "field-%s%s" field-name (make-symbol (format "field-%s%s" field-name
(if parent-field-sym (if parent-field-sym
@ -80,17 +73,18 @@ iterated depth-first, resulting in a flattened list."
for (prev-form form next-form) on `(nil ,@forms) for (prev-form form next-form) on `(nil ,@forms)
for (sym childrenp) = (cond ((snippet--form-field-p form) for (sym childrenp) = (pcase form
(list (snippet--form-make-field-sym (`(field ,name . ,rest)
(second form) (list (snippet--form-make-field-sym
parent-field-sym) name
(listp (third form)))) parent-field-sym)
((snippet--form-mirror-p form) (listp (car rest))))
(incf snippet--form-mirror-sym-idx) (`(mirror ,name . ,_)
(list (snippet--form-make-mirror-sym (incf snippet--form-mirror-sym-idx)
snippet--form-mirror-sym-idx (list (snippet--form-make-mirror-sym
(second form) snippet--form-mirror-sym-idx
parent-field-sym)))) name
parent-field-sym))))
append (cond (sym append (cond (sym
`((,sym `((,sym
@ -106,7 +100,7 @@ iterated depth-first, resulting in a flattened list."
(snippet--function-p form)) (snippet--function-p form))
`((string-or-function ,form ,parent-field-sym))) `((string-or-function ,form ,parent-field-sym)))
(t (t
(error "unknown type of snippet form %s" form))) (error "unknown type of snippet form %s" form)))
do (setq adjacent-prev-sym sym))) do (setq adjacent-prev-sym sym)))
(defun snippet--make-marker-init-forms (tuples) (defun snippet--make-marker-init-forms (tuples)
@ -150,23 +144,28 @@ I would need these somewhere in the let* form
(defun snippet--first-field-sym (tuples) (defun snippet--first-field-sym (tuples)
(first (cl-find-if #'snippet--form-field-p tuples :key #'second))) (first (first (snippet--field-tuples tuples))))
(defun snippet--field-tuples (tuples)
(cl-remove-if-not #'(lambda (form)
(and (consp form)
(eq 'field (car form))))
tuples :key #'cadr))
(defun snippet--init-field-and-mirror-forms (tuples) (defun snippet--init-field-and-mirror-forms (tuples)
(let* ((field-mirrors (make-hash-table)) (let* ((field-mirrors (make-hash-table))
;; we first collect `snippet--make-mirror' forms. When ;; we first collect `snippet--make-mirror' forms. When
;; collecting them, we populate the `field-mirrors' table... ;; collecting them, we populate the `field-mirrors' table...
;; ;;
(tuples (cl-remove 'string-or-function tuples :key #'car))
(make-mirror-forms (make-mirror-forms
(loop for (sym form parent-sym) in tuples (loop for (sym (type name transform) parent-sym) in tuples
when (snippet--form-mirror-p form) when (eq 'mirror type)
collect (let ((source-sym nil)) collect (let ((source-sym nil))
(loop for (sym-b form-b) in tuples (loop for (sym-b (type-b name-b)) in tuples
when (and when (and
(snippet--form-field-p form-b) (eq 'field type-b)
(eq (second form) (eq name name-b))
(second form-b)))
do do
(setq source-sym sym-b) (setq source-sym sym-b)
(puthash source-sym (puthash source-sym
@ -174,32 +173,30 @@ I would need these somewhere in the let* form
field-mirrors)) field-mirrors))
field-mirrors)) field-mirrors))
(unless source-sym (unless source-sym
(error "mirror %s mentions unknown field" (error "mirror mentions unknown field %s"
form)) name))
`((,sym (snippet--make-mirror)) `((,sym (snippet--make-mirror))
(snippet--init-mirror (snippet--init-mirror
,sym ,sym
,source-sym ,source-sym
,(snippet--start-marker-name sym) ,(snippet--start-marker-name sym)
,(snippet--end-marker-name sym) ,(snippet--end-marker-name sym)
,(snippet--transform-lambda (third form)) ,(snippet--transform-lambda transform)
,parent-sym))))) ,parent-sym)))))
;; so that we can now create `snippet--make-field' forms with ;; so that we can now create `snippet--make-field' forms with
;; complete lists of mirror symbols. ;; complete lists of mirror symbols.
;; ;;
(make-field-forms (make-field-forms
(loop with field-tuples = (cl-remove-if-not #'snippet--form-field-p (loop with field-tuples = (snippet--field-tuples tuples)
tuples
:key #'second)
for ((prev-sym) for ((prev-sym)
(sym form parent-sym) (sym (_type name _value) parent-sym)
(next-sym)) on `(nil ,@field-tuples) (next-sym)) on `(nil ,@field-tuples)
when sym when sym
collect `((,sym (snippet--make-field)) collect `((,sym (snippet--make-field))
(snippet--init-field (snippet--init-field
,sym ,sym
,(second form) ,name
,(snippet--start-marker-name sym) ,(snippet--start-marker-name sym)
,(snippet--end-marker-name sym) ,(snippet--end-marker-name sym)
,parent-sym ,parent-sym
@ -230,16 +227,16 @@ I would need these somewhere in the let* form
,@(loop ,@(loop
for (sym form) in sym-tuples for (sym form) in sym-tuples
collect (cond ((snippet--form-field-p form) collect (pcase form
`(snippet--insert-field ,sym ,(if (stringp (`(field ,_ ,text)
(third form)) `(snippet--insert-field ,sym ,(if (stringp text)
(third form)))) text)))
((snippet--form-mirror-p form) (`(mirror . ,_)
`(snippet--insert-mirror ,sym)) `(snippet--insert-mirror ,sym))
((stringp form) ((pred stringp)
`(insert ,form)) `(insert ,form))
((snippet--function-p form) ((pred functionp)
`(insert (funcall ,form))))) `(insert (funcall ,form)))))
(setq snippet--field-overlay (setq snippet--field-overlay
(make-overlay (point) (point) nil nil t)) (make-overlay (point) (point) nil nil t))