-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathkview.el
1476 lines (1341 loc) · 57.5 KB
/
kview.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
;;; kview.el --- Display handling of koutlines -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 6/30/93
;; Last-Mod: 29-Jan-25 at 19:07:24 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1993-2024 Free Software Foundation, Inc.
;; See the "../HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;; Code:
;;; ************************************************************************
;;; Other required Lisp Libraries
;;; ************************************************************************
(eval-and-compile (mapc #'require '(hact kfill klink kproperty outline)))
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(defvar kotl-mode:refill-flag)
(defvar hyrolo-display-buffer)
(defvar hyrolo-hdr-regexp)
(defvar hbut:source-prefix)
(declare-function klabel:format "klabel.el")
(declare-function klabel:idstamp-p "klabel.el")
(declare-function kcell:create-top "kcell")
(declare-function kcell:create "kcell")
(declare-function kcell:get-attr "kcell")
(declare-function kcell:plist "kcell")
(declare-function kcell:remove-attr "kcell")
(declare-function kcell:set-attr "kcell")
(declare-function kfile:narrow-to-kcells "kfile")
(declare-function klabel-type:child "klabel")
(declare-function klabel-type:function "klabel")
(declare-function klabel-type:increment "klabel")
(declare-function klabel-type:parent "klabel")
(declare-function klabel-type:set-labels "klabel")
(declare-function kotl-mode:beginning-of-line "kotl-mode")
(declare-function kotl-mode:fill-cell "kotl-mode")
(declare-function kotl-mode:goto-cell "kotl-mode")
(declare-function kotl-mode:goto-heading "kotl/kotl-mode")
(declare-function kotl-mode:hide-subtree "kotl-mode")
(declare-function kotl-mode:to-end-of-line "kotl-mode")
(declare-function kotl-mode:to-visible-position "kotl-mode")
(declare-function kotl-mode:tree-end "kotl-mode")
(declare-function kvspec:show-lines-this-cell "kvspec")
(declare-function kvspec:update "kvspec")
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(define-obsolete-variable-alias 'label-sep-len 'kview-label-sep-len "8.0.1")
(defvar kview-label-sep-len nil
"Length of the separation between cell's label and start of its contents.")
(defvar-local kotl-kview nil "Buffer local kview object.")
(defcustom kview:default-blank-lines t
"*Default setting of whether to show blank lines between koutline cells.
A value of t means show them, nil means don't show them. Default
value is t."
:type 'boolean
:group 'hyperbole-koutliner)
(defvar kview:default-levels-to-show 0
"Default number of cell levels to show. 0, the default, means all levels.")
(defvar kview:default-lines-to-show 0
"Default number of lines per cell to show. 0, the default, means all lines.")
(defcustom kview:default-label-min-width 4
"*Minimum width to which to pad labels in a kotl view.
Labels are padded with spaces on the left. Default value is 4."
:type '(integer :match (lambda (_widget value)
(and (integerp value) (> value 1) (<= value 99))))
:group 'hyperbole-koutliner)
(defcustom kview:default-label-separator ". "
"*Default string to insert between label and contents of a kcell.
Default value is \". \"."
:type 'string
:group 'hyperbole-koutliner)
(defconst kview:outline-regexp (concat "\\( *\\)\\([0-9][0-9a-z.]*\\)\\("
(regexp-quote kview:default-label-separator)
"\\)")
"Koutline view `outline-regexp' value that handles all label formats.")
(defcustom kview:default-label-type 'alpha
"*Default label-type to use for new koutlines. Default value is \\='alpha.
It must be one of the following symbols:
alpha for `1b3' full alphanumeric labels
id for `027' permanent idstamp labels
legal for `1.2.3' legal-style labels"
:type '(choice (const alpha)
(const id)
(const legal))
:group 'hyperbole-koutliner)
;; no for no labels
;; partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2'
;; star for multi-star labeling, e.g. `***'.
(defcustom kview:default-level-indent 3
"*Default number of spaces to indent each succeeding level in koutlines.
Default value is 3."
:type '(integer :match (lambda (_widget value)
(and (integerp value) (> value 0) (<= value 60))))
:group 'hyperbole-koutliner)
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
;;;
;;; kcell-view - Kcell view-specific functions
;;;
(defun kcell-view:backward (&optional visible-p lbl-sep-len)
"Move to start of the prior cell at the same level as the current cell.
With optional VISIBLE-P, consider only visible cells.
Return t unless no such cell."
(or lbl-sep-len (setq lbl-sep-len
(kview:label-separator-length kotl-kview)))
(let ((opoint (point))
(found) (done)
(curr-indent 0)
(start-indent (kcell-view:indent nil lbl-sep-len)))
(while (and (not (or found done))
(kcell-view:previous visible-p lbl-sep-len))
(if (bobp)
(progn (setq done t)
(goto-char opoint))
(setq curr-indent (kcell-view:indent nil lbl-sep-len))
(cond ((< (abs (- curr-indent start-indent))
(kview:level-indent kotl-kview))
(goto-char (kcell-view:start nil lbl-sep-len))
(setq found t))
((< curr-indent start-indent)
;; Went past start of this tree without a match.
(setq done t)
(goto-char opoint))
;; else go to prior node
)))
found))
(defun kcell-view:cell (&optional pos)
"Return kcell at optional POS or point."
(kproperty:get (kcell-view:plist-point pos) 'kcell))
(defun kcell-view:cell-from-ref (cell-ref)
"Return a kcell referenced by CELL-REF, a cell label, id string or idstamp.
If an idstamp, it must be an integer. Trigger an error if CELL-REF is
not a string or an integer or is not found."
(if (or (stringp cell-ref)
(integerp cell-ref))
(let ((idstamp (kcell:ref-to-id cell-ref))
pos)
(when (and (stringp idstamp) (> (length idstamp) 0) (eq (aref idstamp 0) ?0))
;; remove any concatenated viewspec and convert to an integer
(setq idstamp (string-to-number (substring idstamp 0 (string-match "[^0-9]" idstamp)))))
(cond ((and (integerp idstamp) (zerop idstamp))
(kview:top-cell kotl-kview))
((and (integerp idstamp) (setq pos (kproperty:position 'idstamp idstamp)))
(kcell-view:cell pos))
((save-excursion
(and (stringp idstamp)
;; Not an idstamp but a textual label at the beginning of a cell
(kotl-mode:goto-heading idstamp)
(kcell-view:cell (point)))))
(t (error "(kcell:get-from-ref): No such Koutline cell: '%s'" cell-ref))))
(error "(kcell:get-from-ref): cell-ref arg must be a string, not: '%s'" cell-ref)))
(defun kcell-view:child (&optional visible-p lbl-sep-len)
"Move to start of current cell's child.
With optional VISIBLE-P, consider only visible children.
Return t unless cell has no matching child.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents."
(let* ((opoint (point))
(prev-indent (kcell-view:indent nil lbl-sep-len))
(next (kcell-view:next visible-p lbl-sep-len)))
(unless lbl-sep-len
(setq lbl-sep-len (kview:label-separator-length kotl-kview)))
;; Since kcell-view:next leaves point at the start of a cell, the cell's
;; indent is just the current-column of point.
(if (and next (>= (- (current-column) prev-indent)
(kview:level-indent kotl-kview)))
t
;; Move back to previous point and return nil.
(goto-char opoint)
nil)))
(defun kcell-view:child-p (&optional pos visible-p lbl-sep-len)
"Return t if cell at optional POS or point has a child.
With optional VISIBLE-P, consider only visible children.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents."
(save-excursion
(when pos
(goto-char pos))
(kcell-view:child visible-p lbl-sep-len)))
(defun kcell-view:collapse (&optional pos lbl-sep-len)
"Collapse cell at optional POS or point to a single line within the current view.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents."
(save-excursion
(goto-char (kcell-view:start pos lbl-sep-len))
(kview:end-of-actual-line)
(outline-flag-region (point) (kcell-view:end-contents) t)))
(defun kcell-view:collapsed-p (&optional pos lbl-sep-len)
"Return t if cell at optional POS or point is collapsed within the current view.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents.
A cell may be collapsed yet still have some of its text visible. Use
`kcell-view:invisible-p' to test for invisibility."
(when (memq 'outline (mapcar (lambda (o) (overlay-get o 'invisible))
;; Allow for empty cell
(overlays-in (1- (kcell-view:start pos lbl-sep-len))
(kcell-view:end-contents pos))))
t))
(defun kcell-view:hide (&optional pos lbl-sep-len)
"Make cell at optional POS or point invisible within the current view.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents."
(kcell-view:expand pos lbl-sep-len t))
(defun kcell-view:invisible-p (&optional pos lbl-sep-len)
"Return t if cell at optional POS or point is entirely invisible in current view.
Optional LBL-SEP-LEN is the length of the separation between
a cell's label and the start of its contents.
Any cell that is invisible is also collapsed as indicated by a call to
`kcell-view:collapsed-p'."
(let ((start (1- (kcell-view:start pos lbl-sep-len))) ;; Allow for empty cell
(end (kcell-view:end-contents pos)))
(when (delq nil (mapcar (lambda (o)
(and (eq (overlay-get o 'invisible) 'outline)
(>= start (overlay-start o))
(<= end (overlay-end o))))
(overlays-in start end)))
t)))
(defun kcell-view:contents (&optional pos prefix-flag)
"Return text of cell at optional POS or point.
Remove indentation from all but first line in the returned text.
With optional PREFIX-FLAG non-nil, include back to the start of the
first line, i.e. include the autonumber prefix and indent."
(save-excursion
(when pos
(goto-char pos))
(let ((indent (kcell-view:indent))
(start (if prefix-flag
(progn (goto-char (kcell-view:start))
(line-beginning-position))
(kcell-view:start)))
(end (kcell-view:end-contents)))
;; Remove indentation from all but first line.
(replace-regexp-in-string
(concat "\\([\n\r]\\)" (make-string indent ?\ ))
"\\1" (buffer-substring start end)))))
(defun kcell-view:create (kview cell contents level idstamp klabel &optional no-fill sibling-p)
"Insert into KVIEW at point, CELL with CONTENTS at LEVEL with IDSTAMP and KLABEL.
First level is 1.
If the current view displays klabels, then KLABEL should be inserted
prior to this call, with point following it.
Optional NO-FILL non-nil suppresses filling of cell's contents upon insertion
or movement."
(unless (zerop idstamp)
(unless no-fill
(setq no-fill (kcell:get-attr cell 'no-fill)))
(let* ((label-min-width (kview:label-min-width kview))
(label-fmt (format "%%%ds" label-min-width))
(label (cond ((string-equal klabel "")
"")
((and (string-equal klabel "0")
(setq klabel (klabel:format klabel))
;; Fall through
nil))
(t (format label-fmt klabel))))
(label-separator (if (string-equal klabel "") " "
(kview:label-separator kview)))
(mult-line-indent (* (1- level) (kview:level-indent kview)))
(thru-label (+ mult-line-indent label-min-width
(length label-separator)))
(old-point (point))
(fill-prefix (make-string thru-label ?\ ))
new-point)
(when no-fill
(kcell:set-attr cell 'no-fill t))
(insert fill-prefix)
(setq contents (kview:insert-contents cell contents
(or no-fill sibling-p
(null kotl-mode:refill-flag))
fill-prefix))
;; Insert lines to separate cell from next.
(insert "\n\n")
(unless (kview:get-attr kview 'blank-lines)
;; Make blank lines invisible.
(kproperty:put (1- (point)) (min (point) (point-max))
'(invisible t)))
(kfile:narrow-to-kcells)
(setq new-point (point))
(goto-char old-point)
;; Delete leading spaces used to get fill right in first cell
;; line. Replace it with label.
(delete-char thru-label)
(insert (format (format "%%%ds" (- thru-label (length label-separator)))
label))
(setq old-point (point))
(insert label-separator)
(goto-char old-point)
;; Add cell's attributes to the text property list at point.
(kproperty:set 'idstamp idstamp)
(kproperty:set 'kcell cell)
(goto-char new-point))))
(defun kcell-view:end (&optional pos)
"Return end position of cell from optional POS or point.
Includes blank lines following cell contents."
(unless pos
(setq pos (point)))
(save-excursion
(or (re-search-forward "[\n\r][\n\r]" nil t)
(point-max))))
(defun kcell-view:end-contents (&optional pos)
"Return end position of cell contents from optional POS or point.
Excludes blank lines following cell contents."
(save-excursion
(when pos
(goto-char pos))
(goto-char (kcell-view:end))
(skip-chars-backward "\n\r")
(point)))
(defun kcell-view:expand (&optional pos lbl-sep-len hide-p)
"Expand cell at optional POS or point within the current view."
(save-excursion
(goto-char (kcell-view:start pos lbl-sep-len))
(outline-flag-region (point) (kcell-view:end-contents) hide-p)))
(defun kcell-view:forward (&optional visible-p lbl-sep-len)
"Move to start of the following cell at the same level as the current cell.
With optional VISIBLE-P, consider only visible cells.
Return t unless no such cell."
(unless lbl-sep-len
(setq lbl-sep-len (kview:label-separator-length kotl-kview)))
(let ((opoint (point))
(found) (done)
(curr-indent 0)
(start-indent (kcell-view:indent nil lbl-sep-len)))
(while (and (not (or found done))
(kcell-view:next visible-p lbl-sep-len))
(setq curr-indent (kcell-view:indent nil lbl-sep-len))
(cond ((< (abs (- curr-indent start-indent))
(kview:level-indent kotl-kview))
(goto-char (kcell-view:start nil lbl-sep-len))
(setq found t))
((< curr-indent start-indent)
;; Went past end of this tree without a match.
(setq done t)
(goto-char opoint))
;; else go to following node
))
;; If didn't find a match, return to original point.
(unless found
(goto-char opoint))
found))
(defun kcell-view:get-attr (attribute &optional pos)
"Return ATTRIBUTE's value for current cell or cell at optional POS
Use 0 for POS to retrieve top cell's attributes."
(if (eq pos 0)
(if (eq attribute 'idstamp)
0
(kcell:get-attr (kview:top-cell kotl-kview) attribute))
(save-excursion
(goto-char (or pos (kcell-view:plist-point)))
(if (eq attribute 'idstamp)
(kproperty:get (point) attribute)
(kcell:get-attr (kcell-view:cell) attribute)))))
(defun kcell-view:idstamp-integer (&optional pos)
"Return idstamp integer >= 0 of cell at optional POS or point."
(save-excursion
(goto-char (or pos (kcell-view:plist-point)))
(kproperty:get (point) 'idstamp)))
(defun kcell-view:idstamp (&optional pos)
"Return idstamp string of cell at optional POS or point."
(save-excursion
(goto-char (or pos (kcell-view:plist-point)))
(format "0%s" (or (kproperty:get (point) 'idstamp) ""))))
(defun kcell-view:indent (&optional pos lbl-sep-len)
"Return indentation of cell at optional POS or point.
Optional LBL-SEP-LEN is the view-specific length of the separator between a
cell's label and the start of its contents."
(+ (save-excursion
(kcell-view:to-label-end pos)
(current-column))
(or lbl-sep-len (kview:label-separator-length kotl-kview)
(length kview:default-label-separator))))
(defun kcell-view:label (&optional pos)
"Return displayed label string of cell at optional POS or point.
If labels are off, return cell's idstamp as a string."
(save-excursion
(when pos
(goto-char pos))
(let ((label-type (kview:label-type kotl-kview)))
(if (eq label-type 'no)
(kcell-view:idstamp)
(kcell-view:to-label-end)
(buffer-substring-no-properties
(point) (progn (skip-chars-backward "^ \t\n\r")
(point)))))))
(defun kcell-view:level (&optional pos lbl-sep-len indent)
"Return the outline level of the current cell or the one at optional POS.
0 = top cell level, 1 = 1st level of the outline. Optional
LBL-SEP-LEN is the number of spaces between a cell label and
the start of its body. Optional INDENT is the indentation in
characters of the cell whose level is desired."
(unless lbl-sep-len
(setq lbl-sep-len (kview:label-separator-length kotl-kview)))
(floor (/ (- (or indent (kcell-view:indent pos lbl-sep-len)) lbl-sep-len)
(kview:level-indent kotl-kview))))
(defun kcell-view:line (&optional pos)
"Return contents of cell line at point or optional POS as a string."
(save-excursion
(when pos
(goto-char pos))
(if (kview:valid-position-p)
(buffer-substring (kotl-mode:beginning-of-line) (kotl-mode:to-end-of-line))
(error "(kcell-view:line): Invalid position, `%d'" (point)))))
(defun kcell-view:lines-visible ()
"Return the number of lines visible within the current cell."
;; Use free variable kview-label-sep-len bound in kview:map-* for speed.
(if (kcell-view:invisible-p)
0
(let* ((start (kcell-view:start nil (kview:label-separator-length kotl-kview)))
(end (kview:first-invisible-point start)))
;; Prevent bounds error with empty cells that have hidden subtrees.
(max 1 (count-lines start end)))))
(defun kcell-view:next (&optional visible-p lbl-sep-len)
"Move to start of next cell within current view.
With optional VISIBLE-P, consider only visible cells.
Return t unless no next cell."
(when (kcell-view:next-kcell visible-p lbl-sep-len)
(goto-char (kcell-view:start nil lbl-sep-len))
t))
(defun kcell-view:next-invisible-p (&optional _pos lbl-sep-len)
"Return t if next cell after optional POS or point exists and is invisible."
(save-excursion (and (kcell-view:next nil lbl-sep-len)
(kcell-view:invisible-p (point) lbl-sep-len))))
(defun kcell-view:operate (function &optional start end)
"Invoke FUNCTION with view restricted to current cell contents.
Optional START and END are start and endpoints of cell to use."
(save-restriction
(narrow-to-region (or start (kcell-view:start))
(or end (kcell-view:end-contents)))
(funcall function)))
(defun kcell-view:parent (&optional visible-p lbl-sep-len)
"Move to start of current cell's parent within current view.
If parent is top cell, move to first cell within view and return 0.
Otherwise, return t unless optional VISIBLE-P is non-nil and the parent cell
is not part of the current view, else nil."
(unless lbl-sep-len
(setq lbl-sep-len (kview:label-separator-length kotl-kview)))
(let ((opoint (point))
(parent-level (1- (kcell-view:level nil lbl-sep-len))))
(if (= parent-level 0) ;; top cell
(progn (goto-char (point-min))
(goto-char (kcell-view:start nil lbl-sep-len))
0)
;; Skip from point back past any siblings
(while (kcell-view:backward visible-p lbl-sep-len))
;; Move back to parent.
(if (kcell-view:previous visible-p lbl-sep-len)
t
;; Move back to previous point and return nil.
(goto-char opoint)
nil))))
(defun kcell-view:previous (&optional visible-p lbl-sep-len)
"Move to start of previous cell within current view.
With optional VISIBLE-P, consider only visible cells.
Return t unless no previous cell."
(when (kcell-view:previous-kcell visible-p lbl-sep-len)
(goto-char (kcell-view:start nil lbl-sep-len))
t))
(defun kcell-view:plist (&optional pos)
"Return attributes associated with cell at optional POS or point."
(kcell:plist (kcell-view:cell pos)))
(defun kcell-view:plist-point (&optional pos)
"Return buffer position of attributes associated with cell.
Cell is at optional POS or point."
(save-excursion (1+ (kcell-view:to-label-end pos))))
(defun kcell-view:to-label-end (&optional pos)
"Move point from optional POS to end of current cell's label and return point.
Point is set at end of cell's label but before the label separator.
If between kcells, move to the previous one. The current cell may be hidden."
(when pos (goto-char pos))
(when (eq (current-buffer) (get-buffer hyrolo-display-buffer))
;; May need to move past header to a valid position in HyRolo
;; display match buffer
(while (save-excursion (forward-line 0)
(or (looking-at hyrolo-hdr-regexp)
(looking-at hbut:source-prefix)))
(forward-line 1)))
(kview:end-of-actual-line)
(let (found)
(unless (setq found (kproperty:get (1- (point)) 'kcell))
;; If not at beginning of cell contents, move there.
(setq found (kproperty:previous-single-change (point) 'kcell))
(if found
(goto-char found)
(error "(kcell-view:to-label-end): In cell at pos %d, can't find beginning of cell"
(or pos (point)))))
;; Then move to the end of the label (prior to label separator)
;; via embedded kcell property.
(setq found (kproperty:previous-single-change (point) 'kcell))
(cond (found
(goto-char found))
((save-excursion
(goto-char (line-beginning-position))
(looking-at kview:outline-regexp))
;; kview:outline-regexp may produce false matches, so use this
;; only in cases where no 'kcell property is found in cells,
;; e.g. before in-memory representation is created.
(goto-char (- (match-end 0) 2)))
(t (error "(kcell-view:to-label-end): In cell at pos %d, can't find end of cell's label" (or pos (point)))))))
(defun kcell-view:absolute-reference (&optional pos)
"Return a klink to kcell at optional POS or point; return nil if not in a kcell.
The reference is a string of the form, \"<kcell-file, cell-ref>\"
where cell-ref is as described in the documentation for
`kcell:ref-to-id'. Kcell-file is an absolute path to the current
Koutline file."
(when (derived-mode-p 'kotl-mode)
(klink:set-yank-handler
(format "<%s, %s=%s>" (hypb:buffer-file-name)
(kcell-view:label pos) (kcell-view:idstamp pos)))))
(defun kcell-view:reference (&optional pos relative-dir)
"Return a klink to kcell at optional POS or point; return nil if not in a kcell.
The reference is a string of the form, \"<kcell-file, cell-ref>\"
where cell-ref is as described in the documentation for
`kcell:ref-to-id'. Kcell-file is made relative to optional
RELATIVE-DIR (or `default-directory' if RELATIVE-DIR is not given
or is nil), before it is returned."
(when (derived-mode-p 'kotl-mode)
(klink:set-yank-handler
(format "<%s, %s=%s>" (hpath:relative-to (hypb:buffer-file-name) relative-dir)
(kcell-view:label pos) (kcell-view:idstamp pos)))))
(defun kcell-view:remove-attr (attribute &optional pos)
"Remove ATTRIBUTE, if any, for cell and return the modified cell.
Cell is current or at optional POS."
(interactive "*SAttribute to remove: ")
(unless (eq attribute 'idstamp) ;; Can't remove idstamp
(let (mod-cell)
(save-excursion
(goto-char (or pos (kcell-view:plist-point)))
(setq mod-cell (kcell:remove-attr (kcell-view:cell) attribute))
(kproperty:add-properties (list 'kcell mod-cell))
(when (called-interactively-p 'interactive)
(message "Cell <%s> now has no %s attribute."
(kcell-view:label) attribute)))
mod-cell)))
(defun kcell-view:set-attr (attribute value &optional pos)
"Set ATTRIBUTE's VALUE for cell and return the modified cell.
Cell is current or at optional POS.
Use 0 for POS to set top cell's attributes."
(unless (and (eq pos 0) (eq attribute 'idstamp)) ;; top cell idstamp set when Koutline is created
(save-excursion
(goto-char (or pos (kcell-view:plist-point)))
(if (eq attribute 'idstamp)
(progn (kproperty:set attribute value)
(kcell-view:cell))
;; Returns kcell
(let ((mod-cell (kcell:set-attr (if (eq pos 0) (kview:top-cell kotl-kview) (kcell-view:cell))
attribute value)))
(kproperty:add-properties (list 'kcell mod-cell))
mod-cell)))))
(defun kcell-view:set-cell (kcell idstamp)
"Attach KCELL and IDSTAMP (an integer) properties to cell at point."
(save-excursion
(kcell-view:to-label-end)
(kproperty:add-properties
(list 'idstamp idstamp 'kcell kcell))))
(defun kcell-view:sibling-p (&optional pos visible-p lbl-sep-len)
"Return t if cell at optional POS or point has a successor.
With optional VISIBLE-P, consider only visible siblings."
(save-excursion
(when pos
(goto-char pos))
(kcell-view:forward visible-p lbl-sep-len)))
(defun kcell-view:start (&optional pos lbl-sep-len)
"Return start position of visible cell contents from optional POS or point."
(save-excursion
(+ (kcell-view:to-label-end pos)
(or lbl-sep-len (kview:label-separator-length kotl-kview)))))
(defun kcell-view:to-visible-label-end (&optional pos)
"Move point to end of the visible cell's label.
Cell is current or at optional POS. Point is set before the label separator.
If between kcells, move to the previous one. Return final point location."
(when pos
(goto-char pos))
;; Ensure point is within a visible part of the current cell, not
;; within some collapsed sub-cell.
(beginning-of-line)
(end-of-line)
(when (setq pos (kproperty:previous-single-change (point) 'kcell))
(goto-char pos))
;; Now move to end of label via embedded kcell property.
(goto-char (kproperty:previous-single-change (point) 'kcell)))
(defun kcell-view:visible-label (&optional pos)
"Return the first visible label string of cell preceding optional POS or point.
If labels are off, return cell's idstamp as a string."
(save-excursion
;; Next line ensures point is in the root of the current tree if
;; the tree is at all hidden.
(kotl-mode:beginning-of-line)
(kcell-view:label pos)))
;;;
;;; kview - one view per buffer, multiple views per kotl
;;;
(defun kview:add-cell (klabel level &optional contents prop-list no-fill sibling-p)
"Create a new cell with full KLABEL and add it at point at LEVEL within outline.
Optional cell CONTENTS and PROP-LIST may also be given, as well
as NO-FILL which skips filling of any CONTENTS. Return new cell.
This function does not renumber any other cells. 1 = first
level."
(let* ((idstamp (if (klabel:idstamp-p klabel)
(if (stringp klabel) (string-to-number klabel) klabel)
(kview:id-increment kotl-kview)))
(new-cell (kcell:create prop-list)))
(kcell-view:create kotl-kview new-cell contents level idstamp klabel no-fill sibling-p)
new-cell))
(defun kview:beginning-of-actual-line ()
"Go to the beginning of the current line whether collapsed or not."
(when (re-search-backward "[\n\r]" nil 'move)
(forward-char 1)))
(defun kview:buffer (kview)
"Return KVIEW's buffer or nil if argument is not a kview."
(when (kview:is-p kview)
(kview:get-attr kview 'view-buffer)))
;;;###autoload
(defun kview:char-invisible-p (&optional pos)
"Return t if the character after point is invisible/hidden, else nil."
(when (get-char-property (or pos (point)) 'invisible)
t))
(defun kview:create (buffer-name
&optional id-counter top-cell-attributes
label-type level-indent label-separator
label-min-width blank-lines levels-to-show lines-to-show)
"Return a new kview for BUFFER-NAME.
Optional ID-COUNTER is the maximum permanent id previously
utilized in this outline. Optional LABEL-TYPE, LEVEL-INDENT,
LABEL-SEPARATOR, LABEL-MIN-WIDTH, BLANK-LINES, LEVELS-TO-SHOW,
and LINES-TO-SHOW may also be given; otherwise, default values
are used.
See documentation of:
`kview:default-label-type' for LABEL-TYPE,
`kview:default-level-indent' for LEVEL-INDENT,
`kview:default-label-separator' for LABEL-SEPARATOR,
`kview:default-label-min-width' for LABEL-MIN-WIDTH,
`kview:default-blank-lines' for BLANK-LINES,
`kview:default-levels-to-show' for LEVELS-TO-SHOW,
`kview:default-lines-to-show' for LINES-TO-SHOW."
(let ((buf (get-buffer buffer-name)))
(cond ((null buf)
(error "(kview:create): No such buffer, `%s'" buffer-name))
((or (null id-counter) (= id-counter 0))
(setq id-counter 0))
((not (integerp id-counter))
(error "(kview:create): 2nd arg, `%s', must be an integer" id-counter)))
(set-buffer buf)
;; Don't recreate view if it exists.
(unless (and (boundp 'kotl-kview) (kview:is-p kotl-kview) (eq (kview:buffer kotl-kview) buf))
(make-local-variable 'kotl-kview)
;; Update cell count id-counter.
(setq top-cell-attributes (plist-put top-cell-attributes 'id-counter id-counter))
(setq kotl-kview
(list 'kview 'plist
(list 'view-buffer (current-buffer)
'top-cell
(kcell:create-top top-cell-attributes)
'label-type (or label-type kview:default-label-type)
'label-min-width (or label-min-width
kview:default-label-min-width)
'label-separator (or label-separator
kview:default-label-separator)
'label-separator-length
(length (or label-separator
kview:default-label-separator))
'level-indent (or level-indent
kview:default-level-indent)
'blank-lines
(or blank-lines kview:default-blank-lines)
'levels-to-show
(or levels-to-show kview:default-levels-to-show)
'lines-to-show
(or lines-to-show kview:default-lines-to-show))))
(kview:set-functions (or label-type kview:default-label-type)))
kotl-kview))
(defun kview:delete-region (start end)
"Delete cells between START and END points from current view."
(delete-region start end))
(defun kview:end-of-actual-line ()
"Go to the end of the current line whether collapsed or not."
(when (re-search-forward "[\n\r]" nil 'move)
(backward-char 1)))
(defun kview:fill-region (start end &optional kcell justify)
"Fill region between START and END within current view.
With optional KCELL, assume START and END delimit that cell's contents.
With optional JUSTIFY, justify region as well.
Fill-prefix must be a string of spaces the length of this cell's indent, when
this function is called."
(let ((opoint (set-marker (make-marker) (point)))
(lbl-sep-len (kview:label-separator-length kotl-kview))
(continue t)
prev-point)
(goto-char start)
(while continue
(if (kcell:get-attr (or kcell (kcell-view:cell)) 'no-fill)
(setq continue (kcell-view:next nil lbl-sep-len))
(fill-paragraph justify t)
(setq prev-point (point))
(forward-paragraph)
(re-search-forward "[^ \t\n\r]" nil t))
(setq continue (and continue
(/= (point) prev-point)
(< (point) (min end (point-max))))))
;; Return to original point.
(goto-char opoint)
(set-marker opoint nil)))
(defun kview:first-invisible-point (&optional pos)
"Return the first point that is followed by an invisible character.
Start from point or optional POS. If none are found, return the
end point of the cell contents.
Value may be the character immediately after point."
(unless pos
(setq pos (point)))
(let ((end (kcell-view:end-contents pos)))
(while (and pos (< pos end) (not (invisible-p pos)))
(if (kproperty:get pos 'invisible)
(setq pos (kproperty:next-single-change pos 'invisible nil end))
(let ((overlay (car (delq nil (mapcar (lambda (o) (when (overlay-get o 'invisible) o))
(overlays-at pos))))))
(setq pos (if overlay (overlay-end overlay) (1+ pos))))))
(or pos end)))
(defun kview:first-visible-point (&optional pos)
"Return the first point that is followed by a visible character.
Start from point or optional POS. If not found, return (point-max)."
(unless pos
(setq pos (point)))
(while (and pos (invisible-p pos))
(if (kproperty:get pos 'invisible)
(setq pos (kproperty:next-single-change pos 'invisible))
(let ((overlay (car (delq nil (mapcar (lambda (o) (when (overlay-get o 'invisible) o))
(overlays-at pos))))))
(setq pos (overlay-end overlay)))))
(or pos (point-max)))
(defun kview:get-cells-status (kview start end)
"In current buffer's KVIEW, return a coded list of status of each visible cell.
Return the list between START and END.
Status is returned as: 0 if all the lines of the cell are visible and
it has no hidden branches; a positive count of the lines displayed in
the cell if it has no hidden branches; otherwise, a negative count of
the lines displayed, since it has hidden branches."
;; Process only visible cells and note when one contains invisible
;; subcells, indicating its branches are hidden.
(kview:map-region
(lambda ()
(cond ((kcell-view:next-invisible-p (point) kview-label-sep-len)
;; Skip to end of this subtree
(prog1 (- (kcell-view:lines-visible))
(goto-char (kotl-mode:tree-end t))))
((kcell-view:collapsed-p (point) kview-label-sep-len)
(kcell-view:lines-visible))
(t 0)))
kview t start end))
(defun kview:goto-cell-id (idstamp-or-string)
"Move point to start of cell with permanent IDSTAMP-OR-STRING.
On success, return t, else nil."
(let* ((idstamp (if (integerp idstamp-or-string)
idstamp-or-string
(string-to-number idstamp-or-string)))
(pos (kproperty:position 'idstamp idstamp)))
(when pos
(goto-char pos)
(forward-char (kview:label-separator-length kotl-kview))
t)))
(defun kview:id-counter (kview)
"Return the highest current idstamp (an integer) used by KVIEW."
(kcell:get-attr (kview:get-attr kview 'top-cell) 'id-counter))
(defun kview:id-increment (kview)
"Return next idstamp (an integer) for KVIEW."
(let ((counter (1+ (kview:id-counter kview))))
(kcell:set-attr (kview:get-attr kview 'top-cell) 'id-counter counter)
counter))
(defun kview:idstamp-to-label (permanent-id)
"Return relative label for cell with PERMANENT-ID within current kview."
(save-excursion
(when (kotl-mode:goto-cell permanent-id)
(kcell-view:label))))
(defun kview:insert-contents (kcell contents no-fill cell-fill-prefix)
"Insert KCELL's CONTENTS into view at point and fill resulting paragraphs.
Do not fill if NO-FILL is non-nil.
CELL-FILL-PREFIX is the indentation string for the current cell. If
CONTENTS is nil, get contents from the cell at point. Return contents
inserted (this value may differ from the value passed in) due to
filling."
(let ((start (point))
end)
(setq contents (or contents ""))
(insert contents)
;;
;; Delete any extra newlines at end of cell contents.
(setq end (point))
(skip-chars-backward "\n\r")
(delete-region (point) end)
(setq end (point))
;;
(save-restriction
(if no-fill
;; Insert proper indent in all but the first line which has
;; already been indented.
(progn
(narrow-to-region start end)
(goto-char (point-min))
(while (re-search-forward "[\n\r]" nil t)
(insert cell-fill-prefix))
(goto-char (point-max)))
;;
;; Filling cell will insert proper indent on all lines.
(unless (equal contents "")
(goto-char start)
(beginning-of-line)
(narrow-to-region (point) end)
;; Add cell-fill-prefix to all but paragraph separator lines, so
;; filling is done properly.
(while (re-search-forward "[\n\r][^\n\r]" nil t)
(forward-char -1) (insert cell-fill-prefix))
(kview:fill-region start end kcell)
(goto-char (point-min))
;; Now add cell-fill-prefix to paragraph separator lines.
(while (re-search-forward "[\n\r][\n\r]" nil t)
(forward-char -1) (insert cell-fill-prefix))
;;
(goto-char (point-max))))))
contents)
(defun kview:is-p (object)
"Is OBJECT a kview?"
(when (listp object)
(eq (car object) 'kview)))
(defun kview:kotl (kview)
"Return KVIEW's kotl object or nil if argument is not a kview."
(when (kview:is-p kview)
(kview:get-attr kview 'kotl)))
(defun kview:label (klabel-function prev-label child-p)
"Return label string to display for current cell.
Label is computed from KLABEL-FUNCTION, PREV-LABEL and CHILD-P."
(funcall klabel-function prev-label child-p))
(defun kview:label-function (kview)
"Return function which will return display label for current cell in KVIEW.
Function signature is: (func prev-label &optional child-p), where prev-label
is the display label of the cell preceding the current one and child-p is
non-nil if cell is to be the child of the preceding cell."
(kview:get-attr kview 'label-function))
(defun kview:label-min-width (kview)
"Return KVIEW's label-min-width setting or nil if argument is not a kview.
See documentation for kview:default-label-min-width."
(when (kview:is-p kview)
(kview:get-attr kview 'label-min-width)))
(defun kview:label-separator (kview)
"Return KVIEW's label-separator setting or nil if argument is not a kview.
See documentation for kview:default-label-separator."
(when (kview:is-p kview)
(kview:get-attr kview 'label-separator)))
(defun kview:label-separator-length (kview)
"Return KVIEW's label-separator length or nil if argument is not a kview.
See documentation for kview:default-label-separator."
(kview:get-attr kview 'label-separator-length))
(defun kview:label-type (kview)
"Return KVIEW's label-type setting or nil if argument is not a kview.
See documentation for kview:default-label-type."
(when (kview:is-p kview)
(kview:get-attr kview 'label-type)))
(defun kview:level-indent (kview)
"Return KVIEW's per level-indent setting or nil if argument is not a kview.
See documentation for kview:default-level-indent."
(when (kview:is-p kview)
(kview:get-attr kview 'level-indent)))
(defun kview:map-branch (func kview &optional first-p visible-p)
"Apply FUNC to the sibling trees from point forward within KVIEW.
Return results as a list.
With optional FIRST-P non-nil, begins with first sibling in current branch.
With optional VISIBLE-P, considers only those sibling cells that are visible
in the view.
FUNC should take one argument, the kview local variable of the current
buffer or some other kview, and should operate upon the cell at point.
`Cell-indent' contains the indentation value of the first cell mapped when
FUNC is called so that it may test against this value. `lbl-sep-len'
contains the label separator length.
See also `kview:map-region', `kview:map-siblings' and `kview:map-tree'."
(with-current-buffer (kview:buffer kview)
(save-excursion
(let ((results)
(lbl-sep-len (kview:label-separator-length kview))
cell-indent)
(when first-p
;; Move back to first predecessor at same level.
(while (kcell-view:backward t lbl-sep-len)))
(setq cell-indent (kcell-view:indent nil lbl-sep-len))
;; Terminate when no further cells or when reach a cell at an equal
;; or higher level in the kotl than the first cell that we processed.
(while (and (setq results (cons (funcall func kview) results))
(kcell-view:next visible-p lbl-sep-len)
(>= (- (kcell-view:indent nil lbl-sep-len) cell-indent)
(kview:level-indent kview))))
(nreverse results)))))
(defun kview:map-cells (func kview cell-ref-list)
"Apply FUNC within KVIEW to each valid cell reference in CELL-REFERENCE-LIST.
Return a list of the results of calling FUNC, nil for each
invalid cell reference.
FUNC takes no arguments and operates on the cell at point."
(with-current-buffer (kview:buffer kview)
(save-excursion