-
Notifications
You must be signed in to change notification settings - Fork 16
/
Copy pathindent-bars.el
1783 lines (1616 loc) · 69.1 KB
/
indent-bars.el
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
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; indent-bars.el --- Highlight indentation with bars -*- lexical-binding: t; -*-
;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
;; Author: J.D. Smith <[email protected]>
;; Homepage: https://github.com/jdtsmith/indent-bars
;; Package-Requires: ((emacs "27.1") (compat "29.1"))
;; Version: 0.8.2
;; Keywords: convenience
;; indent-bars is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;; indent-bars is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; indent-bars highlights indentation with configurable vertical
;; graphical bars, using stipples. The color and appearance (weight,
;; pattern, position within the character, zigzag, etc.) are all
;; configurable. Options include depth-varying colors and
;; highlighting the indentation depth of the current line. Bars span
;; blank lines, by default. indent-bars works in any mode using fixed
;; tab or space-based indentation. In the terminal (or on request) it
;; uses vertical bar characters instead of stipple patterns. Optional
;; treesitter support is also available; see indent-bars-ts.el.
;;;; For Developers:
;;
;; To efficiently accommodate simultaneous alternative bar styling, we
;; do two things:
;;
;; 1. Collect all the style related information (color, stipple
;; pattern, etc.) into a single struct, operating on one such
;; "current" style struct at a time.
;;
;; 2. Provide convenience functions for duplicate "alternative"
;; custom style variables the user can configure; see
;; `indent-bars--style'. These variables can "inherit" nil or
;; omitted plist variables from their parent var.
;;
;; Note the shorthand substitution for style related slots;
;; see file-local-variables at the end:
;;
;; ibs/ => indent-bars-style-
;;; Code:
;;;; Requires
(require 'cl-lib)
(require 'map)
(require 'seq)
(require 'subr-x)
(require 'color)
(require 'timer)
(require 'outline)
(require 'font-lock)
(require 'jit-lock)
(require 'face-remap)
(require 'cus-edit)
(require 'compat)
;;;; Variables
(defvar indent-bars-mode)
(defvar-local indent-bars--regexp nil)
;;;; Customization
(defgroup indent-bars nil
"Highlight indentation bars."
:group 'convenience
:prefix "indent-bars-")
(defgroup indent-bars-style nil
"Highlight indentation bars."
:group 'indent-bars
:prefix "indent-bars-")
(defvar indent-bars-depth-update-delay)
(defvar indent-bars-custom-set nil)
(defvar indent-bars--custom-set-inhibit nil)
(defun indent-bars--custom-set (sym val)
"Set SYM to VAL, and reset indent-bars in the `other-window'."
(set-default-toplevel-value sym val)
(when (and (not indent-bars--custom-set-inhibit) (boundp 'indent-bars-mode))
(let ((indent-bars--custom-set-inhibit t)) ; prevent re-entry
(cl-loop for win in (window-list)
if (buffer-local-value 'indent-bars-mode (window-buffer win)) do
(with-selected-window win
(indent-bars-reset)
(let ((indent-bars-depth-update-delay 0))
(indent-bars--compute-and-highlight-current-depth 'force))
(run-hooks 'indent-bars-custom-set))
and return win))))
;;;;; Stipple Bar Shape
(defcustom indent-bars-width-frac 0.25
"The width of the indent bar as a fraction of the character width.
Applies to stipple-based bars only."
:type '(float :tag "Width Fraction"
:match (lambda (_ val) (and val (<= val 1) (>= val 0)))
:type-error "Fraction must be between 0 and 1")
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
(defcustom indent-bars-pad-frac 0.1
"The offset of the bar from the left edge of the character.
A float, the fraction of the character width. Applies to
stipple-based bars only."
:type '(float :tag "Offset Fraction"
:match (lambda (_ val) (and val (<= val 1) (>= val 0)))
:type-error "Fraction must be between 0 and 1")
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
(defcustom indent-bars-pattern " . . ."
"A pattern specifying the vertical structure of indent bars.
Space signifies blank regions, and any other character signifies
filled regions. The pattern length is scaled to match the
character height. Example: \". . \" would specify alternating
filled and blank regions each approximately one-quarter of the
character height. Note that the non-blank characters need not be
the same (e.g., see `indent-bars-zigzag'). Applies to
stipple-based bars only."
:type '(string :tag "Fill Pattern")
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
(defcustom indent-bars-zigzag nil
"The zigzag to apply to the bar pattern.
If non-nil, an alternating zigzag offset will be applied to
consecutive groups of identical non-space characters in
`indent-bars-pattern'. Starting from the top of the pattern,
positive values will zigzag (right, left, right, ..) and negative
values (left, right, left, ...).
Example:
pattern: \" .**.\"
width: 0.5
pad: 0.25
zigzag: -0.25
would produce a zigzag pattern which differs from the normal
bar pattern as follows:
| | | |
| .. | =========> |.. |
| .. | | ..|
| .. | apply zig- | ..|
| .. | zag -0.25 |.. |
Note that the pattern will be truncated at both left and right
boundaries, so (although this is not required) achieving an equal
zigzag left and right requires leaving sufficient padding on each
side of the bar; see `indent-bars-pad-frac' and
`indent-bars-width-frac'. Applies to stipple-based bars only."
:type '(choice :tag "Zigzag Options"
(const :tag "No Zigzag" :value nil)
(float :value 0.1 :tag "Zigzag Fraction"
:match (lambda (_ val) (and val (<= val 1) (>= val -1)))
:type-error "Fraction must be between -1 and 1"))
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
;;;;; Bar Colors
(defcustom indent-bars-color
'(highlight :face-bg t :blend 0.325)
"The main indent bar color.
The format is a list of 1 required element, followed by an
optional plist (keyword/value pairs):
(main_color [:face-bg :blend])
where:
MAIN_COLOR: Specifies the main indentation bar
color (required). It is either a face name symbol, from
which the foreground color will be used as the primary bar
color, or an explicit color (a string). If nil, the default
color foreground will be used.
FACE-BG: A boolean controlling interpretation of the
MAIN_COLOR face (if configured). If non-nil, the background
color of the face will be used as the main bar color instead
of its foreground.
BLEND: an optional blend factor, a float between 0 and 1. If
non-nil, the main bar color will be computed as a blend
between MAIN_COLOR and the frame background color,
notionally:
BLEND * MAIN_COLOR + (1 - BLEND) * frame-background
If BLEND is nil or unspecified, no blending is done, and
MAIN_COLOR is used as-is."
:type
'(list :tag "Color Options"
(choice :tag "Main Bar Color"
color
(face :tag "from Face")
(const :tag "Use default" nil))
(plist :tag "Other Options"
:inline t
:options
((:face-bg (boolean
:tag "Use Face's Background Color"
:value t))
(:blend (float
:tag "Blend Factor"
:value 0.5
:match (lambda (_ val) (and val (<= val 1) (>= val 0)))
:type-error "Factor must be between 0 and 1")))))
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
(defcustom indent-bars-color-by-depth
'(:regexp "outline-\\([0-9]+\\)" :blend 1)
"Configuration for depth-varying indentation bar coloring.
If non-nil, depth-based coloring is performed. This should be a
plist with keys:
([:regexp [:face-bg] | :palette] [:blend])
with:
REGEXP: A regular expression string used to match against all
face names. For the matching faces, the first match group in
the regex (if any) will be interpreted as a number, and used
to sort the resulting list of faces. The foreground color of
each matching face will then constitute the depth color
palette (see also PALETTE, which this option overrides).
FACE-BG: A boolean. If non-nil, use the background color
from the faces matching REGEXP for the palette instead of
their foreground colors.
PALETTE: An explicit cyclical palette of colors/faces for
depth-varying bar colors. Note that REGEXP takes precedence
over this setting. The format is a list of faces (symbols)
or colors (strings) to be used as a color cycle for coloring
indentations at increasing levels. Each face can optionally
be specified as a cons cell (face . \\='bg) to specify using
that face's background color instead of its foreground.
(face_or_color | (face . \\='bg) ...)
While this list can contain a single element, it makes little
sense to do so. The depth palette will be used cyclically,
i.e. when a bar's indentation depth exceeds the length of the
palette, colors will be obtained by wrapping around to the
beginning of the list.
BLEND: a blend factor (0..1) which controls how palette colors
are blended with the main color, prior to possibly blending
with the frame background color (see `indent-bars-color' for
information on how blend factors are specified). A nil value
causes the palette colors to be used as-is. A unity value
causes the palette color to be blended directly with the
background using any blend factor from `indent-bars-color'.
Note that, for this setting to have any effect, one of REGEXP or
PALETTE is required (the former overriding the latter). If both
are omitted or nil, all bars will have the same color, based on
MAIN_COLOR (aside possibly from the bar at the current
indentation level, if configured; see
`indent-bars-highlight-current-depth')."
:type '(choice :tag "Depth Palette"
(const :tag "No Depth-Coloring" nil)
(plist :tag "Depth-Coloring"
:options
((:regexp (regexp :tag "Face regexp"))
(:face-bg
(boolean
:value t
:tag "Use Matching Face's Background Colors"))
(:palette
(repeat :tag "Explicit Color/Face List"
(choice (color :tag "Color")
(face :tag "Foreground from Face")
(cons :tag "Background from Face"
:format "Background from %v"
face
(const :format "\n" :value bg)))))
(:blend
(float :tag "Blend Fraction into Main Color"
:value 0.5
:match (lambda (_ val)
(and val (<= val 1) (>= val 0)))
:type-error
"Factor must be between 0 and 1")))))
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
;;;;; Depth Highlighting
(defcustom indent-bars-highlight-current-depth
'(:pattern ".") ; solid bar, no color change
"Current indentation depth bar highlight configuration.
Use this to configure optional highlighting of the bar at the
current line's indentation depth level.
Format:
nil | (:color :face :face-bg :background :blend :palette
:width :pad :pattern :zigzag)
If nil, no highlighting will be applied to bars at the current
depth of the line at point. Otherwise, a plist describes what
highlighting to apply, which can include changes to color and/or
bar pattern. At least one of :blend, :color, :palette, :face,
:width, :pad, :pattern, or :zigzag must be set and non-nil for
this setting to take effect.
By default, the highlighted bar's color will be the same as the
underlying bar color. With PALETTE, COLOR or FACE set, all bars
at the current depth will be highlighted in the appropriate
color, either from an explicit COLOR, a PALETTE list (see
`indent-bars-color-by-depth'), or, if FACE is set, FACE's
foreground or background color (the latter if FACE-BG is
non-nil). If PALETTE is provided, it overrides any other
foreground color setting for the current depth highlight bar. If
BACKGROUND is set to a color, this will be used for the
background color of the current depth bar.
If BLEND is provided, it is a blend fraction between 0 and 1 for
blending the specified highlight color with the
existing (depth-based or main) bar color; see `indent-bars-color'
for its meaning. BLEND=1 indicates using the full, unblended
highlight color (and is the same as omitting BLEND).
As a special case, if BLEND is provided, but neither COLOR nor
FACE is, BLEND is used as a (presumably distinct) blend factor
between the usual color for that bar and the frame background.
The original colors are specified in `indent-bars-color-by-depth'
or `indent-bars-color'. In this manner the current-depth
highlight can be made a more (or less) prominent version of the
default coloring, just by setting BLEND.
If any of WIDTH, PAD, PATTERN, or ZIGZAG are set, the stipple bar
pattern at the current level will be altered as well. Note that
`indent-bars-width-frac', `indent-bars-pad-frac',
`indent-bars-pattern', and `indent-bars-zigzag' will be used as
defaults for any missing values; see these variables.
Note: on terminal, or if `indent-bars-prefer-character' is
non-nil, any stipple appearance parameters will be ignored."
:type '(choice
:tag "Highlighting Options"
(const :tag "No Current Highlighting" :value nil)
(plist :tag "Highlight Current Depth"
:options
((:color (color :tag "Highlight Color"))
(:face (face :tag "Color from Face"))
(:face-bg (boolean :tag "Use Face's Background Color"))
(:background (color :tag "Background Color of Current Bar"))
(:blend (float :tag "Blend Fraction into Existing Color")
:value 0.5
:match (lambda (_ val) (and (<= val 1) (>= val 0)))
:type-error "Factor must be between 0 and 1")
(:palette
(repeat :tag "Explicit Color/Face List"
(choice (color :tag "Color")
(face :tag "Foreground from Face")
(cons :tag "Background from Face"
:format "Background from %v"
face
(const :format "\n" :value bg)))))
(:width (float :tag "Bar Width"))
(:pad (float :tag "Bar Padding (from left)"))
(:pattern (string :tag "Fill Pattern"))
(:zigzag (float :tag "Zig-Zag")))))
:group 'indent-bars-style
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default)
(defcustom indent-bars-highlight-selection-method 'context
"Method for selecting bar depth for current indentation highlight.
If nil, the last showing bar on the current line is selected for
highlight. If the symbol `on-bar', and the start of the text on
the line would have fallen directly on a bar, highlight that bar
depth instead. If `context', use `on-bar' logic, but only if a
directly adjacent (non-blank) context line is indented deeper, by
more than one indent spacing. Otherwise select the last bar
showing for highlight (i.e. the same as CONTEXT nil)."
:type '(choice (const :tag "Containing" nil)
(const :tag "On Bar" on-bar)
(const :tag "Context" context))
:group 'indent-bars)
(defcustom indent-bars-depth-update-delay 0.075
"Minimum delay time in seconds between depth highlight updates.
Has effect only if `indent-bars-highlight-current-depth' is
non-nil. Set to 0 for instant depth updates."
:type 'float
:group 'indent-bars)
;;;;; Other
(defcustom indent-bars-display-on-blank-lines t
"Whether to display bars on blank lines.
Bars are shown only on blank lines contiguously adjacent to lines
already showing bars, by default the deepest adjacent non-blank
line, or, if set to `least' the least deep such line."
:type '(choice
(const :tag "Disabled" nil)
(const :tag "Deepest adjacent" t)
(const :tag "Least deep adjacent" least))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-no-descend-string t
"Configure bar behavior inside strings.
If non-nil, displayed bars inside the string will go no deeper
than the one more than the indent level of the string's starting
line. If the symbol `all', no bars will be included inside
multiline strings at all."
:local t
:type '(choice (const :tag "All normal bars appear inside strings" nil)
(const :tag "Only one bar deeper than string start appears" t)
(const :tag "No bars in multi-line strings" all))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-no-descend-lists nil
"Configure bar behavior inside lists.
If non-nil, displayed bars will go no deeper than the indent
level at the starting line of the innermost containing list. If
t, any list recognized by the active syntax table will be used to
identify enclosing list contexts. If set to a list of
characters, only list-opening characters on this list will
activate bar suppression."
:local t
:type '(choice
(const :tag "Disabled" nil)
(const :tag "Any list element" t)
(repeat :tag "List of open paren chars" character))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-prefer-character nil
"Use characters instead of stipple to draw bars.
Normally characters are used on terminal only. A non-nil value
specifies using character bars exclusively. See
`indent-bars-no-stipple-char'."
:type 'boolean
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-no-stipple-char ?\│
"Character to display when stipple is unavailable (as in the terminal)."
:type 'character
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-no-stipple-char-font-weight nil
"Font weight to use to draw the character bars.
If non-nil, set the no-stipple character font weight accordingly."
:type `(choice
(const :tag "Use Default Weight" nil)
,@(mapcar (lambda (item) (list 'const (aref item 1)))
font-weight-table))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-unspecified-bg-color "black"
"Color to use as the frame background color if unspecified.
Unless actively set, most terminal frames do not have a
background color specified. This setting controls the background
color to use for color blending in that case."
:type 'color
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-unspecified-fg-color "white"
"Color to use as the default foreground color if unspecified."
:type 'color
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-starting-column nil
"The starting column on which to display the first bar.
Set to nil, for the default behavior (first bar at the first
indent level) or an integer value for some other column."
:type '(choice (const :tag "Default: 1st indent position" nil)
(integer :tag "Specified column"))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-spacing-override nil
"Override for default, major-mode based indentation spacing.
Set only if the default guessed spacing is incorrect. Becomes
buffer-local automatically."
:local t
:type '(choice integer (const :tag "Discover automatically" :value nil))
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
(defcustom indent-bars-treesit-support nil
"Whether to enable tree-sitter support (if available)."
:type 'boolean
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group 'indent-bars)
;;;;; Color Utilities
(defun indent-bars--frame-background-color()
"Return the frame background color."
(let ((fb (frame-parameter nil 'background-color)))
(cond ((not fb) "white")
((string= fb "unspecified-bg") indent-bars-unspecified-bg-color)
(t fb))))
(defun indent-bars--blend-colors (c1 c2 fac)
"Return a fractional color between two colors C1 and C2.
Each is a string color. The fractional blend point is the
float FAC, with 1.0 matching C1 and 0.0 C2."
(apply #'color-rgb-to-hex
(cl-mapcar (lambda (a b)
(+ (* a fac) (* b (- 1.0 fac))))
(color-name-to-rgb c1) (color-name-to-rgb c2))))
(defun indent-bars--colors-from-regexp (regexp &optional face-bg)
"Return a list of colors (strings) for faces matching REGEXP.
The first capture group in REGEXP will be interpreted as a number
and used to sort the list numerically. A list of the foreground
color of the matching, sorted faces will be returned, unless
FACE-BG is non-nil, in which case the background color is
returned."
(mapcar (lambda (x)
(funcall (if face-bg #'face-background #'face-foreground)
(cdr x) nil 'default))
(seq-sort-by #'car
(lambda (a b) (cond
((not (numberp b)) t)
((not (numberp a)) nil)
(t (< a b))))
(mapcan
(lambda (x)
(let ((n (symbol-name x)))
(when (and (string-match regexp n) (match-string 1 n))
(list (cons (string-to-number (match-string 1 n)) x)))))
(face-list)))))
(defun indent-bars--unpack-palette (palette)
"Process a face or color-based PALETTE."
(cl-loop for el in palette
when (cond
((and (consp el) (facep (car el)))
(face-background (car el)))
((facep el)
(face-foreground el))
((color-defined-p el) el))
collect it))
;;;; Style
(defvar indent-bars-style nil
"The `indent-bars-style' struct for the main style.")
(defvar indent-bars--styles nil
"List of known indent-bars style structs.")
(cl-declaim (optimize (safety 0))) ; no need for type check
(cl-defstruct
(indent-bars-style
(:copier nil)
(:conc-name ibs/) ; Note: ibs/ => indent-bars-style- in this file
(:constructor nil)
(:constructor ibs/create
( &optional tag &aux
(stipple-face
(intern (format "indent-bars%s-face"
(if tag (concat "-" tag) "")))))))
"A style configuration structure for indent-bars."
( tag nil :type string
:documentation "An optional tag to include in face name")
;; Colors and Faces
( main-color nil :type string
:documentation "The main bar color")
( depth-palette nil
:documentation "Palette of depth colors.
May be nil, a color string or a vector of colors strings.")
( faces nil :type vector
:documentation "Depth-based faces.")
;; Stipple
( stipple-face nil :type face
:documentation "A stipple face to inherit from.")
( no-stipple-chars nil
:documentation "A vector of styled non-stipple chars.")
;; Current depth highlighting
( current-stipple-face nil :type face
:documentation "A current depth stipple face to inherit from.")
( current-bg-color nil :type color
:documentation "The background color of the current depth highlight.")
( current-depth-palette nil
:documentation "Depth palette of highlighted colors."))
(defsubst indent-bars--tag (format-str s &rest r)
"Tag FORMAT-STR with style S and return the associate interned symbol.
Additional `format' arguments can be passed as R."
(intern (apply #'format format-str
(if (ibs/tag s) (concat "-" (ibs/tag s)) "") r)))
(defun indent-bars--new-style (&optional tag)
"Create and record a new style struct with TAG.
A new style is only created if an existing style with that TAG is
no yet recorded."
(or (seq-find (lambda (s) (equal (ibs/tag s) tag)) indent-bars--styles)
(let ((style (ibs/create tag)))
(cl-pushnew style indent-bars--styles :test #'equal)
style)))
;;;;; Colors
(defun indent-bars--main-color (style &optional tint tint-blend blend-override)
"Calculate the main bar color for STYLE.
Uses `indent-bars-color' for color and background blend config.
If TINT and TINT-BLEND are passed, first blend the TINT color
into the main color with the requested blend, prior to blending
into the background color. If BLEND-OVERRIDE is set, use it
instead of the :blend factor in `indent-bars-color'."
(cl-destructuring-bind (main &key face-bg blend) (indent-bars--style style "color")
(let ((col (cond ((facep main)
(funcall (if face-bg #'face-background #'face-foreground)
main nil 'default))
((color-defined-p main) main)))
(blend (or blend-override blend)))
(when (string-prefix-p "unspecified-" col)
(setq col (if face-bg
indent-bars-unspecified-bg-color
indent-bars-unspecified-fg-color)))
(if (and tint tint-blend (color-defined-p tint)) ;tint main color
(setq col (indent-bars--blend-colors tint col tint-blend)))
(if blend ;now blend into BG
(setq col (indent-bars--blend-colors
col (indent-bars--frame-background-color) blend)))
col)))
(defun indent-bars--depth-palette (style &optional blend-override)
"Calculate the palette of depth-based colors (a vector) for STYLE.
If BLEND-OVERRIDE is set, the main color's :blend will be ignored
and this value will be used instead, for blending into the frame
background color. See `indent-bars-color-by-depth'."
(when-let ((cbd (indent-bars--style style "color-by-depth")))
(cl-destructuring-bind (&key regexp face-bg palette blend) cbd
(let ((colors
(cond
(regexp
(indent-bars--colors-from-regexp regexp face-bg))
(palette
(indent-bars--unpack-palette palette)))))
(vconcat
(if (or blend blend-override)
(mapcar (lambda (c)
(indent-bars--main-color style c blend blend-override))
colors)
colors))))))
(defun indent-bars--current-depth-palette (style)
"Colors for highlighting the current depth bar for STYLE.
A color or palette (vector) of colors is returned, which may be
nil, in which case no special current depth-coloring is used.
See `indent-bars-highlight-current-depth' for configuration."
(when-let ((hcd (indent-bars--style style "highlight-current-depth")))
(cl-destructuring-bind (&key color face face-bg
blend palette &allow-other-keys)
hcd
(let ((color
(cond
((facep face)
(funcall (if face-bg #'face-background #'face-foreground)
face nil 'default))
((and color (color-defined-p color)) color))))
(cond
;; An explicit palette
(palette
(vconcat (indent-bars--unpack-palette palette)))
;; A specified color (possibly to blend in)
(color
(if (string= color "unspecified-fg")
(setq color indent-bars-unspecified-fg-color))
(if blend
(if-let ((palette (indent-bars--depth-palette style))) ; blend into normal depth palette
(vconcat
(mapcar (lambda (c)
(indent-bars--blend-colors color c blend))
palette))
;; Just blend into main color
(indent-bars--blend-colors color (ibs/main-color style) blend))
color))
;; blend-only without a specified color: re-blend originals with BG
(blend
(or (indent-bars--depth-palette style blend)
(indent-bars--main-color style nil nil blend))))))))
(defun indent-bars--get-color (style depth &optional current-highlight)
"Return the color appropriate for indentation DEPTH in STYLE.
If CURRENT-HIGHLIGHT is non-nil, return the appropriate highlight
color, if setup (see `indent-bars-highlight-current-depth')."
(let ((palette (or (and current-highlight
(ibs/current-depth-palette style))
(ibs/depth-palette style))))
(cond
((vectorp palette)
(aref palette (mod (1- depth) (length palette))))
(palette) ; single color
(t (ibs/main-color style)))))
;;;;; Faces
(defun indent-bars--stipple-face-spec (w h rot &optional style stipple)
"Create a face specification for the stipple face for STYLE.
Create for character size W x H with offset ROT. If STIPPLE is
non-nil, use it instead of calculating. Includes
:weight (affecting only non-stipple character display) if
`indent-bars-no-stipple-char-font-weight' (or equivalent for the
STYLE) is non-nil."
(let ((stipple (or stipple (indent-bars--stipple w h rot style)))
(wt (indent-bars--style style "no-stipple-char-font-weight")))
`((t ( :inherit nil
,@(and stipple `(:stipple ,stipple))
,@(and wt `(:weight ,wt)))))))
(defun indent-bars--calculate-face-spec (style depth)
"Calculate the face spec for bar at DEPTH in STYLE.
DEPTH starts at 1."
`((t . ( :inherit ,(ibs/stipple-face style)
:foreground ,(indent-bars--get-color style depth)))))
(defun indent-bars--create-faces (style num)
"Create bar faces up to depth NUM for STYLE."
(vconcat
(cl-loop
for i from 1 to num
for face = (indent-bars--tag "indent-bars%s-%d" style i) do
(face-spec-set face (indent-bars--calculate-face-spec style i))
collect face)))
(defsubst indent-bars--face (style depth)
"Return the bar face for bar DEPTH in STYLE.
The face is created if necessary."
(when (> depth (length (ibs/faces style)))
(setf (ibs/faces style)
(indent-bars--create-faces style depth)))
(aref (ibs/faces style) (1- depth)))
;;;;; No stipple characters (e.g. terminal)
(defun indent-bars--no-stipple-char (style depth)
"Return the no-stipple bar character for DEPTH in STYLE."
(when (> depth (length (ibs/no-stipple-chars style)))
(setf (ibs/no-stipple-chars style)
(indent-bars--create-no-stipple-chars style depth)))
(aref (ibs/no-stipple-chars style) (1- depth)))
(defun indent-bars--create-no-stipple-chars (style num)
"Setup bar characters for bar faces up to depth NUM in STYLE.
Used when not using stipple display (on terminal, or by request;
see `indent-bars-prefer-character')."
(vconcat
(nreverse
(cl-loop
with chars = (ibs/no-stipple-chars style)
with l = (length chars)
for d from num downto 1
collect
(or (and (< d l) (aref chars (1- d)))
(propertize (string indent-bars-no-stipple-char)
'face (indent-bars--face style d)))))))
;;;;; Alternate Style Support
(defmacro indent-bars--alt-custom
(alt opt alt-description std-val &optional add-inherit no-inherit &rest r)
"Define a custom ALT variable for option OPT.
The new custom options default value is set to STD-VAL. This
creates a new variable indent-bars-alt-opt, based on
indent-bars-opt (referred to as the parent variable).
ALT-DESCRIPTION will be used to identify the alternate variable
in the customize interface.
If ADD-INHERIT is non-nil, expand the type to a cons:
(inherit . type)
where INHERIT is either `inherit' or `no-inherit', depending
on the value of NO-INHERIT.
Additional `defcustom` keyword arguments can be given as R."
(require 'cus-edit)
(let* ((optname (symbol-name opt))
(indent-bars--custom-set-inhibit t)
(group (intern (concat "indent-bars-" alt "-style")))
(symname (concat "indent-bars-" optname))
(sym (intern (concat "indent-bars-" optname)))
(tsym (intern (concat "indent-bars-" alt "-" optname)))
(type (custom-variable-type sym))
(choice (cond ((eq (car type) 'choice) type)
((eq (car type) 'list)
(seq-find
(lambda (el) (and (consp el) (eq (car el) 'choice)))
type))
(t (setq type `(choice ,type))))))
;; Add an unspecified choice
(when-let ((tag-pos (member :tag choice)))
(setq choice (cdr tag-pos))) ;after tag
(setcdr choice
(push
`(const :tag ,(concat "No-value (use parent " optname ")") unspecified)
(cdr choice)))
;; Add leading inherit flag, if needed
(when (or no-inherit add-inherit)
(setq type
`(cons :tag ,(concat alt-description " Style")
(choice :tag
,(concat "Inherit missing data from `indent-bars-"
optname "'")
(const :tag "Do not inherit" no-inherit)
(const :tag "Inherit" inherit))
,type)
std-val `( ,(if no-inherit 'no-inherit 'inherit) . ,std-val )))
`(defcustom ,tsym ',std-val
,(concat "Alternate " alt-description " version of `" symname "'.")
:type ',type
:link '(variable-link ,sym)
:set #'indent-bars--custom-set
:initialize #'custom-initialize-default
:group ',group
,@r)))
(defsubst indent-bars--alt (name alt)
"Find the symbol value of NAME, with alternate style ALT.
NAME is a string, and ALT and be a string or nil."
(intern (format "indent-bars%s-%s"
(if alt (concat "-" alt) "") name)))
(defun indent-bars--style1 (style name)
"Return the value of style variable NAME for STYLE.
Considers ([no-]inherit . rest) inheritance."
(let* ((tag (ibs/tag style))
(sym (indent-bars--alt name tag))
(val (symbol-value sym))
(inhrt t)) ; inherit by default
(when tag
;; Check for the ([no-]inherit . actual-val) form
(when (and (consp val) (memq (car val) '(inherit no-inherit)))
(setq inhrt (and (car val) (not (eq (car val) 'no-inherit)))
val (cdr val)))
(when inhrt
(setq val (indent-bars--custom-inherit
(symbol-value (indent-bars--alt name nil)) val))))
val))
(defun indent-bars--style (style name)
"Return the value of style variable NAME for STYLE.
Determines variables to use based on the style tag. For style
variable values of the form (`inherit'|`no-inherit' . plist),
inheritance of the plist is handled. If style is the symbol
`any', return the first non-nil value for all styles in
`indent-bars--styles'."
(if (eq style 'any)
(cl-some (lambda (s) (indent-bars--style1 s name))
indent-bars--styles)
(indent-bars--style1 style name)))
(defun indent-bars--custom-inherit (old new)
"Inherit the values of NEW and OLD, which can be values or lists.
NEW and OLD must have the same form, composed of atoms
and (optionally) a final plist. The symbol `unspecified' in
NEW indicates that that value should be replaced by the
corresponding value in OLD. Any trailing PLIST in NEW and OLD
will be merged (with NEW taking precedence). The merged value is
returned."
(cond
((and old (eq new 'unspecified))
old) ; fully inherited
((and (atom old) (atom new))
(if (eq new 'unspecified) old new))
((and (consp old) (consp new))
(let* ((old (copy-sequence old)) ; avoid editing old
(n new) (o old) last-o)
(while (and n o)
(if (and (plistp n) (plistp o) (keywordp (car o)))
(let ((m (map-merge 'plist o n)))
(if last-o (setcdr last-o m) (setq old m))
(setq o nil)) ; signify list complete
(unless (eq (car n) 'unspecified)
(setcar o (car n))))
(setq last-o o n (cdr n) o (cdr o)))
old))
(t new)))
(defun indent-bars-reset-styles (&rest _r)
"Reset all styles' colors and faces.
Useful for calling after theme changes."
(interactive)
(unless (equal (terminal-name) "initial_terminal")
(mapc #'indent-bars--initialize-style indent-bars--styles)))
(defun indent-bars--initialize-style (style)
"Initialize STYLE."
;; Colors
(setf (ibs/main-color style)
(indent-bars--main-color style)
(ibs/depth-palette style)
(indent-bars--depth-palette style)
(ibs/current-depth-palette style)
(indent-bars--current-depth-palette style)
(ibs/faces style) (indent-bars--create-faces style 7)
(ibs/no-stipple-chars style) (indent-bars--create-no-stipple-chars style 7))
;; Base stipple face
(face-spec-set
(ibs/stipple-face style)
(indent-bars--stipple-face-spec
(frame-char-width) (frame-char-height)
(indent-bars--stipple-rot (selected-window) (frame-char-width))
style))
;; Current depth highlight faces/stipple
(setf (ibs/current-bg-color style)
(indent-bars--current-bg-color style))
(when-let ((stipple (indent-bars--current-depth-stipple nil nil nil style)))
(setf (ibs/current-stipple-face style)
(indent-bars--tag "indent-bars%s-current-face" style))
(face-spec-set (ibs/current-stipple-face style) nil)))
;;;; Indentation and Drawing
(defvar-local indent-bars-spacing nil)
(defvar-local indent-bars--offset nil)
(defvar-local indent-bars--no-stipple nil)
(defsubst indent-bars--depth (len)
"Number of possible bars for initial blank string of length LEN.
Note that the first bar is expected at `indent-bars-starting-column'."
(if (> len indent-bars--offset)
(1+ (/ (- len indent-bars--offset 1) indent-bars-spacing))
0))
(defun indent-bars--context-depth ()
"Return the maximum `current-indentation' around current line.
Skips any fully blank lines."
(let ((prior-indent
(save-excursion
(beginning-of-line)
(skip-chars-backward "[:space:]\n")
(current-indentation))))
(save-excursion
(forward-line 1)
(skip-chars-forward "[:space:]\n")
(max (current-indentation) prior-indent))))
(defvar-local indent-bars--update-depth-function nil)
(defvar-local indent-bars--ppss nil)
(defun indent-bars--current-indentation-depth (&optional on-bar)
"Calculate current indentation depth.
Depth is 1-based (independent of the value of
`indent-bars-starting-column'), with a depth of 1 corresponding
to the outermost bar, and a depth of 0 indicating there is no
valid current depth.
If ON-BAR is nil, return the depth of the last visible bar on the
current line. If ON-BAR is non-nil and content begins at a
column where a bar would otherwise have fallen, report the depth
of that (undrawn) bar. If ON-BAR is the symbol `context', and
the first non-blank line immediately above or below the current
line is not at a deeper indentation level (by at least one bar
spacing), disable on-bar and use the last-visible-bar depth for
that line instead.
If `indent-bars-no-descend-string' is non-nil and point at line
beginning is inside a string, do not add bars deeper than one
more than the string's start. If it is `all', do not add any
bars at all. If `indent-bars-no-descend-lists' is non-nil,
perform the same check for lists.
If `indent-bars--update-depth-function' is non-nil, it will be
called with the indentation depth (prior to the ON-BAR check),
and can return an updated depth."
(let* ((c (current-indentation))