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

fix: prefix cl-lib functions with cl and wrap long lines

Browse Source
This commit is contained in:
Joao Tavora 2013-10-19 00:27:17 +01:00
parent ccf3579344
commit 4149acbaae
1 changed files with 129 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
snippet.el
View File

@ -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,7 +66,7 @@ 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
@ -127,7 +127,7 @@ 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
@ -144,7 +144,7 @@ I would need these somewhere in the let* form
(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,10 +159,10 @@ 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))
@ -187,7 +187,7 @@ I would need these somewhere in the let* form
;; 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)
@ -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))
@ -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,32 +502,33 @@ 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-start mirror)
(snippet--mirror-end 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))))))
@ -532,5 +537,8 @@ can be:
;; 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