forked from unzvfu/pariemacs
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsli-tools.el
2702 lines (2507 loc) · 126 KB
/
sli-tools.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
;; sli-tools.el --- structured languages indentation package
;; Copyright (C) 2000-2014 The PARI group.
;; This file is part of the PARIEMACS package.
;; PARIEMACS 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. It is distributed in the hope that it
;; will be useful, but WITHOUT ANY WARRANTY WHATSOEVER.
;; Check the License for details. You should have received a copy of
;; it, along with the package; see the file 'COPYING'. If not, write
;; to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;; sli-tools.el version 0.98
;; It works out some tools for indentation of structured programs.
;; It has been written for mupad.el and pari.el but should apply to
;; any other structured language like Pascal.
;; See sli-tools and sli-structures below.
;; The way it works inside:
;; sli-tell-indent is the main engine. They are two cases
;; either we want to indent the line the cursor is on,
;; or we want determine the indent of the next line.
;; See also sli-forward-sexp.
;; BASICS FROM SLI-STRUCTURES:
;; you should read the information concerning this variable,
;; but some basics are required to go further.
;; In the construct
;; if toto then tata
;; else
;; titi
;; end_if
;; "if" is called a HEAD or a head-key,
;; "else" is called a STRONG,
;; "end_if" is called an END.
;; Basically, the "else" is aligned on the "if" and the
;; "end_if" on previous "else"/"elif"/"if" if the HEREDITY applies.
;; HEREDITY applies unless otherwise specified.
;; The key "then" is called a SOFT-key: it implies special
;; indentation afterwards but is not aimed at being under
;; the "if".
;; Keys can also be termed
;; FIXED (usually global stuff),
;; BEACON (like "do" in a while-construct),
;; RELATION (math),
;; SEPARATOR,
;; CONSTRUCTOR,
;; SPECIAL-HEAD (initial declarators like "local", "var", "remember").
;; The same END can be used for several HEADs, a word can be
;; a HEAD and a SPECIAL-HEAD, but if so, its corresponding HEAD name
;; cannot be its own.
;; HEADs, RELATIONs, BEACONs, SEPARATORs, SOFTs, ENDs should all be different,
;; and SPECIAL-HEADs can only be also HEADs.
;; SOFTs, STRONGs or ENDs can be used in different constructs.
;; SYNTACTICALLY speaking, chars used in these strings should be word-constituents,
;; symbols, open-parenthesis, close-parenthesis or generic-parenthesis.
;; If sli-case-fold is t, upper/lowercase letters are irrelevant *but*
;; sli-structures and all should use lowercase letters.
;; INDENT OF THIS LINE:
;; we look if the first word on this line is a fixed/strong/end/soft
;; if yes --> fixed keys are easy
;; --> soft keys: find its ancestor (a strong or a head)
;; this ancestor is necessarily on another line,
;; so compute the indent required after this key.
;; --> strong/end keys: find its ancestor and align
;; our key on the ancestor (strong or head), with possible offset.
;; If the attribute is 'absolute, apply this indent.
;; Else, apply it except if this key belongs to sli-no-heredity-list,
;; in which case the alignment is on the head.
;;
;; if no --> use indentation of previous line
;; INDENT OF NEXT LINE:
;; see if previous line has an unclosed head/strong/soft.
;; if yes --> use its indentation.
;; if no --> use indentation of previous line.
;; SEE sli-tools for more info.
;; REGION scanned: the region scanned is extremely important for lengthy programms,
;; since no unclosed constructs may be found before the very beginning of the file.
;; So we provide the variable `sli-safe-place-regexp' which indicates where one
;; can start: after the end of the first grouping. For instance
;; "^\(\\\\--\)$" means that a line containing only "\\--" indicates a place
;; outside any construct. One can start after the string "--" or before the "\\".
;; COMMENTS: nothing much has been done for indenting comments just now.
;; Use of properties:
;; -- 'sli-type can be
;; 'head 'special-head 'strong 'soft 'end 'math-relation 'beacon
;; 'block-comment-start 'block-comment-end 'string
;; -- 'sli-ancestor if present is a buffer location:
;; for 'end it is point at beginning of opening 'head or an intermediate 'strong
;; for 'strong it is point at beginning of corresponding 'head
;; for 'special-head it is point at beginning of previous 'special-head or 'head
;; for 'block-comment-end it is point at beginning of corresponding 'block-comment-start
;; -- 'sli-reverse-ancestor if present is a buffer location:
;; for 'head it is point at beginning of closing 'end *Not Always Present*
;; for 'strong it is point at beginning of next 'strong or 'end *Not Always Present*
;; for 'special-head it is point at beginning of closing separator *Not Always Present*
;; for 'block-comment-start it is point at beginning of corresponding 'block-comment-end
;; -- 'sli-time if present is an integer representing the time when
;; the sli-properties were last set.
;; These properties are lazily computed: everytime we can deduce such a property,
;; we do it, but we do not go out of our way to do so. So the absence of a property
;; only means it has not been computed, and *not* it doesn't exist.
;; Maintainer: Olivier Ramare <ramare AT math.univ-lille1.fr>
;; BUGS:
;; (1) If I remember well, strings spreading over several lines may
;; raise some troubles.
;; (2) sli-tutor has some troubles if used in the middle of already
;; complete structures.
;; (3) Due to lazy computations of text properties, sli-show-sexp may
;; show wrong things. Wait a bit and things will become ok.
;; See `sli-prop-do-not-recompute-time'.
;; Use of sli-special-head-heads-alist ??
(provide 'sli-tools)
;;------------------------------------------------------
;; Variables that defines how indentation should occur.
;; See mupad.el for an example.
;;------------------------------------------------------
;; We use "" and \" for strings.
(eval-and-compile
(require 'backquote)) ; This file is used in macros.
(defgroup sli nil
"sli customization group"
:group 'editing :prefix "sli-")
(defcustom sli-handles-sexp nil "A true value advises forward/backward/scan-sexp/s"
:type 'boolean :group 'sli)
;; These values are modified in sli-tools:
(defvar sli-verbose nil "A true value gives (debugging) infos")
(defvar sli-prop-verbose nil "A true value gives (debugging) infos on text properties")
(eval-and-compile
;; The next variables are here to pacify the compiler !
;; Do *not* assign any value to them or they may override ....
(defvar block-comment-end)
(defvar block-comment-start))
(defvar sli-structures nil
"List of lists. Each item is a vector or a list which we call a STRUCTURE
in this explanation. There are several kind of structures :
([HEAD-STRING head INDENT-HEAD]
[SOFT-STRING1 soft INDENT-SOFT1]
([STRONG-STRING1 strong INDENT-STRONG1]
[SOFT-STRING2 soft INDENT-SOFT2])
([STRONG-STRING2 strong INDENT-STRONG2])
[END-STRING end])
is the usual structure, like in 'if/then/(elif/then)/(else)/end_if'. Between
the 'head' and the 'soft', INDENT-HEAD is used on subsequent lines to offset the
new line with respect to the beginning of HEAD-STRING. When the 'soft' is found,
INDENT-SOFT1 is used still with respect to the 'head'. The next part is
optional. The STRONG-STRING is aligned on its 'head' and INDENT-STRONG is used
after that, with respect to the STRONG-STRING. Finally the END-STRING is aligned
on the previous STRONG-STRING (the 'heredity principle'). If you want to change
this alignement, use `sli-shift-alist' below. Note that an INDENT-* value can
be either an integer or a cons pair whose first element is the symbol 'absolute
and the second one is an integer: it means that the indentation is not relative
but absolute with respect to the left margin. It applies also to the next
strong/end key. In this construct, you can also use [SPECIAL-HEAD-STRING
special-head INDENT-SPECIAL-HEAD SEPARATORS]. This key is closed by SEPARATORS
which is either a separator which belongs to `sli-separators' or a list of
separators all in `sli-separators' in which case the first one is the one used
by sli-maid. No other construct should happen between the special-head and its
separator except comments and keys termed CONSTRUCTORs; for instance the
'proc/(option)/begin/end_proc' construct of MuPAD is
a head/special-head/strong/end. You can use several [END-STRING end]. The first
one is going to be used by the maid. Furthermore you can use the same END-STR
for several constructs. It then applies to the first 'head' that appears
(going backward). Concerning SPECIAL-HEAD, the syntax could make believe that
a string could be used after a HEAD with some separators and after another one
with some other separators: in fact they are merge internally so the union
of all appearing separators for this SPECIAL-HEAD is being used.
([BEACON-STRING beacon INDENT-BEACON]) specifies a special string that can be
found between a 'head' or a 'strong' and its corresponding 'soft'. The typical
example being 'for t from 1 to 2 do' and has pattern
'head/beacon/beacon/soft'. If a newline is asked after the 'from' but before the
'to', indentation is done with respect to the beginning of 'from' and
INDENT-BEACON is added except if this newline is asked just after the beacon
key, in which case indentation is done like from before the beacon but
'math-relation's are ignored. Simply because 'math-relation' are supposedly
closed by the appearance of a beacon, whether a separator has occured or not.
([RELATION-STRING math-relation INDENT-RELATION]) specifies a mathematical type
of relation (like '='). Such operators acts either as beacons (example 'while
t=3D55 do' with pattern 'strong/math-relation/soft') or else are closed by
someone in `sli-separators'. They may contain further structures in between like
in 'foo = if ok then gonethrough=t ; 3 else 5 end_if'. INDENT-RELATION is used
before the appearance of the proper separator.
HEAD-STRINGs, MATH-RELATION-STRINGs, BEACON-STRINGs, SEPARATORs should all be
different, except one case for HEAD-STRINGs indicated below. SOFT-STRINGs and
STRONG-STRINGs are different from any of the above, but a same soft or strong
key can be used in different constructs. Usual examples are 'then' and 'do' and
the 'elif' in 'if/elif/end_if' and '%if/elif/end_if'. But because of the way
things are, the corresponding INDENT should be the same throughout. Note that
longest match is always taken, so that if 'while(' is a head (like in gp) and
'(' is also a head (almost everywhere), indentation after 'while(' is the one it
should. Same applies for the two constructs '%if' and 'if' in mupad.
Concerning HEAD-STRINGs, all starting heads are to be distincts, but inside a
construct, an existing head can be used as a special head. The typical case in
MuPAD is 'category' which is normally a head but can be used like a special head
inside a 'domain' statement.
CONSTRUCTORs are treated in a special way and keys declared as head or end
or whatever can also be termed constructor. Usual example: ( is a head and
is also declared as a constructor.
Cdr's are to be evaled.
If downcase/uppercase is relevant is controled by the variable `sli-case-fold'.
If sli-case-fold is t, sli-structures should use lowercase letters.
Technical note: the first element of this list *has to* contain a 'head'. ")
(defvar sli-case-fold nil
"The strings used as separators, relations, and all. Not yet used.
If set to t, all keywords in sli-stryctures, sli-shift-alist ...
should be in lowercase.")
(defvar sli-escape-key-string ""
"The strings used as separators, relations, and all. Not yet used.")
(defvar sli-shift-alist nil
"Usual 'strong/end' are aligned on the previous
occurence of a corresponding head/strong.
You can add an offset between two keys.
This is also valid in case of an absolute indent.
Elements of this list have format ([key1 key2] . offset).
Cdr's are to be evaled.")
(defvar sli-no-heredity-list nil
"Usual 'strong/end' are aligned on the previous
occurence of a corresponding head/strong except
if mentionned in this list.
Elements of this list have format [head-key key].")
(defvar sli-separators nil "Do not forget `sli-is-a-separatorp'.")
(defvar sli-is-a-separatorp-fn 'sli-is-a-separatorp-default
"Function called to decide if character after POINT
is a separator. This function takes an optional argument
which is the value of POINT and should be surrounded by
save-excursion and save-match-data, see `sli-is-a-separatorp-default'.")
(defun sli-is-a-separatorp-default (&optional pt)
(save-excursion
(when pt (goto-char pt))
(save-match-data
(if sli-separators
(let ((case-fold-search sli-case-fold))
(looking-at (regexp-opt sli-separators)))
nil))))
(defun sli-is-a-separatorp (&optional pt)
(funcall sli-is-a-separatorp-fn pt))
(defvar sli-put-newline-fn 'sli-put-newline-default
"Function used to insert a newline. Takes no argument.")
(defun sli-put-newline-default nil (insert-char ?\n 1))
(defun sli-put-newline nil
"Indirection. Puts a newline according to `sli-put-newline-fn'
and takes care not to write anything on read-only parts."
(unless (get-text-property (point) 'read-only)
(funcall sli-put-newline-fn)))
(defvar sli-safe-place-regexp "^\\(//--+\\|/\\*-+-\\*/\\)$"
"Marker used to tell emacs this point is outside a commented area, a string or a sexp. The safe place starts at beginning of match-group 1 and ends at end of match-group 1.")
(defvar sli-fixed-keys-alist '()
"Some keys should be placed at a fixed place with respect to the
indentation of previous line when following a RELATION sign. See
`sli-relation-keys'. This is the corresponding alist.
List of (STRING . INDENTATION).")
(defvar sli-keys-with-newline nil
"When `sli-maid' tries to further your constructs, some keys should be
followed by a newline before completion is added.")
(defvar sli-keys-without-newline nil
"When `sli-maid' tries to further your constructs, some keys should never be
followed by a newline.")
(defvar sli-maid-correction-alist nil "See `sli-maid'")
(defvar sli-add-to-key-alist nil "See `sli-maid'.")
(defvar sli-more-maidp t "See `sli-maid'.")
(defvar sli-tab-always-indent t "See `sli-electric-tab'.")
(defvar sli-comment-starts '()
"A list of possible starters of one-line comments.
That is to say an extension of `comment-start' in this special case.")
(defvar sli-block-comment-middle-offset -1
"Indentation of block comments: they start with block-comment-start and then
either some whitespace and a word on the same line, on which case next lines
are aligned on this first word. Or the text starts on next line in which case
they start at column-of-end-of-block-comment-start + this-offset.
Exception for the last line if it contains only one word ending with
'block-comment-end in which case this word is where placed at
column-of-end-of-block-comment-start+sli-block-comment-end-offset spaces
from the margin.")
(defvar sli-block-comment-end-offset -1
"See `sli-block-comment-middle-offset'.")
;;;--------------------------------------------------------------------------
;;; Inner variables
;;;--------------------------------------------------------------------------
(defvar sli-head-keys nil)
(defvar sli-special-head-keys nil)
(defvar sli-soft-keys nil)
(defvar sli-beacon-keys nil)
(defvar sli-math-relation-keys nil)
(defvar sli-relation-keys nil)
(defvar sli-constructor-keys nil)
(defvar sli-keys-nomrelations nil) ; nomrelations means no-math-relations
(defvar sli-strong-keys nil)
(defvar sli-end-keys nil)
(defvar sli-keys nil)
(defvar sli-max-keys-length 0
"An integer: the maximum length of a keyword in sli-structures.
Used in `sli-anchored-posix-search-backward', a fix for `posix-search-backward'. ")
(defvar sli-all-keys-nomrelations-noseparators-regexp nil)
(defvar sli-all-keys-regexp nil) ; including string quotes and all kind of comments.
(defvar sli-all-end-strong-regexp nil)
(defvar sli-fixed-regexp nil)
(defvar sli-head-regexp nil)
(defvar sli-strong-regexp nil)
(defvar sli-all-keys-and-constructors-regexp nil)
(defvar sli-head-end-alist nil "The alist ((end . head) ...).")
(defvar sli-ends-head-alist nil "The alist ((head . (end1 end2 ...) ...).")
(defvar sli-heads-strong-alist nil "The alist ((strong . (head1 head2 ...)) ...).")
(defvar sli-special-head-alist nil "The alist ((special-head . (separator1 separator2 ...)) ...).")
(defvar sli-special-head-heads-alist nil
"The alist ((special-head . heads) ...) for those special heads that are also heads.")
(defvar sli-special-head-previous-keys-alist nil
"The alist ((special-head . keys) ...) for special-heads that can be heads.
keys are the keys that can be before special-head.")
(defvar sli-companion-strong-keys-alist nil
"The alist ((strong/head . (strongs that could be after)) ...).
The car should be a member of the cdr if the car is a strong.")
(defvar sli-soft-alist nil
"The alist ((ambiguous-soft . (head-or-strong1 head-or-strong2 ...)) ...).")
(defvar sli-soft-head-or-strong-alist nil "The alist ((head-or-strong . soft) ...)")
(defvar sli-first-offset-alist nil) ; to apply before the soft
; it applies to head/strong keys that are followed by a soft with no
; head or strong in between. Morally speaking this soft "closes" the head/strong.
(defvar sli-relevant-alist nil
"An alist. Put all head/strong/end's in one bundle. say two keys are linked if
they occur in a same constructs. Close this relation transitively.
this is the alist ((key . (keys in the same class)) ...).")
(defvar sli-ancestors-alist nil
"The alist ((end/strong-key . (head/strong1 head/strong2 ...)) ...)
of keys that can occur before the first key.")
(defvar sli-second-offset-alist nil "Alist (key . offset) where
OFFSET is the one to apply after the soft key if it exist, after
KEY if it doesn't have any soft. KEY can be a head/end/strong/soft.") ; to apply after the soft
(defvar sli-special-head-offset-alist nil "Alist (special-head . offset).")
(defvar sli-relation-offset-alist nil)
(defvar sli-maid-alist nil)
(defvar sli-ambiguous-keys nil
"List of keys that may ask for a different following key according
to context. They *should be* soft or strong keys.")
;; Only to shut up compiler. These two variables should be defined when the
;; correct buffer is set ! Used by sli-show-sexp.
(defvar sli-overlay-beg nil "overlay set by `sli-show-sexp' and showing the head key.")
(defvar sli-overlay-end nil "overlay set by `sli-show-sexp' and showing the end key.")
(defvar sli-prop-do-not-recompute-time 10
"Time span in milliseconds under which it is not necessary to recompute
text properties alloted by sli-tools.")
(defvar sli-prop-used 0
"Number of times text-properties have been used.")
(defvar sli-key-is-a-special-headp nil
"Set by `sli-get-corresponding-key' and `sli-get-first-non-end-key'.")
(mapc 'make-variable-buffer-local
'(sli-verbose sli-prop-verbose sli-handles-sexp sli-overlay-beg sli-overlay-end
sli-prop-do-not-recompute-time sli-structures sli-shift-alist sli-separators
sli-is-a-separatorp-fn sli-more-maidp sli-add-to-key-alist
sli-math-relation-keys sli-max-keys-length sli-no-heredity-list sli-head-keys
sli-special-head-keys sli-soft-keys sli-beacon-keys sli-relation-keys
sli-keys-nomrelations sli-strong-keys sli-end-keys sli-keys sli-prop-used
sli-all-keys-nomrelations-noseparators-regexp sli-all-keys-regexp sli-all-end-strong-regexp
sli-soft-head-or-strong-alist sli-head-end-alist sli-heads-strong-alist
sli-special-head-alist sli-special-head-heads-alist
sli-special-head-previous-keys-alist sli-ends-head-alist sli-head-regexp
sli-strong-regexp sli-relevant-alist sli-ancestors-alist sli-fixed-keys-alist
sli-fixed-regexp sli-companion-strong-keys-alist sli-soft-alist
sli-first-offset-alist sli-second-offset-alist sli-relation-offset-alist
sli-maid-alist sli-ambiguous-keys sli-constructor-keys sli-all-keys-and-constructors-regexp
sli-block-comment-middle-offset sli-block-comment-end-offset sli-key-is-a-special-headp
sli-special-head-offset-alist))
;;;-----------------------------------------------------------------------------
;;; This section is devoted to some precomputations from sli-structures.
;;; Lots of work is done several time, but I prefer this modularity
;;; since it is easier to modify.
;;;-----------------------------------------------------------------------------
(defun sli-split-list (lst)
(let ((wordother '()) (otherword '()) (wordword '()) (otherother '()) ls)
(mapc
(lambda (wd)
(setq ls (string-to-list wd))
(cond
((and (= (char-syntax (car ls)) ?w) (= (char-syntax (car (last ls))) ?w))
(add-to-list 'wordword wd))
((= (char-syntax (car ls)) ?w)
(add-to-list 'wordother wd))
((= (char-syntax (car (last ls))) ?w)
(add-to-list 'otherword wd))
(t (add-to-list 'otherother wd))))
lst)
(list wordword wordother otherword otherother)))
(defun sli-regexp-opt (lst)
(let ((qlst (sli-split-list lst)))
(if (null (elt qlst 0))
(if (null (elt qlst 1))
(if (null (elt qlst 2))
(if (null (elt qlst 3))
"\\<\\>"
(regexp-opt (elt qlst 3) t)) ; grouping required for posix
(concat
(regexp-opt (elt qlst 2) t) "\\>"
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))))
(concat
"\\<" (regexp-opt (elt qlst 1) t)
(if (null (elt qlst 2))
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))
(concat
"\\|" (regexp-opt (elt qlst 2) t) "\\>"
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))))))
(concat
"\\<" (regexp-opt (elt qlst 0) t) "\\>"
(if (null (elt qlst 1))
(if (null (elt qlst 2))
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))
(concat
"\\|" (regexp-opt (elt qlst 2) t) "\\>"
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))))
(concat
"\\|\\<" (regexp-opt (elt qlst 1) t)
(if (null (elt qlst 2))
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))
(concat
"\\|" (regexp-opt (elt qlst 2) t) "\\>"
(if (null (elt qlst 3))
""
(concat "\\|" (regexp-opt (elt qlst 3) t)))))))))))
(defun sli-flatten (ls)
(let ((res '()))
(mapc
(lambda (ph)
(cond
((listp ph) (setq res (append res (sli-flatten ph))))
(t (setq res (append res (list ph))))))
ls)
res))
(defun sli-scan-structures-locally (stru symbol)
(let ((res '()))
(mapc (lambda (ph)
(setq res
(append res
(cond
((listp ph) (sli-scan-structures-locally ph symbol))
((equal (elt ph 1) symbol) (list (elt ph 0)))
(t '())))))
stru)
res))
(defun sli-compact-list (lst)
; remove same consecutive occurences.
(let* ((old (car lst)) (nlst (list old)) (lst (cdr lst)))
(while lst
(if (equal (car lst) old)
(setq lst (cdr lst))
(setq nlst (cons (setq old (car lst)) nlst) lst (cdr lst))))
(nreverse nlst)))
(defun sli-scan-structures (symbol)
(let ((res '()))
(mapc
(lambda (st)
(when (equal (elt st 1) symbol)
(add-to-list 'res (elt st 0))))
(sli-flatten sli-structures))
res))
(defun sli-get-ends-head-alist nil
(let ((res '()) all-ends) ; forme la liste (head-key . (end1 end2 ...))
(mapc
(lambda (ph)
(when (equal (elt (elt ph 0) 1) 'head)
(setq all-ends '())
(mapc
(lambda (s)
(when (and (vectorp s) (equal (elt s 1) 'end))
(setq all-ends (append all-ends (list (elt s 0))))))
ph)
(add-to-list 'res (cons (elt (elt ph 0) 0) all-ends))))
sli-structures)
res))
(defun sli-get-head-end-alist nil
(let ((res '()) all-heads) ; forme la liste (end-key . (head1 head2 ...))
(mapc
(lambda (end)
(setq all-heads '())
(mapc
(lambda (s)
(if (member end (cdr s))
(add-to-list 'all-heads (car s))))
sli-ends-head-alist)
(add-to-list 'res (cons end all-heads)))
sli-end-keys)
res))
(defun sli-get-strong (ph)
(let ((res '()))
(mapc
(lambda (st)
(when (equal (elt st 1) 'strong)
(add-to-list 'res (elt st 0))))
ph)
res))
(defun sli-get-heads-strong-alist nil
(let ((res '()) (aux '()) possible-heads) ; forme la liste des (strong-key . (head-key1 head-key2 ...))
; Peut-etre plusieurs strong pour chaque head.
(mapc
(lambda (ph)
(if (equal (elt (elt ph 0) 1) 'head)
(let ((strongs (sli-get-strong (sli-flatten ph))))
(unless (null strongs)
(mapc (lambda (st)
(setq aux (add-to-list 'aux
(cons st (elt (elt ph 0) 0)))))
strongs)))))
sli-structures)
; Une strong peut etre liee a plusieurs heads. Il faut les reunir:
(mapc
(lambda (strong)
(setq possible-heads '())
(mapc
(lambda (ajoint)
(when (equal (car ajoint) strong)
(setq possible-heads (append possible-heads (list (cdr ajoint))))))
aux)
(when (> (length possible-heads) 1)
(add-to-list 'sli-ambiguous-keys strong))
(setq res (append res (list (cons strong possible-heads)))))
(sli-compact-list (sort (mapcar 'car aux) 'string-lessp)))
res))
(defun sli-get-soft-alist nil ; forme la liste (soft . (head of strong using it))
(let ((resaux '()) loc (res '()) astrong-list (asoft-list '()))
(mapc
(lambda (ph)
(setq astrong-list '())
(mapc
(lambda (ve)
(cond
((equal (elt ve 1) 'soft) (unless (null astrong-list)
(add-to-list 'resaux (cons (elt ve 0) astrong-list))
(add-to-list 'asoft-list (elt ve 0))))
((member (elt ve 1) '(strong head)) (setq astrong-list (list (elt ve 0))))))
(sli-flatten ph)))
sli-structures)
;; now gather identical soft:
(mapc
(lambda (asoft)
(setq loc '())
(mapc
(lambda (dd)
(when (string-equal asoft (car dd))
(setq loc (append loc (cdr dd)))))
resaux)
(add-to-list 'res (cons asoft (sli-compact-list (sort loc 'string-lessp)))))
asoft-list)
res
))
(defun sli-common-pointp (l1 l2)
"t if l1 and l2 have a common element. Test is done through member."
(let ((ok nil))
(mapc (lambda (c) (setq ok (or ok (member c l1)))) l2)
ok))
(defun sli-get-companion-alist nil ; case ?? It was not there.
(let ((res '()))
; on prend les car de sli-heads-strong-alist on leur
; associe la liste des car qui ont au moins une tete en commun :
(mapc
(lambda (co)
(let ((end (cdr co)) (companions '()))
(mapc
(lambda (coo)
(when (sli-common-pointp (cdr coo) end)
(setq companions (add-to-list 'companions (car coo)))))
sli-heads-strong-alist)
(setq res (append res (list (cons (car co) companions))))))
sli-heads-strong-alist)
; on prend les cdr de sli-heads-strong-alist on leur
; associe la liste des car possibles :
(mapc
(lambda (head)
(let ((companions '()))
(mapc
(lambda (coo)
(when (member head (cdr coo))
(setq companions (add-to-list 'companions (car coo)))))
sli-heads-strong-alist)
(setq res (add-to-list 'res (cons head companions)))))
(sli-compact-list (sort (sli-flatten (mapcar 'cdr sli-heads-strong-alist)) 'string-lessp)))
res))
(defun sli-get-soft-head-or-strong-alist nil
(let ((res '()) asoft astrong-list)
(mapc
(lambda (ass)
(setq asoft (car ass))
(setq res (append res (mapcar (lambda (st) (cons st asoft)) (cdr ass)))))
sli-soft-alist)
res))
(defun sli-equivalence-classes-local (lst)
(cond
((null lst) lst)
(t (let (lstbis (done nil) (l1 (car lst)))
(setq lstbis
(mapcar
(lambda (c)
(if (sli-common-pointp l1 c)
(progn
(setq done t)
(sli-compact-list (sort (append l1 c) 'string-lessp)))
c))
(sli-equivalence-classes-local (cdr lst))))
(unless done
(setq lstbis (append lstbis (list l1))))
lstbis))))
(defun sli-equivalence-classes (lst)
(while (> (length lst) (length (setq lst (sli-equivalence-classes-local lst)))))
lst)
(defun sli-get-relevant-alist nil
(let (key-lst (res '()))
;; relevant keys are head/strong or end keys.
(mapc
(lambda (class)
(mapc
(lambda (el)
(add-to-list 'res (cons el class)))
class))
(sli-equivalence-classes
(delq nil ; nil had better not be the first one ...
(mapcar
(lambda (ph)
(setq key-lst '())
(mapc
(lambda (co)
(when (member (elt co 1) '(head strong end))
(add-to-list 'key-lst (elt co 0))))
ph)
key-lst)
(mapc 'sli-flatten sli-structures)))))
res))
(defun sli-get-ancestors-alist nil
(append
;; Ancestors for end-keys:
(mapcar
(lambda (end)
(cons end
(sli-flatten
(mapcar
(lambda (head)
(or (assoc head sli-companion-strong-keys-alist) ; works only if a strong is present
(cdr (assoc end sli-head-end-alist))))
(cdr (assoc end sli-head-end-alist))))))
sli-end-keys)
;; Ancestors for strong-keys:
(mapcar
(lambda (strong)
(cons strong
(append (cdr (assoc strong sli-heads-strong-alist))
;; The next one is bad: for "begin" it associates "begin" which
;; can not be an anscestor ...
(cdr (assoc strong sli-companion-strong-keys-alist)))))
sli-strong-keys)))
(defun sli-get-first-offset-alist nil
(let ((res '()) last-head-or-strong stru pl)
(mapc
(lambda (ph)
(setq last-head-or-strong nil stru (sli-flatten ph))
(while (not (null stru))
(setq pl (car stru))
(cond
((member (elt pl 1) '(head strong)) (setq last-head-or-strong pl))
((equal (elt pl 1) 'soft)
(when last-head-or-strong
(setq res (append res (list (cons (elt last-head-or-strong 0)
(elt last-head-or-strong 2))))
last-head-or-strong nil))))
(setq stru (cdr stru))))
sli-structures)
res))
(defun sli-get-second-offset-alist nil
(let ((res '()) last-cand stru pl)
(mapc
(lambda (ph)
(setq last-cand nil stru (sli-flatten ph))
(while (not (null stru))
(setq pl (car stru))
(cond
((equal (elt pl 1) 'head)
(setq last-cand pl))
((and (member (elt pl 1) '(end strong))
(not (assoc (elt pl 0) sli-special-head-heads-alist))) ;; ???
(when last-cand ;; no soft after last-cand.
(setq res (append res (list (cons (elt last-cand 0)
(elt last-cand 2))))))
(if (equal (elt pl 1) 'end)
(setq last-cand nil)
(setq last-cand pl)))
((equal (elt pl 1) 'soft)
(when last-cand ;; last-cand is followed by a soft
(setq res (append res (list (cons (elt last-cand 0)
(elt pl 2))))
last-cand nil))))
(setq stru (cdr stru))))
sli-structures)
res))
(defun sli-get-relation-offset-alist nil
(let ((res '()))
(mapc
(lambda (ph)
(mapc
(lambda (pl)
(cond
((member (elt pl 1) '(math-relation beacon))
(add-to-list 'res (cons (elt pl 0) (elt pl 2))))))
ph))
(mapcar 'sli-flatten sli-structures))
res))
(defun sli-get-special-head-offset-alist nil
(let ((res '()))
(mapc
(lambda (ph)
(mapc
(lambda (pl)
(cond
((member (elt pl 1) '(special-head))
(add-to-list 'res (cons (elt pl 0) (elt pl 2))))))
ph))
(mapcar 'sli-flatten sli-structures))
res))
(defun sli-get-maid-alist-locally (ph lst)
(let ((res '()) aux resaux (nlst '()))
(cond
((null ph))
((listp (car ph))
(setq ; process the internal with no 'lst' since it is optional:
aux (sli-get-maid-alist-locally (car ph) '())
; Then process the remainder with both candidates 'lst' and (cadr aux):
resaux (sli-get-maid-alist-locally (cdr ph) (append (cadr aux) lst))
; glue things together:
res (list (append aux (car resaux)) (cadr resaux))))
(t (setq aux (elt (car ph) 0) ; the new 'last-word (lst=(last-word))
ph (cdr ph))
; Link 'lst' to the new compulsory:
(mapc (lambda (s) (add-to-list 'res (cons s aux))) lst)
(while (and (not (null ph)) (listp (car ph)))
; (car ph) is an optional construct. Scan it with no 'lst'
(setq resaux (sli-get-maid-alist-locally (car ph) '())
; gather all 'last-words':
nlst (append nlst (cadr resaux))
; gather all bindings :
res (append res (car resaux))
ph (cdr ph)))
(when (car ph) ; aux is linked to the new guy:
(add-to-list 'res (cons aux (elt (car ph) 0)))
; the new guy is linked with all the 'last-words':
(mapc(lambda (s) (add-to-list 'res (cons s (elt (car ph) 0)))) nlst))
; process things farther:
(setq resaux (sli-get-maid-alist-locally ph '())
res (list (append (car resaux) res)
(if (null (cadr resaux)) (append (list aux) nlst)
(cadr resaux))))))
res))
(defun sli-full-stuff (key alist fn1 fn2)
(let ((res '()) aux)
(while alist
(when (setq aux (funcall fn1 (funcall fn2 key alist)))
(add-to-list 'res aux))
(setq alist (cdr alist)))
res))
(defun sli-full-assoc (key alist)
"The list of cdrs in alist whose car is key."
(sli-full-stuff key alist 'cdr 'assoc))
(defun sli-full-rassoc (key alist)
"The list of cars in alist whose cdr is key."
(sli-full-stuff key alist 'car 'rassoc))
(defun sli-get-automatic-maid-alist nil
;; sli-ambiguous-keys is also created here.
;(setq sli-ambiguous-keys nil)
(let ((res '()))
(mapc
(lambda (ph)
(setq res (append res (car (sli-get-maid-alist-locally ph '())))))
sli-structures) ;(princ "\n") (princ (list "sli-get-automatic-maid-alist" res))
(add-to-list 'res (cons block-comment-start block-comment-end))
; well, soft keys may correspond to different strong keys...
(mapcar (lambda (co) (let ((to (sli-full-assoc co res)))
(cons co (if (null (cdr to)) (car to)
(progn
(add-to-list 'sli-ambiguous-keys co) to)))))
(sli-compact-list (sort (mapcar 'car res) 'string-lessp)))))
(defun sli-get-maid-alist nil
;; First, create the list automatically:
(setq sli-maid-alist (sli-get-automatic-maid-alist))
;(princ "\n") (princ (list "sli-get-maid-alist" sli-maid-alist))
;; But now users may want something else. A typical example is
;; for-from-do-end_for where the proposed completion of "for"
;; is "do" because "from" is only a beacon.
;; Correction is done is two steps: first the elements who have
;; a car is sli-maid-correction-alist are removed from
;; from sli-maid-alist and then sli-maid-correction-alist
;; is added.
(let ((new-lst '()) (correction-words (mapcar 'car sli-maid-correction-alist)))
(while sli-maid-alist ;(princ "\n") (car sli-maid-alist)
(unless (member (caar sli-maid-alist) correction-words)
(setq new-lst (append new-lst (list (car sli-maid-alist)))))
(setq sli-maid-alist (cdr sli-maid-alist)))
(append new-lst sli-maid-correction-alist)))
(defun sli-get-special-head-alist nil
(let ((res '()) aux)
(mapc
(lambda (ph)
(if (equal (elt ph 1) 'special-head)
(progn
(if (setq aux (assoc (elt ph 0) res))
;; This special-head has already been used, but maybe with
;; different separators. Merge everything ... Sorry !
(progn
(setq res (delq aux res));(print res)
(setq aux (cdr aux))
(mapc (lambda (wd) (add-to-list 'aux wd))
(if (listp (elt ph 3)) (elt ph 3)(list (elt ph 3))))
(add-to-list 'res (cons (elt ph 0) aux)))
(add-to-list 'res (cons (elt ph 0)
(if (listp (elt ph 3))
(elt ph 3)
(list (elt ph 3)))))))))
(sli-flatten sli-structures))
res))
(defun sli-agglomerate (lst)
"LST is a list of list (beg end).
If beg1 = beg2= ... = begN, we answer (beg1 end1 end2 ... endN)."
(let ((res '()) beg (listend '()))
(mapc
(lambda (ph)
(unless (assoc (setq beg (elt ph 0)) res) ;; already done
(setq listend '())
(mapc
(lambda (nph)
(when (equal (elt nph 0) beg)
(add-to-list 'listend (elt nph 1))))
lst)
(setq res (append res (list (append (list beg) listend))))))
lst)
res))
(defun sli-get-special-head-head-alist nil
(let ((res '()) previous-head (previous-keys '()))
(mapc
(lambda (ph)
(cond
((equal (elt ph 1) 'head)
(setq previous-head (list (elt ph 0)) previous-keys (list (elt ph 0))))
((and (equal (elt ph 1) 'special-head) (member (elt ph 0) sli-head-keys))
(add-to-list 'res (cons (elt ph 0) previous-head)); (print (list (elt ph 0) previous-keys))
(add-to-list 'sli-special-head-previous-keys-alist (cons (elt ph 0) previous-keys)))
(t (add-to-list 'previous-keys (elt ph 0)))))
(sli-flatten sli-structures))
;; Some work for sli-special-head-previous-keys-alist and res:
;; some special-head are linked to different things.
(setq sli-special-head-previous-keys-alist (sli-agglomerate sli-special-head-previous-keys-alist))
(sli-agglomerate res)))
(defun sli-get-max-keys-length (lst)
(let ((res 0))
(mapc (lambda (to) (setq res (max res to)))
(mapcar 'length lst))
res))
(defun sli-precomputations nil
;; variables:
;(princ "\nPrecomputations: variables")
(setq sli-head-keys (sli-scan-structures 'head)
sli-special-head-keys (sli-scan-structures 'special-head)
sli-soft-keys (sli-scan-structures 'soft)
sli-beacon-keys (sli-scan-structures 'beacon)
sli-math-relation-keys (sli-scan-structures 'math-relation)
sli-relation-keys (append sli-beacon-keys sli-math-relation-keys)
sli-strong-keys (sli-scan-structures 'strong)
sli-end-keys (sli-scan-structures 'end)
sli-constructor-keys (sli-scan-structures 'constructor)
sli-keys-nomrelations (append sli-head-keys sli-soft-keys sli-strong-keys sli-beacon-keys
sli-special-head-keys ;; momentanous !!
sli-end-keys)
sli-keys (append sli-keys-nomrelations sli-relation-keys)
sli-max-keys-length (sli-get-max-keys-length sli-keys))
;(princ "...done.\n")
;;regexps:
;(princ "\nPrecomputations: regexps")
(setq sli-all-end-strong-regexp (sli-regexp-opt (append sli-end-keys sli-strong-keys))
sli-fixed-regexp (sli-regexp-opt (mapcar 'car sli-fixed-keys-alist))
sli-head-regexp (sli-regexp-opt sli-head-keys)
sli-strong-regexp (sli-regexp-opt sli-strong-keys)
sli-all-keys-nomrelations-noseparators-regexp
(sli-regexp-opt (append sli-keys-nomrelations sli-comment-starts
(list "\"" block-comment-start block-comment-end)))
sli-all-keys-regexp
(sli-regexp-opt (append sli-keys sli-separators sli-comment-starts
(list "\"" block-comment-start block-comment-end)))
sli-all-keys-and-constructors-regexp
(sli-regexp-opt (append sli-keys sli-separators sli-comment-starts
sli-constructor-keys
(list "\"" block-comment-start block-comment-end))))
;(princ "...done.\n")
;; association lists:
;(princ "\nPrecomputations: alists")
(setq sli-ends-head-alist (sli-get-ends-head-alist)
sli-head-end-alist (sli-get-head-end-alist)
sli-heads-strong-alist (sli-get-heads-strong-alist) ; sli-ambiguous-keys also is partly created there.
sli-companion-strong-keys-alist (sli-get-companion-alist)
sli-soft-alist (sli-get-soft-alist)
sli-soft-head-or-strong-alist (sli-get-soft-head-or-strong-alist)
sli-special-head-alist (sli-get-special-head-alist)
sli-special-head-heads-alist (sli-get-special-head-head-alist) ;; sli-special-head-previous-keys-alist is also created here
sli-relevant-alist (sli-get-relevant-alist)