-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathorg-ol-tree.el
1540 lines (1184 loc) · 59.9 KB
/
org-ol-tree.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
;;; org-ol-tree.el --- an outline window for Org files -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2021 Thiago Alves
;;
;; Author: Thiago Alves <[email protected]>
;; Maintainer: Thiago Alves <[email protected]>
;; Created: March 20, 2021
;; Version: 0.0.1
;; Keywords: org, org-mode, outline, tree, tree-view, treeview, treemacs
;; Homepage: https://github.com/Townk/org-ol-tree
;; Package-Requires: ((org "9.4") (treemacs "2.8") (dash "2.18.1") (s "1.12.0") (ht "2.3") (seq) (cl-lib))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; For an overview information about the package with a quick start,
;; installation and usages, refer to the README.org file distributed along with
;; this file.
;;
;; This file is splitted into 8 major sections with each one having its own
;; number of subsections. I chose this organization to force me to keep a good
;; separation between the package major components. These sections are also used
;; to separate their unit test files.
;;
;; For namespaces the package uses the `org-ol-tree' prefix and each section
;; adds its own namespace to it.
;;
;; This is the list of all sections with their namespace indicated between
;; parenthesis, and its respective subsections:
;;
;; - Variables
;; - Private variables
;; - Configuration variables
;; - Constants
;; - System information (system)
;; - Core objects (core)
;; - Sections
;; - Headlines
;; - Document
;; - UI (ui)
;; - Icons
;; - Window
;; - Buffer
;; - Node actions (actions)
;; - Treemacs extension
;; - Mode definition
;; - Commands
;;
;; Because each variable has its namespaces defined by the section that uses it,
;; the "Variables" section has no namespace defined. The "Treemacs extension"
;; and "Mode definition" don't have namespaces either because those are pure
;; configuration sections. And in the end, the "Commands" section uses the main
;; namespace for itself.
;;
;; Another important convention I use in this file is the "double-dash" for
;; privates. This means that if you see a function or variable with a "--"
;; separating its namespace from its name, this function or variable are meant
;; exclusively for the internals of this package.
;;
;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;; * * * *
;; * * The private functions and private variables are subject to * *
;; * * change without any warning, even after a stable release. So do * *
;; * * yourself a favor and DO NOT USE THEM in your config. * *
;; * * * *
;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'ht)
(require 'org)
(require 's)
(require 'seq)
(require 'subr-x)
(require 'treemacs)
(require 'all-the-icons nil 'noerror)
(require 'evil nil 'noerror)
;;;; --- Faces
(defface org-ol-tree-document-face
'((t :inherit treemacs-root-face))
"Face used by org-ol-tree to display the root node."
:group 'org-ol-tree-faces)
(defface org-ol-tree-section-title-face
'((t :inherit font-lock-doc-face))
"Face used by org-ol-tree to display section titles."
:group 'org-ol-tree-faces)
(defface org-ol-tree-section-id-face
'((t :inherit treemacs-file-face))
"Face used by org-ol-tree to display section titles."
:group 'org-ol-tree-faces)
;;;; --- Variables
;; After reading about sections in this file and their respective namespaces,
;; you might ask why am I defining the package's variables on the top of the
;; file? There are 2 reasons for it:
;;
;; 1) When you open this file, besides the information on th header, th first
;; thing I want you to see, are what you can and can't customize on your
;; personal config file;
;;
;; 2) I still have some C in me and my first reaction when I declare variables
;; on any programming language I use, is to put them on the top of the scope,
;; so I used reason #1 to not change an old habit;
;;; --- Private variables -------------------------------------------------------
(defvar-local org-ol-tree--buffer-p nil
"Flag indicating if current buffer is an org-ol-tree buffer.")
(defvar-local org-ol-tree--buffer nil
"The org-ol-tree buffer associated with the current Org file.
This variable is only set on Org files when user displays the outline.
Never set or modify this variable directly.")
(defvar-local org-ol-tree--org-buffer nil
"The Outline buffer displaying the tree view.")
(defvar-local org-ol-tree-action--debounce-timer nil
"The timer waiting to debounce click operations on the tree view.")
(defvar-local org-ol-tree-ui--window-width 0
"The timer waiting to debounce click operations on the tree view.")
(defvar org-ol-tree-ui--icon-set nil
"This variable holds the current icon set used by the outline.
To know how this variable is populated, check the `org-ol-tree-ui-icon-set'
documentation.
Never update this variable manually. It is intended to self-mutate when calling
the `org-ol-tree-ui--update-icon-set' function.")
(defvar org-ol-tree-action--buffer-watchers (ht-create)
"A hash table that associates watcher description and their outline buffer.")
(defvar org-ol-tree-action--watcher-buffers (ht-create)
"A hash table that associates org buffers and their file watchers.")
;;; --- Configuration variables -------------------------------------------------
(defvar org-ol-tree-action-move-to-target nil
"When non nil, move cursor to the selected header on the org file.
If nil, after selecting a header on the Outline window, show the header and move
the cursor back to the Outline window.")
(defvar org-ol-tree-action-close-on-selected nil
"When non nil, close the Outline window after selecting a header.")
(defvar org-ol-tree-ui-window-position 'right
"Symbol indicating where to open the outline window.
Possible values for this variable are `left' or `right'.")
(defvar org-ol-tree-ui-window-max-width 0.4
"Define the outline window maximum width.
If the value is a float between 0 and 1, the maximum width is given by
multiplying this value and the maximum available size for the window.
If this value is an integer greater or equal 1, the maximum size is the given
value. If the option `org-ol-tree-ui-window-use-pixel' is non nil, the given
value is consider to be in pixels.
If the given value does not fall into these two categories, its assumed you want
the maximum width to be the size of the maximum available size. If it does, the
value will also be capped between `window-min-width' and the maximum available
size.")
(defvar org-ol-tree-ui-window-min-width 0.2
"Define the outline window minimum width.
If the value is a float between 0 and 1, the minimum width is given by
multiplying this value and the maximum available size for the window.
If this value is an integer greater or equal 1, the minimum size is the given
value itself. If the option `org-ol-tree-ui-window-use-pixel' is non nil, the
given value is consider to be in pixels.
If the given value does not fall into these two categories, its assumed you want
the minimum width to be the size of `window-min-width'. If it does, the value
will also be capped between `window-min-width' and the maximum available size.")
(defvar org-ol-tree-ui-window-use-pixel t
"Flag indicating if window measurements should be in pixels.
This flag will only be used on graphical frames, and it is useful if you have
any `variable-pitch' among outline faces.")
(defvar org-ol-tree-ui-window-auto-resize t
"Indicates the outline window should adjust its size to show its content.
When this option is nil, `org-ol-tree-ui-window-max-width' is used as the
outline window absolute size.")
(defvar org-ol-tree-ui-window-increase-only nil
"If set to a non nil value, only grow the size of the window.
This behavior is applied during window resize, which happens when the window
configuration for the outline window changes, or when use expands or collapses
the nodes.")
(defvar org-ol-tree-ui-window-header-format '(" ☰ Outline")
"Control the Outline Header's appearance.
If this variable is nil, org-ol-tree won't display a header on the outline
window. If its value should be the same type accepted by `modeline' and
`headerline', or a function. If th value is a function, before displaying the
header, org-ol-tree evaluates the function and uses the result as header. This
result must be in the format required by `modeline' and `headerline'")
(defvar org-ol-tree-ui-icon-set-list (list)
"A property list of property list representing all icon themes available.
An icon theme is a simple property list with four entries:
`:root' - The root node icon for the outline, displayed on the left of the
document's title;
`:expanded' - The icon displayed on the left of expandable nodes that are
currently expanded;
`:collapsed' - The icon displayed on the left of expandable nodes that are
currently collapsed;
`:sectiion' - The icon displayed on the left side of all section headline on
the outline;
All icons are strings. The `:root', `:expanded', and `collapsed' icons are
displayed with the `display' property of a two-characters propertized string.
This is done to guarantee the proper alignment of icons when using unicode or
all-the-icons icons.
The `:section' icon is actually a simple one-line string where we replace the
string \"%(section)\" by the section number of the headline. Different then the
other icons, the `:section' icon allows any arbitrary size string.")
(defvar org-ol-tree-ui-icon-set nil
"The theme to use on the outline icons.
To check all available themes, look into `org-ol-tree-ui-icon-set-list'
documentation.
The outline chooses the theme based on the following criteria:
1) If this variable is not nil, and the symbol from it is one of the available
themes, the theme indicated by the variable is used;
2) If the Emacs frame is a graphical frame, and the package all-the-icons is
installed and available, the theme `all-the-icons' is used;
3) If the Emacs frame is a graphical frame, and the package all-the-icons is NOT
installed nor available, the theme `unicode' is used;
4) Fallback to the `ascii' theme;")
;;; --- Constants ---------------------------------------------------------------
(defconst org-ol-tree-ui--buffer-prefix "*OrgOutlineTree"
"String prefixing all org-ol-tree buffers.")
(defconst org-ol-tree-core--headline-re
(concat "\\(.*\\)[[:blank:]]+"
"\\(\\[[[:digit:]]*[[:blank:]]*/[[:blank:]]*[[:digit:]]*[[:blank:]]*\\]\\)"
"[[:blank:]]*$")
"Regular expression to match task progress on an Org headline.")
(defconst org-ol-tree-core--title-re
"^#\\+title:[ \t]*\\([^\n]+\\)"
"Regular expression to match an Org document title.")
;;;; --- System information
(defun org-ol-tree-system--all-the-icons-p ()
"Constant indicating if package all-the-icons is installed."
(fboundp 'all-the-icons-material))
(defun org-ol-tree-system--evil-p ()
"Constant indicating if package evil is installed."
(and (fboundp 'evil-define-key)
(fboundp 'evil-window-top)
(fboundp 'evil-window-middle)
(fboundp 'evil-window-bottom)))
(defun org-ol-tree-system--graphical-frame-p ()
"Return t if current frame is a GUI frame, nil otherwise.
To find out if Emacs is running in GUI mode, we query the variable
`window-system'."
(member window-system '(x w32 ns)))
;;;; --- Core objects
;;; --- Sections ---------------------------------------------------------------
(defun org-ol-tree-core--section-p (stack-or-string)
"Return t when STACK-OR-STRING is a valid section object.
If STACK-OR-STRING is a list, all its elements should be numbers representing
individual numbers from a section id as on the reverse order do they appear. For
instance, the section \"1.3.2 My section text\" would be represented as (2 3 1)
on the stack form.
If STACK-OR-STRING is a string it should have only integers separated by dots as
they would appear on a section headline. For instance, the same \"1.3.2 My
section text\" headline is represented by the string \"1.3.2\"."
(and stack-or-string
(or (and (stringp stack-or-string)
(string-match-p "^[0-9]+\\(\\.[0-9]+\\)*$" stack-or-string))
(and (listp stack-or-string)
(seq-every-p 'number-or-marker-p stack-or-string)))))
(defun org-ol-tree-core--section-string (section-stack)
"Convert a list of numbers into a section number string notation.
This function does the conversion by transforming each element from
SECTION-STACK into a string, reversing the list, and joining all elements with a
'.' character.
Example::
(org-ol-tree-core--section-string '(3 2 1))
;; => \"1.2.3\""
(when (org-ol-tree-core--section-p section-stack)
(string-join (reverse (mapcar 'number-to-string section-stack)) ".")))
(defun org-ol-tree-core--section-from-string (section-string)
"Convert SECTION-STRING into a section stack.
Example::
(org-ol-tree-core--section-from-string \"1.2.3\")
;; => (3 2 1)"
(when (org-ol-tree-core--section-p section-string)
(reverse (mapcar 'string-to-number (split-string section-string "\\.")))))
(defun org-ol-tree-core--next-section (section target-level)
"Return a new section-stack for the next SECTION on TARGET-LEVEL.
For more information on the meaning of a section-stack, look the
`org-ol-tree-core--section-p' documentation.
Examples::
(org-ol-tree-core--next-section '(3 2 1) 3) ;; => (4 2 1)
(org-ol-tree-core--next-section '(3 2 1) 2) ;; => (3 1)
(org-ol-tree-core--next-section '(3 2 1) 4) ;; => (1 3 2 1)"
(if (or (not section)
(and (stringp section) (string-empty-p section)))
(-repeat target-level 1)
(unless (org-ol-tree-core--section-p section)
(error "The given section object is not an org-ol-tree-section"))
(let* ((section (if (stringp section) (org-ol-tree-core--section-from-string section) section))
(target-level (max 1 target-level))
(curr-level (length section))
(new-stack section))
(cond ((> curr-level target-level)
(setq new-stack (seq-drop section (- curr-level target-level))
new-stack (cons (1+ (car new-stack)) (cdr new-stack))))
((< curr-level target-level)
(setq new-stack (append (-repeat (- target-level curr-level) 1) new-stack)))
(t
(setcar new-stack (1+ (car new-stack)))))
new-stack)))
;;; --- Headlines ---------------------------------------------------------------
(defun org-ol-tree-headline--split-progress (text)
"Return a cons cell with headline title and progress mark.
TEXT is the full headline title where this function will search for the progress
mark ([/])."
(if (string-match org-ol-tree-core--headline-re text)
`(,(s-trim (match-string 1 text)) . ,(s-trim (match-string 2 text)))
`(,text . nil)))
(cl-defstruct (org-ol-tree-core--headline (:constructor org-ol-tree-core--headline-create-internal)
(:copier nil)
:noinline)
"The Org Outline Tree headline structure.
It has the basic information to build and draw a tree-like structure
representing an entire org document."
(name nil
:type string
:documentation "The org headline text with no decorations.")
(progress nil
:type string
:documentation "A string indicating progress on this headline tasks.")
(id nil
:type string
:documentation "A string representing the section number.")
(marker nil
:type marker
:documentation "Location of this headline on its org file buffer.")
(level 0
:type number
:documentation "The nested level for this org headline.")
(parent nil
:type org-ol-tree-core--headline
:documentation "The parent headline or nil if this is a root headline.")
(children nil
:type list
:documentation "A collection of children headlines."))
(defun org-ol-tree-core--create-headline (&optional previous-headline)
"Create a new `org-ol-tree-core--headline' from `point' on current org buffer.
If PREVIOUS-HEADLINE is non nil, this function creates the new headline as a
child of the given parent.
If `current-buffer' is not an org buffer, or `point' is not over an org headline,
this functions raises a user error."
(unless (eq major-mode 'org-mode)
(user-error "Cannot create an org-ol-tree-core--headline on a non-org buffer"))
(unless (org-at-heading-p)
(user-error "Cannot create a headline with cursor outside an actual org headline"))
(unless (or (null previous-headline)
(org-ol-tree-core--headline-p previous-headline))
(error "Given parent must be nil or an 'org-ol-tree-core--headline' object"))
(let* ((previous-level (if (null previous-headline)
0
(org-ol-tree-core--headline-level previous-headline)))
(previous-id (when (org-ol-tree-core--headline-p previous-headline)
(org-ol-tree-core--headline-id previous-headline)))
(this-components (org-heading-components))
(this-name (nth 4 this-components))
(this-name (org-ol-tree-headline--split-progress this-name))
(this-progress (cdr this-name))
(this-name (car this-name))
(this-level (nth 0 this-components))
(this-marker (point-marker))
(this-parent (cond
((= this-level previous-level)
(org-ol-tree-core--headline-parent previous-headline))
((> this-level previous-level) previous-headline)
((< this-level previous-level)
(let ((node previous-headline)
(node-level previous-level))
(while (and (not (null node))
(<= this-level node-level))
(setq node (org-ol-tree-core--headline-parent node))
(if (null node)
(setq node-level 0)
(setq node-level (org-ol-tree-core--headline-level node))))
node))
(t nil)))
(this-section-stack (org-ol-tree-core--next-section previous-id this-level))
(this-section-id (org-ol-tree-core--section-string this-section-stack))
(this-headline (org-ol-tree-core--headline-create-internal :name this-name
:progress this-progress
:id this-section-id
:marker this-marker
:level this-level
:parent this-parent)))
(when this-parent
(push this-headline (org-ol-tree-core--headline-children this-parent)))
this-headline))
(defun org-ol-tree-core--root-headline ()
"Return the headline object for the root node of the tree."
(org-ol-tree-core--node-get :headline (org-ol-tree-core--root-node)))
(defun org-ol-tree-core--current-headline ()
"Return the headline object for the tree node under the cursor.
If cursor is outside a headline node, return nil."
(org-ol-tree-core--node-get :headline))
;;; --- Treemacs integration ---------------------------------------------------
(defun org-ol-tree-core--root-path ()
"Return the treemacs path to the root node."
'(:custom root))
(defun org-ol-tree-core--section-path (&optional section-id skip-root)
"Return the path list for the given SECTION-ID.
If SECTION-ID is nil, uses the headline id of current node.
If SKIP-ROOT is non nil, it will not include the initial path of
`org-ol-tree-core--root-path'."
(append (unless skip-root (org-ol-tree-core--root-path))
(-reduce-from
(lambda (acc-list elm)
(-snoc acc-list (mapconcat 'identity (-snoc (last acc-list) elm) ".")))
nil
(split-string
(or section-id (org-ol-tree-core--headline-id (org-ol-tree-core--current-headline)))
"\\."))))
(defun org-ol-tree-core--root-node ()
"Return the treemacs button for the root node of the tree."
(save-excursion
(goto-char (treemacs-project->position (treemacs-project-at-point)))
(org-ol-tree-core--current-node)))
(defun org-ol-tree-core--current-node ()
"Wrapper function around `treemacs-current-button' to allow mocks."
(treemacs-current-button))
(defun org-ol-tree-core--node-get (property &optional node)
"Wrapper function around `treemacs-button-get' to allow mocks.
Return the value of PROPERTY associated with NODE."
(treemacs-button-get (or node (org-ol-tree-core--current-node)) property))
(defun org-ol-tree-core--node-put (property value &optional node)
"Wrapper function around `treemacs-button-put' to allow mocks.
Set the VALUE of PROPERTY associated with NODE."
(treemacs-button-put (or node (org-ol-tree-core--current-node)) property value))
;;; --- Document ---------------------------------------------------------------
(defun org-ol-tree-core--create-dom (&optional buffer-or-name)
"Traverse BUFFER-OR-NAME buffer to create a tree-like structure for headlines.
This function uses the `outline-next-heading' function to traverse the org file
and uses the cl-struct `org-ol-tree-core--headline' as node information.
If BUFFER-OR-NAME is nil, uses the `current-buffer'. If the given buffer is not
an Org buffer, raises a `user-error'."
(let ((buffer (if buffer-or-name
(get-buffer buffer-or-name)
(or org-ol-tree--org-buffer
(current-buffer)))))
(with-current-buffer buffer
(unless (eq major-mode 'org-mode)
(user-error "Can't traverse an Org document on a NON-Org buffer"))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(let ((root (org-ol-tree-core--headline-create-internal
:id "0"
:marker (point-min-marker)
:level 0))
current-headline)
(while (outline-next-heading)
(let ((this-headline (org-ol-tree-core--create-headline current-headline)))
(unless (org-ol-tree-core--headline-parent this-headline)
(push this-headline (org-ol-tree-core--headline-children root)))
(setq current-headline this-headline)))
root))))))
(defun org-ol-tree-core--find-title (&optional buffer-or-name)
"Return a string label for the outline root node.
The label is given by the title on the BUFFER-OR-NAME buffer if one is defined,
by the file name of the target buffer transformed to title case, if the target
buffer has a file associated with it, or by the target's buffer name
transformed to title case."
(let ((buffer (if buffer-or-name
(get-buffer buffer-or-name)
(or org-ol-tree--org-buffer
(current-buffer))))
(title-limit (* 1024 10)))
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(cond
((re-search-forward org-ol-tree-core--title-re title-limit t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1)))
((buffer-file-name)
(s-titleized-words (file-name-base (buffer-file-name))))
(t (s-titleized-words (buffer-name))))))))
;;;; --- UI
;;; --- Icons -------------------------------------------------------------------
(defun org-ol-tree-ui--update-icon-set ()
"Refresh `org-ol-tree-ui--icon-set' values.
To know how this function populate the `org-ol-tree-ui--icon-set',
check the `org-ol-tree-ui-icon-set' variable documentation."
(setq org-ol-tree-ui--icon-set
(plist-get org-ol-tree-ui-icon-set-list
(cond
((member org-ol-tree-ui-icon-set org-ol-tree-ui-icon-set-list)
org-ol-tree-ui-icon-set)
((and (org-ol-tree-system--graphical-frame-p)
(org-ol-tree-system--all-the-icons-p))
'all-the-icons)
((org-ol-tree-system--graphical-frame-p)
'unicode)
(t 'ascii)))))
(defun org-ol-tree-ui--use-fancy-icons-p ()
"Return t if the selected icon set is one of the `all-the-icons' set."
(and (org-ol-tree-system--graphical-frame-p)
(org-ol-tree-system--all-the-icons-p)
(or (not org-ol-tree-ui-icon-set)
(member org-ol-tree-ui-icon-set '(all-the-icons iconless-fancy)))))
(defun org-ol-tree-ui--expand-collapse-icon (headline state)
"Return the string used for the collapse or expand symbol on sections.
If the HEADLINE used to get this icon does not have children, this function
returns two white spaces used to align with the collapsable headlines.
The STATE argument indicates if this icon should represent an open or closed
node.Valid values for STATE are 'expanded,'collapsed, and nil. In practice, this
function considers the state as 'collapsed for any value non nil and different
than 'expanded."
(if (org-ol-tree-core--headline-children headline)
(let ((expanded-icon (plist-get org-ol-tree-ui--icon-set :expanded))
(collapsed-icon (plist-get org-ol-tree-ui--icon-set :collapsed)))
(if (org-ol-tree-ui--use-fancy-icons-p)
(propertize "--"
'face 'org-ol-tree-section-title-face
'display (if (eq state 'expanded) expanded-icon collapsed-icon))
(propertize (if (eq state 'expanded) expanded-icon collapsed-icon)
'face 'org-ol-tree-section-title-face)))
" "))
(defun org-ol-tree-ui--doc-icon ()
"Return the string used as the icon for the root element."
(let* ((doc-icon (plist-get org-ol-tree-ui--icon-set :root))
(display-p (> (length doc-icon) 0)))
(concat
" "
(when display-p (if (org-ol-tree-ui--use-fancy-icons-p)
(propertize "--" 'face 'org-ol-tree-document-face 'display doc-icon)
(propertize doc-icon 'face 'org-ol-tree-document-face)))
(when display-p " "))))
(defun org-ol-tree-ui--section-icon (headline state)
"Return the full icon for the giving HEADLINE.
The icon depends on the icon theme configuration as well as the given STATE
of the HEADLINE."
(let ((section-icon (plist-get org-ol-tree-ui--icon-set :section)))
(concat
" "
(org-ol-tree-ui--expand-collapse-icon headline state)
(when (> (length section-icon) 0)
(propertize
(format "%s " (s-replace "%(section)" (org-ol-tree-core--headline-id headline) section-icon))
'face
'org-ol-tree-section-title-face)))))
;; I define the icon themes here because 1) this is the UI section and the Icons
;; subsection, and 2) we want all functions related to icons to be defined
;; before we define the actual icons.
(setq org-ol-tree-ui-icon-set-list
(-non-nil
(append '()
(when (org-ol-tree-system--all-the-icons-p)
(list 'all-the-icons `(:root ,(all-the-icons-material "description"
:height 0.95
:v-adjust -0.17)
:expanded ,(all-the-icons-material "keyboard_arrow_down"
:height 0.95
:v-adjust -0.17)
:collapsed ,(all-the-icons-material "chevron_right"
:height 0.95
:v-adjust -0.17)
:section "§ %(section)")))
(list 'unicode `(:root "■" ; <-- I really don't like
:expanded "▾ " ; this icon, please
:collapsed "▸ " ; give me a better
:section "§ %(section)") ; suggestion!
'ascii `(:root "*"
:expanded "- "
:collapsed "+ "
:section "%(section)"))
(when (org-ol-tree-system--all-the-icons-p)
(list 'iconless-fancy `(:root ""
:expanded ,(all-the-icons-material "keyboard_arrow_down"
:height 0.95
:v-adjust -0.17)
:collapsed ,(all-the-icons-material "chevron_right"
:height 0.95
:v-adjust -0.17)
:section "")))
(list 'iconless-unicode `(:root ""
:expanded "▾ "
:collapsed "▸ "
:section "")
'iconless-ascii `(:root ""
:expanded "- "
:collapsed "+ "
:section "")
'iconless `(:root ""
:expanded ""
:collapsed ""
:section "")))))
;;; --- Window ------------------------------------------------------------------
(defun org-ol-tree-ui--setup-window (create-window)
"Display the Outline buffer on a side window.
If CREATE-WINDOW is a non nil value, this function creates a side window and
displays the Outline buufer into it."
(if (not create-window)
(select-window (get-buffer-window org-ol-tree--buffer))
(-> org-ol-tree--buffer
(display-buffer-in-side-window `((side . ,org-ol-tree-ui-window-position)))
(select-window)
(set-window-dedicated-p t))
(add-hook 'window-configuration-change-hook 'org-ol-tree-ui--window-resize nil t)))
(defun org-ol-tree-ui--get-window ()
"Return the window displaying the org-ol-tree buffer for the current org file.
Returns nil if no org-ol-tree buffer is visible."
(if org-ol-tree--buffer-p
(selected-window)
(when (buffer-live-p org-ol-tree--buffer)
(get-buffer-window org-ol-tree--buffer))))
(defun org-ol-tree-ui--visibility ()
"Return whether the current visibility state of the org-ol-tree buffer.
Valid states are 'visible, 'exists and 'none."
(cond
((org-ol-tree-ui--get-window) 'visible)
((buffer-live-p org-ol-tree--buffer) 'exists)
(t 'none)))
(defun org-ol-tree-ui--use-pixel-p ()
"Return t if the measurement unit should be pixels.
This function takes in account the value of `org-ol-tree-ui-window-use-pixel'
and if this frame is a graphical frame or not."
(and (org-ol-tree-system--graphical-frame-p)
org-ol-tree-ui-window-use-pixel))
(defun org-ol-tree-ui--window-system-min-width (window char-width pixelwise)
"Return real minimal width for WINDOW.
If PIXELWISE is non nil, this function uses CHAR-WIDTH to calculate the minimal
width in pixels.
The real minimal width is given by the variable `window-min-width' and the
function `window-min-size' (which can potentially differ), whichever is bigger."
(max (if pixelwise (* char-width window-min-width) window-min-width)
(window-min-size window nil window pixelwise)))
(defun org-ol-tree-ui--window-min-width (available-width system-min-width)
"Return the minimum possible width for window.
This function uses AVAILABLE-WIDTH and SYSTEM-MIN-WIDTH to calculate the
minimum width from `org-ol-tree-ui-window-min-width'.
For mor information on SYSTEM-MIN-WIDTH check
`org-ol-tree-ui--window-system-min-width' documentation."
(cond
((<= org-ol-tree-ui-window-min-width 0) system-min-width)
((integerp org-ol-tree-ui-window-min-width)
(max org-ol-tree-ui-window-min-width system-min-width))
((> org-ol-tree-ui-window-max-width 1.0) system-min-width)
(t (max (round (* org-ol-tree-ui-window-min-width (float available-width)))
system-min-width))))
(defun org-ol-tree-ui--window-max-width (available-width)
"Return the maximum possible width for window.
This function uses AVAILABLE-WIDTH as the maximum size the window can take in
the frame when `org-ol-tree-ui-window-max-width' is a ration rather then a
number."
(cond
((<= org-ol-tree-ui-window-max-width 0) available-width)
((integerp org-ol-tree-ui-window-max-width) (min org-ol-tree-ui-window-max-width
available-width))
((>= org-ol-tree-ui-window-max-width 1) available-width)
(t (min (round (* org-ol-tree-ui-window-max-width (float available-width)))
available-width))))
(defun org-ol-tree-ui--window-required-width (window current-width pixelwise)
"Calculates the minimal width of WINDOW to display its entire buffer.
This function uses the CURRENT-WIDTH to calculate WINDOW's fringes, margins,
scroll bars, and its right divider, if any. If PIXELWISE is non nil, this
calculation uses pixels instead of characters."
(+ (car (window-text-pixel-size window
(window-start window) nil
(frame-pixel-width (window-frame window)) nil))
(- current-width (window-body-width window pixelwise))))
(defun org-ol-tree-ui--window-pad-width (width char-width pixelwise)
"Return WIDTH with the necessary padding for the Outline.
This function uses the given CHAR-WIDTH to pad its width.
If PIXELWISE is non nil, this calculation uses pixels instead of characters."
(let ((width (+ width (* char-width 2))))
(if pixelwise
width
(/ (+ width char-width -1) char-width))))
(defun org-ol-tree-ui--window-perform-resize (window current-width new-width pixelwise)
"Adjust the size of WINDOW to NEW-WIDTH if it's different than CURRENT-WIDTH.
If PIXELWISE is non nil, perform the resize using pixels instead of characters."
(unless (= new-width current-width)
(window-preserve-size window t)
(window-resize-no-error
window (- new-width current-width) t window pixelwise)
(when org-ol-tree-ui-window-increase-only
(setq-local org-ol-tree-ui--window-width new-width))))
(defun org-ol-tree-ui--window-resize ()
"Adjust the window width to fit the outline content as much as possible.
The adjustment respects the value of `org-ol-tree-ui-window-max-width' (check
its documentation for more details).
The majority of the code in this function was copied from the Emacs function
`fit-window-to-buffer'."
(let* ((pixelwise (org-ol-tree-ui--use-pixel-p))
(char-width (frame-char-width))
(window (window-normalize-window (selected-window) t))
(current-width (window-size window t pixelwise))
(max-delta (window-max-delta window t window nil t nil pixelwise))
(available-width (+ current-width max-delta))
(system-min-width (org-ol-tree-ui--window-system-min-width window char-width pixelwise))
(max-width (org-ol-tree-ui--window-max-width available-width))
(min-width (org-ol-tree-ui--window-min-width available-width system-min-width))
(min-width (max min-width org-ol-tree-ui--window-width))
(required-width (org-ol-tree-ui--window-required-width window current-width pixelwise))
(required-width (org-ol-tree-ui--window-pad-width required-width char-width pixelwise))
(target-width (max min-width (min max-width required-width)))
(window-size-fixed nil))
(org-ol-tree-ui--window-perform-resize window
current-width
(if org-ol-tree-ui-window-auto-resize
target-width
max-width)
pixelwise)))
;;; --- Buffer ------------------------------------------------------------------
(defun org-ol-tree-ui--get-buffer-create (name)
"Retrieve or create an org-ol-tree buffer with NAME for current Org buffer."
(if (buffer-live-p org-ol-tree--buffer)
org-ol-tree--buffer
(get-buffer-create (format "%s:%s*" org-ol-tree-ui--buffer-prefix name))))
(defun org-ol-tree-ui--setup-buffer ()
"Create and setup a buffer for Org Outline Tree."
(if-let ((origin-buffer (current-buffer))
(org-buffer-p (eq major-mode 'org-mode))
(buffer (org-ol-tree-ui--get-buffer-create (buffer-name))))
(progn
(add-hook 'kill-buffer-hook 'org-ol-tree-action--quit-on-kill nil t)
(setq-local org-ol-tree--buffer buffer)
(with-current-buffer buffer
(unless org-ol-tree--buffer-p
(treemacs-initialize)
(setq-local org-ol-tree--org-buffer origin-buffer
org-ol-tree--buffer-p t
treemacs--width-is-locked nil
window-size-fixed nil
org-ol-tree-ui--window-width 0)
(setq header-line-format (if (functionp org-ol-tree-ui-window-header-format)
(funcall org-ol-tree-ui-window-header-format)
org-ol-tree-ui-window-header-format))
(org-ol-tree-mode 1))))
(error "Can't use Org Outline Tree on non-Org buffers")))
(defun org-ol-tree-ui--kill-buffer ()
"Kill the org-ol-tree buffer."
(interactive)
(when org-ol-tree--buffer-p
;; teardown logic handled in kill hook
(if (one-window-p)
(kill-this-buffer)
(kill-buffer-and-window))))
(defun org-ol-tree-ui--build-outline-tree ()
"Erase and re-draw the entire tree hierarchy for the current Outline."
(let ((buffer (if org-ol-tree--buffer-p (current-buffer) org-ol-tree--buffer)))
(unless buffer
(user-error "Cannot rebuild the Outline tree from an unrelated buffer"))
(with-current-buffer buffer
(treemacs-with-writable-buffer
(erase-buffer)
(treemacs-ORG-OL-DOC-extension)
(org-ol-tree-core--node-put :headline (org-ol-tree-core--create-dom)
(org-ol-tree-core--root-node))
(treemacs-expand-org-ol-doc)
(save-excursion
(goto-char (point-max))
(insert "\n"))))))
;;;; --- Node actions
;;; --- Mouse -------------------------------------------------------------------
(defun org-ol-tree-action--leftclick (event)
"Function used to perform a mouse click on a node.
The action triggered by this function depends if the node is a leaf or an
expandable node. If leaf, it will trigger the `treemacs-RET-action', and if it
is an expandable node, it will trigger the `treemacs-TAB-action'. A potential
prefix EVENT is passed on to the executed action, if possible."
(interactive "e")
(when org-ol-tree-action--debounce-timer
(cancel-timer org-ol-tree-action--debounce-timer))
(setq org-ol-tree-action--debounce-timer
(run-with-idle-timer 0.1 nil #'org-ol-tree-action--expand-or-visit event)))
(defun org-ol-tree-action--expand-or-visit (event)
"Helper function called by `org-ol-tree-action--leftclick'.