docutils/tools/editors/emacs/tests/adornment.el

   1 ;; Tests for various functions handling adornments  -*- lexical-binding: t -*-
   2
   3 (add-to-list 'load-path ".")
   4 (load "init" nil t)
   5 (init-rst-ert t)
   6
   7 (ert-deftest adornment-asserts ()
   8   "Check some assertions."
   9   (should (equal ert-Buf-point-char "\^@"))
  10   (should (equal ert-Buf-mark-char "\^?"))
  11   )
  12
  13 (defun ttl-at-point ()
  14   "Wrapper for calling `rst-ttl-at-point'."
  15   (apply-ttl-match (rst-ttl-at-point)))
  16
  17 (ert-deftest rst-ttl-at-point ()
  18   "Tests for `rst-ttl-at-point'."
  19   (should (ert-equal-buffer-return
  20            '(ttl-at-point)
  21            "
  22
  23 Du bon vin tous les jours.
  24 \^@
  25 "
  26            "
  27
  28 \^@Du bon vin tous les jours.
  29
  30 "
  31            '(nil 0 nil "Du bon vin tous les jours." nil)
  32            ))
  33   (should (ert-equal-buffer-return
  34            '(ttl-at-point)
  35            "
  36 \^@
  37 Du bon vin tous les jours.
  38
  39 "
  40            "
  41
  42 \^@Du bon vin tous les jours.
  43
  44 "
  45            '(nil 0 nil "Du bon vin tous les jours." nil)
  46            ))
  47   (should (ert-equal-buffer-return
  48            '(ttl-at-point)
  49            "
  50
  51 Du bon vin tous les jours.
  52 ------\^@-----
  53 "
  54            "
  55
  56 \^@Du bon vin tous les jours.
  57 -----------
  58 "
  59            (list
  60             (rst-Ado-new-simple ?-) 0
  61             nil "Du bon vin tous les jours." "-----------")
  62            ))
  63   (should (ert-equal-buffer-return
  64            '(ttl-at-point)
  65            "
  66 ------\^@-----
  67 Du bon vin tous les jours.
  68
  69 "
  70            "
  71 -----------
  72 \^@Du bon vin tous les jours.
  73
  74 "
  75            (list
  76             (rst-Ado-new-over-and-under ?-) 0
  77             "-----------" "Du bon vin tous les jours." nil)
  78            ))
  79   (should (ert-equal-buffer-return
  80            '(ttl-at-point)
  81            "
  82 \^@-----------
  83 Du bon vin tous les jours.
  84 -----------
  85
  86 "
  87            "
  88 -----------
  89 \^@Du bon vin tous les jours.
  90 -----------
  91
  92 "
  93            (list
  94             (rst-Ado-new-over-and-under ?-) 0
  95             "-----------" "Du bon vin tous les jours." "-----------")
  96            ))
  97   (should (ert-equal-buffer-return
  98            '(ttl-at-point)
  99            "
 100 \^@===========
 101 Du bon vin tous les jours.
 102 -----------
 103 "
 104            "
 105 \^@===========
 106 Du bon vin tous les jours.
 107 -----------
 108 "
 109            nil
 110            ))
 111   (should (ert-equal-buffer-return
 112            '(ttl-at-point)
 113            "
 114 Du bon vin tous les jours.
 115 \^@-----------
 116 Du bon vin tous les jours.
 117 -----------
 118
 119 "
 120            "
 121 Du bon vin tous les jours.
 122 -----------
 123 \^@Du bon vin tous les jours.
 124 -----------
 125
 126 " ; This is not how the parser works but looks more logical
 127            (list
 128             (rst-Ado-new-over-and-under ?-) 0
 129             "-----------" "Du bon vin tous les jours." "-----------")
 130            ))
 131   (should (ert-equal-buffer-return
 132            '(ttl-at-point)
 133            "
 134
 135 \^@===========
 136
 137 "
 138            "
 139
 140 \^@===========
 141
 142 "
 143            nil
 144            ))
 145   (should (ert-equal-buffer-return
 146            '(ttl-at-point)
 147            "\^@"
 148            "\^@"
 149            nil
 150            ))
 151   (should (ert-equal-buffer-return
 152            '(ttl-at-point)
 153            "\^@
 154 "
 155            "\^@
 156 "
 157            nil
 158            ))
 159   (should (ert-equal-buffer-return
 160            '(ttl-at-point)
 161            "
 162 Line 1
 163 \^@
 164 Line 2
 165
 166 "
 167            "
 168 \^@Line 1
 169
 170 Line 2
 171
 172 "
 173            '(nil 0 nil "Line 1" nil)
 174            ))
 175   (should (ert-equal-buffer-return
 176            '(ttl-at-point)
 177            "
 178 =====================================
 179    Project Idea: Panorama Stitcher
 180 ====================================
 181
 182 :Author: Martin Blais <blais@furius.ca>
 183 \^@
 184 Another Title
 185 =============
 186 "
 187            "
 188 =====================================
 189    Project Idea: Panorama Stitcher
 190 ====================================
 191
 192 \^@:Author: Martin Blais <blais@furius.ca>
 193
 194 Another Title
 195 =============
 196 "
 197            '(nil 0 nil ":Author: Martin Blais <blais@furius.ca>" nil)
 198            ))
 199   )
 200
 201 (setq text-1
 202 "===============================
 203    Project Idea: My Document
 204 ===============================
 205
 206 :Author: Martin Blais
 207
 208 Introduction
 209 ============
 210
 211 This is the introduction.
 212
 213 Notes
 214 -----
 215
 216 Some notes.
 217
 218 Main Points
 219 ===========
 220
 221 Yep.
 222
 223 Super Point
 224 -----------
 225
 226 ~~~~~~~~~~~
 227 \^@ Sub Point
 228 ~~~~~~~~~~~
 229
 230 Isn't this fabulous?
 231
 232 Conclusion
 233 ==========
 234
 235 That's it, really.
 236
 237 ")
 238
 239 (setq text-2
 240 "
 241
 242 Previous
 243 --------
 244
 245 Current\^@
 246 ~~~~~~~
 247
 248 Next
 249 ++++
 250
 251 ")
 252
 253 (setq text-3
 254 "
 255
 256 Previous
 257 --------
 258
 259 Current\^@
 260 ~~~~~~~
 261
 262   Next
 263   ++++
 264
 265 ")
 266
 267 (setq text-4
 268 "
 269
 270 Previous
 271 --------
 272
 273 Current\^@
 274 ~~~~~~~
 275
 276 Next
 277 ++++
 278
 279 Same
 280 ~~~~
 281
 282 ")
 283
 284 (defun find-all-adornments ()
 285   "Call `rst-all-ttls' and return conses of line and `rst-Ado'."
 286   (mapcar (lambda (ttl)
 287             (cons (line-number-at-pos (rst-Ttl-get-title-beginning ttl))
 288                   (rst-Ttl-ado ttl)))
 289           (rst-all-ttls-compute)))
 290
 291 (ert-deftest rst-all-ttls ()
 292   "Tests for `rst-all-ttls'."
 293   (should (ert-equal-buffer-return
 294            (find-all-adornments)
 295            ""
 296            t
 297            nil
 298            ))
 299   (should (ert-equal-buffer-return
 300            '(find-all-adornments)
 301            "
 302   Not a valid section header because of indentation
 303 ===================================================
 304 "
 305            t
 306            nil
 307            ))
 308   (should (ert-equal-buffer-return
 309            '(find-all-adornments)
 310            "
 311 Only a...
 312
 313 ===================================================
 314
 315 ...transition
 316 "
 317            t
 318            nil
 319            ))
 320   (should (ert-equal-buffer-return
 321            '(find-all-adornments)
 322            "
 323 =======================================================
 324 Not a valid section header because of missing underline
 325
 326 "
 327            t
 328            nil
 329            ))
 330   (should (ert-equal-buffer-return
 331            '(find-all-adornments)
 332            "
 333 =====================================================
 334 Not a valid section header because of wrong underline
 335 -----------------------------------------------------
 336 "
 337            t
 338            nil
 339            ))
 340   (should (ert-equal-buffer-return
 341            '(find-all-adornments)
 342            "
 343 Valid simple section header
 344 ===========================
 345 "
 346            t
 347            (list
 348             (cons 2 (rst-Ado-new-simple ?=)))
 349            ))
 350   (should (ert-equal-buffer-return
 351            '(find-all-adornments)
 352            "
 353 =======================================
 354   Valid over and under section header
 355 =======================================
 356 "
 357            t
 358            (list
 359             (cons 3 (rst-Ado-new-over-and-under ?=)))
 360            ))
 361   (should (ert-equal-buffer-return
 362            '(find-all-adornments)
 363            text-1
 364            t
 365            (list
 366             (cons 2 (rst-Ado-new-over-and-under ?=))
 367             (cons 7 (rst-Ado-new-simple ?=))
 368             (cons 12 (rst-Ado-new-simple ?-))
 369             (cons 17 (rst-Ado-new-simple ?=))
 370             (cons 22 (rst-Ado-new-simple ?-))
 371             (cons 26 (rst-Ado-new-over-and-under ?~))
 372             (cons 31 (rst-Ado-new-simple ?=)))
 373            ))
 374   (should (ert-equal-buffer-return
 375            '(find-all-adornments)
 376            text-2
 377            t
 378            (list
 379             (cons 3 (rst-Ado-new-simple ?-))
 380             (cons 6 (rst-Ado-new-simple ?~))
 381             (cons 9 (rst-Ado-new-simple ?+)))
 382            ))
 383   (should (ert-equal-buffer-return
 384            '(find-all-adornments)
 385            text-3
 386            t
 387            (list
 388             (cons 3 (rst-Ado-new-simple ?-))
 389             (cons 6 (rst-Ado-new-simple ?~)))
 390            ))
 391   (should (ert-equal-buffer-return
 392            '(find-all-adornments)
 393            "=====
 394 Title
 395 =====
 396
 397 Header A
 398 ========
 399
 400 Header B
 401 ========
 402
 403 Subheader B.a
 404 -------------
 405
 406 SubSubheader B.a.1
 407 ~~~~~~~~~~~~~~~~~~
 408
 409 Header C
 410 ========
 411
 412 Missing node C.a.1
 413 ~~~~~~~~~~~~~~~~~~
 414 "
 415            t
 416            (list
 417             (cons 2 (rst-Ado-new-over-and-under ?=))
 418             (cons 5 (rst-Ado-new-simple ?=))
 419             (cons 8 (rst-Ado-new-simple ?=))
 420             (cons 11 (rst-Ado-new-simple ?-))
 421             (cons 14 (rst-Ado-new-simple ?~))
 422             (cons 17 (rst-Ado-new-simple ?=))
 423             (cons 20 (rst-Ado-new-simple ?~)))
 424            ))
 425   )
 426
 427 (ert-deftest rst-hdr-hierarchy ()
 428   "Tests for `rst-hdr-hierarchy'."
 429   (let ( ;; Set customizable variables to defined values
 430         (rst-default-indent 5))
 431     (should (ert-equal-buffer-return
 432              '(rst-hdr-hierarchy)
 433              text-1
 434              t
 435              (list
 436               (rst-Hdr-new (rst-Ado-new-over-and-under ?=) 3)
 437               (rst-Hdr-new (rst-Ado-new-simple ?=) 0)
 438               (rst-Hdr-new (rst-Ado-new-simple ?-) 0)
 439               (rst-Hdr-new (rst-Ado-new-over-and-under ?~) 1))
 440              ))
 441     (should (ert-equal-buffer-return
 442              '(rst-hdr-hierarchy)
 443              (concat text-1
 444                      "
 445 =========
 446 No indent
 447 =========
 448 ")
 449              t
 450              (list
 451               (rst-Hdr-new (rst-Ado-new-over-and-under ?=) 5)
 452               (rst-Hdr-new (rst-Ado-new-simple ?=) 0)
 453               (rst-Hdr-new (rst-Ado-new-simple ?-) 0)
 454               (rst-Hdr-new (rst-Ado-new-over-and-under ?~) 1))
 455              ))
 456   ))
 457
 458 (ert-deftest rst-get-hierarchy-ignore ()
 459   "Tests for `rst-hdr-hierarchy' with ignoring a line."
 460   (should (ert-equal-buffer-return
 461            '(rst-hdr-hierarchy (point))
 462            text-1
 463            t
 464            (list
 465             (rst-Hdr-new (rst-Ado-new-over-and-under ?=) 3)
 466             (rst-Hdr-new (rst-Ado-new-simple ?=) 0)
 467             (rst-Hdr-new (rst-Ado-new-simple ?-) 0))
 468            ))
 469   (should (ert-equal-buffer-return
 470            '(rst-hdr-hierarchy (point))
 471            text-4
 472            t
 473            (list
 474             (rst-Hdr-new (rst-Ado-new-simple ?-) 0)
 475             (rst-Hdr-new (rst-Ado-new-simple ?~) 0)
 476             (rst-Hdr-new (rst-Ado-new-simple ?+) 0))
 477            ))
 478   )
 479
 480 (ert-deftest rst-adornment-level ()
 481   "Tests for `rst-adornment-level'."
 482   (should (ert-equal-buffer-return
 483            '(rst-adornment-level (rst-Ado-new-transition))
 484            text-1
 485            t
 486            t
 487            ))
 488   (should (ert-equal-buffer-return
 489            '(rst-adornment-level (rst-Ado-new-over-and-under ?=))
 490            text-1
 491            t
 492            1
 493            ))
 494   (should (ert-equal-buffer-return
 495            '(rst-adornment-level (rst-Ado-new-simple ?=))
 496            text-1
 497            t
 498            2
 499            ))
 500   (should (ert-equal-buffer-return
 501            '(rst-adornment-level (rst-Ado-new-simple ?-))
 502            text-1
 503            t
 504            3
 505            ))
 506   (should (ert-equal-buffer-return
 507            '(rst-adornment-level (rst-Ado-new-over-and-under ?~))
 508            text-1
 509            t
 510            4
 511            ))
 512   (should (ert-equal-buffer-return
 513            '(rst-adornment-level (rst-Ado-new-simple ?#))
 514            text-1
 515            t
 516            5
 517            ))
 518   )
 519
 520 (ert-deftest rst-adornment-complete-p ()
 521   "Tests for `rst-adornment-complete-p'."
 522   (should (ert-equal-buffer-return
 523            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 524            "Vaudou\^@"
 525            t
 526            nil))
 527   (should (ert-equal-buffer-return
 528            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 529            "Vaudou\^@
 530 ======"
 531            t
 532            nil))
 533   (should (ert-equal-buffer-return
 534            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 535            "
 536
 537 \^@Vaudou
 538
 539 "
 540            t
 541            nil))
 542   (should (ert-equal-buffer-return
 543            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 544            "
 545 \^@Vaudou
 546 ======
 547 "
 548            t
 549            t))
 550   (should (ert-equal-buffer-return
 551            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 552            "
 553 ======
 554 \^@Vaudou
 555 ======
 556 "
 557            t
 558            t))
 559   (should (ert-equal-buffer-return
 560            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 2)
 561            "
 562 ==========
 563 \^@  Vaudou
 564 ==========
 565 "
 566            t
 567            t))
 568   (should (ert-equal-buffer-return
 569            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 570            "
 571 \^@Vaudou
 572 =====
 573 "
 574            t
 575            nil))
 576   (should (ert-equal-buffer-return
 577            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 578            "
 579 \^@Vaudou
 580 =======
 581 "
 582            t
 583            nil))
 584   (should (ert-equal-buffer-return
 585            '(rst-adornment-complete-p (rst-Ado-new-simple ?=) 0)
 586            "
 587 \^@Vaudou
 588 ===-==
 589 "
 590            t
 591            nil))
 592   (should (ert-equal-buffer-return
 593            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 594            "
 595 ======
 596 \^@Vaudou
 597 =====
 598 "
 599            t
 600            nil))
 601   (should (ert-equal-buffer-return
 602            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 603            "
 604 =====
 605 \^@Vaudou
 606 ======
 607 "
 608            t
 609            nil))
 610   (should (ert-equal-buffer-return
 611            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 612            "
 613 ======
 614 \^@Vaudou
 615 ===-==
 616 "
 617            t
 618            nil))
 619   (should (ert-equal-buffer-return
 620            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 621            "
 622 ===-==
 623 \^@Vaudou
 624 ======
 625 "
 626            t
 627            nil))
 628   (should (ert-equal-buffer-return
 629            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 630            "
 631 ======
 632 \^@Vaudou
 633
 634 "
 635            t
 636            nil))
 637   (should (ert-equal-buffer-return
 638            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 639            "
 640 ======
 641 \^@Vaudou
 642 ------
 643 "
 644            t
 645            nil))
 646   (should (ert-equal-buffer-return
 647            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 648            "
 649 ==========
 650   \^@Vaudou
 651 =========
 652 "
 653            t
 654            nil))
 655   (should (ert-equal-buffer-return
 656            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 657            "
 658 =========
 659   \^@Vaudou
 660 ==========
 661 "
 662            t
 663            nil))
 664   (should (ert-equal-buffer-return
 665            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 666            "
 667 ==========
 668   \^@Vaudou
 669 ===-======
 670 "
 671            t
 672            nil))
 673   (should (ert-equal-buffer-return
 674            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 675            "
 676 ===-======
 677   \^@Vaudou
 678 ==========
 679 "
 680            t
 681            nil))
 682   (should (ert-equal-buffer-return
 683            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 684            "
 685 ==========
 686   \^@Vaudou
 687
 688 "
 689            t
 690            nil))
 691   (should (ert-equal-buffer-return
 692            '(rst-adornment-complete-p (rst-Ado-new-over-and-under ?=) 0)
 693            "
 694 ==========
 695   \^@Vaudou
 696 ----------
 697 "
 698            t
 699            nil))
 700   )
 701
 702 (ert-deftest rst-get-previous-hdr ()
 703   "Tests for `rst-get-previous-hdr'."
 704   (should (ert-equal-buffer-return
 705            '(rst-get-previous-hdr)
 706            "
 707
 708 Previous
 709 --------
 710
 711 \^@Current
 712
 713 Next
 714 ++++
 715
 716 "
 717            t
 718            (rst-Hdr-new (rst-Ado-new-simple ?-) 0)))
 719   (should (ert-equal-buffer-return
 720            '(rst-get-previous-hdr)
 721            "
 722
 723 Previous
 724 --------
 725
 726 Current\^@
 727 ~~~~~~~
 728
 729 Next
 730 ++++
 731
 732 "
 733            t
 734            (rst-Hdr-new (rst-Ado-new-simple ?-) 0)))
 735   )
 736
 737 (defun apply-ttl-match (ttl)
 738   "Apply the match in TTL to the buffer and return important data.
 739 Puts point at the beginning of the title line. Return a list
 740 consisting of the `rst-Ado', the indent and the three matched
 741 texts. Return nil if TTL is nil. Checks whether embedded match
 742 groups match match group 0."
 743   (when ttl
 744     (let ((match (rst-Ttl-match ttl)))
 745       (set-match-data match)
 746       (let ((whole (match-string-no-properties 0))
 747             (over (match-string-no-properties 1))
 748             (text (match-string-no-properties 2))
 749             (under (match-string-no-properties 3))
 750             (gather ""))
 751         (if over
 752             (setq gather (concat gather over "\n")))
 753         (if text
 754             (setq gather (concat gather text "\n")))
 755         (if under
 756             (setq gather (concat gather under "\n")))
 757         (if (not (string= (substring gather 0 -1) whole))
 758             (error "Match 0 '%s' doesn't match concatenated parts '%s'"
 759                    whole gather))
 760         (goto-char (match-beginning 2))
 761         (list (rst-Ttl-ado ttl) (rst-Ttl-indent ttl) over text under)))))
 762
 763 (defun classify-adornment (beg end)
 764   "Wrapper for calling `rst-classify-adornment'."
 765   (interactive "r")
 766   (apply-ttl-match (rst-classify-adornment
 767                     (buffer-substring-no-properties beg end) end)))
 768
 769 (defun classify-adornment-accept (beg end)
 770   "Wrapper for calling `rst-classify-adornment'."
 771   (interactive "r")
 772   (apply-ttl-match (rst-classify-adornment
 773                     (buffer-substring-no-properties beg end) end t)))
 774
 775 (ert-deftest rst-classify-adornment ()
 776   "Tests for `rst-classify-adornment'."
 777   (should (ert-equal-buffer-return
 778            '(classify-adornment)
 779            "
 780
 781 Du bon vin tous les jours
 782 \^@=========================\^?
 783
 784 "
 785            nil
 786            (list
 787             (rst-Ado-new-simple ?=) 0
 788             nil "Du bon vin tous les jours" "=========================")
 789            t))
 790   (should (ert-equal-buffer-return
 791            '(classify-adornment)
 792            "
 793
 794 Du bon vin tous les jours
 795 \^@====================\^?
 796
 797 "
 798            nil
 799            (list
 800             (rst-Ado-new-simple ?=) 0
 801             nil "Du bon vin tous les jours" "====================")
 802            t))
 803   (should (ert-equal-buffer-return
 804            '(classify-adornment)
 805            "\^@====================\^?
 806 Du bon vin tous les jours"
 807            nil
 808            nil
 809            t))
 810   (should (ert-equal-buffer-return
 811            '(classify-adornment-accept)
 812            "\^@====================\^?
 813 Du bon vin tous les jours"
 814            nil
 815            (list
 816             (rst-Ado-new-over-and-under ?=) 0
 817             "====================" "Du bon vin tous les jours" nil)
 818            t))
 819   (should (ert-equal-buffer-return
 820            '(classify-adornment)
 821            "
 822
 823      Du bon vin tous les jours
 824 \^@====================\^?
 825
 826 "
 827            nil
 828            (list
 829             (rst-Ado-new-simple ?=) 5
 830             nil "     Du bon vin tous les jours" "====================")
 831            t))
 832   (should (ert-equal-buffer-return
 833            '(classify-adornment)
 834            "     Du bon vin tous les jours
 835 \^@====================\^?
 836 "
 837            nil
 838            (list
 839             (rst-Ado-new-simple ?=) 5
 840             nil "     Du bon vin tous les jours" "====================")
 841            t))
 842   (should (ert-equal-buffer-return
 843            '(classify-adornment)
 844            "
 845
 846 Du bon vin tous les jours
 847 \^@-\^?
 848 "
 849            nil
 850            nil
 851            t))
 852   (should (ert-equal-buffer-return
 853            '(classify-adornment)
 854            "
 855
 856 Du bon vin tous les jours
 857 \^@--\^?
 858 "
 859            nil
 860            nil
 861            t))
 862   (should (ert-equal-buffer-return
 863            '(classify-adornment)
 864            "
 865
 866 Du bon vin tous les jours
 867 \^@---\^?
 868 "
 869            nil
 870            (list
 871             (rst-Ado-new-simple ?-) 0
 872             nil "Du bon vin tous les jours" "---")
 873            t))
 874   (should (ert-equal-buffer-return
 875            '(classify-adornment)
 876            "
 877 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 878 Du bon vin tous les jours
 879 ~~~~~~~~~~~~~~~~~~~~~~~~~
 880
 881 "
 882            nil
 883            (list
 884             (rst-Ado-new-over-and-under ?~) 0
 885             "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 886            t))
 887   (should (ert-equal-buffer-return
 888            '(classify-adornment)
 889            "~~~~~~~~~~~~~~~~~~~~~~~~~
 890 Du bon vin tous les jours
 891 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 892
 893 "
 894            nil
 895            (list
 896             (rst-Ado-new-over-and-under ?~) 0
 897             "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 898            t))
 899   (should (ert-equal-buffer-return
 900            '(classify-adornment)
 901            "
 902 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 903    Du bon vin tous les jours
 904 ~~~~~~~~~~~~~~~~~~~~~~~~~
 905
 906 "
 907            nil
 908            (list
 909             (rst-Ado-new-over-and-under ?~) 3
 910             "~~~~~~~~~~~~~~~~~~~~~~~~~" "   Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 911            t))
 912   (should (ert-equal-buffer-return
 913            '(classify-adornment)
 914            "
 915 \^@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 916 Du bon vin tous les jours
 917 ~~~~~~~~~~~~~~~~~~~
 918
 919 "
 920            nil
 921            (list
 922             (rst-Ado-new-over-and-under ?~) 0
 923             "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~")
 924            t))
 925   (should (ert-equal-buffer-return
 926            '(classify-adornment)
 927            "
 928 ---------------------------
 929 Du bon vin tous les jours
 930 \^@~~~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 931
 932 "
 933            nil
 934            nil
 935            t))
 936   (should (ert-equal-buffer-return
 937            '(classify-adornment)
 938            "\^@---------------------------\^?"
 939            nil
 940            (list
 941             (rst-Ado-new-transition) nil
 942             nil "---------------------------" nil)
 943            t))
 944   (should (ert-equal-buffer-return
 945            '(classify-adornment)
 946            "
 947 \^@===\^?
 948 "
 949            nil
 950            (list
 951             (rst-Ado-new-transition) nil
 952             nil "===" nil)
 953            t))
 954   (should (ert-equal-buffer-return
 955            '(classify-adornment)
 956            "
 957 \^@---------------------------\^?
 958 Du bon vin tous les jours
 959 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 960
 961 "
 962            nil
 963            nil
 964            t))
 965   (should (ert-equal-buffer-return
 966            '(classify-adornment)
 967            "
 968 =========================
 969 Du bon vin tous les jours
 970 \^@=========================\^?
 971 Du bon vin
 972
 973 "
 974            nil
 975            (list
 976             (rst-Ado-new-over-and-under ?=) 0
 977             "=========================" "Du bon vin tous les jours" "=========================")
 978            t))
 979   (should (ert-equal-buffer-return
 980            '(classify-adornment)
 981            "
 982 =========================
 983 Du bon vin tous les jours
 984 =========================
 985 Du bon vin
 986 \^@----------\^?
 987
 988 "
 989            nil
 990            (list
 991             (rst-Ado-new-simple ?-) 0
 992             nil "Du bon vin" "----------")
 993            t))
 994   (should (ert-equal-buffer-return
 995            '(classify-adornment)
 996            "
 997 =========================
 998 Du bon vin tous les jours
 999 =========================
1000 \^@----------\^?
1001 Du bon vin
1002 ----------
1003
1004 "
1005            nil
1006            (list
1007             (rst-Ado-new-over-and-under ?-) 0
1008             "----------" "Du bon vin" "----------")
1009            t))
1010   (should (ert-equal-buffer-return
1011            '(classify-adornment)
1012            "
1013 =========================
1014 Du bon vin tous les jours
1015 =========================
1016 --------------
1017   Du bon vin
1018 \^@--------------\^?
1019
1020 "
1021            nil
1022            (list
1023             (rst-Ado-new-over-and-under ?-) 2
1024              "--------------" "  Du bon vin" "--------------")
1025            t))
1026   )
1027
1028 (defun display-adornments-hierarchy ()
1029   "Wrapper for calling `rst-display-hdr-hierarchy'."
1030   (rst-display-hdr-hierarchy)
1031   (let ((source (get-buffer "*rest section hierarchy*")))
1032     (delete-region (point-min) (point-max))
1033     (insert (with-current-buffer source
1034               (buffer-substring (point-min) (point-max))))
1035     (kill-buffer source)))
1036
1037 (ert-deftest rst-display-hdr-hierarchy ()
1038   "Tests for `rst-display-hdr-hierarchy'."
1039   (should (ert-equal-buffer
1040            '(display-adornments-hierarchy)
1041            ""
1042            "
1043 "
1044            ))
1045   (should (ert-equal-buffer
1046            '(display-adornments-hierarchy)
1047            "
1048 First
1049 -----
1050
1051 Second
1052 ======
1053
1054 First again
1055 -----------
1056
1057 Second again
1058 ============
1059
1060 +++++
1061 Third
1062 +++++
1063
1064 "
1065            "
1066 Section Level 1
1067 ---------------
1068
1069
1070 Section Level 2
1071 ===============
1072
1073
1074 +++++++++++++++
1075 Section Level 3
1076 +++++++++++++++
1077 "
1078              ))
1079     )
1080
1081 (ert-deftest rst-adjust-region ()
1082   "Tests for `rst-adjust-region'."
1083   (let ((rst-preferred-adornments '((?= over-and-under 1)
1084                                     (?= simple 0)
1085                                     (?- simple 0)
1086                                     (?~ simple 0)
1087                                     (?+ simple 0)
1088                                     (?` simple 0)
1089                                     (?# simple 0)
1090                                     (?@ simple 0))))
1091     (should (ert-equal-buffer
1092              '(rst-adjust-region nil)
1093              "\^@\^?"
1094              t
1095              ))
1096     (should (ert-equal-buffer
1097              '(rst-adjust-region nil)
1098              "
1099 First
1100 -----
1101 \^@
1102 Second
1103 ======
1104 \^?
1105 First again
1106 -----------
1107
1108 Second again
1109 ============
1110
1111 +++++
1112 Third
1113 +++++
1114
1115 "
1116              "
1117 First
1118 -----
1119 \^@
1120 Second
1121 ------
1122 \^?
1123 First again
1124 -----------
1125
1126 Second again
1127 ============
1128
1129 +++++
1130 Third
1131 +++++
1132
1133 "
1134              ))
1135     (should (ert-equal-buffer
1136              '(rst-adjust-region nil)
1137              "
1138 First
1139 -----
1140
1141 Second
1142 ======
1143
1144 First again
1145 -----------
1146 \^@
1147 Second again
1148 ============
1149
1150 +++++
1151 Third
1152 +++++
1153 \^?
1154 "
1155              "
1156 First
1157 -----
1158
1159 Second
1160 ======
1161
1162 First again
1163 -----------
1164 \^@
1165 Second again
1166 ------------
1167
1168 Third
1169 =====
1170 \^?
1171 "
1172              ))
1173     (should (ert-equal-buffer
1174              '(rst-adjust-region nil)
1175              "
1176 First
1177 -----
1178
1179 Second
1180 ======
1181 \^@
1182 First again
1183 -----------
1184 \^?
1185 Second again
1186 ============
1187
1188 +++++
1189 Third
1190 +++++
1191
1192 "
1193              "
1194 First
1195 -----
1196
1197 Second
1198 ======
1199
1200 =============
1201  First again
1202 =============
1203
1204 Second again
1205 ============
1206
1207 +++++
1208 Third
1209 +++++
1210
1211 "
1212              ))
1213     (should (ert-equal-buffer
1214              '(rst-adjust-region t)
1215              "
1216 First
1217 -----
1218
1219 Second
1220 ======
1221 \^@
1222 First again
1223 -----------
1224 \^?
1225 Second again
1226 ============
1227
1228 +++++
1229 Third
1230 +++++
1231
1232 "
1233              "
1234 First
1235 -----
1236
1237 Second
1238 ======
1239 \^@
1240 First again
1241 ===========
1242 \^?
1243 Second again
1244 ============
1245
1246 +++++
1247 Third
1248 +++++
1249
1250 "
1251              ))
1252     (should (ert-equal-buffer
1253              '(rst-adjust-region t)
1254              "
1255 First
1256 -----
1257
1258 Second
1259 ======
1260
1261 First again
1262 -----------
1263
1264 Second again
1265 ============
1266 \^@
1267 +++++
1268 Third
1269 +++++
1270 \^?
1271 "
1272              "
1273 First
1274 -----
1275
1276 Second
1277 ======
1278
1279 First again
1280 -----------
1281
1282 Second again
1283 ============
1284
1285 =======
1286  Third
1287 =======
1288
1289 "
1290              ))
1291   ))
1292
1293 (ert-deftest rst-straighten-sections ()
1294   "Tests for `rst-straighten-sections'."
1295   (let ((rst-preferred-adornments '((?= over-and-under 1)
1296                                     (?= simple 0)
1297                                     (?- simple 0)
1298                                     (?~ simple 0)
1299                                     (?+ simple 0)
1300                                     (?` simple 0)
1301                                     (?# simple 0)
1302                                     (?@ simple 0))))
1303     (should (ert-equal-buffer
1304              '(rst-straighten-sections)
1305              ""
1306              t
1307              ))
1308     (should (ert-equal-buffer
1309              '(rst-straighten-sections)
1310              "
1311 First
1312 -----
1313
1314 Second
1315 ======
1316
1317 First again
1318 -----------
1319
1320 Second again
1321 ============
1322
1323 +++++
1324 Third
1325 +++++
1326
1327 "
1328              "
1329 =======
1330  First
1331 =======
1332
1333 Second
1334 ======
1335
1336 =============
1337  First again
1338 =============
1339
1340 Second again
1341 ============
1342
1343 Third
1344 -----
1345
1346 "
1347              ))
1348   ))
1349
1350 (defun find-all-levels ()
1351   "Call `rst-all-ttls-with-level' and return conses of line and level."
1352   (mapcar (cl-function
1353            (lambda ((ttl . level))
1354              (cons (line-number-at-pos (rst-Ttl-get-title-beginning ttl))
1355                    level)))
1356           (rst-all-ttls-with-level)))
1357
1358 (ert-deftest rst-all-ttls-with-level ()
1359   "Tests for `rst-all-ttls-with-level'."
1360   (should (ert-equal-buffer-return
1361            '(find-all-levels)
1362            ""
1363            t
1364            nil
1365            ))
1366   (should (ert-equal-buffer-return
1367            '(find-all-levels)
1368            "
1369   Not a valid section header because of indentation
1370 ===================================================
1371 "
1372            t
1373            nil
1374            ))
1375   (should (ert-equal-buffer-return
1376            '(find-all-levels)
1377            "
1378 Valid simple section header
1379 ===========================
1380 "
1381            t
1382            (list
1383             '(2 . 0))
1384            ))
1385   (should (ert-equal-buffer-return
1386            '(find-all-levels)
1387            "
1388 =======================================
1389   Valid over and under section header
1390 =======================================
1391 "
1392            t
1393            (list
1394             '(3 . 0))
1395            ))
1396   (should (ert-equal-buffer-return
1397            '(find-all-levels)
1398            text-1
1399            t
1400            '(
1401              (2 . 0)
1402              (7 . 1)
1403              (12 . 2)
1404              (17 . 1)
1405              (22 . 2)
1406              (26 . 3)
1407              (31 . 1))
1408            ))
1409   (should (ert-equal-buffer-return
1410            '(find-all-levels)
1411            text-2
1412            t
1413            '(
1414              (3 . 0)
1415              (6 . 1)
1416              (9 . 2))
1417            ))
1418   (should (ert-equal-buffer-return
1419            '(find-all-levels)
1420            text-3
1421            t
1422            '(
1423              (3 . 0)
1424              (6 . 1))
1425            ))
1426   )
1427
1428 (defun update-section (char simplep indent)
1429   "Call `rst-update-section' with proper header."
1430   (rst-update-section
1431    (rst-Hdr-new (if simplep
1432                     (rst-Ado-new-simple char)
1433                   (rst-Ado-new-over-and-under char)) indent)))
1434
1435 (ert-deftest rst-update-section ()
1436   "Tests for `rst-update-section'."
1437   (should (ert-equal-buffer
1438            '(update-section ?= t 0)
1439            "
1440
1441 \^@abc
1442
1443 "
1444            "
1445
1446 abc\^@
1447 ===
1448
1449 "
1450
1451            ))
1452   (should (ert-equal-buffer
1453            '(update-section ?= nil 2)
1454            "
1455
1456 \^@abc
1457
1458 "
1459            "
1460
1461 =======
1462   abc\^@
1463 =======
1464
1465 "
1466
1467            ))
1468   (should (ert-equal-buffer
1469            '(update-section ?= nil 2)
1470            "
1471
1472 def
1473 ---
1474 \^@abc
1475
1476 "
1477            "
1478
1479 def
1480 ---
1481 =======
1482   abc\^@
1483 =======
1484
1485 "
1486
1487            ))
1488   (should (ert-equal-buffer
1489            '(update-section ?= nil 2)
1490            "
1491
1492 ---
1493 \^@abc
1494
1495 "
1496            "
1497
1498 =======
1499   abc\^@
1500 =======
1501
1502 "
1503
1504            ))
1505   (should (ert-equal-buffer
1506            '(update-section ?= t 0)
1507            "\^@abc
1508
1509 "
1510            "abc\^@
1511 ===
1512
1513 "
1514
1515            ))
1516   (should (ert-equal-buffer
1517            '(update-section ?= nil 0)
1518            "\^@abc
1519
1520 "
1521            "===
1522 abc\^@
1523 ===
1524
1525 "
1526
1527            ))
1528   (should (ert-equal-buffer
1529            '(update-section ?= t 0)
1530            "\^@abc"
1531            "abc\^@
1532 ===
1533 "
1534
1535            ))
1536   (should (ert-equal-buffer
1537            '(update-section ?= t 0)
1538            "\^@abc
1539 "
1540            "abc\^@
1541 ===
1542 "
1543
1544            ))
1545   (should (ert-equal-buffer
1546            '(update-section ?= t 0)
1547            "\^@abc
1548  "
1549            "abc\^@
1550 ===
1551  "
1552
1553            ))
1554   (should (ert-equal-buffer
1555            '(update-section ?= t 0)
1556            "===
1557 \^@abc
1558 ===
1559 "
1560            "abc\^@
1561 ===
1562 "
1563
1564            ))
1565   )