code.delx.au - gnu-emacs-elpa/blob - packages/hydra/hydra-test.el

   1 ;;; hydra-test.el --- Tests for Hydra
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24
  25 ;;; Code:
  26
  27 (require 'ert)
  28 (require 'hydra)
  29 (message "Emacs version: %s" emacs-version)
  30
  31 (ert-deftest hydra-red-error ()
  32   (should
  33    (equal
  34     (macroexpand
  35      '(defhydra hydra-error (global-map "M-g")
  36        "error"
  37        ("h" first-error "first")
  38        ("j" next-error "next")
  39        ("k" previous-error "prev")
  40        ("SPC" hydra-repeat "rep" :bind nil)))
  41     '(progn
  42       (set
  43        (defvar hydra-error/keymap nil
  44          "Keymap for hydra-error.")
  45        (quote
  46         (keymap
  47          (32 . hydra-repeat)
  48          (107 . hydra-error/previous-error)
  49          (106 . hydra-error/next-error)
  50          (104 . hydra-error/first-error)
  51          (kp-subtract . hydra--negative-argument)
  52          (kp-9 . hydra--digit-argument)
  53          (kp-8 . hydra--digit-argument)
  54          (kp-7 . hydra--digit-argument)
  55          (kp-6 . hydra--digit-argument)
  56          (kp-5 . hydra--digit-argument)
  57          (kp-4 . hydra--digit-argument)
  58          (kp-3 . hydra--digit-argument)
  59          (kp-2 . hydra--digit-argument)
  60          (kp-1 . hydra--digit-argument)
  61          (kp-0 . hydra--digit-argument)
  62          (57 . hydra--digit-argument)
  63          (56 . hydra--digit-argument)
  64          (55 . hydra--digit-argument)
  65          (54 . hydra--digit-argument)
  66          (53 . hydra--digit-argument)
  67          (52 . hydra--digit-argument)
  68          (51 . hydra--digit-argument)
  69          (50 . hydra--digit-argument)
  70          (49 . hydra--digit-argument)
  71          (48 . hydra--digit-argument)
  72          (45 . hydra--negative-argument)
  73          (21 . hydra--universal-argument))))
  74       (set
  75        (defvar hydra-error/heads nil
  76          "Heads for hydra-error.")
  77        (quote
  78         (("h"
  79           first-error
  80           "first"
  81           :exit nil)
  82          ("j"
  83           next-error
  84           "next"
  85           :exit nil)
  86          ("k"
  87           previous-error
  88           "prev"
  89           :exit nil)
  90          ("SPC"
  91           hydra-repeat
  92           "rep"
  93           :bind nil
  94           :exit nil))))
  95       (set
  96        (defvar hydra-error/hint nil
  97          "Dynamic hint for hydra-error.")
  98        (quote
  99         (format
 100          #("error: [h]: first, [j]: next, [k]: prev, [SPC]: rep."
 101            8 9 (face hydra-face-red)
 102            20 21 (face hydra-face-red)
 103            31 32 (face hydra-face-red)
 104            42 45 (face hydra-face-red)))))
 105       (defun hydra-error/first-error nil
 106         "Create a hydra with a \"M-g\" body and the heads:
 107
 108 \"h\":    `first-error',
 109 \"j\":    `next-error',
 110 \"k\":    `previous-error',
 111 \"SPC\":    `hydra-repeat'
 112
 113 The body can be accessed via `hydra-error/body'.
 114
 115 Call the head: `first-error'."
 116         (interactive)
 117         (hydra-default-pre)
 118         (let ((hydra--ignore t))
 119           (hydra-keyboard-quit))
 120         (condition-case err
 121             (progn
 122               (setq this-command
 123                     (quote first-error))
 124               (call-interactively
 125                (function first-error)))
 126           ((quit error)
 127            (message "%S" err)
 128            (unless hydra-lv (sit-for 0.8))))
 129         (when hydra-is-helpful
 130           (if hydra-lv
 131               (lv-message
 132                (eval hydra-error/hint))
 133             (message
 134              (eval hydra-error/hint))))
 135         (hydra-set-transient-map
 136          hydra-error/keymap
 137          (lambda nil
 138            (hydra-keyboard-quit)
 139            nil)
 140          nil))
 141       (defun hydra-error/next-error nil
 142         "Create a hydra with a \"M-g\" body and the heads:
 143
 144 \"h\":    `first-error',
 145 \"j\":    `next-error',
 146 \"k\":    `previous-error',
 147 \"SPC\":    `hydra-repeat'
 148
 149 The body can be accessed via `hydra-error/body'.
 150
 151 Call the head: `next-error'."
 152         (interactive)
 153         (hydra-default-pre)
 154         (let ((hydra--ignore t))
 155           (hydra-keyboard-quit))
 156         (condition-case err
 157             (progn
 158               (setq this-command
 159                     (quote next-error))
 160               (call-interactively
 161                (function next-error)))
 162           ((quit error)
 163            (message "%S" err)
 164            (unless hydra-lv (sit-for 0.8))))
 165         (when hydra-is-helpful
 166           (if hydra-lv
 167               (lv-message
 168                (eval hydra-error/hint))
 169             (message
 170              (eval hydra-error/hint))))
 171         (hydra-set-transient-map
 172          hydra-error/keymap
 173          (lambda nil
 174            (hydra-keyboard-quit)
 175            nil)
 176          nil))
 177       (defun hydra-error/previous-error nil
 178         "Create a hydra with a \"M-g\" body and the heads:
 179
 180 \"h\":    `first-error',
 181 \"j\":    `next-error',
 182 \"k\":    `previous-error',
 183 \"SPC\":    `hydra-repeat'
 184
 185 The body can be accessed via `hydra-error/body'.
 186
 187 Call the head: `previous-error'."
 188         (interactive)
 189         (hydra-default-pre)
 190         (let ((hydra--ignore t))
 191           (hydra-keyboard-quit))
 192         (condition-case err
 193             (progn
 194               (setq this-command
 195                     (quote previous-error))
 196               (call-interactively
 197                (function previous-error)))
 198           ((quit error)
 199            (message "%S" err)
 200            (unless hydra-lv (sit-for 0.8))))
 201         (when hydra-is-helpful
 202           (if hydra-lv
 203               (lv-message
 204                (eval hydra-error/hint))
 205             (message
 206              (eval hydra-error/hint))))
 207         (hydra-set-transient-map
 208          hydra-error/keymap
 209          (lambda nil
 210            (hydra-keyboard-quit)
 211            nil)
 212          nil))
 213       (unless (keymapp
 214                (lookup-key
 215                 global-map
 216                 (kbd "M-g")))
 217         (define-key global-map (kbd "M-g")
 218           nil))
 219       (define-key global-map [134217831 104]
 220        (function
 221         hydra-error/first-error))
 222       (define-key global-map [134217831 106]
 223        (function
 224         hydra-error/next-error))
 225       (define-key global-map [134217831 107]
 226        (function
 227         hydra-error/previous-error))
 228       (defun hydra-error/body nil
 229         "Create a hydra with a \"M-g\" body and the heads:
 230
 231 \"h\":    `first-error',
 232 \"j\":    `next-error',
 233 \"k\":    `previous-error',
 234 \"SPC\":    `hydra-repeat'
 235
 236 The body can be accessed via `hydra-error/body'."
 237         (interactive)
 238         (hydra-default-pre)
 239         (let ((hydra--ignore nil))
 240           (hydra-keyboard-quit))
 241         (when hydra-is-helpful
 242           (if hydra-lv
 243               (lv-message
 244                (eval hydra-error/hint))
 245             (message
 246              (eval hydra-error/hint))))
 247         (hydra-set-transient-map
 248          hydra-error/keymap
 249          (lambda nil
 250            (hydra-keyboard-quit)
 251            nil)
 252          nil)
 253         (setq prefix-arg
 254               current-prefix-arg))))))
 255
 256 (ert-deftest hydra-blue-toggle ()
 257   (should
 258    (equal
 259     (macroexpand
 260      '(defhydra hydra-toggle (:color blue)
 261        "toggle"
 262        ("t" toggle-truncate-lines "truncate")
 263        ("f" auto-fill-mode "fill")
 264        ("a" abbrev-mode "abbrev")
 265        ("q" nil "cancel")))
 266     '(progn
 267       (set
 268        (defvar hydra-toggle/keymap nil
 269          "Keymap for hydra-toggle.")
 270        (quote
 271         (keymap
 272          (113 . hydra-toggle/nil)
 273          (97 . hydra-toggle/abbrev-mode-and-exit)
 274          (102 . hydra-toggle/auto-fill-mode-and-exit)
 275          (116 . hydra-toggle/toggle-truncate-lines-and-exit)
 276          (kp-subtract . hydra--negative-argument)
 277          (kp-9 . hydra--digit-argument)
 278          (kp-8 . hydra--digit-argument)
 279          (kp-7 . hydra--digit-argument)
 280          (kp-6 . hydra--digit-argument)
 281          (kp-5 . hydra--digit-argument)
 282          (kp-4 . hydra--digit-argument)
 283          (kp-3 . hydra--digit-argument)
 284          (kp-2 . hydra--digit-argument)
 285          (kp-1 . hydra--digit-argument)
 286          (kp-0 . hydra--digit-argument)
 287          (57 . hydra--digit-argument)
 288          (56 . hydra--digit-argument)
 289          (55 . hydra--digit-argument)
 290          (54 . hydra--digit-argument)
 291          (53 . hydra--digit-argument)
 292          (52 . hydra--digit-argument)
 293          (51 . hydra--digit-argument)
 294          (50 . hydra--digit-argument)
 295          (49 . hydra--digit-argument)
 296          (48 . hydra--digit-argument)
 297          (45 . hydra--negative-argument)
 298          (21 . hydra--universal-argument))))
 299       (set
 300        (defvar hydra-toggle/heads nil
 301          "Heads for hydra-toggle.")
 302        (quote
 303         (("t"
 304           toggle-truncate-lines
 305           "truncate"
 306           :exit t)
 307          ("f"
 308           auto-fill-mode
 309           "fill"
 310           :exit t)
 311          ("a"
 312           abbrev-mode
 313           "abbrev"
 314           :exit t)
 315          ("q" nil "cancel" :exit t))))
 316       (set
 317        (defvar hydra-toggle/hint nil
 318          "Dynamic hint for hydra-toggle.")
 319        (quote
 320         (format
 321          #("toggle: [t]: truncate, [f]: fill, [a]: abbrev, [q]: cancel."
 322            9 10 (face hydra-face-blue)
 323            24 25 (face hydra-face-blue)
 324            35 36 (face hydra-face-blue)
 325            48 49 (face hydra-face-blue)))))
 326       (defun hydra-toggle/toggle-truncate-lines-and-exit nil
 327         "Create a hydra with no body and the heads:
 328
 329 \"t\":    `toggle-truncate-lines',
 330 \"f\":    `auto-fill-mode',
 331 \"a\":    `abbrev-mode',
 332 \"q\":    `nil'
 333
 334 The body can be accessed via `hydra-toggle/body'.
 335
 336 Call the head: `toggle-truncate-lines'."
 337         (interactive)
 338         (hydra-default-pre)
 339         (hydra-keyboard-quit)
 340         (progn
 341           (setq this-command
 342                 (quote toggle-truncate-lines))
 343           (call-interactively
 344            (function
 345             toggle-truncate-lines))))
 346       (defun hydra-toggle/auto-fill-mode-and-exit nil
 347         "Create a hydra with no body and the heads:
 348
 349 \"t\":    `toggle-truncate-lines',
 350 \"f\":    `auto-fill-mode',
 351 \"a\":    `abbrev-mode',
 352 \"q\":    `nil'
 353
 354 The body can be accessed via `hydra-toggle/body'.
 355
 356 Call the head: `auto-fill-mode'."
 357         (interactive)
 358         (hydra-default-pre)
 359         (hydra-keyboard-quit)
 360         (progn
 361           (setq this-command
 362                 (quote auto-fill-mode))
 363           (call-interactively
 364            (function auto-fill-mode))))
 365       (defun hydra-toggle/abbrev-mode-and-exit nil
 366         "Create a hydra with no body and the heads:
 367
 368 \"t\":    `toggle-truncate-lines',
 369 \"f\":    `auto-fill-mode',
 370 \"a\":    `abbrev-mode',
 371 \"q\":    `nil'
 372
 373 The body can be accessed via `hydra-toggle/body'.
 374
 375 Call the head: `abbrev-mode'."
 376         (interactive)
 377         (hydra-default-pre)
 378         (hydra-keyboard-quit)
 379         (progn
 380           (setq this-command
 381                 (quote abbrev-mode))
 382           (call-interactively
 383            (function abbrev-mode))))
 384       (defun hydra-toggle/nil nil
 385         "Create a hydra with no body and the heads:
 386
 387 \"t\":    `toggle-truncate-lines',
 388 \"f\":    `auto-fill-mode',
 389 \"a\":    `abbrev-mode',
 390 \"q\":    `nil'
 391
 392 The body can be accessed via `hydra-toggle/body'.
 393
 394 Call the head: `nil'."
 395         (interactive)
 396         (hydra-default-pre)
 397         (hydra-keyboard-quit))
 398       (defun hydra-toggle/body nil
 399         "Create a hydra with no body and the heads:
 400
 401 \"t\":    `toggle-truncate-lines',
 402 \"f\":    `auto-fill-mode',
 403 \"a\":    `abbrev-mode',
 404 \"q\":    `nil'
 405
 406 The body can be accessed via `hydra-toggle/body'."
 407         (interactive)
 408         (hydra-default-pre)
 409         (let ((hydra--ignore nil))
 410           (hydra-keyboard-quit))
 411         (when hydra-is-helpful
 412           (if hydra-lv
 413               (lv-message
 414                (eval hydra-toggle/hint))
 415             (message
 416              (eval hydra-toggle/hint))))
 417         (hydra-set-transient-map
 418          hydra-toggle/keymap
 419          (lambda nil
 420            (hydra-keyboard-quit)
 421            nil)
 422          nil)
 423         (setq prefix-arg
 424               current-prefix-arg))))))
 425
 426 (ert-deftest hydra-amaranth-vi ()
 427   (should
 428    (equal
 429     (macroexpand
 430      '(defhydra hydra-vi
 431        (:pre
 432         (set-cursor-color "#e52b50")
 433         :post
 434         (set-cursor-color "#ffffff")
 435         :color amaranth)
 436        "vi"
 437        ("j" next-line)
 438        ("k" previous-line)
 439        ("q" nil "quit")))
 440     '(progn
 441       (set
 442        (defvar hydra-vi/keymap nil
 443          "Keymap for hydra-vi.")
 444        (quote
 445         (keymap
 446          (113 . hydra-vi/nil)
 447          (107 . hydra-vi/previous-line)
 448          (106 . hydra-vi/next-line)
 449          (kp-subtract . hydra--negative-argument)
 450          (kp-9 . hydra--digit-argument)
 451          (kp-8 . hydra--digit-argument)
 452          (kp-7 . hydra--digit-argument)
 453          (kp-6 . hydra--digit-argument)
 454          (kp-5 . hydra--digit-argument)
 455          (kp-4 . hydra--digit-argument)
 456          (kp-3 . hydra--digit-argument)
 457          (kp-2 . hydra--digit-argument)
 458          (kp-1 . hydra--digit-argument)
 459          (kp-0 . hydra--digit-argument)
 460          (57 . hydra--digit-argument)
 461          (56 . hydra--digit-argument)
 462          (55 . hydra--digit-argument)
 463          (54 . hydra--digit-argument)
 464          (53 . hydra--digit-argument)
 465          (52 . hydra--digit-argument)
 466          (51 . hydra--digit-argument)
 467          (50 . hydra--digit-argument)
 468          (49 . hydra--digit-argument)
 469          (48 . hydra--digit-argument)
 470          (45 . hydra--negative-argument)
 471          (21 . hydra--universal-argument))))
 472       (set
 473        (defvar hydra-vi/heads nil
 474          "Heads for hydra-vi.")
 475        (quote
 476         (("j" next-line "" :exit nil)
 477          ("k"
 478           previous-line
 479           ""
 480           :exit nil)
 481          ("q" nil "quit" :exit t))))
 482       (set
 483        (defvar hydra-vi/hint nil
 484          "Dynamic hint for hydra-vi.")
 485        (quote
 486         (format
 487          #("vi: j, k, [q]: quit."
 488            4 5 (face hydra-face-amaranth)
 489            7 8 (face hydra-face-amaranth)
 490            11 12 (face hydra-face-teal)))))
 491       (defun hydra-vi/next-line nil
 492         "Create a hydra with no body and the heads:
 493
 494 \"j\":    `next-line',
 495 \"k\":    `previous-line',
 496 \"q\":    `nil'
 497
 498 The body can be accessed via `hydra-vi/body'.
 499
 500 Call the head: `next-line'."
 501         (interactive)
 502         (hydra-default-pre)
 503         (set-cursor-color "#e52b50")
 504         (let ((hydra--ignore t))
 505           (hydra-keyboard-quit))
 506         (condition-case err
 507             (progn
 508               (setq this-command
 509                     (quote next-line))
 510               (call-interactively
 511                (function next-line)))
 512           ((quit error)
 513            (message "%S" err)
 514            (unless hydra-lv (sit-for 0.8))))
 515         (when hydra-is-helpful
 516           (if hydra-lv
 517               (lv-message
 518                (eval hydra-vi/hint))
 519             (message (eval hydra-vi/hint))))
 520         (hydra-set-transient-map
 521          hydra-vi/keymap
 522          (lambda nil
 523            (hydra-keyboard-quit)
 524            (set-cursor-color "#ffffff"))
 525          (quote warn)))
 526       (defun hydra-vi/previous-line nil
 527         "Create a hydra with no body and the heads:
 528
 529 \"j\":    `next-line',
 530 \"k\":    `previous-line',
 531 \"q\":    `nil'
 532
 533 The body can be accessed via `hydra-vi/body'.
 534
 535 Call the head: `previous-line'."
 536         (interactive)
 537         (hydra-default-pre)
 538         (set-cursor-color "#e52b50")
 539         (let ((hydra--ignore t))
 540           (hydra-keyboard-quit))
 541         (condition-case err
 542             (progn
 543               (setq this-command
 544                     (quote previous-line))
 545               (call-interactively
 546                (function previous-line)))
 547           ((quit error)
 548            (message "%S" err)
 549            (unless hydra-lv (sit-for 0.8))))
 550         (when hydra-is-helpful
 551           (if hydra-lv
 552               (lv-message
 553                (eval hydra-vi/hint))
 554             (message (eval hydra-vi/hint))))
 555         (hydra-set-transient-map
 556          hydra-vi/keymap
 557          (lambda nil
 558            (hydra-keyboard-quit)
 559            (set-cursor-color "#ffffff"))
 560          (quote warn)))
 561       (defun hydra-vi/nil nil
 562         "Create a hydra with no body and the heads:
 563
 564 \"j\":    `next-line',
 565 \"k\":    `previous-line',
 566 \"q\":    `nil'
 567
 568 The body can be accessed via `hydra-vi/body'.
 569
 570 Call the head: `nil'."
 571         (interactive)
 572         (hydra-default-pre)
 573         (set-cursor-color "#e52b50")
 574         (hydra-keyboard-quit))
 575       (defun hydra-vi/body nil
 576         "Create a hydra with no body and the heads:
 577
 578 \"j\":    `next-line',
 579 \"k\":    `previous-line',
 580 \"q\":    `nil'
 581
 582 The body can be accessed via `hydra-vi/body'."
 583         (interactive)
 584         (hydra-default-pre)
 585         (set-cursor-color "#e52b50")
 586         (let ((hydra--ignore nil))
 587           (hydra-keyboard-quit))
 588         (when hydra-is-helpful
 589           (if hydra-lv
 590               (lv-message
 591                (eval hydra-vi/hint))
 592             (message (eval hydra-vi/hint))))
 593         (hydra-set-transient-map
 594          hydra-vi/keymap
 595          (lambda nil
 596            (hydra-keyboard-quit)
 597            (set-cursor-color "#ffffff"))
 598          (quote warn))
 599         (setq prefix-arg
 600               current-prefix-arg))))))
 601
 602 (ert-deftest hydra-zoom-duplicate-1 ()
 603   (should
 604    (equal
 605     (macroexpand
 606      '(defhydra hydra-zoom ()
 607        "zoom"
 608        ("r" (text-scale-set 0) "reset")
 609        ("0" (text-scale-set 0) :bind nil :exit t)
 610        ("1" (text-scale-set 0) nil :bind nil :exit t)))
 611     '(progn
 612       (set
 613        (defvar hydra-zoom/keymap nil
 614          "Keymap for hydra-zoom.")
 615        (quote
 616         (keymap
 617          (114 . hydra-zoom/lambda-r)
 618          (kp-subtract . hydra--negative-argument)
 619          (kp-9 . hydra--digit-argument)
 620          (kp-8 . hydra--digit-argument)
 621          (kp-7 . hydra--digit-argument)
 622          (kp-6 . hydra--digit-argument)
 623          (kp-5 . hydra--digit-argument)
 624          (kp-4 . hydra--digit-argument)
 625          (kp-3 . hydra--digit-argument)
 626          (kp-2 . hydra--digit-argument)
 627          (kp-1 . hydra--digit-argument)
 628          (kp-0 . hydra--digit-argument)
 629          (57 . hydra--digit-argument)
 630          (56 . hydra--digit-argument)
 631          (55 . hydra--digit-argument)
 632          (54 . hydra--digit-argument)
 633          (53 . hydra--digit-argument)
 634          (52 . hydra--digit-argument)
 635          (51 . hydra--digit-argument)
 636          (50 . hydra--digit-argument)
 637          (49 . hydra-zoom/lambda-0-and-exit)
 638          (48 . hydra-zoom/lambda-0-and-exit)
 639          (45 . hydra--negative-argument)
 640          (21 . hydra--universal-argument))))
 641       (set
 642        (defvar hydra-zoom/heads nil
 643          "Heads for hydra-zoom.")
 644        (quote
 645         (("r"
 646           (text-scale-set 0)
 647           "reset"
 648           :exit nil)
 649          ("0"
 650           (text-scale-set 0)
 651           ""
 652           :bind nil
 653           :exit t)
 654          ("1"
 655           (text-scale-set 0)
 656           nil
 657           :bind nil
 658           :exit t))))
 659       (set
 660        (defvar hydra-zoom/hint nil
 661          "Dynamic hint for hydra-zoom.")
 662        (quote
 663         (format
 664          #("zoom: [r 0]: reset."
 665            7 8 (face hydra-face-red)
 666            9 10 (face hydra-face-blue)))))
 667       (defun hydra-zoom/lambda-r nil
 668         "Create a hydra with no body and the heads:
 669
 670 \"r\":    `(text-scale-set 0)',
 671 \"0\":    `(text-scale-set 0)',
 672 \"1\":    `(text-scale-set 0)'
 673
 674 The body can be accessed via `hydra-zoom/body'.
 675
 676 Call the head: `(text-scale-set 0)'."
 677         (interactive)
 678         (hydra-default-pre)
 679         (let ((hydra--ignore t))
 680           (hydra-keyboard-quit))
 681         (condition-case err
 682             (call-interactively
 683              (function
 684               (lambda nil
 685                (interactive)
 686                (text-scale-set 0))))
 687           ((quit error)
 688            (message "%S" err)
 689            (unless hydra-lv (sit-for 0.8))))
 690         (when hydra-is-helpful
 691           (if hydra-lv
 692               (lv-message
 693                (eval hydra-zoom/hint))
 694             (message
 695              (eval hydra-zoom/hint))))
 696         (hydra-set-transient-map
 697          hydra-zoom/keymap
 698          (lambda nil
 699            (hydra-keyboard-quit)
 700            nil)
 701          nil))
 702       (defun hydra-zoom/lambda-0-and-exit nil
 703         "Create a hydra with no body and the heads:
 704
 705 \"r\":    `(text-scale-set 0)',
 706 \"0\":    `(text-scale-set 0)',
 707 \"1\":    `(text-scale-set 0)'
 708
 709 The body can be accessed via `hydra-zoom/body'.
 710
 711 Call the head: `(text-scale-set 0)'."
 712         (interactive)
 713         (hydra-default-pre)
 714         (hydra-keyboard-quit)
 715         (call-interactively
 716          (function
 717           (lambda nil
 718            (interactive)
 719            (text-scale-set 0)))))
 720       (defun hydra-zoom/body nil
 721         "Create a hydra with no body and the heads:
 722
 723 \"r\":    `(text-scale-set 0)',
 724 \"0\":    `(text-scale-set 0)',
 725 \"1\":    `(text-scale-set 0)'
 726
 727 The body can be accessed via `hydra-zoom/body'."
 728         (interactive)
 729         (hydra-default-pre)
 730         (let ((hydra--ignore nil))
 731           (hydra-keyboard-quit))
 732         (when hydra-is-helpful
 733           (if hydra-lv
 734               (lv-message
 735                (eval hydra-zoom/hint))
 736             (message
 737              (eval hydra-zoom/hint))))
 738         (hydra-set-transient-map
 739          hydra-zoom/keymap
 740          (lambda nil
 741            (hydra-keyboard-quit)
 742            nil)
 743          nil)
 744         (setq prefix-arg
 745               current-prefix-arg))))))
 746
 747 (ert-deftest hydra-zoom-duplicate-2 ()
 748   (should
 749    (equal
 750     (macroexpand
 751      '(defhydra hydra-zoom ()
 752        "zoom"
 753        ("r" (text-scale-set 0) "reset")
 754        ("0" (text-scale-set 0) :bind nil :exit t)
 755        ("1" (text-scale-set 0) nil :bind nil)))
 756     '(progn
 757       (set
 758        (defvar hydra-zoom/keymap nil
 759          "Keymap for hydra-zoom.")
 760        (quote
 761         (keymap
 762          (114 . hydra-zoom/lambda-r)
 763          (kp-subtract . hydra--negative-argument)
 764          (kp-9 . hydra--digit-argument)
 765          (kp-8 . hydra--digit-argument)
 766          (kp-7 . hydra--digit-argument)
 767          (kp-6 . hydra--digit-argument)
 768          (kp-5 . hydra--digit-argument)
 769          (kp-4 . hydra--digit-argument)
 770          (kp-3 . hydra--digit-argument)
 771          (kp-2 . hydra--digit-argument)
 772          (kp-1 . hydra--digit-argument)
 773          (kp-0 . hydra--digit-argument)
 774          (57 . hydra--digit-argument)
 775          (56 . hydra--digit-argument)
 776          (55 . hydra--digit-argument)
 777          (54 . hydra--digit-argument)
 778          (53 . hydra--digit-argument)
 779          (52 . hydra--digit-argument)
 780          (51 . hydra--digit-argument)
 781          (50 . hydra--digit-argument)
 782          (49 . hydra-zoom/lambda-r)
 783          (48 . hydra-zoom/lambda-0-and-exit)
 784          (45 . hydra--negative-argument)
 785          (21 . hydra--universal-argument))))
 786       (set
 787        (defvar hydra-zoom/heads nil
 788          "Heads for hydra-zoom.")
 789        (quote
 790         (("r"
 791           (text-scale-set 0)
 792           "reset"
 793           :exit nil)
 794          ("0"
 795           (text-scale-set 0)
 796           ""
 797           :bind nil
 798           :exit t)
 799          ("1"
 800           (text-scale-set 0)
 801           nil
 802           :bind nil
 803           :exit nil))))
 804       (set
 805        (defvar hydra-zoom/hint nil
 806          "Dynamic hint for hydra-zoom.")
 807        (quote
 808         (format
 809          #("zoom: [r 0]: reset."
 810            7 8 (face hydra-face-red)
 811            9 10 (face hydra-face-blue)))))
 812       (defun hydra-zoom/lambda-r nil
 813         "Create a hydra with no body and the heads:
 814
 815 \"r\":    `(text-scale-set 0)',
 816 \"0\":    `(text-scale-set 0)',
 817 \"1\":    `(text-scale-set 0)'
 818
 819 The body can be accessed via `hydra-zoom/body'.
 820
 821 Call the head: `(text-scale-set 0)'."
 822         (interactive)
 823         (hydra-default-pre)
 824         (let ((hydra--ignore t))
 825           (hydra-keyboard-quit))
 826         (condition-case err
 827             (call-interactively
 828              (function
 829               (lambda nil
 830                (interactive)
 831                (text-scale-set 0))))
 832           ((quit error)
 833            (message "%S" err)
 834            (unless hydra-lv (sit-for 0.8))))
 835         (when hydra-is-helpful
 836           (if hydra-lv
 837               (lv-message
 838                (eval hydra-zoom/hint))
 839             (message
 840              (eval hydra-zoom/hint))))
 841         (hydra-set-transient-map
 842          hydra-zoom/keymap
 843          (lambda nil
 844            (hydra-keyboard-quit)
 845            nil)
 846          nil))
 847       (defun hydra-zoom/lambda-0-and-exit nil
 848         "Create a hydra with no body and the heads:
 849
 850 \"r\":    `(text-scale-set 0)',
 851 \"0\":    `(text-scale-set 0)',
 852 \"1\":    `(text-scale-set 0)'
 853
 854 The body can be accessed via `hydra-zoom/body'.
 855
 856 Call the head: `(text-scale-set 0)'."
 857         (interactive)
 858         (hydra-default-pre)
 859         (hydra-keyboard-quit)
 860         (call-interactively
 861          (function
 862           (lambda nil
 863            (interactive)
 864            (text-scale-set 0)))))
 865       (defun hydra-zoom/body nil
 866         "Create a hydra with no body and the heads:
 867
 868 \"r\":    `(text-scale-set 0)',
 869 \"0\":    `(text-scale-set 0)',
 870 \"1\":    `(text-scale-set 0)'
 871
 872 The body can be accessed via `hydra-zoom/body'."
 873         (interactive)
 874         (hydra-default-pre)
 875         (let ((hydra--ignore nil))
 876           (hydra-keyboard-quit))
 877         (when hydra-is-helpful
 878           (if hydra-lv
 879               (lv-message
 880                (eval hydra-zoom/hint))
 881             (message
 882              (eval hydra-zoom/hint))))
 883         (hydra-set-transient-map
 884          hydra-zoom/keymap
 885          (lambda nil
 886            (hydra-keyboard-quit)
 887            nil)
 888          nil)
 889         (setq prefix-arg
 890               current-prefix-arg))))))
 891
 892 (ert-deftest defhydradio ()
 893   (should (equal
 894            (macroexpand
 895             '(defhydradio hydra-test ()
 896               (num "Num" [0 1 2 3 4 5 6 7 8 9 10])
 897               (str "Str" ["foo" "bar" "baz"])))
 898            '(progn
 899              (defvar hydra-test/num 0
 900                "Num")
 901              (put 'hydra-test/num 'range [0 1 2 3 4 5 6 7 8 9 10])
 902              (defun hydra-test/num ()
 903                (hydra--cycle-radio 'hydra-test/num))
 904              (defvar hydra-test/str "foo"
 905                "Str")
 906              (put 'hydra-test/str 'range ["foo" "bar" "baz"])
 907              (defun hydra-test/str ()
 908                (hydra--cycle-radio 'hydra-test/str))
 909              (defvar hydra-test/names '(hydra-test/num hydra-test/str))))))
 910
 911 (ert-deftest hydra-blue-compat ()
 912   (should
 913    (equal
 914     (macroexpand
 915      '(defhydra hydra-toggle (:color blue)
 916        "toggle"
 917        ("t" toggle-truncate-lines "truncate")
 918        ("f" auto-fill-mode "fill")
 919        ("a" abbrev-mode "abbrev")
 920        ("q" nil "cancel")))
 921     (macroexpand
 922      '(defhydra hydra-toggle (:exit t)
 923        "toggle"
 924        ("t" toggle-truncate-lines "truncate")
 925        ("f" auto-fill-mode "fill")
 926        ("a" abbrev-mode "abbrev")
 927        ("q" nil "cancel"))))))
 928
 929 (ert-deftest hydra-amaranth-compat ()
 930   (should
 931    (equal
 932     (macroexpand
 933      '(defhydra hydra-vi
 934        (:pre
 935         (set-cursor-color "#e52b50")
 936         :post
 937         (set-cursor-color "#ffffff")
 938         :color amaranth)
 939        "vi"
 940        ("j" next-line)
 941        ("k" previous-line)
 942        ("q" nil "quit")))
 943     (macroexpand
 944      '(defhydra hydra-vi
 945        (:pre
 946         (set-cursor-color "#e52b50")
 947         :post
 948         (set-cursor-color "#ffffff")
 949         :foreign-keys warn)
 950        "vi"
 951        ("j" next-line)
 952        ("k" previous-line)
 953        ("q" nil "quit"))))))
 954
 955 (ert-deftest hydra-pink-compat ()
 956   (should
 957    (equal
 958     (macroexpand
 959      '(defhydra hydra-zoom (global-map "<f2>"
 960                             :color pink)
 961        "zoom"
 962        ("g" text-scale-increase "in")
 963        ("l" text-scale-decrease "out")
 964        ("q" nil "quit")))
 965     (macroexpand
 966      '(defhydra hydra-zoom (global-map "<f2>"
 967                             :foreign-keys run)
 968        "zoom"
 969        ("g" text-scale-increase "in")
 970        ("l" text-scale-decrease "out")
 971        ("q" nil "quit"))))))
 972
 973 (ert-deftest hydra-teal-compat ()
 974   (should
 975    (equal
 976     (macroexpand
 977      '(defhydra hydra-zoom (global-map "<f2>"
 978                             :color teal)
 979        "zoom"
 980        ("g" text-scale-increase "in")
 981        ("l" text-scale-decrease "out")
 982        ("q" nil "quit")))
 983     (macroexpand
 984      '(defhydra hydra-zoom (global-map "<f2>"
 985                             :foreign-keys warn
 986                             :exit t)
 987        "zoom"
 988        ("g" text-scale-increase "in")
 989        ("l" text-scale-decrease "out")
 990        ("q" nil "quit"))))))
 991
 992 (ert-deftest hydra-format-1 ()
 993   (should (equal
 994            (let ((hydra-fontify-head-function
 995                   'hydra-fontify-head-greyscale))
 996              (hydra--format
 997               'hydra-toggle
 998               nil
 999               "
1000 _a_ abbrev-mode:       %`abbrev-mode
1001 _d_ debug-on-error:    %`debug-on-error
1002 _f_ auto-fill-mode:    %`auto-fill-function
1003 " '(("a" abbrev-mode nil)
1004     ("d" toggle-debug-on-error nil)
1005     ("f" auto-fill-mode nil)
1006     ("g" golden-ratio-mode nil)
1007     ("t" toggle-truncate-lines nil)
1008     ("w" whitespace-mode nil)
1009     ("q" nil "quit"))))
1010            '(concat (format "%s abbrev-mode:       %S
1011 %s debug-on-error:    %S
1012 %s auto-fill-mode:    %S
1013 " "{a}" abbrev-mode "{d}" debug-on-error "{f}" auto-fill-function) "[{q}]: quit"))))
1014
1015 (ert-deftest hydra-format-2 ()
1016   (should (equal
1017            (let ((hydra-fontify-head-function
1018                   'hydra-fontify-head-greyscale))
1019              (hydra--format
1020               'bar
1021               nil
1022               "\n  bar %s`foo\n"
1023               '(("a" (quote t) "" :cmd-name bar/lambda-a :exit nil)
1024                 ("q" nil "" :cmd-name bar/nil :exit t))))
1025            '(concat (format "  bar %s\n" foo) "{a}, [q]"))))
1026
1027 (ert-deftest hydra-format-3 ()
1028   (should (equal
1029            (let ((hydra-fontify-head-function
1030                   'hydra-fontify-head-greyscale))
1031              (hydra--format
1032               'bar
1033               nil
1034               "\n_<SPC>_   ^^ace jump\n"
1035               '(("<SPC>" ace-jump-char-mode nil :cmd-name bar/ace-jump-char-mode))))
1036            '(concat (format "%s   ace jump\n" "{<SPC>}") ""))))
1037
1038 (ert-deftest hydra-format-4 ()
1039   (should
1040    (equal (hydra--format
1041            nil
1042            '(nil nil :hint nil)
1043            "\n_j_,_k_"
1044            '(("j" nil nil :exit t) ("k" nil nil :exit t)))
1045           '(concat (format "%s,%s"
1046                     #("j" 0 1 (face hydra-face-blue))
1047                     #("k" 0 1 (face hydra-face-blue))) ""))))
1048
1049 (ert-deftest hydra-format-5 ()
1050   (should
1051    (equal (hydra--format
1052            nil nil "\n_-_: mark          _u_: unmark\n"
1053            '(("-" Buffer-menu-mark)
1054              ("u" Buffer-menu-unmark)))
1055           '(concat
1056            (format
1057             "%s: mark          %s: unmark\n"
1058             #("-" 0 1 (face hydra-face-red))
1059             #("u" 0 1 (face hydra-face-red)))
1060             ""))))
1061
1062 (ert-deftest hydra-format-with-sexp-1 ()
1063   (should (equal
1064            (let ((hydra-fontify-head-function
1065                   'hydra-fontify-head-greyscale))
1066              (hydra--format
1067               'hydra-toggle nil
1068               "\n_n_ narrow-or-widen-dwim %(progn (message \"checking\")(buffer-narrowed-p))asdf\n"
1069               '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
1070            '(concat (format "%s narrow-or-widen-dwim %Sasdf\n"
1071                      "{n}"
1072                      (progn
1073                        (message "checking")
1074                        (buffer-narrowed-p)))
1075              "[[q]]: cancel"))))
1076
1077 (ert-deftest hydra-format-with-sexp-2 ()
1078   (should (equal
1079            (let ((hydra-fontify-head-function
1080                   'hydra-fontify-head-greyscale))
1081              (hydra--format
1082               'hydra-toggle nil
1083               "\n_n_ narrow-or-widen-dwim %s(progn (message \"checking\")(buffer-narrowed-p))asdf\n"
1084               '(("n" narrow-to-region nil) ("q" nil "cancel" :exit t))))
1085            '(concat (format "%s narrow-or-widen-dwim %sasdf\n"
1086                      "{n}"
1087                      (progn
1088                        (message "checking")
1089                        (buffer-narrowed-p)))
1090              "[[q]]: cancel"))))
1091
1092 (ert-deftest hydra-compat-colors-2 ()
1093   (should
1094    (equal
1095     (macroexpand
1096      '(defhydra hydra-test (:color amaranth)
1097        ("a" fun-a)
1098        ("b" fun-b :color blue)
1099        ("c" fun-c :color blue)
1100        ("d" fun-d :color blue)
1101        ("e" fun-e :color blue)
1102        ("f" fun-f :color blue)))
1103     (macroexpand
1104      '(defhydra hydra-test (:color teal)
1105        ("a" fun-a :color red)
1106        ("b" fun-b)
1107        ("c" fun-c)
1108        ("d" fun-d)
1109        ("e" fun-e)
1110        ("f" fun-f))))))
1111
1112 (ert-deftest hydra-compat-colors-3 ()
1113   (should
1114    (equal
1115     (macroexpand
1116      '(defhydra hydra-test ()
1117        ("a" fun-a)
1118        ("b" fun-b :color blue)
1119        ("c" fun-c :color blue)
1120        ("d" fun-d :color blue)
1121        ("e" fun-e :color blue)
1122        ("f" fun-f :color blue)))
1123     (macroexpand
1124      '(defhydra hydra-test (:color blue)
1125        ("a" fun-a :color red)
1126        ("b" fun-b)
1127        ("c" fun-c)
1128        ("d" fun-d)
1129        ("e" fun-e)
1130        ("f" fun-f))))))
1131
1132 (ert-deftest hydra-compat-colors-4 ()
1133   (should
1134    (equal
1135     (macroexpand
1136      '(defhydra hydra-test ()
1137        ("a" fun-a)
1138        ("b" fun-b :exit t)
1139        ("c" fun-c :exit t)
1140        ("d" fun-d :exit t)
1141        ("e" fun-e :exit t)
1142        ("f" fun-f :exit t)))
1143     (macroexpand
1144      '(defhydra hydra-test (:exit t)
1145        ("a" fun-a :exit nil)
1146        ("b" fun-b)
1147        ("c" fun-c)
1148        ("d" fun-d)
1149        ("e" fun-e)
1150        ("f" fun-f))))))
1151
1152 (ert-deftest hydra--pad ()
1153   (should (equal (hydra--pad '(a b c) 3)
1154                  '(a b c)))
1155   (should (equal (hydra--pad '(a) 3)
1156                  '(a nil nil))))
1157
1158 (ert-deftest hydra--matrix ()
1159   (should (equal (hydra--matrix '(a b c) 2 2)
1160                  '((a b) (c nil))))
1161   (should (equal (hydra--matrix '(a b c d e f g h i) 4 3)
1162                  '((a b c d) (e f g h) (i nil nil nil)))))
1163
1164 (ert-deftest hydra--cell ()
1165   (should (equal (hydra--cell "% -75s %%`%s" '(hydra-lv hydra-verbose))
1166                  "When non-nil, `lv-message' (not `message') will be used to display hints.   %`hydra-lv^^^^^
1167 When non-nil, hydra will issue some non essential style warnings.           %`hydra-verbose")))
1168
1169 (ert-deftest hydra--vconcat ()
1170   (should (equal (hydra--vconcat '("abc\ndef" "012\n34" "def\nabc"))
1171                  "abc012def\ndef34abc")))
1172
1173 (defhydradio hydra-tng ()
1174   (picard "_p_ Captain Jean Luc Picard:")
1175   (riker "_r_ Commander William Riker:")
1176   (data "_d_ Lieutenant Commander Data:")
1177   (worf "_w_ Worf:")
1178   (la-forge "_f_ Geordi La Forge:")
1179   (troi "_t_ Deanna Troi:")
1180   (dr-crusher "_c_ Doctor Beverly Crusher:")
1181   (phaser "_h_ Set phasers to " [stun kill]))
1182
1183 (ert-deftest hydra--table ()
1184   (let ((hydra-cell-format "% -30s %% -8`%s"))
1185     (should (equal (hydra--table hydra-tng/names 5 2)
1186                    (substring "
1187 _p_ Captain Jean Luc Picard:   % -8`hydra-tng/picard^^    _t_ Deanna Troi:               % -8`hydra-tng/troi^^^^^^
1188 _r_ Commander William Riker:   % -8`hydra-tng/riker^^^    _c_ Doctor Beverly Crusher:    % -8`hydra-tng/dr-crusher
1189 _d_ Lieutenant Commander Data: % -8`hydra-tng/data^^^^    _h_ Set phasers to             % -8`hydra-tng/phaser^^^^
1190 _w_ Worf:                      % -8`hydra-tng/worf^^^^
1191 _f_ Geordi La Forge:           % -8`hydra-tng/la-forge" 1)))
1192     (should (equal (hydra--table hydra-tng/names 4 3)
1193                    (substring "
1194 _p_ Captain Jean Luc Picard:   % -8`hydra-tng/picard    _f_ Geordi La Forge:           % -8`hydra-tng/la-forge^^
1195 _r_ Commander William Riker:   % -8`hydra-tng/riker^    _t_ Deanna Troi:               % -8`hydra-tng/troi^^^^^^
1196 _d_ Lieutenant Commander Data: % -8`hydra-tng/data^^    _c_ Doctor Beverly Crusher:    % -8`hydra-tng/dr-crusher
1197 _w_ Worf:                      % -8`hydra-tng/worf^^    _h_ Set phasers to             % -8`hydra-tng/phaser^^^^" 1)))))
1198
1199 (ert-deftest hydra--make-funcall ()
1200   (should (equal (let ((body-pre 'foo))
1201                    (hydra--make-funcall body-pre)
1202                    body-pre)
1203                  '(funcall (function foo)))))
1204
1205 (defhydra hydra-simple-1 (global-map "C-c")
1206   ("a" (insert "j"))
1207   ("b" (insert "k"))
1208   ("q" nil))
1209
1210 (defhydra hydra-simple-2 (global-map "C-c" :color amaranth)
1211   ("c" self-insert-command)
1212   ("d" self-insert-command)
1213   ("q" nil))
1214
1215 (defhydra hydra-simple-3 (global-map "C-c")
1216   ("g" goto-line)
1217   ("1" find-file)
1218   ("q" nil))
1219
1220 (defmacro hydra-with (in &rest body)
1221   `(let ((temp-buffer (generate-new-buffer " *temp*")))
1222      (save-window-excursion
1223        (unwind-protect
1224             (progn
1225               (switch-to-buffer temp-buffer)
1226               (transient-mark-mode 1)
1227               (insert ,in)
1228               (goto-char (point-min))
1229               (when (search-forward "~" nil t)
1230                 (backward-delete-char 1)
1231                 (set-mark (point)))
1232               (goto-char (point-max))
1233               (search-backward "|")
1234               (delete-char 1)
1235               (setq current-prefix-arg)
1236               ,@body
1237               (insert "|")
1238               (when (region-active-p)
1239                 (exchange-point-and-mark)
1240                 (insert "~"))
1241               (buffer-substring-no-properties
1242                (point-min)
1243                (point-max)))
1244          (and (buffer-name temp-buffer)
1245               (kill-buffer temp-buffer))))))
1246
1247 (ert-deftest hydra-integration-1 ()
1248   (should (string= (hydra-with "|"
1249                                (execute-kbd-macro
1250                                 (kbd "C-c aabbaaqaabbaa")))
1251                    "jjkkjjaabbaa|"))
1252   (should (string= (hydra-with "|"
1253                                (condition-case nil
1254                                    (execute-kbd-macro
1255                                     (kbd "C-c aabb C-g"))
1256                                  (quit nil))
1257                                (execute-kbd-macro "aaqaabbaa"))
1258                    "jjkkaaqaabbaa|")))
1259
1260 (ert-deftest hydra-integration-2 ()
1261   (should (string= (hydra-with "|"
1262                                (execute-kbd-macro
1263                                 (kbd "C-c c 1 c 2 d 4 c q")))
1264                    "ccddcccc|"))
1265   (should (string= (hydra-with "|"
1266                                (execute-kbd-macro
1267                                 (kbd "C-c c 1 c C-u d C-u 10 c q")))
1268                    "ccddddcccccccccc|")))
1269
1270 (ert-deftest hydra-integration-3 ()
1271   (should (string= (hydra-with "foo\nbar|"
1272                                (execute-kbd-macro
1273                                 (kbd "C-c g 1 RET q")))
1274                    "|foo\nbar")))
1275
1276 (provide 'hydra-test)
1277
1278 ;;; hydra-test.el ends here