From 9e83cbe850e17780f646217d932645e2105b605c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 29 Jul 2019 12:48:00 +0000 Subject: Add support for "(x|y)view scroll number mouseunits" for text widget, and use it in mouse bindings. --- generic/tkTextDisp.c | 20 +++++++++++++++++--- generic/tkUtil.c | 8 ++++---- library/text.tcl | 8 ++++---- tests/entry.test | 4 ++-- tests/spinbox.test | 4 ++-- tests/textDisp.test | 16 ++++++++-------- tests/util.test | 6 +++--- 7 files changed, 40 insertions(+), 26 deletions(-) diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index d4f6b83..2aeec2e 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -631,6 +631,7 @@ static int IsStartOfNotMergedLine(TkText *textPtr, #define TKTEXT_SCROLL_UNITS 3 #define TKTEXT_SCROLL_ERROR 4 #define TKTEXT_SCROLL_PIXELS 5 +#define TKTEXT_SCROLL_MOUSE 6 /* *---------------------------------------------------------------------- @@ -5893,6 +5894,10 @@ TkTextXviewCmd( case TKTEXT_SCROLL_PIXELS: dInfoPtr->newXPixelOffset += count; break; + case TKTEXT_SCROLL_MOUSE: + if (count < 0) count -= 2; + dInfoPtr->newXPixelOffset += (-count)/3; + break; } dInfoPtr->flags |= DINFO_OUT_OF_DATE; @@ -6297,6 +6302,10 @@ TkTextYviewCmd( case TKTEXT_SCROLL_PIXELS: YScrollByPixels(textPtr, count); break; + case TKTEXT_SCROLL_MOUSE: + if (count < 0) count -= 2; + YScrollByPixels(textPtr, (-count)/3); + break; case TKTEXT_SCROLL_UNITS: YScrollByLines(textPtr, count); break; @@ -8770,10 +8779,10 @@ TextGetScrollInfoObj( VIEW_MOVETO, VIEW_SCROLL }; static const char *const units[] = { - "units", "pages", "pixels", NULL + "mouseunits", "pages", "pixels", "units", NULL }; enum viewUnits { - VIEW_SCROLL_UNITS, VIEW_SCROLL_PAGES, VIEW_SCROLL_PIXELS + VIEW_SCROLL_MOUSE, VIEW_SCROLL_PAGES, VIEW_SCROLL_PIXELS, VIEW_SCROLL_UNITS }; int index; @@ -8794,7 +8803,7 @@ TextGetScrollInfoObj( return TKTEXT_SCROLL_MOVETO; case VIEW_SCROLL: if (objc != 5) { - Tcl_WrongNumArgs(interp, 3, objv, "number units|pages|pixels"); + Tcl_WrongNumArgs(interp, 3, objv, "number mouseunits|pages|pixels|units"); return TKTEXT_SCROLL_ERROR; } if (Tcl_GetIndexFromObjStruct(interp, objv[4], units, @@ -8802,6 +8811,11 @@ TextGetScrollInfoObj( return TKTEXT_SCROLL_ERROR; } switch ((enum viewUnits) index) { + case VIEW_SCROLL_MOUSE: + if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { + return TKTEXT_SCROLL_ERROR; + } + return TKTEXT_SCROLL_MOUSE; case VIEW_SCROLL_PAGES: if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { return TKTEXT_SCROLL_ERROR; diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 2950fe0..4844bc2 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -668,7 +668,7 @@ Tk_GetScrollInfo( if (argc != 5) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s %s %s\"", - argv[0], argv[1], "scroll number units|pages")); + argv[0], argv[1], "scroll number pages|units")); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } @@ -684,7 +684,7 @@ Tk_GetScrollInfo( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be units or pages", argv[4])); + "bad argument \"%s\": must be pages or units", argv[4])); Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } @@ -746,7 +746,7 @@ Tk_GetScrollInfoObj( return TK_SCROLL_MOVETO; } else if (ArgPfxEq("scroll")) { if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages"); + Tcl_WrongNumArgs(interp, 2, objv, "scroll number pages|units"); return TK_SCROLL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { @@ -761,7 +761,7 @@ Tk_GetScrollInfoObj( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be units or pages", arg)); + "bad argument \"%s\": must be pages or units", arg)); Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } diff --git a/library/text.tcl b/library/text.tcl index 72da6ff..98255e4 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -428,16 +428,16 @@ bind Text { set ::tk::Priv(prevPos) {} bind Text { - %W yview scroll [expr {-((%D+1)/3)}] pixels + %W yview scroll %D mouseunits } bind Text { - %W yview scroll [expr {-4 * (%D)}] pixels + %W yview scroll [expr {10 * (%D)}] mouseunits } bind Text { - %W xview scroll [expr {-((%D+1)/3)}] pixels + %W xview scroll %D mouseunits } bind Text { - %W xview scroll [expr {-4 * (%D)}] pixels + %W xview scroll [expr {10 * (%D)}] mouseunits } # ::tk::TextClosestGap -- diff --git a/tests/entry.test b/tests/entry.test index 75a5da8..6207c69 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1435,7 +1435,7 @@ test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e xview scroll 24 } -cleanup { destroy .e -} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +} -returnCodes error -result {wrong # args: should be ".e xview scroll number pages|units"} test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1512,7 +1512,7 @@ test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { .e xview scroll 23 foobars } -cleanup { destroy .e -} -returnCodes error -result {bad argument "foobars": must be units or pages} +} -returnCodes error -result {bad argument "foobars": must be pages or units} test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e diff --git a/tests/spinbox.test b/tests/spinbox.test index 28ebe68..efd5b63 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -1773,7 +1773,7 @@ test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e xview scroll 24 } -cleanup { destroy .e -} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +} -returnCodes error -result {wrong # args: should be ".e xview scroll number pages|units"} test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e @@ -1850,7 +1850,7 @@ test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .e xview scroll 23 foobars } -cleanup { destroy .e -} -returnCodes error -result {bad argument "foobars": must be units or pages} +} -returnCodes error -result {bad argument "foobars": must be pages or units} test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e diff --git a/tests/textDisp.test b/tests/textDisp.test index 5df5467..698f8a7 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1867,10 +1867,10 @@ test textDisp-14.9 {TkTextXviewCmd procedure} { } [list [expr {9.0/14}] 1.0] test textDisp-14.10 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a} msg] $msg -} {1 {wrong # args: should be ".t xview scroll number units|pages|pixels"}} +} {1 {wrong # args: should be ".t xview scroll number mouseunits|pages|pixels|units"}} test textDisp-14.11 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a b c} msg] $msg -} {1 {wrong # args: should be ".t xview scroll number units|pages|pixels"}} +} {1 {wrong # args: should be ".t xview scroll number mouseunits|pages|pixels|units"}} test textDisp-14.12 {TkTextXviewCmd procedure} { list [catch {.t xview scroll gorp units} msg] $msg } {1 {expected integer but got "gorp"}} @@ -1904,7 +1904,7 @@ test textDisp-14.14 {TkTextXviewCmd procedure} { } {2.21 2.20 2.99 2.84} test textDisp-14.15 {TkTextXviewCmd procedure} { list [catch {.t xview scroll 14 globs} msg] $msg -} {1 {bad argument "globs": must be units, pages, or pixels}} +} {1 {bad argument "globs": must be mouseunits, pages, pixels, or units}} test textDisp-14.16 {TkTextXviewCmd procedure} { list [catch {.t xview flounder} msg] $msg } {1 {bad option "flounder": must be moveto or scroll}} @@ -2086,13 +2086,13 @@ test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} { } [list [expr {1.0/3}] [expr {5.0/6}]] test textDisp-16.19 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a} msg] $msg -} {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}} +} {1 {wrong # args: should be ".t yview scroll number mouseunits|pages|pixels|units"}} test textDisp-16.20 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a b c} msg] $msg -} {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}} +} {1 {wrong # args: should be ".t yview scroll number mouseunits|pages|pixels|units"}} test textDisp-16.21 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll badInt bogus} msg] $msg -} {1 {bad argument "bogus": must be units, pages, or pixels}} +} {1 {bad argument "bogus": must be mouseunits, pages, pixels, or units}} test textDisp-16.21.2 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll badInt units} msg] $msg } {1 {expected integer but got "badInt"}} @@ -2104,7 +2104,7 @@ test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} { } {42.0} test textDisp-16.22.1 {TkTextYviewCmd procedure, "scroll" option, back pages} { list [catch {.t yview scroll -3 p} res] $res -} {1 {ambiguous argument "p": must be units, pages, or pixels}} +} {1 {ambiguous argument "p": must be mouseunits, pages, pixels, or units}} test textDisp-16.23 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t yview 50.0 update @@ -2175,7 +2175,7 @@ test textDisp-16.31 {TkTextYviewCmd procedure, "scroll units" option} { } {151.40} test textDisp-16.32 {TkTextYviewCmd procedure} { list [catch {.t yview scroll 12 bogoids} msg] $msg -} {1 {bad argument "bogoids": must be units, pages, or pixels}} +} {1 {bad argument "bogoids": must be mouseunits, pages, pixels, or units}} test textDisp-16.33 {TkTextYviewCmd procedure} { list [catch {.t yview bad_arg 1 2} msg] $msg } {1 {bad option "bad_arg": must be moveto or scroll}} diff --git a/tests/util.test b/tests/util.test index c1ec6a5..d457b50 100644 --- a/tests/util.test +++ b/tests/util.test @@ -28,10 +28,10 @@ test util-1.3 {Tk_GetScrollInfo procedure} -body { } -result {0.5 0.75} test util-1.4 {Tk_GetScrollInfo procedure} -body { .l yview scroll a -} -returnCodes error -result {wrong # args: should be ".l yview scroll number units|pages"} +} -returnCodes error -result {wrong # args: should be ".l yview scroll number pages|units"} test util-1.5 {Tk_GetScrollInfo procedure} -body { .l yview scroll a b c -} -returnCodes error -result {wrong # args: should be ".l yview scroll number units|pages"} +} -returnCodes error -result {wrong # args: should be ".l yview scroll number pages|units"} test util-1.6 {Tk_GetScrollInfo procedure} -body { .l yview scroll xyz units } -returnCodes error -result {expected integer but got "xyz"} @@ -57,7 +57,7 @@ test util-1.10 {Tk_GetScrollInfo procedure} -body { } -result {13} test util-1.11 {Tk_GetScrollInfo procedure} -body { .l yview scroll 3 zips -} -returnCodes error -result {bad argument "zips": must be units or pages} +} -returnCodes error -result {bad argument "zips": must be pages or units} test util-1.12 {Tk_GetScrollInfo procedure} -body { .l yview dropdead 3 times } -returnCodes error -result {unknown option "dropdead": must be moveto or scroll} -- cgit v0.12