mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-17 06:53:03 +00:00
fix: prefix cl-lib functions with cl and wrap long lines
This commit is contained in:
Joao Tavora
parent
ccf3579344
commit
4149acbaae
250
snippet.el
250
snippet.el
@ -52,10 +52,10 @@
|
|||||||
|
|
||||||
(defun snippet--function-p (form)
|
(defun snippet--function-p (form)
|
||||||
(or (functionp form)
|
(or (functionp form)
|
||||||
(and (eq 'function (first form))
|
(and (eq 'function (car form))
|
||||||
(fboundp (second form)))
|
(fboundp (cl-second form)))
|
||||||
(and (eq 'quote (first form))
|
(and (eq 'quote (car form))
|
||||||
(fboundp (second form)))))
|
(fboundp (cl-second form)))))
|
||||||
|
|
||||||
(defun snippet--form-sym-tuples (forms &optional parent-field-sym)
|
(defun snippet--form-sym-tuples (forms &optional parent-field-sym)
|
||||||
"Produce information for composing the snippet expansion function.
|
"Produce information for composing the snippet expansion function.
|
||||||
@ -66,42 +66,42 @@ A tuple of 6 elements is created for each form in FORMS.
|
|||||||
|
|
||||||
Forms representing fields with nested elements are recursively
|
Forms representing fields with nested elements are recursively
|
||||||
iterated depth-first, resulting in a flattened list."
|
iterated depth-first, resulting in a flattened list."
|
||||||
(loop unless forms return nil
|
(cl-loop unless forms return nil
|
||||||
with snippet--form-mirror-sym-idx = (or snippet--form-mirror-sym-idx
|
with snippet--form-mirror-sym-idx = (or snippet--form-mirror-sym-idx
|
||||||
0)
|
0)
|
||||||
with adjacent-prev-sym
|
with adjacent-prev-sym
|
||||||
|
|
||||||
for (prev-form form next-form) on `(nil ,@forms)
|
for (prev-form form next-form) on `(nil ,@forms)
|
||||||
|
|
||||||
for (sym childrenp) = (pcase form
|
for (sym childrenp) = (pcase form
|
||||||
(`(field ,name . ,rest)
|
(`(field ,name . ,rest)
|
||||||
(list (snippet--form-make-field-sym
|
(list (snippet--form-make-field-sym
|
||||||
name
|
name
|
||||||
parent-field-sym)
|
parent-field-sym)
|
||||||
(listp (car rest))))
|
(listp (car rest))))
|
||||||
(`(mirror ,name . ,_)
|
(`(mirror ,name . ,_)
|
||||||
(incf snippet--form-mirror-sym-idx)
|
(incf snippet--form-mirror-sym-idx)
|
||||||
(list (snippet--form-make-mirror-sym
|
(list (snippet--form-make-mirror-sym
|
||||||
snippet--form-mirror-sym-idx
|
snippet--form-mirror-sym-idx
|
||||||
name
|
name
|
||||||
parent-field-sym))))
|
parent-field-sym))))
|
||||||
|
|
||||||
append (cond (sym
|
append (cond (sym
|
||||||
`((,sym
|
`((,sym
|
||||||
,form
|
,form
|
||||||
,parent-field-sym
|
,parent-field-sym
|
||||||
,adjacent-prev-sym
|
,adjacent-prev-sym
|
||||||
,prev-form
|
,prev-form
|
||||||
,next-form)
|
,next-form)
|
||||||
,@(when childrenp
|
,@(when childrenp
|
||||||
(snippet--form-sym-tuples (third form) sym))))
|
(snippet--form-sym-tuples (third form) sym))))
|
||||||
((null form) nil)
|
((null form) nil)
|
||||||
((or (stringp form)
|
((or (stringp form)
|
||||||
(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)
|
||||||
"Make marker init forms for the snippet objects in TUPLES.
|
"Make marker init forms for the snippet objects in TUPLES.
|
||||||
@ -127,24 +127,24 @@ I would need these somewhere in the let* form
|
|||||||
(mm5-beg ff2-end)
|
(mm5-beg ff2-end)
|
||||||
(mm5-end (make-marker)))
|
(mm5-end (make-marker)))
|
||||||
"
|
"
|
||||||
(loop for (sym nil parent-sym adjacent-prev-sym prev next) in tuples
|
(cl-loop for (sym nil parent-sym adjacent-prev-sym prev next) in tuples
|
||||||
unless (eq sym 'string-or-function)
|
unless (eq sym 'string-or-function)
|
||||||
append `((,(snippet--start-marker-name sym)
|
append `((,(snippet--start-marker-name sym)
|
||||||
,(or (and adjacent-prev-sym
|
,(or (and adjacent-prev-sym
|
||||||
(snippet--end-marker-name adjacent-prev-sym))
|
(snippet--end-marker-name adjacent-prev-sym))
|
||||||
(and parent-sym
|
(and parent-sym
|
||||||
(not prev)
|
(not prev)
|
||||||
(snippet--start-marker-name parent-sym))
|
(snippet--start-marker-name parent-sym))
|
||||||
`(snippet--make-marker)))
|
`(snippet--make-marker)))
|
||||||
(,(snippet--end-marker-name sym)
|
(,(snippet--end-marker-name sym)
|
||||||
,(or (and parent-sym
|
,(or (and parent-sym
|
||||||
(not next)
|
(not next)
|
||||||
(snippet--end-marker-name parent-sym))
|
(snippet--end-marker-name parent-sym))
|
||||||
`(snippet--make-marker))))))
|
`(snippet--make-marker))))))
|
||||||
|
|
||||||
|
|
||||||
(defun snippet--first-field-sym (tuples)
|
(defun snippet--first-field-sym (tuples)
|
||||||
(first (first (snippet--field-tuples tuples))))
|
(car (car (snippet--field-tuples tuples))))
|
||||||
|
|
||||||
(defun snippet--field-tuples (tuples)
|
(defun snippet--field-tuples (tuples)
|
||||||
(cl-remove-if-not #'(lambda (form)
|
(cl-remove-if-not #'(lambda (form)
|
||||||
@ -159,52 +159,52 @@ I would need these somewhere in the let* form
|
|||||||
;;
|
;;
|
||||||
(tuples (cl-remove 'string-or-function tuples :key #'car))
|
(tuples (cl-remove 'string-or-function tuples :key #'car))
|
||||||
(make-mirror-forms
|
(make-mirror-forms
|
||||||
(loop for (sym (type name transform) parent-sym) in tuples
|
(cl-loop for (sym (type name transform) parent-sym) in tuples
|
||||||
when (eq 'mirror type)
|
when (eq 'mirror type)
|
||||||
collect (let ((source-sym nil))
|
collect (let ((source-sym nil))
|
||||||
(loop for (sym-b (type-b name-b)) in tuples
|
(cl-loop for (sym-b (type-b name-b)) in tuples
|
||||||
when (and
|
when (and
|
||||||
(eq 'field type-b)
|
(eq 'field type-b)
|
||||||
(eq name name-b))
|
(eq name name-b))
|
||||||
do
|
do
|
||||||
(setq source-sym sym-b)
|
(setq source-sym sym-b)
|
||||||
(puthash source-sym
|
(puthash source-sym
|
||||||
(cons sym (gethash source-sym
|
(cons sym (gethash source-sym
|
||||||
field-mirrors))
|
field-mirrors))
|
||||||
field-mirrors))
|
field-mirrors))
|
||||||
(unless source-sym
|
(unless source-sym
|
||||||
(error "mirror mentions unknown field %s"
|
(error "mirror mentions unknown field %s"
|
||||||
name))
|
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 transform)
|
,(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 = (snippet--field-tuples tuples)
|
(cl-loop with field-tuples = (snippet--field-tuples tuples)
|
||||||
for ((prev-sym)
|
for ((prev-sym)
|
||||||
(sym (_type name _value) 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
|
||||||
,name
|
,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
|
||||||
(list
|
(list
|
||||||
,@(reverse
|
,@(reverse
|
||||||
(gethash sym field-mirrors)))
|
(gethash sym field-mirrors)))
|
||||||
,next-sym
|
,next-sym
|
||||||
,prev-sym)))))
|
,prev-sym)))))
|
||||||
|
|
||||||
(append make-field-forms
|
(append make-field-forms
|
||||||
make-mirror-forms)))
|
make-mirror-forms)))
|
||||||
@ -220,12 +220,12 @@ I would need these somewhere in the let* form
|
|||||||
(marker-init-forms (snippet--make-marker-init-forms sym-tuples))
|
(marker-init-forms (snippet--make-marker-init-forms sym-tuples))
|
||||||
(init-object-forms (snippet--init-field-and-mirror-forms sym-tuples))
|
(init-object-forms (snippet--init-field-and-mirror-forms sym-tuples))
|
||||||
(first-field-sym (snippet--first-field-sym sym-tuples)))
|
(first-field-sym (snippet--first-field-sym sym-tuples)))
|
||||||
`(let* (,@(mapcar #'first init-object-forms)
|
`(let* (,@(mapcar #'car init-object-forms)
|
||||||
,@marker-init-forms)
|
,@marker-init-forms)
|
||||||
|
|
||||||
,@(mapcar #'second init-object-forms)
|
,@(mapcar #'second init-object-forms)
|
||||||
|
|
||||||
,@(loop
|
,@(cl-loop
|
||||||
for (sym form) in sym-tuples
|
for (sym form) in sym-tuples
|
||||||
collect (pcase form
|
collect (pcase form
|
||||||
(`(field ,_ ,text)
|
(`(field ,_ ,text)
|
||||||
@ -258,7 +258,7 @@ I would need these somewhere in the let* form
|
|||||||
(overlay-put snippet--field-overlay
|
(overlay-put snippet--field-overlay
|
||||||
'snippet--objects
|
'snippet--objects
|
||||||
(list ,@(remove 'string-or-function
|
(list ,@(remove 'string-or-function
|
||||||
(mapcar #'first
|
(mapcar #'car
|
||||||
sym-tuples))))
|
sym-tuples))))
|
||||||
,(if first-field-sym
|
,(if first-field-sym
|
||||||
`(snippet--move-to-field ,first-field-sym))
|
`(snippet--move-to-field ,first-field-sym))
|
||||||
@ -377,10 +377,10 @@ can be:
|
|||||||
(goto-char (snippet--field-start field))
|
(goto-char (snippet--field-start field))
|
||||||
(snippet-exit-snippet)))
|
(snippet-exit-snippet)))
|
||||||
(t
|
(t
|
||||||
(if (snippet--field-next-field field)
|
(if (snippet--field-next-field field)
|
||||||
(snippet--move-to-field (snippet--field-next-field field))
|
(snippet--move-to-field (snippet--field-next-field field))
|
||||||
(goto-char (snippet--field-end field))
|
(goto-char (snippet--field-end field))
|
||||||
(snippet-exit-snippet))))))
|
(snippet-exit-snippet))))))
|
||||||
|
|
||||||
(defun snippet-prev-field ()
|
(defun snippet-prev-field ()
|
||||||
(interactive)
|
(interactive)
|
||||||
@ -464,11 +464,15 @@ can be:
|
|||||||
(let* ((field (overlay-get overlay 'snippet--field))
|
(let* ((field (overlay-get overlay 'snippet--field))
|
||||||
(inhibit-modification-hooks t))
|
(inhibit-modification-hooks t))
|
||||||
(cond (after?
|
(cond (after?
|
||||||
(snippet--close-markers (snippet--field-start field) (snippet--field-end field))
|
(snippet--close-markers (snippet--field-start field)
|
||||||
|
(snippet--field-end field))
|
||||||
(mapc #'snippet--update-mirror (snippet--field-mirrors field))
|
(mapc #'snippet--update-mirror (snippet--field-mirrors field))
|
||||||
(move-overlay overlay (snippet--field-start field) (snippet--field-end field)))
|
(move-overlay overlay
|
||||||
|
(snippet--field-start field)
|
||||||
|
(snippet--field-end field)))
|
||||||
(t
|
(t
|
||||||
(snippet--open-markers (snippet--field-start field) (snippet--field-end field))))))
|
(snippet--open-markers (snippet--field-start field)
|
||||||
|
(snippet--field-end field))))))
|
||||||
|
|
||||||
(defun snippet--field-text (field)
|
(defun snippet--field-text (field)
|
||||||
(buffer-substring-no-properties (snippet--field-start field)
|
(buffer-substring-no-properties (snippet--field-start field)
|
||||||
@ -498,39 +502,43 @@ can be:
|
|||||||
(cl-flet ((describe-field
|
(cl-flet ((describe-field
|
||||||
(field)
|
(field)
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(format "active field overlay %s from %s to %s covering \"%s\", with %s mirrors"
|
(format "field %s [%s,%s] covering \"%s\""
|
||||||
(snippet--field-name field)
|
(snippet--field-name field)
|
||||||
(marker-position (snippet--field-start field))
|
(marker-position (snippet--field-start field))
|
||||||
(marker-position (snippet--field-end field))
|
(marker-position (snippet--field-end field))
|
||||||
(buffer-substring-no-properties (snippet--field-start field)
|
(buffer-substring-no-properties
|
||||||
(snippet--field-end field))
|
(snippet--field-start field)
|
||||||
(length (snippet--field-mirrors field)))))
|
(snippet--field-end field)))))
|
||||||
(describe-mirror
|
(describe-mirror
|
||||||
(mirror)
|
(mirror)
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(format " mirror from %s to %s covering \"%s\""
|
(format " mirror from %s to %s covering \"%s\""
|
||||||
(marker-position (snippet--mirror-start mirror))
|
(marker-position (snippet--mirror-start mirror))
|
||||||
(marker-position (snippet--mirror-end mirror))
|
(marker-position (snippet--mirror-end mirror))
|
||||||
(buffer-substring-no-properties (snippet--mirror-start mirror)
|
(buffer-substring-no-properties
|
||||||
(snippet--mirror-end mirror))))))
|
(snippet--mirror-start mirror)
|
||||||
|
(snippet--mirror-end mirror))))))
|
||||||
(with-current-buffer (get-buffer-create "*snippet-debug*")
|
(with-current-buffer (get-buffer-create "*snippet-debug*")
|
||||||
(let ((inhibit-read-only t))
|
(let ((inhibit-read-only t))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(let ((active-field (overlay-get field-overlay 'snippet--field)))
|
(let ((active-field (overlay-get field-overlay 'snippet--field)))
|
||||||
(loop for object in (overlay-get field-overlay 'snippet--objects)
|
(cl-loop for object in (overlay-get field-overlay 'snippet--objects)
|
||||||
when (snippet--field-p object)
|
when (snippet--field-p object)
|
||||||
do
|
do
|
||||||
(insert (describe-field object))
|
(insert (describe-field object))
|
||||||
(when (eq object active-field) (insert "*ACTIVE*"))
|
(when (eq object active-field) (insert "*ACTIVE*"))
|
||||||
(insert "\n")
|
(insert "\n")
|
||||||
(loop for mirror in (snippet--field-mirrors object)
|
(cl-loop for mirror in (snippet--field-mirrors object)
|
||||||
do (insert (describe-mirror mirror)
|
do (insert (describe-mirror mirror)
|
||||||
"\n")))))
|
"\n")))))
|
||||||
(display-buffer (current-buffer))))))
|
(display-buffer (current-buffer))))))
|
||||||
|
|
||||||
(provide 'snippet)
|
(provide 'snippet)
|
||||||
|
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
;; coding: utf-8
|
;; coding: utf-8
|
||||||
|
;; whitespace-style: (face lines-tail)
|
||||||
|
;; whitespace-line-column: 80
|
||||||
|
;; fill-column: 80
|
||||||
;; End:
|
;; End:
|
||||||
;; snippet.el ends here
|
;; snippet.el ends here
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user