xorblink.pl revision 04b94745 
1#!/usr/bin/env perl
2# $XTermId: xorblink.pl,v 1.16 2017/12/24 21:03:54 tom Exp $
3# -----------------------------------------------------------------------------
4# Copyright 2017 by Thomas E. Dickey
5#
6#                         All Rights Reserved
7#
8# Permission is hereby granted, free of charge, to any person obtaining a
9# copy of this software and associated documentation files (the
10# "Software"), to deal in the Software without restriction, including
11# without limitation the rights to use, copy, modify, merge, publish,
12# distribute, sublicense, and/or sell copies of the Software, and to
13# permit persons to whom the Software is furnished to do so, subject to
14# the following conditions:
15#
16# The above copyright notice and this permission notice shall be included
17# in all copies or substantial portions of the Software.
18#
19# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
20# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
22# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
23# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
24# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
25# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
26#
27# Except as contained in this notice, the name(s) of the above copyright
28# holders shall not be used in advertising or otherwise to promote the
29# sale, use or other dealings in this Software without prior written
30# authorization.
31# -----------------------------------------------------------------------------
32# walk through the different states of cursor-blinking, with annotation
33#
34# Manual:
35#        +bc     turn off text cursor blinking.  This overrides the cursorBlink
36#                resource.
37#
38#        -bc     turn on text cursor blinking.  This overrides the cursorBlink
39#                resource.
40#
41#        cursorBlink (class CursorBlink)
42#                Specifies whether to make the cursor blink.  The default is
43#                "false".
44#
45#                Xterm-dev uses two variables to determine whether the cursor
46#                blinks.  One is set by this resource.  The other is set by
47#                control sequences (private mode 12 and DECSCUSR).  Xterm-dev
48#                tests the XOR of the two variables.
49#
50#               Enable Blinking Cursor (resource cursorblink)
51#                      Enable (or disable) the blinking-cursor feature.  This
52#                      corresponds to the -bc option and the cursorBlink
53#                      resource.  There is also an escape sequence (see Xterm-
54#                      dev Control Sequences).  The menu entry and the escape
55#                      sequence states are XOR'd: if both are enabled, the
56#                      cursor will not blink, if only one is enabled, the cursor
57#                      will blink.
58#
59#        set-cursorblink(on/off/toggle)
60#                This action sets, unsets or toggles the cursorBlink resource.
61#                It is also invoked from the cursorblink entry in vtMenu.
62#
63# Control sequences:
64#
65# CSI ? Pm h
66#           DEC Private Mode Set (DECSET).
67#             Ps = 1 2  -> Start Blinking Cursor (att610).
68#
69# CSI ? Pm l
70#           DEC Private Mode Reset (DECRST).
71#             Ps = 1 2  -> Stop Blinking Cursor (att610).
72#
73# CSI Ps SP q
74#           Set cursor style (DECSCUSR, VT520).
75#             Ps = 0  -> blinking block.
76#             Ps = 1  -> blinking block (default).
77#             Ps = 2  -> steady block.
78#             Ps = 3  -> blinking underline.
79#             Ps = 4  -> steady underline.
80#             Ps = 5  -> blinking bar (xterm).
81#             Ps = 6  -> steady bar (xterm).
82#
83use strict;
84
85use Term::ReadKey;
86
87use IO::Handle;
88STDERR->autoflush(1);
89STDOUT->autoflush(1);
90
91our %DECSET = (
92    "\e[?12h", "Start Blinking Cursor (AT&T 610)",
93    "\e[?12l", "Stop Blinking Cursor (AT&T 610)"
94);
95
96our %DECSCUSR = (
97    "\e[0 q",
98    "blinking block",
99    "\e[1 q",
100    "blinking block (default)",
101    "\e[2 q",
102    "steady block",
103    "\e[3 q",
104    "blinking underline",
105    "\e[4 q",
106    "steady underline",
107    "\e[5 q",
108    "blinking bar (xterm)",
109    "\e[6 q",
110    "steady bar (xterm)"
111);
112
113sub show($$) {
114    my $seq = shift;
115    my $txt = shift;
116    printf "%s -> %s\n", &visible($seq), $txt;
117}
118
119sub get_reply($$) {
120    my $seq = shift;
121    my $end = shift;
122    printf STDERR "%s", $seq;
123    my $key;
124    my $result = "";
125    $key = ReadKey(0);
126    $result .= $key;
127    if ( $key eq "\e" ) {
128
129        while (1) {
130            $key = ReadKey(100);
131            $result .= $key;
132            next if ( length($result) < length($end) );
133            last if ( substr( $result, -length($end) ) eq $end );
134        }
135    }
136    return $result;
137}
138
139sub mode_value($) {
140    my $value = shift;
141    if ( $value eq 1 ) {
142        $value = "set";
143    }
144    elsif ( $value eq 2 ) {
145        $value = "reset";
146    }
147    elsif ( $value eq 3 ) {
148        $value = "*set";
149    }
150    elsif ( $value eq 4 ) {
151        $value = "*reset";
152    }
153    else {
154        $value = &visible( "?" . $value );
155    }
156    return $value;
157}
158
159sub DECRQM($) {
160    my $mode     = shift;
161    my $sequence = sprintf( "\e[?%d\$p", $mode );
162    my $reply    = &get_reply( $sequence, "y" );
163    if ( $reply =~ /^\e\[\?$mode;\d+\$y$/ ) {
164        $reply =~ s/^\e\[\?$mode;(\d+)\$y$/$1/;
165    }
166    return &mode_value($reply);
167}
168
169sub DECRQSS($) {
170    my $request  = shift;
171    my $ending   = "\e\\";
172    my $sequence = sprintf( "\eP\$q%s$ending", $request );
173    my $reply    = &get_reply( $sequence, $ending );
174
175    # xterm responds with
176    # DCS 1 $ r Pt ST for valid requests,
177    # DCS 0 $ r Pt ST for invalid requests.
178    #if ( $reply =~ /^\eP1\$r.*$ending$/ ) {
179    if ( $reply =~ /^\eP1\$r\d+ q\e\\$/ ) {
180        $reply =~ s/^\eP1\$r(\d+) q\e\\$/$1/;
181    }
182    return &visible($reply);
183}
184
185sub get_key() {
186    my $key;
187    do {
188        $key = ReadKey(0);
189        if ( $key eq "\e" ) {
190            while ( ReadKey(10) !~ /[@-~]/ ) {
191                #
192            }
193        }
194    } while ( $key eq "\e" );
195    return $key;
196}
197
198sub visible($) {
199    my $txt = shift;
200    $txt =~ s/\e/\\e/g;
201    $txt =~ s/\a/\\a/g;
202    return $txt;
203}
204
205sub test($$) {
206    my $set = shift;
207    my $msg = shift;
208
209    ReadMode 'raw';
210
211    printf STDERR "%s\t[", &visible($set);
212
213    # save the cursor position
214    printf STDERR "\e7";
215
216    # send the escape sequence
217    printf STDERR "%s", $set;
218
219    # print the description
220    printf STDERR "X] ";
221
222    printf STDERR " [C=%s,",  &DECRQSS(" q");
223    printf STDERR "B=%s,",    &DECRQM(12);
224    printf STDERR "M=%s,%s]", &DECRQM(13), &DECRQM(14);
225    printf STDERR " %s",      $msg;
226    printf STDERR "\e[0J";
227
228    # restore the cursor position
229    printf STDERR "\e8";
230
231    # wait for any key
232    my $key = &get_key;
233    ReadMode 'restore';
234
235    # print newline
236    printf STDERR "\n";
237
238    # A backspace response makes the current line reprint (to test menus)
239    return ( $key ne "\b" and $key ne "\177" ) ? 1 : 0;
240}
241
242if ( -t STDOUT ) {
243    printf "Legend:\n";
244    printf "  C = cursor shape (1,2 block, 3,4 underline, 5,6 left-bar)\n";
245    printf "  B = escape-sequence blink\n";
246    printf "  M = menu blink and XOR mode\n";
247    printf "\n";
248    printf "An asterisk means the mode is always set or reset.\n";
249    printf "Press any key to proceed; press backspace to reprint line.\n";
250    printf "\n";
251    my @DECSET   = sort keys %DECSET;
252    my @DECSCUSR = sort keys %DECSCUSR;
253
254    for ( my $h = 0 ; $h <= $#DECSET ; ++$h ) {
255        $h-- unless &test( $DECSET[$h], $DECSET{ $DECSET[$h] } );
256    }
257    for my $l ( 0 .. $#DECSCUSR ) {
258        $l-- unless &test( $DECSCUSR[$l], $DECSCUSR{ $DECSCUSR[$l] } );
259    }
260}
261else {
262    printf "DECSET (AT&T 610 blinking cursor):\n";
263    for my $key ( sort keys %DECSET ) {
264        &show( $key, $DECSET{$key} );
265    }
266
267    printf "DECSCUSR:\n";
268    for my $key ( sort keys %DECSCUSR ) {
269        &show( $key, $DECSCUSR{$key} );
270    }
271}
2721;
273