-
Notifications
You must be signed in to change notification settings - Fork 0
/
adoc-mode.el
1900 lines (1673 loc) · 76 KB
/
adoc-mode.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
;;; adoc-mode.el --- a major-mode for editing AsciiDoc files in Emacs
;;
;; Copyright 2010 Florian Kaufmann <[email protected]>
;;
;; Author: Florian Kaufmann <[email protected]>
;; URL: http://code.google.com/p/adoc-mode/
;; Created: 2009
;; Version: 0.4.0
;; Keywords: wp AsciiDoc
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;;
;; AsciiDoc (http://www.methods.co.nz/asciidoc/) is a text document format for
;; writing short documents, articles, books and UNIX man pages. AsciiDoc files
;; can be translated to HTML and DocBook markups.
;;
;; This is just a first version which works not too bad for my small uses of
;; AsciiDoc. It's mostly about syntax highlighting. I still like to play a lot
;; and thus it's not stable at all.
;;
;; I actually would like to improve it, but realistically will invest
;; my time in other activities.
;;
;; Installation:
;;
;; Installation is as usual, so if you are proficient with Emacs you don't need
;; to read this.
;;
;; 1. Copy this file to a directory in `load-path'. To add a specific directory
;; to the load path, add this to your initialization file (~/.emacs or ~/_emacs):
;; (add-to-list 'load-path "mypath")
;;
;; 2. Add either of the two following lines to your initialization file:
;; a) (autoload 'adoc-mode "adoc-mode")
;; b) (require 'adoc-mode)
;; The first only loads adoc mode when necessary, the 2nd always during
;; startup of Emacs.
;;
;; 3. To use adoc mode, call adoc-mode after you opened an AsciiDoc file
;; M-x adoc-mode
;;
;; Each of the following is optional
;;
;; * Byte compile this file (adoc-mode.el) for faster startup:
;; M-x byte-compile
;;
;; * According to AsciiDoc manual, '.txt' is the standard file extension for
;; AsciiDoc files. Add the following to your initialization file to open all
;; '.txt' files with adoc-mode as major mode automatically:
;; (add-to-list 'auto-mode-alist (cons "\\.txt\\'" 'adoc-mode))
;;
;; * If your default face is a fixed pitch (monospace) face, but in AsciiDoc
;; files you liked to have normal text with a variable pitch face,
;; `buffer-face-mode' is for you:
;; (add-hook 'adoc-mode-hook (lambda() (buffer-face-mode t)))
;;
;;
;; Todo:
;; - Fontlock
;; - make font-lock regexps based upon AsciiDoc configuration file, or
;; make them configurable in a way similar to that configuration file
;; - respect font-lock-maximum-decoration
;; - Other common emacs functionality/features
;; - indent functions
;; - imenu / outline / hideshow
;; - tags
;; - Make 'compilation', i.e. translating into the desired output format more
;; conventient
;; - tempo-templates
;; - spell check shall ignore text that is not part of the output
;; - supply a regexp for magic-mode-alist
;; - Is there something that would remove hard newlines within a paragraph,
;; but just for display, so the paragraph uses the whole buffer length.
;; - are there generic base packages to handle lists / tables?
;; - AsciiDoc related features
;; - Two (or gruadualy fading) display modes: one emphasises to see the
;; AsciiDoc source text, the other emphasises to see how the output will
;; look like.
;; - invisible text property could be used to hide meta characters
;; - tags tables for anchors, indixes, bibliography items, titles, ...
;;
;; Bugs:
;; - delimited blocks are supported, but not well at all
;; - Most regexps for highlighting can spawn at most over two lines.
;; - font-lock's multi line capabilities are not used well enough
;; - AsciiDoc's escape rules don't seem to be what one expects. E.g. \\__bla__
;; is *not* a literal backslashed followed by an emphasised bla, but an
;; emphasised _bla_. Try to find out what AsciiDoc's rules are. adoc-mode
;; currently uses 'common' escaping rule: backslash always makes the following
;; char literal.
;;
;;; Variables:
(defconst adoc-mode-version "0.4.0"
"Based upon AsciiDoc version 8.5.2. I.e. regexeps and rules are taken from
that version's asciidoc.conf/manual.")
(defgroup adoc nil
"Support for AsciiDoc documents."
:group 'wp)
(defgroup adoc-faces nil
"Faces used in adoc mode.
Note that what is really used to highlight is the content of the
corresponding variables. E.g. for titles not really the face
adoc-title-0 is used, but the content of the variable
adoc-title-0."
:group 'adoc
:group 'faces )
(defcustom adoc-script-raise '(-0.3 0.3)
"How much to lower and raise subscript and superscript content.
This is a list of two floats. The first is negative and specifies
how much subscript is lowered, the second is positive and
specifies how much superscript is raised. Heights are measured
relative to that of the normal text. The faces used are
adoc-superscript and adoc-subscript respectively."
:type '(list (float :tag "Subscript")
(float :tag "Superscript"))
:group 'adoc)
(defcustom adoc-insert-replacement t
"When true the character/string a replacment/entity stands for is displayed.
E.g. after '&' an '&' is displayed, after '(C)' the copy right
sign is displayed. It's only about display, neither the file nor
the buffer content is affected.
You need to call `adoc-calc' after you change
`adoc-insert-replacement'. For named character entities (e.g.
'&', in contrast to '' or '(C)' ) to be displayed you need to
set `adoc-unichar-name-resolver'."
:type 'boolean
:group 'adoc)
(defcustom adoc-unichar-name-resolver nil
"Function taking a unicode char name and returing it's codepoint.
E.g. when given \"amp\" (as in the character entity reference
\"&\"), it shall return 38 (#x26). Is used to insert the
character a character entity reference is refering to after the
entity. When adoc-unichar-name-resolver is nil, or when its
function returns nil, nothing is done with named character
entities. Note that if `adoc-insert-replacement' is nil,
adoc-unichar-name-resolver is not used.
You can set it to `adoc-unichar-by-name'; however it requires
unichars.el (http://nwalsh.com/emacs/xmlchars/unichars.el). When
you set adoc-unichar-name-resolver to adoc-unichar-by-name, you
need to call `adoc-calc' for the change to take effect."
:type '(choice (const nil)
(const adoc-unichar-by-name)
function)
:group 'adoc)
(defcustom adoc-two-line-title-del '("==" "--" "~~" "^^" "++")
"Delimiter used for the underline of two line titles.
Each string must be exactly 2 characters long. Corresponds to the
underlines element in the titles section of the asciidoc
configuration file."
:type '(list
(string :tag "level 0")
(string :tag "level 1")
(string :tag "level 2")
(string :tag "level 3")
(string :tag "level 4") )
:group 'adoc)
;; todo: limit value range to 1 or 2
(defcustom adoc-default-title-type 1
"Default title type, see `adoc-title-descriptor'."
:group 'adoc)
;; todo: limit value range to 1 or 2
(defcustom adoc-default-title-sub-type 1
"Default title sub type, see `adoc-title-descriptor'."
:group 'adoc )
(defface adoc-orig-default
'((t (:inherit (default))))
"The default face before buffer-face-mode was in effect.
This face is only a kludge. If I understood the face-remap
library better, it probably woudn't be needed."
:group 'adoc-faces)
(defface adoc-generic
'((((background light))
(:foreground "blue"))
(((background dark))
(:foreground "skyblue")))
"For things that don't have their dedicated face.
Many important AsciiDoc constructs have their dedicated face in
adoc-mode like e.g. adoc-title-0, adoc-strong etc.
For all other, less often used constructs, where it wasn't deemed
necessary to create an own dedicated face, adoc-generic is used.
E.g. #...#, the label text of a labeled list item, block titles.
Beside that it servers as a base face from which other adoc
faces, at least their default value, inherit."
:group 'adoc-faces)
(defface adoc-title-0
'((t (:inherit adoc-generic :weight bold :height 2.0)))
""
:group 'adoc-faces)
(defface adoc-title-1
'((t (:inherit adoc-generic :weight bold :height 1.8)))
""
:group 'adoc-faces)
(defface adoc-title-2
'((t (:inherit adoc-generic :weight bold :height 1.4)))
""
:group 'adoc-faces)
(defface adoc-title-3
'((t (:inherit adoc-generic :slant italic :weight bold)))
""
:group 'adoc-faces)
(defface adoc-title-4
'((t (:inherit adoc-generic :slant italic :weight bold)))
""
:group 'adoc-faces)
(defface adoc-monospace
'((t (:inherit (fixed-pitch adoc-generic))))
"For monospace, literal or pass through text"
:group 'adoc-faces)
(defface adoc-strong
'((t (:inherit (adoc-generic bold))))
""
:group 'adoc-faces)
(defface adoc-emphasis
'((t (:inherit (adoc-generic italic))))
""
:group 'adoc-faces)
(defface adoc-superscript
'((t (:inherit adoc-generic :height 0.8)))
"How much to raise it is defined by adoc-script-raise.
Note that the example here in the customization buffer is not
correctly highlighted the raising by adoc-script-raise part is
missing."
:group 'adoc-faces)
(defface adoc-subscript
'((t (:inherit adoc-generic :height 0.8)))
"How much to lower it is defined by adoc-script-raise.
Note that the example here in the customization buffer is not
correctly highlighted, the lowering by adoc-script-raise part is
missing."
:group 'adoc-faces)
(defface adoc-secondary-text
'((t (:height 0.8)))
"Text that is not part of the running text in the output.
E.g. captions or footnotes."
:group 'adoc-faces)
(defface adoc-replacement
'((default (:inherit adoc-orig-default))
(((background light))
(:foreground "purple1"))
(((background dark))
(:foreground "plum1")))
"For things that will be replaced by something simple/similar.
A text phrase that is replaced by another phrase.
E.g. AsciiDoc replacements ('(C)' for the copy right sign),
entity references ('¶' for a carriage return sign),
single/double quoted text (that is, the quotes in `...' , ``...''
are replaced by actual single/double quotation marks.)"
:group 'adoc-faces)
(defface adoc-complex-replacement
'((default (:inherit adoc-orig-default))
(((background light))
(:background "plum1" :foreground "purple3" :box (:line-width 2 :color "plum1" :style released-button)))
(((background dark))
(:background "purple3" :foreground "plum1" :box (:line-width 2 :color "purple3" :style released-button))))
"For things that will be replaced by something complex (e.g an image).
E.g. adominition paragraphs ('WARNING: '), images ('image::images/tiger.png'), rulers, ..."
:group 'adoc-faces)
(defface adoc-list-item
'((default (:inherit adoc-orig-default))
(((background light))
(:background "plum1" :foreground "purple3" ))
(((background dark))
(:background "purple3" :foreground "plum1" )))
"For the bullets and numbers of list items.
However not for the label text of a labeled list item. That is
highlighted with adoc-generic-face."
:group 'adoc-faces)
(defface adoc-table-del
'((default (:inherit adoc-orig-default))
(((background light))
(:background "light steel blue" :foreground "blue" ))
(((background dark))
(:background "purple3" :foreground "plum1" )))
"For table ('|===...')and cell ('|') delimiters "
:group 'adoc-faces)
(defface adoc-reference
'((t (:inherit (adoc-generic link))))
"For references, e.g. URLs, references to other sections etc."
:group 'adoc-faces)
;; todo: inherit 'specialized' delimiters from it.
(defface adoc-delimiter
'((default (:inherit adoc-orig-default))
(((background light))
(:background "gray95" :foreground "gray60"))
(((background dark))
(:background "gray20" :foreground "gray50")))
"For generic delimiters (meta characters) not having their own
dedicated face."
:group 'adoc-faces)
(defface adoc-hide-delimiter
'((default (:inherit adoc-orig-default))
(((background light))
(:foreground "gray85"))
(((background dark))
(:foreground "gray40")))
"For delimiters you don't really need to see.
When the enclosed text, due to highlighting, already indicates
what the delimiter is you don't need to see the delimiter
properly. E.g. in 'bla *foo* bli' foo will be highlighted with
adoc-strong, thus you know that the delimiter must be an
astrisk, and thus you don't need to properly see it. That also
makes the whole text look more like the final output, where you
can't see the delimiters at all of course."
:group 'adoc-faces)
(defface adoc-anchor
'((t (:underline t :inherit (adoc-delimiter))))
"For the anchor id"
:group 'adoc-faces)
(defface adoc-comment
'((t (:inherit font-lock-comment-face adoc-orig-default)))
""
:group 'adoc-faces)
(defface adoc-warning
'((t (:inherit font-lock-warning-face adoc-orig-default)))
""
:group 'adoc-faces)
(defface adoc-preprocessor
'((t (:inherit font-lock-preprocessor-face adoc-orig-default)))
""
:group 'adoc-faces)
;; Despite the comment in font-lock.el near 'defvar font-lock-comment-face', it
;; seems I still need variables to refer to faces in adoc-font-lock-keywords.
;; Not having variables and only referring to face names in
;; adoc-font-lock-keywords does not work.
(defvar adoc-orig-default 'adoc-orig-default)
(defvar adoc-generic 'adoc-generic)
(defvar adoc-title-0 'adoc-title-0)
(defvar adoc-title-1 'adoc-title-1)
(defvar adoc-title-2 'adoc-title-2)
(defvar adoc-title-3 'adoc-title-3)
(defvar adoc-title-4 'adoc-title-4)
(defvar adoc-monospace 'adoc-monospace)
(defvar adoc-strong 'adoc-strong)
(defvar adoc-emphasis 'adoc-emphasis)
(defvar adoc-superscript 'adoc-superscript)
(defvar adoc-subscript 'adoc-subscript)
(defvar adoc-replacement 'adoc-replacement)
(defvar adoc-complex-replacement 'adoc-complex-replacement)
(defvar adoc-list-item 'adoc-list-item)
(defvar adoc-table-del 'adoc-table-del)
(defvar adoc-reference 'adoc-reference)
(defvar adoc-secondary-text 'adoc-secondary-text)
(defvar adoc-delimiter 'adoc-delimiter)
(defvar adoc-hide-delimiter 'adoc-hide-delimiter)
(defvar adoc-anchor 'adoc-anchor)
(defvar adoc-comment 'adoc-comment)
(defvar adoc-warning 'adoc-warning)
(defvar adoc-preprocessor 'adoc-preprocessor)
(defconst adoc-title-max-level 4
"Max title level, counting starts at 0.")
(defconst adoc-uolist-max-level 5
"Max unordered (bulleted) list item nesting level, counting starts at 0.")
;; I think it's actually not worth the fuzz to try to sumarize regexps until
;; profiling profes otherwise. Nevertheless I can't stop doing it.
(defconst adoc-summarize-re-uolisti t
"When non-nil, sumarize regexps for unordered list items into one regexp.
To become a customizable variable when regexps for list items become customizable.")
(defconst adoc-summarize-re-olisti t
"As `adoc-summarize-re-uolisti', but for ordered list items.")
(defconst adoc-summarize-re-llisti t
"As `adoc-summarize-re-uolisti', but for labeled list items.")
(defvar adoc-unichar-alist nil
"An alist, key=unicode character name as string, value=codepoint.")
(defvar adoc-mode-hook nil
"Normal hook run when entering Adoc Text mode.")
(defvar adoc-mode-abbrev-table nil
"Abbrev table in use in adoc-mode buffers.")
(defvar adoc-font-lock-keywords nil
"Font lock keywords in adoc-mode buffers.")
(defvar adoc-replacement-failed nil )
(define-abbrev-table 'adoc-mode-abbrev-table ())
;;; Code:
;; from asciidoc.conf:
;; ^:(?P<attrname>\w[^.]*?)(\.(?P<attrname2>.*?))?:(\s+(?P<attrvalue>.*))?$
(defun adoc-re-attribute-entry ()
(concat "^\\(:[a-zA-Z0-9_][^.\n]*?\\(?:\\..*?\\)?:[ \t]*\\)\\(.*?\\)$"))
;; from asciidoc.conf:
;; ^= +(?P<title>[\S].*?)( +=)?$
(defun adoc-re-one-line-title (level)
"Returns a regex matching a one line title of the given LEVEL.
When LEVEL is nil, a one line title of any level is matched.
match-data has this sub groups:
1 leading delimiter inclusive whites
2 title's text exclusive leading/trailing whites
3 trailing delimiter inclusive whites
0 only chars that belong to the title block element"
(let* ((del (if level
(make-string (+ level 1) ?=)
(concat "=\\{1," (+ adoc-title-max-level 1) "\\}"))))
(concat
"^\\(" del "[ \t]+\\)"
"\\([^ \t\n].*?\\)"
"\\(\\(?:[ \t]+" del "\\)?\\)[ \t]*$")))
(defun adoc-make-one-line-title (sub-type level text)
"Returns a one line title of LEVEL and SUB-TYPE containing the given text."
(let ((del (make-string (+ level 1) ?=)))
(concat del " " text (when (eq sub-type 2) (concat " " del)))))
;; for first line, 2nd line is not a regex but python code
;; ^(?P<title>.*?)$
(defun adoc-re-two-line-title (del)
"Note that even if this regexp matches it still doesn't mean it is a two line title.
You additionaly have to test if the underline has the correct length.
match-data has his this sub groups:
1 title's text
2 delimiter
0 only chars that belong to the title block element"
(when (not (eq (length del) 2))
(error "two line title delimiters must be 2 chars long"))
(concat
;; title must contain at least one \w character. You don't see that in
;; asciidoc.conf, only in asciidoc source code.
"\\(^.*?[a-zA-Z0-9_].*?\\)[ \t]*\n"
"\\("
"\\(?:" (regexp-quote del) "\\)+"
(regexp-quote (substring del 0 1)) "?"
"\\)[ \t]*$" ))
(defun adoc-make-two-line-title (del text)
"Returns a two line title using given DEL containing given TEXT."
(when (not (eq (length del) 2))
(error "two line title delimiters must be 2 chars long"))
(let ((repetition-cnt (if (>= (length text) 2) (/ (length text) 2) 1))
(result (concat text "\n")))
(while (> repetition-cnt 0)
(setq result (concat result del))
(setq repetition-cnt (- repetition-cnt 1)))
(when (eq (% (length text) 2) 1)
(setq result (concat result (substring del 0 1))))
result))
(defun adoc-re-oulisti (type &optional level sub-type)
"Returns a regexp matching an (un)ordered list item.
match-data his this sub groups:
1 leading whites
2 delimiter
3 trailing white between delimiter and item's text
0 only chars belonging to delimiter/whites. I.e. none of text.
WARNING: See warning about list item nesting level in `adoc-list-descriptor'."
(cond
;; ^\s*- +(?P<text>.+)$ normal 0
;; ^\s*\* +(?P<text>.+)$ normal 1
;; ... ...
;; ^\s*\*{5} +(?P<text>.+)$ normal 5
;; ^\+ +(?P<text>.+)$ bibliograpy(DEPRECATED)
((eq type 'adoc-unordered)
(cond
((or (eq sub-type 'adoc-normal) (null sub-type))
(let ((r (cond ((numberp level) (if (eq level 0) "-" (make-string level ?\*)))
((or (null level) (eq level 'adoc-all-levels)) "-\\|\\*\\{1,5\\}")
(t (error "adoc-unordered/adoc-normal: invalid level")))))
(concat "^\\([ \t]*\\)\\(" r "\\)\\([ \t]\\)")))
((and (eq sub-type 'adoc-bibliography) (null level))
"^\\(\\)\\(\\+\\)\\([ \t]+\\)")
(t (error "adoc-unordered: invalid sub-type/level combination"))))
;; ^\s*(?P<index>\d+\.) +(?P<text>.+)$ decimal = 0
;; ^\s*(?P<index>[a-z]\.) +(?P<text>.+)$ lower alpha = 1
;; ^\s*(?P<index>[A-Z]\.) +(?P<text>.+)$ upper alpha = 2
;; ^\s*(?P<index>[ivx]+\)) +(?P<text>.+)$ lower roman = 3
;; ^\s*(?P<index>[IVX]+\)) +(?P<text>.+)$ upper roman = 4
((eq type 'adoc-explicitly-numbered)
(when level (error "adoc-explicitly-numbered: invalid level"))
(let* ((l '("[0-9]+\\." "[a-z]\\." "[A-Z]\\." "[ivx]+)" "[IVX]+)"))
(r (cond ((numberp sub-type) (nth sub-type l))
((or (null sub-type) (eq sub-type 'adoc-all-subtypes)) (mapconcat 'identity l "\\|"))
(t (error "adoc-explicitly-numbered: invalid subtype")))))
(concat "^\\([ \t]*\\)\\(" r "\\)\\([ \t]\\)")))
;; ^\s*\. +(?P<text>.+)$ normal 0
;; ^\s*\.{2} +(?P<text>.+)$ normal 1
;; ... etc until 5 ...
((eq type 'adoc-implicitly-numbered)
(let ((r (cond ((numberp level) (number-to-string (+ level 1)))
((or (null level) (eq level 'adoc-all-levels)) "1,5")
(t (error "adoc-implicitly-numbered: invalid level")))))
(concat "^\\([ \t]*\\)\\(\\.\\{" r "\\}\\)\\([ \t]\\)")))
;; ^<?(?P<index>\d*>) +(?P<text>.+)$ callout
((eq type 'adoc-callout)
(when (or level sub-type) (error "adoc-callout invalid level/sub-type"))
"^\\(\\)\\(<?[0-9]*>\\)\\([ t]+\\)")
;; invalid
(t (error "invalid (un)ordered list type"))))
(defun adoc-make-uolisti (level is-1st-line)
"Returns a regexp matching a unordered list item."
(let* ((del (if (eq level 0) "-" (make-string level ?\*)))
(white-1st (if indent-tabs-mode
(make-string (/ (* level standard-indent) tab-width) ?\t)
(make-string (* level standard-indent) ?\ )))
(white-rest (make-string (+ (length del) 1) ?\ )))
(if is-1st-line
(concat white-1st del " ")
white-rest)))
;; ^\s*(?P<label>.*[^:])::(\s+(?P<text>.+))?$ normal 0
;; ^\s*(?P<label>.*[^;]);;(\s+(?P<text>.+))?$ normal 1
;; ^\s*(?P<label>.*[^:]):{3}(\s+(?P<text>.+))?$ normal 2
;; ^\s*(?P<label>.*[^:]):{4}(\s+(?P<text>.+))?$ normal 3
;; ^\s*(?P<label>.*\S)\?\?$ qanda (DEPRECATED)
;; ^(?P<label>.*\S):-$ glossary (DEPRECATED)
(defun adoc-re-llisti (type level)
"Returns a regexp matching a labeled list item.
Subgroups:
1 leading blanks
2 label text
3 delimiter
4 white between delimiter and paragraph-text
0 no"
(cond
((eq type 'adoc-labeled-normal)
(let* ((deluq (nth level '("::" ";;" ":::" "::::"))) ; unqutoed
(del (regexp-quote deluq))
(del1st (substring deluq 0 1)))
(concat "^\\([ \t]*\\)\\(.*[^" del1st "\n]\\)\\(" del "\\)\\([ \t]+\\|[ \t]*$\\)")))
((eq type 'adoc-labeled-qanda)
"^\\([ \t]*\\)\\(.*[^ \t\n]\\)\\(\\?\\?\\)\\(\\)$")
((eq type 'adoc-labeled-glossary)
"^\\(\\)\\(.*[^ \t\n]\\)\\(:-\\)\\(\\)$")
(t (error "Unknown type/level"))))
;; Ala ^\*{4,}$
(defun adoc-re-delimited-block-line (charset)
(concat "^\\(\\(" charset "\\)\\2\\{3,\\}\\)[ \t]*\n"))
(defun adoc-re-delimited-block (del)
(concat
"\\(^" (regexp-quote del) "\\{4,\\}\\)[ \t]*\n"
"\\(\\(?:.*\n\\)*?\\)"
"\\(" (regexp-quote del) "\\{4,\\}\\)[ \t]*$"))
;; TODO: since its multiline, it doesn't yet work properly.
(defun adoc-re-verbatim-paragraph-sequence ()
(concat
"\\("
;; 1. paragraph in sequence delimited by blank line or list continuation
"^\\+?[ \t]*\n"
;; sequence of verbatim paragraphs
"\\(?:"
;; 1st line starts with blanks, but has also non blanks, i.e. is not empty
"[ \t]+[^ \t\n].*"
;; 2nd+ line is neither a blank line nor a list continuation line
"\\(?:\n\\(?:[^+ \t\n]\\|[ \t]+[^ \t\n]\\|\\+[ \t]*[^ \t\n]\\).*?\\)*?"
;; paragraph delimited by blank line or list continuation
;; NOTE: now list continuation belongs the the verbatim paragraph sequence,
;; but actually we want to highlight it differently. Thus the font lock
;; keywoard handling list continuation must come after verbatim paraphraph
;; sequence.
"\n\\+?[ \t]*\n"
"\\)+"
"\\)" ))
(defun adoc-re-precond (&optional unwanted-chars backslash-allowed disallowed-at-bol)
(concat
(when disallowed-at-bol ".")
"\\(?:"
(unless disallowed-at-bol "^\\|")
"[^"
(if unwanted-chars unwanted-chars "")
(if backslash-allowed "" "\\")
"\n"
"]"
"\\)"))
(defun adoc-re-quote-precondition (not-allowed-chars)
"Regexp that matches before a (un)constrained quote delimiter.
NOT-ALLOWED-CHARS are chars not allowed before the quote."
(concat
"\\(?:"
"^"
"\\|"
"\\="
"\\|"
; or *not* after
; - an backslash
; - user defined chars
"[^" not-allowed-chars "\\\n]"
"\\)"))
;; AsciiDoc src:
;; # Unconstrained quotes can appear anywhere.
;; reo = re.compile(r'(?msu)(^|.)(\[(?P<attrlist>[^[\]]+?)\])?' \
;; + r'(?:' + re.escape(lq) + r')' \
;; + r'(?P<content>.+?)(?:'+re.escape(rq)+r')')
;;
;; BUG: Escaping ala \\**...** does not yet work. Probably adoc-mode should do
;; it like this, which is more similar to how asciidoc does it: 'Allow'
;; backslash as the first char. If the first char is ineed a backslash, it is
;; 'removed' (-> adoc-hide-delimiter face), and the rest of the match is left
;; unaffected.
(defun adoc-re-unconstrained-quote (ldel &optional rdel)
(unless rdel (setq rdel ldel))
(let* ((qldel (regexp-quote ldel))
(qrdel (regexp-quote rdel)))
(concat
(adoc-re-quote-precondition "")
"\\(\\[[^][]+?\\]\\)?"
"\\(" qldel "\\)"
"\\(.+?\\(?:\n.*?\\)\\{,1\\}?\\)"
"\\(" qrdel "\\)")))
;; AsciiDoc src for constrained quotes
;; # The text within constrained quotes must be bounded by white space.
;; # Non-word (\W) characters are allowed at boundaries to accommodate
;; # enveloping quotes.
;;
;; reo = re.compile(r'(?msu)(^|[^\w;:])(\[(?P<attrlist>[^[\]]+?)\])?' \
;; + r'(?:' + re.escape(lq) + r')' \
;; + r'(?P<content>\S|\S.*?\S)(?:'+re.escape(rq)+r')(?=\W|$)')
(defun adoc-re-constrained-quote (ldel &optional rdel)
"
subgroups:
1 attribute list [optional]
2 starting del
3 enclosed text
4 closing del"
(unless rdel (setq rdel ldel))
(let ((qldel (regexp-quote ldel))
(qrdel (regexp-quote rdel)))
(concat
;; added &<> because those are special chars which are substituted by a
;; entity, which ends in ;, which is prohibited in the ascidoc.conf regexp
(adoc-re-quote-precondition "A-Za-z0-9;:&<>")
"\\(\\[[^][]+?\\]\\)?"
"\\(" qldel "\\)"
"\\([^ \t\n]\\|[^ \t\n].*?\\(?:\n.*?\\)\\{,1\\}?[^ \t\n]\\)"
"\\(" qrdel "\\)"
;; BUG: now that Emacs doesn't has look-ahead, the match is too long, and
;; adjancted quotes of the same type wouldn't be recognized.
"\\(?:[^A-Za-z0-9\n]\\|[ \t]*$\\)")))
(defun adoc-re-quote (type ldel &optional rdel)
(cond
((eq type 'adoc-constrained)
(adoc-re-constrained-quote ldel rdel))
((eq type 'adoc-unconstrained)
(adoc-re-unconstrained-quote ldel rdel))
(t
(error "Invalid type"))))
;; todo: use same regexps as for font lock
(defun adoc-re-paragraph-separate ()
(concat
;; empty line
"[ \t]*$"
;; delimited blocks / two line titles
"\\|"
"\\("
"^+" "\\|"
"\\++" "\\|"
"/+" "\\|"
"-+" "\\|"
"\\.+" "\\|"
"\\*+" "\\|"
"_*+" "\\|"
"=*+" "\\|"
"~*+" "\\|"
"^*+" "\\|"
"--"
"\\)"
"[ \t]*$"
))
;; todo: use same regexps as for font lock
(defun adoc-re-paragraph-start ()
(concat
paragraph-separate
;; list items
"\\|"
"[ \t]*"
"\\("
"-" "\\|"
"\\*\\{1,5\\}" "\\|"
"\\.\\{1,5\\}" "\\|"
"[0-9]\\{,3\\}\\." "\\|"
"[a-z]\\{,3\\}\\." "\\|"
"[A-Z]\\{,3\\}\\." "\\|"
"[ivxmcIVXMC]+)" "\\|"
".*?:\\{2,4\\}"
"\\)"
"\\( \\|$\\)"
;; table rows
"\\|"
"|"
;; one line titles
"\\|"
"[=.].*$"
))
(defun adoc-re-aor(e1 e2)
"all or: Returns a regex matching \(e1\|e2\|e1e2\)? "
(concat "\\(?:" e1 "\\)?\\(?:" e2 "\\)?"))
(defun adoc-re-ror(e1 e2)
"real or: Returns a regex matching \(e1\|e2\|e1e2\)"
(concat "\\(?:\\(?:" e1 "\\)\\|\\(?:" e2 "\\)\\|\\(?:" e1 "\\)\\(?:" e2 "\\)\\)"))
;; ((?<!\S)((?P<span>[\d.]+)(?P<op>[*+]))?(?P<align>[<\^>.]{,3})?(?P<style>[a-z])?)?\|'
(defun adoc-re-cell-specifier ()
(let* ((fullspan (concat (adoc-re-ror "[0-9]+" "\\.[0-9]+") "[*+]"))
(align (adoc-re-ror "[<^>]" "\\.[<^>]"))
(style "[demshalv]"))
(concat "\\(?:" fullspan "\\)?\\(?:" align "\\)?\\(?:" style "\\)?")))
(defun adoc-facespec-subscript ()
`(face adoc-subscript display (raise ,(nth 0 adoc-script-raise))))
(defun adoc-facespec-superscript ()
`(face adoc-superscript display (raise ,(nth 1 adoc-script-raise))))
;; adoc-lexxer will set these faces when it finds a match. The numbers are the
;; regexp group numbers of the match.
(defvar adoc-lex-face-1 adoc-orig-default)
(defvar adoc-lex-face-2 adoc-orig-default)
(defvar adoc-lex-face-3 adoc-orig-default)
(defvar adoc-lex-face-4 adoc-orig-default)
(defvar adoc-lex-face-5 adoc-orig-default)
(defvar adoc-lex-face-6 adoc-orig-default)
(defvar adoc-lexems `(
;; the order of lexems is given by AsciiDoc, see source code Lex.next
;;
;; attribute entry
;; attribute list
;; title
;; single line
,(list (adoc-re-one-line-title 0) adoc-hide-delimiter adoc-title-0 adoc-hide-delimiter)
,(list (adoc-re-one-line-title 1) adoc-hide-delimiter adoc-title-1 adoc-hide-delimiter)
,(list (adoc-re-one-line-title 2) adoc-hide-delimiter adoc-title-2 adoc-hide-delimiter)
,(list (adoc-re-one-line-title 3) adoc-hide-delimiter adoc-title-3 adoc-hide-delimiter)
,(list (adoc-re-one-line-title 4) adoc-hide-delimiter adoc-title-4 adoc-hide-delimiter)
;; double line
,(list (adoc-re-two-line-title "==") adoc-title-0 adoc-hide-delimiter)
,(list (adoc-re-two-line-title "--") adoc-title-1 adoc-hide-delimiter)
,(list (adoc-re-two-line-title "~~") adoc-title-2 adoc-hide-delimiter)
,(list (adoc-re-two-line-title "^^") adoc-title-3 adoc-hide-delimiter)
,(list (adoc-re-two-line-title "++") adoc-title-4 adoc-hide-delimiter)
;; macros
;; lists
;; blocks
,(list (adoc-re-delimited-block "/") adoc-delimiter adoc-hide-delimiter adoc-comment adoc-delimiter adoc-hide-delimiter) ; comment
,(list (adoc-re-delimited-block "+") adoc-delimiter adoc-hide-delimiter adoc-monospace adoc-delimiter adoc-hide-delimiter) ; pass through
,(list (adoc-re-delimited-block "-") adoc-delimiter adoc-hide-delimiter adoc-monospace adoc-delimiter adoc-hide-delimiter) ; listing
,(list (adoc-re-delimited-block ".") adoc-delimiter adoc-hide-delimiter adoc-monospace adoc-delimiter adoc-hide-delimiter) ; literal
,(list (adoc-re-delimited-block "*") adoc-delimiter adoc-hide-delimiter adoc-secondary-text adoc-delimiter adoc-hide-delimiter) ; sidebar
,(list (adoc-re-delimited-block "_") adoc-delimiter adoc-hide-delimiter adoc-generic adoc-delimiter adoc-hide-delimiter) ; quote
,(list (adoc-re-delimited-block "=") adoc-delimiter adoc-hide-delimiter adoc-monospace adoc-delimiter adoc-hide-delimiter) ; example
("^--[ \t]*$" adoc-delimiter) ; open block
;; tables OLD
;; tables
;; block title
(list "^\\(\\.\\)\\(\\.?[^. \t\n].*\\)$" adoc-delimiter adoc-generic)
;; paragraph
))
;; Todo:
;; - 'compile' adoc-lexems. So the concat "\\=" below and the evals doesn't have
;; to be done all the time.
;;
;; - instead of setting a face variable, do it more general
;; (1 '(face face-1 prop-11 prop-val11 prop-12 prop-val12) override-1 laxmatch-1)
;; (2 '(face face-2 prop-21 prop-val21 prop-22 prop-val22) override-2 laxmatch-2)
;; ...
(defun adoc-lexxer (end)
(let* (item
found)
(while (and (< (point) end) (not found))
(setq item adoc-lexems)
(while (and item (not found))
(setq found (re-search-forward (concat "\\=" (nth 0 (car item))) end t))
(when found
(setq adoc-lex-face-1 (eval (nth 1 (car item))))
(setq adoc-lex-face-2 (eval (nth 2 (car item))))
(setq adoc-lex-face-3 (eval (nth 3 (car item))))
(setq adoc-lex-face-4 (eval (nth 4 (car item))))
(setq adoc-lex-face-5 (eval (nth 5 (car item))))
(setq adoc-lex-face-6 (eval (nth 6 (car item))))
)
(setq item (cdr item)))
(when (not found)
(forward-line 1)))
found))
;; todo: use & learn some more macro magic so adoc-kw-unconstrained-quote and
;; adoc-kw-constrained-quote are less redundant and have common parts in one
;; macro. E.g. at least such 'lists'
;; (not (text-property-not-all (match-beginning 1) (match-end 1) 'adoc-reserved nil))
;; (not (text-property-not-all (match-beginning 3) (match-end 3) 'adoc-reserved nil))
;; ...
;; could surely be replaced by a single (adoc-not-reserved-bla-bla 1 3)
;; BUG: Remember that if a matcher function returns nil, font-lock does not
;; further call it and abandons that keyword. Thus in adoc-mode in general,
;; there should be a loop around (and (re-search-forward ...) (not
;; (text-property-not-all...)) ...). Currently if say a constrained quote cant
;; match because of adoc-reserved, following quotes of the same type which
;; should be highlighed are not, because font-lock abandons that keyword.
(defmacro adoc-kw-one-line-title (level text-face)
"Creates a keyword for font-lock which highlights one line titles"
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-one-line-title level) end t)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(1 '(face adoc-hide-delimiter adoc-reserved t) t)
'(2 ,text-face t)
'(3 '(face adoc-hide-delimiter adoc-reserved t) t)))
;; todo: highlight bogous 'two line titles' with warning face
(defmacro adoc-kw-two-line-title (del text-face)
"Creates a keyword for font-lock which highlights two line titles"
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-two-line-title del) end t)
(< (abs (- (length (match-string 1)) (length (match-string 2)))) 3)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(1 ,text-face t)
'(2 '(face adoc-hide-delimiter adoc-reserved t) t)))
(defmacro adoc-kw-oulisti (type &optional level sub-type)
"Creates a keyword for font-lock which highlights both (un)ordered list elements.
Concerning TYPE, LEVEL and SUB-TYPE see `adoc-re-oulisti'"
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-oulisti type level sub-type) end t)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(0 '(face nil adoc-reserved t) t)
'(1 adoc-orig-default t)
'(2 adoc-list-item t)
'(3 adoc-orig-default t)))
(defmacro adoc-kw-llisti (sub-type &optional level)
"Creates a keyword for font-lock which highlights labeled list elements.
Concerning TYPE, LEVEL and SUB-TYPE see `adoc-re-llisti'."
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-llisti sub-type level) end t)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(1 adoc-orig-default t)
'(2 adoc-generic t)
'(3 '(face adoc-list-item adoc-reserved t) t)
'(4 adoc-orig-default t)))
(defmacro adoc-kw-delimited-block (del text-face text-prop text-prop-val)
"Creates a keyword for font-lock which highlights a delimited block."
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-delimited-block del) end t)
(not (text-property-not-all (match-beginning 1) (match-end 1) 'adoc-reserved nil))
(not (text-property-not-all (match-beginning 3) (match-end 3) 'adoc-reserved nil))))
;; highlighers
'(0 '(face nil font-lock-multiline t) t)
'(1 '(face adoc-hide-delimiter adoc-reserved t) t)
'(2 '(face ,text-face ,text-prop ,text-prop-val) t)
'(3 '(face adoc-hide-delimiter adoc-reserved t) t)))
;; if adoc-kw-delimited-block, adoc-kw-two-line-title don't find the whole
;; delimited block / two line title, at least 'use up' the delimiter line so it
;; is later not conused as a funny serries of unconstrained quotes
(defmacro adoc-kw-delimtier-line-fallback (charset)
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-delimited-block-line charset) end t)
(not (text-property-not-all (match-beginning 1) (match-end 1) 'adoc-reserved nil))))
;; highlighters
'(1 '(face adoc-hide-delimiter adoc-reserved t) t)))
;; admonition paragraph. Note that there is also the style with the leading attribute list.
;; (?s)^\s*(?P<style>NOTE|TIP|IMPORTANT|WARNING|CAUTION):\s+(?P<text>.+)
(defmacro adoc-kw-admonition-paragraph ()
"Creates a keyword which highlights admonition paragraphs"
`(list
;; matcher function
(lambda (end)
(and (re-search-forward "^[ \t]*\\(\\(?:CAUTION\\|WARNING\\|IMPORTANT\\|TIP\\|NOTE\\):\\)\\([ \t]+\\)" end t)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(1 '(face adoc-complex-replacement adoc-reserved t))
'(2 '(face adoc-orig-default adoc-reserved t))))
(defmacro adoc-kw-verbatim-paragraph-sequence ()
"Creates a keyword which highlights a sequence of verbatim paragraphs."
`(list
;; matcher function
(lambda (end)
(and (re-search-forward ,(adoc-re-verbatim-paragraph-sequence) end t)
(not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil))))
;; highlighers
'(1 '(face adoc-monospace adoc-reserved t font-lock-multiline t))))