-
-
Notifications
You must be signed in to change notification settings - Fork 147
/
datepicker.cljs
633 lines (582 loc) · 36.4 KB
/
datepicker.cljs
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
(ns re-com.datepicker
(:require-macros
[re-com.core :refer [handler-fn at reflect-current-component]])
(:require
[reagent.core :as reagent]
[cljs-time.core :as cljs-time]
[re-com.config :refer [include-args-desc?]]
[re-com.validate :refer [date-like? css-style? html-attr? parts? position? position-options-list] :refer-macros [validate-args-macro]]
[cljs-time.predicates :refer [sunday?]]
[cljs-time.format :refer [parse unparse formatters formatter]]
[re-com.box :refer [border gap box line h-box flex-child-style]]
[re-com.util :refer [deref-or-value now->utc]]
[re-com.popover :refer [popover-anchor-wrapper popover-content-wrapper]]
[clojure.string :as string])
(:import
[goog.i18n DateTimeFormat]))
;; Loosely based on ideas: https://github.com/dangrossman/bootstrap-daterangepicker
;; --- cljs-time facades ------------------------------------------------------
(def month-format (formatter "MMMM yyyy"))
(def week-format (formatter "ww"))
(def ^:const date-format-str "yyyy MMM dd")
(def ^:const date-format (formatter date-format-str))
(defn iso8601->date [iso8601]
(when (seq iso8601)
(parse (formatters :basic-date) iso8601)))
(defn- month-label [date-time {:keys [months] :as i18n}]
(if months
(str (nth months (dec (cljs-time/month date-time))) " " (unparse (formatter "yyyy") date-time))
(unparse month-format date-time)))
(defn- dec-year [date-time] (cljs-time/minus date-time (cljs-time/years 1)))
(defn- dec-month [date-time] (cljs-time/minus date-time (cljs-time/months 1)))
(defn- inc-month [date-time] (cljs-time/plus date-time (cljs-time/months 1)))
(defn- inc-year [date-time] (cljs-time/plus date-time (cljs-time/years 1)))
(defn- inc-date [date-time n] (cljs-time/plus date-time (cljs-time/days n)))
(defn previous
"If date fails pred, subtract period until true, otherwise answer date"
;; date - a date object that satisfies cljs-time.core/DateTimeProtocol.
;; If omitted, use now->utc, which returns a goog.date.UtcDateTime version of now with time removed.
;; pred - can be one of cljs-time.predicate e.g. sunday? but any valid pred is supported.
;; period - a period which will be subtracted see cljs-time.core periods
;; Note: If period and pred do not represent same granularity, some steps may be skipped
; e.g Pass a Wed date, specify sunday? as pred and a period (days 2) will skip one Sunday.
([pred]
(previous pred (now->utc)))
([pred date]
(previous pred date (cljs-time/days 1)))
([pred date period]
(if (pred date)
date
(recur pred (cljs-time/minus date period) period))))
(defn- =date [date1 date2]
(and
(= (cljs-time/year date1) (cljs-time/year date2))
(= (cljs-time/month date1) (cljs-time/month date2))
(= (cljs-time/day date1) (cljs-time/day date2))))
(defn- <=date [date1 date2]
(or (=date date1 date2) (cljs-time/before? date1 date2)))
(defn- >=date [date1 date2]
(or (=date date1 date2) (cljs-time/after? date1 date2)))
(def log-formatter (formatter "E dd MMM Y HH:mm:ss"))
(defn leap-year?
[year]
;; A year is a leap year if it is...
(not
(or
;; Divisible by 4 (bitwise and 3), OR
(pos? (bit-and year 3))
;; Divisible by 16 (bitwise and 15) AND
;; not divisible by 25.
(and
(pos? (bit-and year 15))
(not (mod 25 year))))))
(defn first-weekday-of-year
[week-day-at-start-of-week year]
{:pre [(number? week-day-at-start-of-week)
(number? year)]}
(let [;; First, we find jan-1-date-time for the year.
jan-1-date-time (cljs-time/at-midnight (cljs-time/date-time year 1 1))
;; Second, we find the week-day number (0-6 re-com numbering, not 1-6 cljs-time numbering) of jan-1-date-time.
jan-1-day-of-week (dec (cljs-time/day-of-week jan-1-date-time))
;; Third, we find the delta between the week-day-at-start-of-week that we are searching for, and the week-day of
;; jan-1-date-time.
week-day-delta (- jan-1-day-of-week week-day-at-start-of-week)
;; Forth, we use the delta to find the number of days-to-add to jan-1-date-time to reach the date-time of the
;; first week-day in that year matching week-day-at-start-of-week. The calculation is different depending on if
;; the delta is positive (week-day in that week is after Jan 1) or not (week day in that week is before, or on,
;; Jan 1).
days-to-add (if (pos? week-day-delta)
(- 7 week-day-delta)
(js/Math.abs week-day-delta))]
(cljs-time/plus jan-1-date-time (cljs-time/days days-to-add))))
(defn week-of-year
[week-day-at-start-of-week start-of-week-date-time]
(let [;; First, we must find the year at the end of the week. For example, the first row in January 2021 with Sunday
;; as the week-day-at-start-of-week is Sun 27 Dec 2020 to Sat 2 Jan 2021. The value for state-of-week-date-time
;; will be Sun 27 Dec 2020. Therefore, we would otherwise incorrectly calculate year as 2020 if we used the year
;; at the start of the week when we should be using 2021.
end-of-week-date-time (cljs-time/at-midnight (cljs-time/plus start-of-week-date-time (cljs-time/days 6)))
year-at-end-of-week (cljs-time/year end-of-week-date-time)
;; Second, we find the first weekday (e.g. Sun 3 January 2021) in the year-at-end-of-week that matches
;; week-day-at-start-of-week (e.g. Sun/6).
-first-weekday-of-year (first-weekday-of-year week-day-at-start-of-week year-at-end-of-week)
;; Third, if the start-of-week-date-time comes before the first-weekday-of-year, then we need to display the
;; week number as the final week of the previous year. It will be either 53 where the previous year is a leap
;; year (as 366 days make 52.29 weeks), or 52 where the previous year is a normal year. E.g. continuing the 2021
;; example it would be 53 as 2020 was a leap year.
last-week-of-previous-year? (cljs-time/before? start-of-week-date-time -first-weekday-of-year)]
(if last-week-of-previous-year?
(let [previous-year (dec year-at-end-of-week)
previous-year-is-leap-year? (leap-year? previous-year)]
(if previous-year-is-leap-year?
53
52))
;; Otherwise, calculate the difference in weeks between the ordinal day of the first-weekday-of-year and the
;; start-of-week-date-time, round it up to the nearest integer and add one.
(let [ordinal-day (.getDayOfYear ^js/goog.date.UtcDateTime start-of-week-date-time)
first-weekday-ordinal-day (.getDayOfYear ^js/goog.date.UtcDateTime -first-weekday-of-year)
difference-in-days (- ordinal-day first-weekday-ordinal-day)
difference-in-weeks (js/Math.ceil (/ difference-in-days 7))]
(inc difference-in-weeks)))))
(def ^:private days-vector
[{:key :Mo :short-name "M" :name "MON"}
{:key :Tu :short-name "T" :name "TUE"}
{:key :We :short-name "W" :name "WED"}
{:key :Th :short-name "T" :name "THU"}
{:key :Fr :short-name "F" :name "FRI"}
{:key :Sa :short-name "S" :name "SAT"}
{:key :Su :short-name "S" :name "SUN"}])
(defn to-days-vector [xs] (mapv (fn [x m] (assoc m :name x)) xs days-vector))
(defn- rotate
[n coll]
(let [c (count coll)]
(take c (drop (mod n c) (cycle coll)))))
(defn- is-day-pred [d]
#(= (cljs-time/day-of-week %) (inc d)))
;; ----------------------------------------------------------------------------
(defn- main-div-with
[table-div hide-border? class style attr parts src debug-as]
;;extra h-box is currently necessary so that calendar & border do not stretch to width of any containing v-box
[h-box
:src src
:debug-as debug-as
:class "rc-datepicker-wrapper"
:children [[border
:src (at)
:class (str "rc-datepicker-border " (get-in parts [:border :class]))
:style (get-in parts [:border :style] {})
:attr (get-in parts [:border :attr] {})
:radius "4px"
:size "none"
:border (when hide-border? "none")
:child [:div
(merge
{:class (str "datepicker noselect rc-datepicker " class)
;; override inherited body larger 14px font-size
;; override position from css because we are inline
:style (merge {:font-size "13px"
:position "static"}
style)}
attr)
table-div]]]])
(defn- prev-year-icon
[& {:keys [parts]}]
[:svg
(merge {:class (str "rc-datepicker-prev-year-icon " (get-in parts [:prev-year-icon :class]))
:style (get-in parts [:prev-year-icon :style])
:height "24"
:viewBox "0 0 24 24"
:width "24"}
(get-in parts [:prev-year-icon :attr]))
[:g
{:transform "translate(1.5)"}
[:path {:d "m 16.793529,7.4382353 -1.41,-1.41 -5.9999996,5.9999997 5.9999996,6 1.41,-1.41 -4.58,-4.59 z"}]
[:path {:d "m 10.862647,7.4429412 -1.4100003,-1.41 -6,5.9999998 6,6 1.4100003,-1.41 -4.5800003,-4.59 z"}]]])
(defn- prev-month-icon
[& {:keys [parts]}]
[:svg
(merge {:class (str "rc-datepicker-prev-month-icon " (get-in parts [:prev-month-icon :class]))
:style (get-in parts [:prev-month-icon :style])
:height "24"
:viewBox "0 0 24 24"
:width "24"}
(get-in parts [:prev-month-icon :attr]))
[:path {:d "M15.41 7.41L14 6l-6 6 6 6 1.41-1.41L10.83 12l4.58-4.59z"}]])
(defn- next-month-icon
[& {:keys [parts]}]
[:svg
(merge {:class (str "rc-datepicker-next-month-icon " (get-in parts [:next-month-icon :class]))
:style (get-in parts [:next-month-icon :style])
:height "24"
:viewBox "0 0 24 24"
:width "24"}
(get-in parts [:next-month-icon :attr]))
[:path {:d "M10 6L8.59 7.41 13.17 12l-4.58 4.59L10 18l6-6-6-6z"}]])
(defn- next-year-icon
[& {:keys [parts]}]
[:svg
(merge {:class (str "rc-datepicker-next-year-icon " (get-in parts [:next-year-icon :class]))
:style (get-in parts [:next-year-icon :style])
:height "24"
:viewBox "0 0 24 24"
:width "24"}
(get-in parts [:next-year-icon :attr]))
[:g
{:transform "translate(-1.5)"}
[:path {:d "m 8.5882353,6 -1.41,1.41 4.5799997,4.59 -4.5799997,4.59 1.41,1.41 5.9999997,-6 z"}]
[:path {:d "m 14.547353,5.9623529 -1.41,1.41 4.58,4.5900001 -4.58,4.59 1.41,1.41 6,-6 z"}]]])
(defn- prev-year-nav
[& {:keys [display-month minimum disabled? parts]}]
(let [prev-year-date-time (dec-year @display-month)
prev-year-enabled? (if minimum (cljs-time/after? prev-year-date-time (dec-month minimum)) true)]
(when (not disabled?)
[:<>
[box
:src (at)
:class (str (if prev-year-enabled? "rc-datepicker-selectable " "rc-datepicker-disabled ") "rc-datepicker-prev-year " (get-in parts [:prev-year :class]))
:style (get-in parts [:prev-year :style])
:attr (merge
{:on-click (handler-fn (when prev-year-enabled? (reset! display-month prev-year-date-time)))}
(get-in parts [:prev-year :attr]))
:width "20px"
:align :center
:justify :center
:child [prev-year-icon
:parts parts]]
[line
:src (at)]])))
(defn- prev-month-nav
[& {:keys [display-month minimum disabled? parts]}]
(let [prev-month-date-time (dec-month @display-month)
prev-month-enabled? (if minimum (cljs-time/after? prev-month-date-time (dec-month minimum)) true)]
(when (not disabled?)
[:<>
[box
:src (at)
:class (str (if prev-month-enabled? "rc-datepicker-selectable " "rc-datepicker-disabled ") "rc-datepicker-prev-month " (get-in parts [:prev-month :class]))
:style (get-in parts [:prev-month :style])
:attr (merge
{:on-click (handler-fn (when prev-month-enabled? (reset! display-month prev-month-date-time)))}
(get-in parts [:prev-month :attr]))
:width "20px"
:align :center
:justify :center
:child [prev-month-icon
:parts parts]]
[line
:src (at)]])))
(defn- next-month-nav
[& {:keys [display-month maximum disabled? parts]}]
(let [next-month-date-time (inc-month @display-month)
next-month-enabled? (if maximum (cljs-time/before? next-month-date-time maximum) true)]
(when (not disabled?)
[:<>
[line
:src (at)]
[box
:src (at)
:class (str (if next-month-enabled? "rc-datepicker-selectable " "rc-datepicker-disabled ") "rc-datepicker-next-month " (get-in parts [:next-month :class]))
:style (get-in parts [:next-month :style])
:attr (merge
{:on-click (handler-fn (when next-month-enabled? (reset! display-month next-month-date-time)))}
(get-in parts [:next-month :attr]))
:align :center
:justify :center
:width "20px"
:child [next-month-icon
:parts parts]]])))
(defn- next-year-nav
[& {:keys [display-month maximum disabled? parts]}]
(let [next-year-date-time (inc-year @display-month)
next-year-enabled? (if maximum (cljs-time/before? next-year-date-time maximum) true)]
(when (not disabled?)
[:<>
[line
:src (at)]
[box
:src (at)
:class (str (if next-year-enabled? "rc-datepicker-selectable " "rc-datepicker-disabled ") "rc-datepicker-next-year " (get-in parts [:next-year :class]))
:style (get-in parts [:next-year :style])
:attr (merge
{:on-click (handler-fn (when next-year-enabled? (reset! display-month next-year-date-time)))}
(get-in parts [:next-year :attr]))
:align :center
:justify :center
:width "20px"
:child [next-year-icon
:parts parts]]])))
(defn- nav
[& {:keys [display-month minimum maximum disabled? i18n parts]}]
(let [minimum (deref-or-value minimum)
maximum (deref-or-value maximum)]
[:th
(merge
{:col-span "7"
:class (str "rc-datepicker-nav " (get-in parts [:nav :class]))
:style (merge {:padding "0px"} (get-in parts [:nav :style]))}
(get-in parts [:nav :attr]))
[h-box
:src (at)
:height "100%"
:children [[prev-year-nav
:display-month display-month
:minimum minimum
:disabled? disabled?
:parts parts]
[prev-month-nav
:display-month display-month
:minimum minimum
:disabled? disabled?
:parts parts]
[box
:src (at)
:class (str "rc-datepicker-month " (get-in parts [:month :class]))
:style (get-in parts [:month :style])
:attr (get-in parts [:month :attr])
:size "1"
:align :center
:justify :center
:child (month-label @display-month i18n)]
[next-month-nav
:display-month display-month
:maximum maximum
:disabled? disabled?
:parts parts]
[next-year-nav
:display-month display-month
:maximum maximum
:disabled? disabled?
:parts parts]]]]))
(defn- week-days
[& {:keys [start-of-week i18n parts]}]
(let [{:keys [days]} i18n]
(into
[:<>]
(for [day (rotate start-of-week (or (when days (to-days-vector days)) days-vector))]
[:th
(merge
{:class (str "rc-datepicker-day rc-datepicker-day-" (string/lower-case (:name day)) " " (get-in parts [:day :class]))
:style (get-in parts [:day :style] {})}
(get-in parts [:day :attr]))
(str (:name day))]))))
(defn- table-thead
"Answer 2 x rows showing month with nav buttons and days"
[display-month {:keys [show-weeks? minimum maximum start-of-week i18n]} disabled? parts]
(let [template-row (if show-weeks? [:tr [:th]] [:tr])]
[:thead
(merge
{:class (str "rc-datepicker-header " (get-in parts [:header :class]))
:style (get-in parts [:header :style] {})}
(get-in parts [:header :attr]))
(conj template-row
[nav
:display-month display-month
:minimum minimum
:maximum maximum
:disabled? disabled?
:i18n i18n
:parts parts])
(conj template-row
[week-days
:start-of-week start-of-week
:i18n i18n
:parts parts])]))
(defn- selection-changed
[selection change-callback]
(change-callback selection))
(defn- table-td
[date focus-month selected today {minimum :minimum maximum :maximum selectable-fn :selectable-fn :as attributes} disabled? on-change parts]
;;following can be simplified and terse
(let [minimum (deref-or-value minimum)
maximum (deref-or-value maximum)
enabled-min (if minimum (>=date date minimum) true)
enabled-max (if maximum (<=date date maximum) true)
enabled-day (and enabled-min enabled-max)
unselectable-day? (if enabled-day
(not (selectable-fn date))
true)
classes (cond disabled? "rc-datepicker-disabled"
unselectable-day? "rc-datepicker-unselectable"
(= focus-month (cljs-time/month date)) "rc-datepicker-selectable"
:else "rc-datepicker-selectable rc-datepicker-out-of-focus")
classes (cond (and selected (=date selected date)) (str classes " rc-datepicker-selected start-date end-date ")
(and today (=date date today) (not disabled?)) (str classes " rc-datepicker-today ")
:else (str classes " "))
on-click #(when-not (or disabled? unselectable-day?) (selection-changed date on-change))]
[:td
(merge
{:class (str classes "rc-datepicker-date " (get-in parts [:date :class]))
:style (get-in parts [:date :style])
:on-click (handler-fn (on-click))}
(get-in parts [:date :attr]))
(cljs-time/day date)]))
(defn- week-td [start-of-week date]
[:td {:class "week"} (week-of-year start-of-week date)])
(defn- table-tr
"Return 7 columns of date cells from date inclusive"
[date start-of-week focus-month selected attributes disabled? on-change parts]
; {:pre [(sunday? date)]}
(let [table-row (if (:show-weeks? attributes) [:tr (week-td start-of-week date)] [:tr])
row-dates (map #(inc-date date %) (range 7))
today (when (:show-today? attributes) (now->utc))]
(into table-row (map #(table-td % focus-month selected today attributes disabled? on-change parts) row-dates))))
(defn- table-tbody
"Return matrix of 6 rows x 7 cols table cells representing 41 days from start-date inclusive"
[display-month selected attributes disabled? on-change parts]
(let [start-of-week (:start-of-week attributes)
current-start (previous (is-day-pred start-of-week) display-month)
focus-month (cljs-time/month display-month)
row-start-dates (map #(inc-date current-start (* 7 %)) (range 6))]
(into [:tbody
(merge
{:class (str "rc-datepicker-dates " (get-in parts [:dates :class]))
:style (get-in parts [:dates :style])}
(get-in parts [:dates :attr]))]
(map #(table-tr % start-of-week focus-month selected attributes disabled? on-change parts) row-start-dates))))
(defn- configure
"Augment passed attributes with extra info/defaults"
[attributes]
(let [selectable-fn (if (-> attributes :selectable-fn fn?)
(:selectable-fn attributes)
(constantly true))]
(merge attributes {:selectable-fn selectable-fn})))
(def datepicker-parts-desc
(when include-args-desc?
[{:name :wrapper :level 0 :class "rc-datepicker-wrapper" :impl "[datepicker]" :notes "Outer wrapper of the datepicker."}
{:name :border :level 1 :class "rc-datepicker-border" :impl "[border]" :notes "The datepicker border."}
{:type :legacy :level 2 :class "rc-datepicker" :impl "[:div]" :notes "The datepicker container."}
{:name :table :level 3 :class "rc-datepicker-table" :impl "[:table]" :notes "The datepicker table."}
{:name :header :level 4 :class "rc-datepicker-header" :impl "[:thead]" :notes "The datepicker header."}
{:type :legacy :level 5 :impl "[:tr]" :notes "The datepicker month row." :name-label "-"}
{:name :nav :level 6 :class "rc-datepicker-nav" :impl "[:th]" :notes "The datepicker navigation."}
{:type :legacy :level 7 :impl "[h-box]" :name-label "-"}
{:name :prev-year :level 8 :class "rc-datepicker-prev-year" :impl "[box]" :notes "The datepicker previous year button."}
{:name :prev-year-icon :level 9 :class "rc-datepicker-prev-year-icon" :impl "[:svg]" :notes "The datepicker previous year button icon."}
{:name :prev-month :level 8 :class "rc-datepicker-prev-month" :impl "[box]" :notes "The datepicker previous month button."}
{:name :prev-month-icon :level 9 :class "rc-datepicker-prev-month-icon" :impl "[:svg]" :notes "The datepicker previous month button icon."}
{:name :month :level 8 :class "rc-datepicker-month" :impl "[box]" :notes "The datepicker month label."}
{:name :next-month :level 8 :class "rc-datepicker-next-month" :impl "[box]" :notes "The datepicker next month button."}
{:name :next-month-icon :level 9 :class "rc-datepicker-next-month-icon" :impl "[:svg]" :notes "The datepicker next month button icon."}
{:name :next-year :level 8 :class "rc-datepicker-next-year" :impl "[box]" :notes "The datepicker next year button."}
{:name :next-year-icon :level 9 :class "rc-datepicker-next-year-icon" :impl "[:svg]" :notes "The datepicker next year button icon."}
{:type :legacy :level 5 :impl "[:tr]" :notes "The datepicker weekday row." :name-label "-"}
{:name :day :level 6 :class "rc-datepicker-day-mon" :impl "[:th]" :notes "Monday. WARNING: First weekday of week depends on arguments."}
{:name :day :level 6 :class "rc-datepicker-day-tue" :impl "[:th]" :notes "Tuesday."}
{:name :day :level 6 :class "rc-datepicker-day-wed" :impl "[:th]" :notes "Wednesday."}
{:name :day :level 6 :class "rc-datepicker-day-thu" :impl "[:th]" :notes "Thursday."}
{:name :day :level 6 :class "rc-datepicker-day-fri" :impl "[:th]" :notes "Friday."}
{:name :day :level 6 :class "rc-datepicker-day-sat" :impl "[:th]" :notes "Saturday."}
{:name :day :level 6 :class "rc-datepicker-day-sun" :impl "[:th]" :notes "Sunday."}
{:name :dates :level 4 :class "rc-datepicker-dates" :impl "[:tbody]" :notes "The table body containing the dates."}
{:type :legacy :level 5 :impl "[:tr]" :notes "A date row. Repeats 6 times." :name-label "-"}
{:name :date :level 6 :class "rc-datepicker-date" :impl "[:td]" :notes "A date cell. Repeats 7 times per date row."}]))
(def datepicker-parts
(when include-args-desc?
(-> (map :name datepicker-parts-desc) set)))
(def datepicker-args-desc
(when include-args-desc?
[{:name :model :required false :type "satisfies DateTimeProtocol | r/atom" :validate-fn date-like? :description [:span "the selected date. If provided, should pass pred " [:code ":selectable-fn"] ". If not provided, (now->utc) will be used and the returned date will be a " [:code "goog.date.UtcDateTime"]]}
{:name :on-change :required true :type "satisfies DateTimeProtocol -> nil" :validate-fn fn? :description [:span "called when a new selection is made. Returned type is the same as model (unless model is nil, in which case it will be " [:code "goog.date.UtcDateTime"] ")"]}
{:name :disabled? :required false :default false :type "boolean | atom" :description "when true, the user can't select dates but can navigate"}
{:name :selectable-fn :required false :default "(fn [date] true)" :type "function" :validate-fn fn? :description "This predicate function is called with one argument, the date. If it answers false, day will be shown disabled and can't be selected."}
{:name :show-weeks? :required false :default false :type "boolean" :description "when true, week numbers are shown to the left"}
{:name :show-today? :required false :default false :type "boolean" :description "when true, today's date is highlighted"}
{:name :minimum :required false :type "satisfies DateTimeProtocol | r/atom" :validate-fn date-like? :description "no selection or navigation before this date"}
{:name :maximum :required false :type "satisfies DateTimeProtocol | r/atom" :validate-fn date-like? :description "no selection or navigation after this date"}
{:name :start-of-week :required false :default 6 :type "int" :description "first day of week (Monday = 0 ... Sunday = 6)"}
{:name :hide-border? :required false :default false :type "boolean" :description "when true, the border is not displayed"}
{:name :i18n :required false :type "map" :description [:span "internationalization map with optional keys " [:code ":days"] " and " [:code ":months"] " (both vectors of strings)"]}
{:name :class :required false :type "string" :validate-fn string? :description "CSS class names, space separated (applies to the outer border div, not the wrapping div)"}
{:name :style :required false :type "CSS style map" :validate-fn css-style? :description "CSS styles to add or override (applies to the outer border div, not the wrapping div)"}
{:name :attr :required false :type "HTML attr map" :validate-fn html-attr? :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] " allowed (applies to the outer border div, not the wrapping div)"]}
{:name :parts :required false :type "map" :validate-fn (parts? datepicker-parts) :description "See Parts section below."}
{:name :src :required false :type "map" :validate-fn map? :description [:span "Used in dev builds to assist with debugging. Source code coordinates map containing keys" [:code ":file"] "and" [:code ":line"] ". See 'Debugging'."]}
{:name :debug-as :required false :type "map" :validate-fn map? :description [:span "Used in dev builds to assist with debugging, when one component is used implement another component, and we want the implementation component to masquerade as the original component in debug output, such as component stacks. A map optionally containing keys" [:code ":component"] "and" [:code ":args"] "."]}]))
(defn datepicker
[& {:keys [model] :as args}]
(or
(validate-args-macro datepicker-args-desc args)
(let [external-model (reagent/atom (deref-or-value model)) ;; Set model type in stone on creation of this datepicker instance
internal-model (reagent/atom @external-model) ;; Holds the last known external value of model, to detect external model changes
display-month (reagent/atom (cljs-time/first-day-of-the-month (or @internal-model (now->utc))))]
(fn datepicker-render
[& {:keys [model on-change disabled? start-of-week hide-border? class style attr parts src debug-as]
:or {start-of-week 6} ;; Default to Sunday
:as args}]
(or
(validate-args-macro datepicker-args-desc args)
(let [latest-ext-model (deref-or-value model)
disabled? (deref-or-value disabled?)
props-with-defaults (merge args {:start-of-week start-of-week})
configuration (configure props-with-defaults)]
(when (not= @external-model latest-ext-model) ;; Has model changed externally?
(reset! external-model latest-ext-model)
(reset! internal-model latest-ext-model)
(reset! display-month (cljs-time/first-day-of-the-month (or @internal-model (now->utc)))))
[main-div-with
[:table
(merge
{:class (str "table-condensed rc-datepicker-table " (get-in parts [:table :class]))
:style (get-in parts [:table :style])}
(get-in parts [:table :attr]))
[table-thead display-month configuration disabled? parts]
[table-tbody @display-month @internal-model configuration disabled? on-change parts]]
hide-border?
class
style
attr
parts
src
(or debug-as (reflect-current-component))]))))))
(defn- anchor-button
"Provide clickable field with current date label and dropdown button e.g. [ 2014 Sep 17 | # ]"
[shown? model format goog? placeholder width disabled?]
[:div {:class "rc-datepicker-dropdown-anchor input-group display-flex noselect"
:style (flex-child-style "none")
:on-click (handler-fn
(when (not (deref-or-value disabled?))
(swap! shown? not)))}
[h-box
:align :center
:class "noselect"
:min-width (when-not width "10em")
:max-width (when-not width "10em")
:width width
:children [[:label {:disabled (deref-or-value disabled?)
:class (str "form-control dropdown-button" (when (deref-or-value disabled?) " dropdown-button-disabled"))}
(cond (not (date-like? (deref-or-value model))) [:span {:style {:color "#bbb"}} placeholder]
goog? (.format (DateTimeFormat. (if (seq format) format date-format-str)) (deref-or-value model))
:else (unparse (if (seq format) (formatter format) date-format) (deref-or-value model)))]
[:span
{:class (str "dropdown-button activator input-group-addon" (when (deref-or-value disabled?) " dropdown-button-disabled"))
:style {:padding "3px 0px 0px 0px"}}
[:i.zmdi.zmdi-apps {:style {:font-size "24px"}}]]]]])
(def datepicker-dropdown-args-desc
(when include-args-desc?
(conj datepicker-args-desc
{:name :format :required false :default "yyyy MMM dd" :type "string" :description "[datepicker-dropdown only] a representation of a date format. See cljs_time.format"}
{:name :goog? :required false :default false :type "boolean" :description [:span "[datepicker-dropdown only] use " [:code "goog.i18n.DateTimeFormat"] " instead of " [:code "cljs_time.format"] " for applying " [:code ":format"]]}
{:name :no-clip? :required false :default true :type "boolean" :description "[datepicker-dropdown only] when an anchor is in a scrolling region (e.g. scroller component), the popover can sometimes be clipped. When this parameter is true (which is the default), re-com will use a different CSS method to show the popover. This method is slightly inferior because the popover can't track the anchor if it is repositioned"}
{:name :placeholder :required false :type "string" :description "[datepicker-dropdown only] placeholder text for when a date is not selected."}
{:name :width :required false :validate-fn string? :type "string" :description "[datepicker-dropdown only] a CSS width style"}
{:name :position-offset :required false :validate-fn number? :type "integer" :description "[datepicker-dropdown only] px horizontal offset of the popup"}
{:name :position :required false :default :below-left :type "keyword" :validate-fn position? :description [:span "[datepicker-dropdown only] relative to date anchor. One of " position-options-list]})))
(defn datepicker-dropdown
[& {:keys [src] :as args}]
(or
(validate-args-macro datepicker-dropdown-args-desc args)
(let [shown? (reagent/atom false)
cancel-popover #(reset! shown? false)]
(fn datepicker-dropdown-render
[& {:keys [model show-weeks? on-change format goog? no-clip? placeholder width disabled? position-offset position src debug-as]
:or {no-clip? true, position-offset 0, position :below-left}
:as passthrough-args}]
(or
(validate-args-macro datepicker-dropdown-args-desc passthrough-args)
(let [collapse-on-select (fn [new-model]
(reset! shown? false)
(when on-change (on-change new-model))) ;; wrap callback to collapse popover
passthrough-args (-> passthrough-args
(dissoc :format :goog? :no-clip? :placeholder :width :position-offset :position) ;; these keys only valid at this API level
(assoc :on-change collapse-on-select)
(assoc :src (at))
(merge {:hide-border? true}) ;; apply defaults
vec
flatten)]
[popover-anchor-wrapper
:src src
:debug-as (or debug-as (reflect-current-component))
:class "rc-datepicker-dropdown-wrapper"
:showing? shown?
:position position
:anchor [anchor-button shown? model format goog? placeholder width disabled?]
:popover [popover-content-wrapper
:src (at)
:position-offset (+ (if show-weeks? 43 44) position-offset)
:no-clip? no-clip?
:arrow-length 0
:arrow-width 0
:arrow-gap 3
:padding "0px"
:on-cancel cancel-popover
:body (into [datepicker] passthrough-args)]]))))))