sandbox/gitpull/web_stylesheet_and_menu/tools/editors/emacs/tests/adornment.el

   1 ;; Tests for various functions handling adornments
   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 find-title-line ()
  14   "Wrapper for calling `rst-find-title-line'."
  15   (apply-adornment-match (rst-find-title-line)))
  16
  17 (ert-deftest rst-find-title-line ()
  18   "Tests for `rst-find-title-line'."
  19   (should (ert-equal-buffer-return
  20            (find-title-line)
  21            "
  22
  23 Du bon vin tous les jours.
  24 \^@
  25 "
  26            "
  27
  28 \^@Du bon vin tous les jours.
  29
  30 "
  31            '((nil . nil) nil "Du bon vin tous les jours." nil)
  32            ))
  33   (should (ert-equal-buffer-return
  34            (find-title-line)
  35            "
  36 \^@
  37 Du bon vin tous les jours.
  38
  39 "
  40            "
  41
  42 \^@Du bon vin tous les jours.
  43
  44 "
  45            '((nil . nil) nil "Du bon vin tous les jours." nil)
  46            ))
  47   (should (ert-equal-buffer-return
  48            (find-title-line)
  49            "
  50
  51 Du bon vin tous les jours.
  52 ------\^@-----
  53 "
  54            "
  55
  56 \^@Du bon vin tous les jours.
  57 -----------
  58 "
  59            '((?- . simple) nil "Du bon vin tous les jours." "-----------")
  60            ))
  61   (should (ert-equal-buffer-return
  62            (find-title-line)
  63            "
  64 ------\^@-----
  65 Du bon vin tous les jours.
  66
  67 "
  68            "
  69 -----------
  70 \^@Du bon vin tous les jours.
  71
  72 "
  73            '((?- . nil) "-----------" "Du bon vin tous les jours." nil)
  74            ))
  75   (should (ert-equal-buffer-return
  76            (find-title-line)
  77            "
  78 \^@-----------
  79 Du bon vin tous les jours.
  80 -----------
  81
  82 "
  83            "
  84 -----------
  85 \^@Du bon vin tous les jours.
  86 -----------
  87
  88 "
  89            '((?- . over-and-under) "-----------" "Du bon vin tous les jours."
  90              "-----------")
  91            ))
  92   (should (ert-equal-buffer-return
  93            (find-title-line)
  94            "
  95 Du bon vin tous les jours.
  96 \^@-----------
  97 Du bon vin tous les jours.
  98 -----------
  99
 100 "
 101            "
 102 Du bon vin tous les jours.
 103 -----------
 104 \^@Du bon vin tous les jours.
 105 -----------
 106
 107 " ; This is not how the parser works but looks more logical
 108            '((?- . over-and-under) "-----------" "Du bon vin tous les jours."
 109              "-----------")
 110            ))
 111   (should (ert-equal-buffer-return
 112            (find-title-line)
 113            "
 114
 115 \^@-----------
 116
 117 "
 118            "
 119
 120 \^@-----------
 121
 122 "
 123            nil
 124            ))
 125   (should (ert-equal-buffer-return
 126            (find-title-line)
 127            "
 128 Line 1
 129 \^@
 130 Line 2
 131
 132 "
 133            "
 134 \^@Line 1
 135
 136 Line 2
 137
 138 "
 139            '((nil . nil) nil "Line 1" nil)
 140            ))
 141   (should (ert-equal-buffer-return
 142            (find-title-line)
 143            "
 144 =====================================
 145    Project Idea: Panorama Stitcher
 146 ====================================
 147
 148 :Author: Martin Blais <blais@furius.ca>
 149 \^@
 150 Another Title
 151 =============
 152 "
 153            "
 154 =====================================
 155    Project Idea: Panorama Stitcher
 156 ====================================
 157
 158 \^@:Author: Martin Blais <blais@furius.ca>
 159
 160 Another Title
 161 =============
 162 "
 163            '((nil . nil) nil ":Author: Martin Blais <blais@furius.ca>" nil)
 164            ))
 165   )
 166
 167 (setq text-1
 168 "===============================
 169    Project Idea: My Document
 170 ===============================
 171
 172 :Author: Martin Blais
 173
 174 Introduction
 175 ============
 176
 177 This is the introduction.
 178
 179 Notes
 180 -----
 181
 182 Some notes.
 183
 184 Main Points
 185 ===========
 186
 187 Yep.
 188
 189 Super Point
 190 -----------
 191
 192 ~~~~~~~~~~~
 193 \^@ Sub Point
 194 ~~~~~~~~~~~
 195
 196 Isn't this fabulous?
 197
 198 Conclusion
 199 ==========
 200
 201 That's it, really.
 202
 203 ")
 204
 205 (setq text-2
 206 "
 207
 208 Previous
 209 --------
 210
 211 Current\^@
 212 ~~~~~~~
 213
 214 Next
 215 ++++
 216
 217 ")
 218
 219 (setq text-3
 220 "
 221
 222 Previous
 223 --------
 224
 225 Current\^@
 226 ~~~~~~~
 227
 228   Next
 229   ++++
 230
 231 ")
 232
 233 (ert-deftest rst-find-all-adornments ()
 234   "Tests for `rst-find-all-adornments'."
 235   (should (ert-equal-buffer-return
 236            (rst-find-all-adornments)
 237            text-1
 238            t
 239            '((2 ?= over-and-under 3)
 240              (7 ?= simple 0)
 241              (12 ?- simple 0)
 242              (17 ?= simple 0)
 243              (22 ?- simple 0)
 244              (26 ?~ over-and-under 1)
 245              (31 ?= simple 0))
 246            ))
 247   (should (ert-equal-buffer-return
 248            (rst-find-all-adornments)
 249            text-2
 250            t
 251            '((3 ?- simple 0)
 252              (6 ?~ simple 0)
 253              (9 ?+ simple 0))
 254            ))
 255   (should (ert-equal-buffer-return
 256            (rst-find-all-adornments)
 257            text-3
 258            t
 259            '((3 ?- simple 0)
 260              (6 ?~ simple 0))
 261            ))
 262   )
 263
 264 (ert-deftest rst-get-hierarchy ()
 265   "Tests for `rst-get-hierarchy'."
 266   (should (ert-equal-buffer-return
 267            (rst-get-hierarchy)
 268            text-1
 269            t
 270            '((?= over-and-under 3)
 271              (?= simple 0)
 272              (?- simple 0)
 273              (?~ over-and-under 1))
 274            ))
 275   )
 276
 277 (ert-deftest rst-get-hierarchy-ignore ()
 278   "Tests for `rst-get-hierarchy' with ignoring a line."
 279   (should (ert-equal-buffer-return
 280            (rst-get-hierarchy 26)
 281            text-1
 282            t
 283            '((?= over-and-under 3)
 284              (?= simple 0)
 285              (?- simple 0))
 286            ))
 287   )
 288
 289 (ert-deftest rst-adornment-level ()
 290   "Tests for `rst-adornment-level'."
 291   (should (ert-equal-buffer-return
 292            (rst-adornment-level t)
 293            text-1
 294            t
 295            t
 296            ))
 297   (should (ert-equal-buffer-return
 298            (rst-adornment-level nil)
 299            text-1
 300            t
 301            nil
 302            ))
 303   (should (ert-equal-buffer-return
 304            (rst-adornment-level (?= . over-and-under))
 305            text-1
 306            t
 307            1
 308            ))
 309   (should (ert-equal-buffer-return
 310            (rst-adornment-level (?= . simple))
 311            text-1
 312            t
 313            2
 314            ))
 315   (should (ert-equal-buffer-return
 316            (rst-adornment-level (?- . simple))
 317            text-1
 318            t
 319            3
 320            ))
 321   (should (ert-equal-buffer-return
 322            (rst-adornment-level (?~ . over-and-under))
 323            text-1
 324            t
 325            4
 326            ))
 327   (should (ert-equal-buffer-return
 328            (rst-adornment-level (?# . simple))
 329            text-1
 330            t
 331            5
 332            ))
 333   )
 334
 335 (ert-deftest rst-adornment-complete-p ()
 336   "Tests for `rst-adornment-complete-p'."
 337   (should (ert-equal-buffer-return
 338            (rst-adornment-complete-p (?= simple 0))
 339            "
 340
 341 \^@Vaudou
 342
 343 "
 344            t
 345            nil))
 346   (should (ert-equal-buffer-return
 347            (rst-adornment-complete-p (?= simple 0))
 348            "
 349 \^@Vaudou
 350 ======
 351 "
 352            t
 353            t))
 354   (should (ert-equal-buffer-return
 355            (rst-adornment-complete-p (?= over-and-under 0))
 356            "
 357 ======
 358 \^@Vaudou
 359 ======
 360 "
 361            t
 362            t))
 363   (should (ert-equal-buffer-return
 364            (rst-adornment-complete-p (?= over-and-under 2))
 365            "
 366 ==========
 367 \^@  Vaudou
 368 ==========
 369 "
 370            t
 371            t))
 372   (should (ert-equal-buffer-return
 373            (rst-adornment-complete-p (?= simple 0))
 374            "
 375 \^@Vaudou
 376 =====
 377 "
 378            t
 379            nil))
 380   (should (ert-equal-buffer-return
 381            (rst-adornment-complete-p (?= simple 0))
 382            "
 383 \^@Vaudou
 384 =======
 385 "
 386            t
 387            nil))
 388   (should (ert-equal-buffer-return
 389            (rst-adornment-complete-p (?= simple 0))
 390            "
 391 \^@Vaudou
 392 ===-==
 393 "
 394            t
 395            nil))
 396   (should (ert-equal-buffer-return
 397            (rst-adornment-complete-p (?= over-and-under 0))
 398            "
 399 ======
 400 \^@Vaudou
 401 =====
 402 "
 403            t
 404            nil))
 405   (should (ert-equal-buffer-return
 406            (rst-adornment-complete-p (?= over-and-under 0))
 407            "
 408 =====
 409 \^@Vaudou
 410 ======
 411 "
 412            t
 413            nil))
 414   (should (ert-equal-buffer-return
 415            (rst-adornment-complete-p (?= over-and-under 0))
 416            "
 417 ======
 418 \^@Vaudou
 419 ===-==
 420 "
 421            t
 422            nil))
 423   (should (ert-equal-buffer-return
 424            (rst-adornment-complete-p (?= over-and-under 0))
 425            "
 426 ===-==
 427 \^@Vaudou
 428 ======
 429 "
 430            t
 431            nil))
 432   (should (ert-equal-buffer-return
 433            (rst-adornment-complete-p (?= over-and-under 0))
 434            "
 435 ======
 436 \^@Vaudou
 437
 438 "
 439            t
 440            nil))
 441   (should (ert-equal-buffer-return
 442            (rst-adornment-complete-p (?= over-and-under 0))
 443            "
 444 ======
 445 \^@Vaudou
 446 ------
 447 "
 448            t
 449            nil))
 450   (should (ert-equal-buffer-return
 451            (rst-adornment-complete-p (?= over-and-under 0))
 452            "
 453 ==========
 454   \^@Vaudou
 455 =========
 456 "
 457            t
 458            nil))
 459   (should (ert-equal-buffer-return
 460            (rst-adornment-complete-p (?= over-and-under 0))
 461            "
 462 =========
 463   \^@Vaudou
 464 ==========
 465 "
 466            t
 467            nil))
 468   (should (ert-equal-buffer-return
 469            (rst-adornment-complete-p (?= over-and-under 0))
 470            "
 471 ==========
 472   \^@Vaudou
 473 ===-======
 474 "
 475            t
 476            nil))
 477   (should (ert-equal-buffer-return
 478            (rst-adornment-complete-p (?= over-and-under 0))
 479            "
 480 ===-======
 481   \^@Vaudou
 482 ==========
 483 "
 484            t
 485            nil))
 486   (should (ert-equal-buffer-return
 487            (rst-adornment-complete-p (?= over-and-under 0))
 488            "
 489 ==========
 490   \^@Vaudou
 491
 492 "
 493            t
 494            nil))
 495   (should (ert-equal-buffer-return
 496            (rst-adornment-complete-p (?= over-and-under 0))
 497            "
 498 ==========
 499   \^@Vaudou
 500 ----------
 501 "
 502            t
 503            nil))
 504   )
 505
 506 (ert-deftest rst-get-adornments-around ()
 507   "Tests for `rst-get-adornments-around'."
 508   (should (ert-equal-buffer-return
 509            (rst-get-adornments-around)
 510            "
 511
 512 Previous
 513 --------
 514
 515 \^@Current
 516
 517 Next
 518 ++++
 519
 520 "
 521            t
 522            '((?- simple 0) (?+ simple 0))))
 523   (should (ert-equal-buffer-return
 524            (rst-get-adornments-around)
 525            "
 526
 527 Previous
 528 --------
 529
 530 Current\^@
 531 ~~~~~~~
 532
 533 Next
 534 ++++
 535
 536 "
 537            t
 538            '((?- simple 0) (?+ simple 0))))
 539   )
 540
 541 (defun apply-adornment-match (match)
 542   "Apply the MATCH to the buffer and return important data.
 543 MATCH is as returned by `rst-classify-adornment' or
 544 `rst-find-title-line'. Puts point in the beginning of the title
 545 line. Return a list consisting of (CHARACTER . STYLE) and the
 546 three embedded match groups. Return nil if MATCH is nil. Checks
 547 whether embedded match groups match match group 0."
 548   (when match
 549     (set-match-data (cdr match))
 550     (let ((whole (match-string-no-properties 0))
 551           (over (match-string-no-properties 1))
 552           (text (match-string-no-properties 2))
 553           (under (match-string-no-properties 3))
 554           (gather ""))
 555       (if over
 556           (setq gather (concat gather over "\n")))
 557       (if text
 558           (setq gather (concat gather text "\n")))
 559       (if under
 560           (setq gather (concat gather under "\n")))
 561       (if (not (string= (substring gather 0 -1) whole))
 562           (error "Match 0 '%s' doesn't match concatenated parts '%s'"
 563                  whole gather))
 564       (goto-char (match-beginning 2))
 565       (list (car match) over text under))))
 566
 567 (defun classify-adornment (beg end)
 568   "Wrapper for calling `rst-classify-adornment'."
 569   (interactive "r")
 570   (apply-adornment-match (rst-classify-adornment
 571                           (buffer-substring-no-properties beg end) end)))
 572
 573 (ert-deftest rst-classify-adornment ()
 574   "Tests for `rst-classify-adornment'."
 575   (should (ert-equal-buffer-return
 576            (classify-adornment)
 577            "
 578
 579 Du bon vin tous les jours
 580 \^@=========================\^?
 581
 582 "
 583            nil
 584            '((?= . simple)
 585              nil "Du bon vin tous les jours" "=========================")
 586            t))
 587   (should (ert-equal-buffer-return
 588            (classify-adornment)
 589            "
 590
 591 Du bon vin tous les jours
 592 \^@====================\^?
 593
 594 "
 595            nil
 596            '((?= . simple)
 597              nil "Du bon vin tous les jours" "====================")
 598            t))
 599   (should (ert-equal-buffer-return
 600            (classify-adornment)
 601            "
 602
 603      Du bon vin tous les jours
 604 \^@====================\^?
 605
 606 "
 607            nil
 608            '((?= . simple)
 609              nil "     Du bon vin tous les jours" "====================")
 610            t))
 611   (should (ert-equal-buffer-return
 612            (classify-adornment)
 613            "
 614
 615 Du bon vin tous les jours
 616 \^@-\^?
 617 "
 618            nil
 619            nil
 620            t))
 621   (should (ert-equal-buffer-return
 622            (classify-adornment)
 623            "
 624
 625 Du bon vin tous les jours
 626 \^@--\^?
 627 "
 628            nil
 629            nil
 630            t))
 631   (should (ert-equal-buffer-return
 632            (classify-adornment)
 633            "
 634
 635 Du bon vin tous les jours
 636 \^@---\^?
 637 "
 638            nil
 639            '((?- . simple)
 640              nil "Du bon vin tous les jours" "---")
 641            t))
 642   (should (ert-equal-buffer-return
 643            (classify-adornment)
 644            "
 645 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 646 Du bon vin tous les jours
 647 ~~~~~~~~~~~~~~~~~~~~~~~~~
 648
 649 "
 650            nil
 651            '((?~ . over-and-under)
 652              "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 653            t))
 654   (should (ert-equal-buffer-return
 655            (classify-adornment)
 656            "~~~~~~~~~~~~~~~~~~~~~~~~~
 657 Du bon vin tous les jours
 658 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 659
 660 "
 661            nil
 662            '((?~ . over-and-under)
 663              "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 664            t))
 665   (should (ert-equal-buffer-return
 666            (classify-adornment)
 667            "
 668 \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 669    Du bon vin tous les jours
 670 ~~~~~~~~~~~~~~~~~~~~~~~~~
 671
 672 "
 673            nil
 674            '((?~ . over-and-under)
 675              "~~~~~~~~~~~~~~~~~~~~~~~~~" "   Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~")
 676            t))
 677   (should (ert-equal-buffer-return
 678            (classify-adornment)
 679            "
 680 \^@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 681 Du bon vin tous les jours
 682 ~~~~~~~~~~~~~~~~~~~
 683
 684 "
 685            nil
 686            '((?~ . over-and-under)
 687              "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~")
 688            t))
 689   (should (ert-equal-buffer-return
 690            (classify-adornment)
 691            "
 692 ---------------------------
 693 Du bon vin tous les jours
 694 \^@~~~~~~~~~~~~~~~~~~~~~~~~~~~\^?
 695
 696 "
 697            nil
 698            '((?~ . simple)
 699              nil "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~~~")
 700            t))
 701   (should (ert-equal-buffer-return
 702            (classify-adornment)
 703            "\^@---------------------------\^?"
 704            nil
 705            '(t
 706              nil "---------------------------" nil)
 707            t))
 708   (should (ert-equal-buffer-return
 709            (classify-adornment)
 710            "
 711 \^@---------------------------\^?
 712 Du bon vin tous les jours
 713 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 714
 715 "
 716            nil
 717            nil
 718            t))
 719   (should (ert-equal-buffer-return
 720            (classify-adornment)
 721            "
 722 =========================
 723 Du bon vin tous les jours
 724 \^@=========================\^?
 725 Du bon vin
 726
 727 "
 728            nil
 729            '((?= . over-and-under)
 730              "=========================" "Du bon vin tous les jours" "=========================")
 731            t))
 732   (should (ert-equal-buffer-return
 733            (classify-adornment)
 734            "
 735 =========================
 736 Du bon vin tous les jours
 737 =========================
 738 Du bon vin
 739 \^@----------\^?
 740
 741 "
 742            nil
 743            '((?- . simple)
 744              nil "Du bon vin" "----------")
 745            t))
 746   (should (ert-equal-buffer-return
 747            (classify-adornment)
 748            "
 749 =========================
 750 Du bon vin tous les jours
 751 =========================
 752 \^@----------\^?
 753 Du bon vin
 754 ----------
 755
 756 "
 757            nil
 758            '((?- . over-and-under)
 759              "----------" "Du bon vin" "----------")
 760            t))
 761   (should (ert-equal-buffer-return
 762            (classify-adornment)
 763            "
 764 =========================
 765 Du bon vin tous les jours
 766 =========================
 767 --------------
 768   Du bon vin
 769 \^@--------------\^?
 770
 771 "
 772            nil
 773            '((?- . over-and-under)
 774              "--------------" "  Du bon vin" "--------------")
 775            t))
 776   )