-
-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy pathlquery-funcs.lisp
739 lines (654 loc) · 33.9 KB
/
lquery-funcs.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
(in-package #:org.shirakumo.lquery)
(define-lquery-list-function add (working-nodes selector-or-nodes)
"Add elements to the set of matched elements."
(vector-append working-nodes (nodes-or-select selector-or-nodes)))
(define-lquery-function add-class (node &rest classes)
"Adds the specified class(es) to the set of matched elements.
The following types are handled for each class to add:
NULL --- No class is added.
STRING --- The string is added as a class.
SYMBOL --- The symbol name, downcased, is added as a class.
LIST --- Add all classes in the list. Each item must be one of
the above types."
(setf (plump:attribute node "class")
(with-output-to-string (stream)
(let ((prev (plump:attribute node "class")))
(when prev (write-string prev stream)))
(dolist (classish classes)
(dolist (class (if (listp classish) classish (list classish)))
(write-char #\Space stream)
(etypecase class
(string (write-string class stream))
(symbol (format stream "~(~a~)" (symbol-name class))))))))
node)
(define-lquery-list-function after (nodes html-or-nodes)
"Insert content (in html-string or node-list form) after each element."
(let ((inserts (nodes-or-build html-or-nodes)))
(loop for node across nodes
for position = (plump:child-position node)
do (array-shift (plump:family node) :n (length inserts) :from (1+ position))
(loop for i from (1+ position)
for insert across inserts
do (let ((insert (plump:clone-node insert)))
(setf (plump:parent insert) node
(aref (plump:family node) i) insert)))))
nodes)
(defun parent-lists (nodes)
(loop with parent-lists = (make-array (length nodes))
for node across nodes
for i from 0
do (loop with list = ()
for parent = (plump:parent node)
then (plump:parent parent)
until (plump:root-p parent)
do (push parent list)
finally (setf (aref parent-lists i) list))
finally (return parent-lists)))
(define-lquery-list-function ancestor (working-nodes)
"Find the common ancestor of all elements."
(loop with parent-lists = (parent-lists working-nodes)
with previous = NIL
with current = NIL
while (when (loop for i from 1 below (length parent-lists)
for a = (setf current (pop (aref parent-lists i)))
then (pop (aref parent-lists i))
for b = (pop (aref parent-lists 0))
then a
always (and a (eq a b)))
(setf previous current))
finally (return (make-proper-vector :size 1 :initial-element previous))))
(define-lquery-list-function append (nodes html-or-nodes)
"Insert content (in html-string or node-list form) to the end of each element."
(let ((inserts (nodes-or-build html-or-nodes)))
(loop for node across nodes
do (loop for insert across inserts
do (plump:append-child node (plump:clone-node insert)))))
nodes)
(define-lquery-list-function append-to (working-nodes selector-or-nodes)
"Insert every element to the end of the target(s)."
(let ((targets (nodes-or-select selector-or-nodes)))
(lquery-funcs:append targets working-nodes))
working-nodes)
(define-lquery-function attr (node &rest pairs)
"Retrieve or set attributes on a node.
The value on a node is turned into a string using PRINC-TO-STRING.
If a value is NIL, the associated attribute is removed."
(case (length pairs)
(0 (error "Attribute arguments must be one or more attributes or one or more key-value pairs."))
(1 (plump:attribute node (assure-attribute (first pairs))))
(otherwise
(loop for (key val) on pairs by #'cddr
do (if val
(setf (plump:attribute node (assure-attribute key))
(princ-to-string val))
(plump:remove-attribute node (assure-attribute key))))
node)))
(define-lquery-list-function before (nodes html-or-nodes)
"Insert content (in html-string or node-list form) before each element."
(let ((inserts (nodes-or-build html-or-nodes)))
(loop for node across nodes
for position = (plump:child-position node)
do (array-shift (plump:family node) :n (length inserts) :from position)
(loop for i from position
for insert across inserts
do (let ((insert (plump:clone-node insert)))
(setf (plump:parent insert) node
(aref (plump:family node) i) insert)))))
nodes)
(define-lquery-list-function children (nodes &optional selector)
"Get the children of each element, optionally filtered by a selector."
(loop with result = (make-proper-vector)
for node across nodes
do (loop for child across (plump:children node)
do (when (and (plump:element-p child)
(or (not selector)
(clss:node-matches-p selector child)))
(vector-push-extend child result)))
finally (return result)))
(define-lquery-function child-index (node)
"Returns the index of the element within its parent, also counting text nodes. See index() otherwise."
(plump:child-position node))
(define-lquery-function clone (node)
"Create a deep copy of the set of matched elements."
(plump:clone-node node))
(define-lquery-function closest (node selector)
"For each element in the set, get the first element that matches the selector by testing the element itself and traversing up through its ancestors in the DOM tree.
If no matching element can be found the root is entered instead."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(loop do (setf node (plump:parent node))
until (or (plump:root-p node)
(clss:node-matches-p selector node)))
node)
(define-lquery-list-function contains (nodes string)
"Select all elements that contain the specified text."
(loop with string = (trim string)
with result = (make-proper-vector)
for node across nodes
do (when (search string (plump:text node))
(vector-push-extend node result))
finally (return result)))
(define-lquery-list-function contents (nodes)
"Get the children of each element, including text and comment nodes."
(loop with result = (make-proper-vector)
for node across nodes
do (loop for child across (plump:children node)
do (vector-push-extend child result))
finally (return result)))
(define-lquery-function css (node &rest pairs)
"Retrieve or set css style attributes on a node."
(let ((css-styles (get-css-styles node)))
(case (length pairs)
(0 (error "CSS attribute arugments must be one or more attributes or one or more key-value pairs."))
(1 (gethash (assure-attribute (first pairs)) css-styles))
(otherwise
(loop for (key val) on pairs by #'cddr
do (setf (gethash (assure-attribute key) css-styles) val))
(set-css-styles node css-styles)
node))))
(define-lquery-function data (node &rest pairs)
"Retrieve or set data attributes on a node. This is a convenience method and uses attr in the back."
(case (length pairs)
(0 (error "Data attribute arguments must be one or more attributes or one or more key-value pairs."))
(1 (plump:attribute node (concatenate 'string "data-" (assure-attribute (first pairs)))))
(otherwise
(loop for (key val) on pairs by #'cddr
for name = (concatenate 'string "data-" (assure-attribute key))
do (if val
(setf (plump:attribute node name)
(princ-to-string val))
(plump:remove-attribute node name)))
node)))
(define-lquery-function deepest (node)
"Returns the innermost (left-bound) child element."
(labels ((r (node)
(loop with elp = NIL
for child across (plump:children node)
when (plump:element-p child)
do (setf elp child)
until elp
finally (return (if elp
(r elp)
node)))))
(r node)))
(define-lquery-list-function detach (nodes &optional selector)
"Removes the node (optionally filtered by the selector) from the document. Alias for remove()"
(lquery-funcs:remove nodes selector))
(define-lquery-list-function each (nodes fun &key replace)
"Execute the specified function on each element until NIL is returned or all elements have been processed. The original set of elements is returned if replace is NIL."
(if replace
(loop for i from 0 below (length nodes)
for result = (funcall fun (aref nodes i))
while result
do (setf (aref nodes i) result)
finally (setf (fill-pointer nodes) i))
(loop for node across nodes
while (funcall fun node)))
nodes)
(define-lquery-function empty (node)
"Remove all child nodes from the set of matched elements."
(plump:clear node))
(define-lquery-function empty-p (node)
"Check if the node contains no children and/or only empty (whitespace) text nodes. If it is empty, T is returned, otherwise NIL."
(loop for child across (plump:children node)
never (or (plump:element-p child)
(and (plump:text-node-p child)
(< 0 (length (trim (plump:text child))))))))
(define-lquery-list-function eq (working-nodes index)
"Reduce the set of matched elements to the one at the specified index"
(setf (aref working-nodes 0) (aref working-nodes index)
(fill-pointer working-nodes) 1)
working-nodes)
(define-lquery-list-function even (working-nodes)
"Selects even elements, 1-indexed"
(loop for i from 0
while (< (1+ (* i 2)) (length working-nodes))
do (setf (aref working-nodes i)
(aref working-nodes (1+ (* i 2))))
finally (setf (fill-pointer working-nodes) i))
working-nodes)
(define-lquery-list-function filter (nodes selector-or-function)
"Reduce the set of matched elements to those that match the selector or pass the function's test."
(replace-vector-if nodes (funcs-or-select selector-or-function)))
(define-lquery-list-function find (nodes selector-or-function &key (test-self NIL))
"Get the descendants of each element filtered by selector or function."
(loop with result = (make-proper-vector)
with func = (funcs-or-select selector-or-function)
for node across nodes
do (labels ((r (node)
(loop for child across (plump:children node)
do (when (plump:element-p child)
(r child)
(when (funcall func child)
(vector-push-extend child result))))))
(r node))
(when (and test-self (funcall func node))
(vector-push-extend node result))
finally (return result)))
(define-lquery-list-function first (working-nodes)
"Reduce the set of matched elements to the first in the set."
(setf (fill-pointer working-nodes) 1)
working-nodes)
(define-lquery-list-function gt (working-nodes index)
"Select all elements at a greater than index(0) within the matched set."
(loop for i from 0 below (- (length working-nodes) index)
do (setf (aref working-nodes i)
(aref working-nodes (+ i index)))
finally (setf (fill-pointer working-nodes) (- (length working-nodes) index)))
working-nodes)
(define-lquery-list-function has (nodes selector-or-nodes)
"Reduce the set of matched elements to those that have a descendant that matches the selector or element."
(let ((find-fun (nodes-or-selector-func selector-or-nodes)))
(replace-vector-if nodes #'(lambda (node)
(< 0 (length (lquery-funcs:find node find-fun)))))))
(define-lquery-list-function has-class (working-nodes class)
"Determine whether any of the matched elements are assigned to the given class."
(let ((class (assure-attribute class)))
(loop for node across working-nodes
if (find class (classes node) :test #'string-equal)
return T)))
(define-lquery-list-function hide (working-nodes )
"Hide the matched elements (short for (css \"display\" \"none\"))."
(lquery-funcs:css working-nodes "display" "none"))
(define-lquery-function html (node &optional new-content)
"Get the HTML contents of the elements or set the HTML contents of every matched element.
The new content can be either a plump node, root, pathname, or string. If it is none of those,
it is treated as a string via PRINC-TO-STRING"
(if new-content
(progn
(plump:clear node)
(typecase new-content
(plump:root (loop for child across (plump:children new-content)
do (plump:append-child node child)))
(plump:node (plump:append-child node new-content))
(pathname (plump:parse new-content :root node))
(T (plump:parse (princ-to-string new-content) :root node)))
node)
(with-output-to-string (stream)
(plump:serialize (plump:children node) stream))))
(define-lquery-list-function html-file (working-nodes pathname)
"Read an HTML file and insert its contents into each element."
(let ((document (plump:parse pathname)))
(loop for node across working-nodes
do (plump:clear node)
(loop for child across (plump:children document)
do (plump:append-child node (plump:clone-node child))))
working-nodes))
(define-lquery-function index (node)
"Find the index of the node within its parent."
(plump:element-position node))
(define-lquery-list-function initialize (working-nodes document)
"Re-initializes lQuery with a new page."
(make-proper-vector :size 1 :initial-element (initialize (load-page document))))
(define-lquery-list-function insert-after (working-nodes selector-or-nodes)
"Insert every element after the target."
(lquery-funcs:after (nodes-or-select selector-or-nodes) working-nodes))
(define-lquery-list-function insert-before (working-nodes selector-or-nodes)
"Insert every element before the target."
(lquery-funcs:before (nodes-or-select selector-or-nodes) working-nodes))
(define-lquery-list-function is (working-nodes selector-or-nodes)
"Check the current elements against a selector or list of elements and return true if at least one of them matches."
(let ((find-fun (nodes-or-selector-func selector-or-nodes)))
(loop for node across working-nodes
thereis (funcall find-fun node))))
(defun lquery-funcs:is-empty (node)
"Check if the node contains no children and/or only empty (whitespace) text nodes. If it is empty, T is returned, otherwise NIL.
Alias of EMPTY-P"
(lquery-funcs:empty-p node))
(define-lquery-list-function last (working-nodes)
"Reduce the set of matched elements to the final one in the set."
(when (< 0 (length working-nodes))
(setf (aref working-nodes 0)
(aref working-nodes (1- (length working-nodes)))
(fill-pointer working-nodes) 1))
working-nodes)
(define-lquery-list-function length (working-nodes)
"Returns the number of elements in the list."
(length working-nodes))
(define-lquery-list-function lt (working-nodes index)
"Select all elements at an index less than the index within the matched set."
(setf (fill-pointer working-nodes) index)
working-nodes)
(define-lquery-list-function map (working-nodes function)
"Pass each element through a function (which has to accept one argument, the node), returning the list of all results."
(replace-vector working-nodes function))
(define-lquery-list-function map-apply (working-nodes function)
"Pass each element through a function by apply, returning the vector of all results.
This is commonly useful in combination with COMBINE."
(replace-vector working-nodes #'(lambda (element) (apply function element))))
(define-lquery-list-function next (nodes &optional selector)
"Get the immediately following sibling of each element (if there is one). If a selector is provided, the sibling is only included if it matches."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(replace-vector-if nodes #'(lambda (sibling)
(and sibling (or (not selector) (clss:node-matches-p selector sibling))))
:key #'plump:next-element))
(define-lquery-list-function next-all (nodes &optional selector)
"Get all following siblings of each element. If a selector is provided, the sibling is only included if it matches."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(loop with result = (make-proper-vector)
for node across nodes
do (loop for i from (1+ (plump:child-position node))
below (length (plump:family node))
for sibling = (aref (plump:family node) i)
do (when (and (plump:element-p sibling)
(or (not selector)
(clss:node-matches-p selector sibling)))
(vector-push-extend sibling result)))
finally (return result)))
(define-lquery-list-function next-until (nodes selector-or-nodes)
"Get all following silings of each element up to (excluding) the element matched by the selector or node list."
(loop with fun = (nodes-or-selector-func selector-or-nodes)
with result = (make-proper-vector)
for node across nodes
do (loop for i from (1+ (plump:child-position node))
below (length (plump:family node))
for sibling = (aref (plump:family node) i)
until (and (plump:element-p sibling)
(funcall fun sibling))
do (when (plump:element-p sibling)
(vector-push-extend sibling result)))
finally (return result)))
(define-lquery-list-function node (working-nodes &optional (n 0))
"Return the specified node (default first) directly, without encompassing it into a vector if it exists. Otherwise return NIL."
(when (< n (length working-nodes))
(elt working-nodes n)))
(define-lquery-list-function not (working-nodes selector-or-nodes)
"Remove matching elements from the working elements."
(let ((fun (nodes-or-selector-func selector-or-nodes)))
(replace-vector-if working-nodes (complement fun))))
(define-lquery-function not-empty (node)
"Check if the node contains no children and/or only empty (whitespace) text nodes. If the node is effectively empty NIL is returned, otherwise T"
(loop for child across (plump:children node)
thereis (or (plump:element-p child)
(and (plump:text-node-p child)
(< 0 (length (trim (plump:text child))))))))
(define-lquery-list-function odd (working-nodes)
"Select all odd elements from the current set, 1-indexed."
(loop for i from 0
while (< (* i 2) (length working-nodes))
do (setf (aref working-nodes i)
(aref working-nodes (* i 2)))
finally (setf (fill-pointer working-nodes) i))
working-nodes)
(define-lquery-list-function parent (nodes &optional selector)
"Get the parent of each element, optionally filtered by a selector."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(replace-vector-if nodes #'(lambda (el)
(or (not selector) (clss:node-matches-p selector el))) :key #'plump:parent))
(define-lquery-list-function parents (nodes &optional selector)
"Get the ancestors of each element, optionally filtered by a selector. Closest parent first."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(loop with result = (make-proper-vector)
for node across nodes
do (loop for parent = (plump:parent node)
then (plump:parent parent)
until (or (not parent) (plump:root-p parent))
do (when (or (not selector) (clss:node-matches-p selector parent))
(vector-push-extend parent result)))
finally (return result)))
(define-lquery-list-function parents-until (nodes selector-or-nodes)
"Get the ancestors of each element, up to (excluding) the element matched by the selector or node list. Closest parent first"
(loop with result = (make-proper-vector)
with func = (nodes-or-selector-func selector-or-nodes)
for node across nodes
do (loop for parent = (plump:parent node)
then (plump:parent parent)
until (or (not parent)
(plump:root-p parent)
(funcall func parent))
do (vector-push-extend parent result))
finally (return result)))
(define-lquery-list-function prepend (nodes html-or-nodes)
"Insert content, specified by the parameter, to the beginning of each element."
(let ((inserts (nodes-or-build html-or-nodes)))
(loop for node across nodes
do (loop for insert across inserts
do (plump:prepend-child node (plump:clone-node insert)))))
nodes)
(define-lquery-list-function prepend-to (working-nodes selector-or-nodes)
"Insert every element to the beginning of the target(s)."
(let ((targets (nodes-or-select selector-or-nodes)))
(lquery-funcs:prepend targets working-nodes))
working-nodes)
(define-lquery-list-function prev (nodes &optional selector)
"Get the immediately preceding sibling of each element (if there is one). If a selector is provided, the sibling is only included if it matches."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(replace-vector-if nodes #'(lambda (sibling)
(and sibling (or (not selector) (clss:node-matches-p selector sibling))))
:key #'plump:previous-element))
(define-lquery-list-function prev-all (nodes &optional selector)
"Get all preceeding siblings of each element. If a selector is provided, the sibling is only included if it matches."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(loop with result = (make-proper-vector)
for node across nodes
do (loop for i downfrom (1- (plump:child-position node))
above 0
for sibling = (aref (plump:family node) i)
do (when (and (plump:element-p sibling)
(or (not selector)
(clss:node-matches-p selector sibling)))
(vector-push-extend sibling result)))
finally (return result)))
(define-lquery-list-function prev-until (nodes selector-or-nodes)
"Get all preceeding silings of each element down to (excluding) the element matched by the selector or node list."
(loop with fun = (nodes-or-selector-func selector-or-nodes)
with result = (make-proper-vector)
for node across nodes
do (loop for i downfrom (1- (plump:child-position node))
above 0
for sibling = (aref (plump:family node) i)
until (and (plump:element-p sibling)
(funcall fun sibling))
do (when (plump:element-p sibling)
(vector-push-extend sibling result)))
finally (return result)))
(define-lquery-function remove (node &optional selector)
"Remove the set of matched elements from the DOM."
(when (or (not selector) (clss:node-matches-p selector node))
(plump:remove-child node))
node)
(define-lquery-function remove-attr (node &rest attributes)
"Remove attributes from each element."
(dolist (attr attributes)
(plump:remove-attribute node (assure-attribute attr)))
node)
(define-lquery-function remove-class (node &rest classes)
"Remove classes from each element.
Each class in the list can be of the following types:
NULL --- Nothing is done.
STRING --- Matching classes by string= are removed.
SYMBOL --- Matching classes against the symbol name by string-equal are removed.
LIST --- Add all classes in the list. Each item must be one of
the above types."
(setf (plump:attribute node "class")
(let ((existing (classes node)))
(dolist (classish classes)
(dolist (class (if (listp classish) classish (list classish)))
(setf existing
(typecase class
(string (delete class existing :test #'string=))
(symbol (delete (symbol-name class) existing :test #'string-equal))))))
(format NIL "~{~a~^ ~}" existing)))
node)
(define-lquery-function remove-data (node &rest data)
"Remove data attributes from each element. This is a convenience method and uses remove-attr in the back."
(loop for dat in data
do (plump:remove-attribute node (concatenate 'string "data-" dat)))
node)
(define-lquery-function render-text (node)
"Return the \"rendered\" representation of the text inside the node and its children.
In effect the text is gathered from the component and all of
its children, but transforming the text in such a way that:
- All ASCII white space (Space, Tab, CR, LF) is converted into spaces.
- There are no consecutive spaces.
- There are no spaces at the beginning or end."
(plump-dom:render-text node))
(define-lquery-list-function replace-all (working-nodes selector-or-nodes)
"Replace each in the set of matched elements with the current nodes."
(let ((targets (nodes-or-select selector-or-nodes)))
(unless (= 0 (length working-nodes))
(loop for target across targets
for position = (plump:child-position target)
for family = (plump:family target)
do (array-shift family :n (1- (length working-nodes)) :from position)
(loop for i from 0 below (length working-nodes)
do (setf (aref family (+ i position))
(aref working-nodes i)))
(setf (plump:parent target) NIL)))
working-nodes))
(define-lquery-list-function replace-with (working-nodes html-or-nodes)
"Replace each element with the provided new content and return the set of elements that was removed."
(let ((new-nodes (nodes-or-build html-or-nodes)))
(lquery-funcs:replace-all new-nodes working-nodes)
working-nodes))
(define-lquery-list-function root (working-nodes)
"Returns to the root. Essentially traverses up the tree of the first element in the set until the root is reached."
(if (= 0 (length working-nodes))
working-nodes
(loop for child = (aref working-nodes 0)
then (plump:parent child)
do (when (or (not (plump:child-node-p child))
(not (plump:parent child)))
(return (make-proper-vector :size 1 :initial-element child))))))
(define-lquery-list-function show (working-nodes)
"Display the matched elements (short for (css :display 'block'))"
(lquery-funcs:css working-nodes "display" "block"))
(define-lquery-list-function siblings (nodes &optional selector)
"Get the siblings of each element, optionally filtered by a selector."
(when (stringp selector)
(setf selector (clss:parse-selector selector)))
(loop with result = (make-proper-vector)
for node across nodes
do (loop for sibling across (plump:family node)
unless (or (eq node sibling)
(not (plump:element-p sibling))
(and selector
(clss:node-matches-p selector sibling)))
do (vector-push-extend sibling result))
finally (return result)))
(define-lquery-list-function size (working-nodes)
"Return the number of elements in the list."
(length working-nodes))
(define-lquery-list-function slice (working-nodes start &optional end)
"Reduce the set of matched elements to a subset specified by a range of indices"
(unless end (setf end (length working-nodes)))
(array-shift working-nodes :from start :to end :n (- start) :adjust NIL)
(setf (fill-pointer working-nodes) (- end start))
working-nodes)
(define-lquery-function splice (node)
"Splice the element's contents in place of itself."
(plump-dom:splice node)
node)
(define-lquery-function text (node &optional (text NIL t-s-p))
"Get the combined text contents of each element, including their descendants. If text is set, all text nodes are removed and a new text node is appended to the end of the node. If text is NIL, all direct text nodes are removed from the node. If text is not a string, it is transformed into one by PRINC-TO-STRING."
(if t-s-p
(if text
(progn
(replace-vector-if (plump:children node) (complement #'plump:textual-node-p))
(plump:make-text-node node (typecase text
(plump:node (with-output-to-string (stream)
(plump:serialize text stream)))
(T (princ-to-string text))))
node)
(progn
(replace-vector-if (plump:children node) (complement #'plump:textual-node-p))
node))
(plump:text node)))
(define-lquery-function toggle-class (node &rest classes)
"Add or remove one or more classes from each element, depending on their presence within the element."
(let ((list (classes node)))
(loop for class in classes
if (member class list :test #'string=)
collect class into to-remove
else
collect class into to-add
finally (setf (plump:attribute node "class")
(with-output-to-string (stream)
(format stream "~{~a~^ ~}" to-add)
(loop for item in list
do (unless (member item to-remove :test #'string=)
(write-char #\Space)
(write-string item stream)))))))
node)
(define-lquery-function unwrap (node)
"Remove the parents of the set of matched elements from the DOM, inserting the parents children in place of it."
(let* ((parent (plump:parent node))
(pparent (plump:parent parent))
(parentpos (plump:child-position parent)))
(array-shift (plump:children pparent) :n (1- (length (plump:children parent))) :from parentpos)
(loop for child across (plump:children parent)
for i from parentpos
do (setf (aref (plump:children pparent) i) child
(plump:parent child) pparent))
(setf (plump:parent parent) NIL
(fill-pointer (plump:children parent)) 0))
node)
(define-lquery-function val (node &optional (value NIL v-p))
"Get the current values or set the value of every matched element."
(if v-p
(progn
(if value
(setf (plump:attribute node "value")
(princ-to-string value))
(plump:remove-attribute node "value"))
node)
(plump:attribute node "value")))
(define-lquery-list-function wrap (nodes html-or-nodes)
"Wrap an HTML structure around each element. Note that always the first node of the structure to wrap is chosen."
(let ((base (aref (nodes-or-build html-or-nodes) 0)))
(loop for node across nodes
for wrapper = (plump:clone-node base)
do (setf (aref (plump:family node) (plump:child-position node)) wrapper)
(setf (plump:parent wrapper) (plump:parent node))
(plump:append-child wrapper node)))
nodes)
(define-lquery-list-function wrap-all (working-nodes html-or-nodes)
"Wrap an HTML structure around all elements and put it in place of the first element, removing all other elements from their position."
(let* ((first (aref working-nodes 0))
(parent (plump:parent first))
(position (plump:child-position first))
(wrapper (aref (nodes-or-build html-or-nodes) 0)))
(plump:append-child wrapper first)
(loop for i from 1 below (length working-nodes)
for node = (aref working-nodes i)
do (plump:remove-child node)
(plump:append-child wrapper node))
(setf (aref (plump:children parent) position) wrapper
(plump:parent wrapper) parent))
working-nodes)
(define-lquery-list-function wrap-inner (nodes html-or-nodes)
"Wrap an HTML structure around the contents of each element."
(let ((base (aref (nodes-or-build html-or-nodes) 0)))
(loop for node across nodes
for wrapper = (plump:clone-node base)
do (loop for child across (plump:children node)
do (setf (plump:parent child) wrapper)
(vector-push-extend child (plump:children wrapper)))
(setf (plump:children node) (make-proper-vector :size 1 :initial-element wrapper)
(plump:parent wrapper) node)))
nodes)
(define-lquery-list-function write-to-file (working-nodes file &key (if-does-not-exist :CREATE) (if-exists :SUPERSEDE))
"Write the serialized node to the file. Note that always only the first element is written."
(with-open-file (stream file :direction :OUTPUT :if-does-not-exist if-does-not-exist :if-exists if-exists)
(plump:serialize (aref working-nodes 0) stream))
working-nodes)
(define-lquery-function serialize (node &optional (stream NIL) (format :default))
"Serialize the node into a string.
Allows two optional arguments:
STREAM --- NIL to return a string, or a stream to output to.
FORMAT --- One of :DEFAULT, :HTML, :XML to designate the way
in which to invoke Plump's serializer."
(let ((plump:*tag-dispatchers* (case format
(:default plump:*tag-dispatchers*)
(:html plump:*html-tags*)
(:xml plump:*xml-tags*))))
(if stream
(plump:serialize node stream)
(with-output-to-string (stream)
(plump:serialize node stream)))))