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