cmdr
Check-in [ff5bdec2ca]
Not logged in
Myself Home DocumentationDownloads Tickets | Timeline Branches Tags Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:cmdr::help, cmdr::pager - Moved the paging support into a separate package, for use outside of the help code. Functiomnality tweak: Linenoise not supporting querying the height does not disable paging, just goes with a default height.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ff5bdec2ca0a9ad7328ee9a113652232876b1fdd
User & Date: andreask 2014-06-03 20:40:54.224
Context
2014-06-17
18:27
cmdr::config - Fix long-standing bug in forced parameter value calculation (method 'Force'). Any error in the calculations left the flag 'myinforce' set, causing a future invokation to believe to be in a recursive call and do nothing. While this had no effect on regular operation, i.e. where the using application exits after the command, in interactive mode this disabled checks and validations for the command in question, and also retained old parameter values. Fixed by putting a try/finally around the section, resetting the flag even in the presence of errors thrown by it. cmdr::config version bumped to 1.1.1. check-in: f74095b252 user: andreask tags: trunk
2014-06-03
20:40
cmdr::help, cmdr::pager - Moved the paging support into a separate package, for use outside of the help code. Functiomnality tweak: Linenoise not supporting querying the height does not disable paging, just goes with a default height. check-in: ff5bdec2ca user: andreask tags: trunk
00:24
cmdr::help - Added option to forcibly disable the pager. check-in: a52e457615 user: andreask tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to help.tcl.
︙︙
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require lambda
# Meta require linenoise
# Meta require textutil::adjust
# Meta require cmdr::util

# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
package require lambda
package require linenoise
package require textutil::adjust
package require cmdr::util
package require cmdr::tty

# # ## ### ##### ######## ############# #####################

debug define cmdr/help
debug level  cmdr/help
debug prefix cmdr/help {[debug caller] | }









>












|








13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require lambda
# Meta require linenoise
# Meta require textutil::adjust
# Meta require cmdr::util
# Meta require cmdr::pager
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
package require lambda
package require linenoise
package require textutil::adjust
package require cmdr::util
package require cmdr::pager

# # ## ### ##### ######## ############# #####################

debug define cmdr/help
debug level  cmdr/help
debug prefix cmdr/help {[debug caller] | }
︙︙
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

		  [$actor root] \
		  $width \
		  [cmdr util dictsort \
		       [query $actor $words]]]

    # Determine how to show the help, in a pager, or not ?

    if {$nopage || ![tty stdout]} {
	# Not a terminal, no pager possible.
	# This is also the case handling windows.
	puts $text
    } else {
	# Terminal
	if {[catch {
	    set height [linenoise lines]
	}]} {
	    # Unable to get the terminal height.
	    # Don't do paging.
	    puts $text
	} else {
	    # Compare the help's height to the terminal.
	    set lines [llength [split $text \n]]
	    if {$lines <= $height} {
		# The help fits fully into the terminal, no pager
		# needed.
		puts $text
	    } else {
		# The help is too high, and does not fit into the
		# current terminal.
		set pager [Pager]
		if {![llength $pager]} {
		    # We found no pager, and give up on trying to use
		    # one.
		    puts $text
		} else {
		    # We needed and have a pager, run it with the help.
		    # as input.
		    set    pipe [open "|$pager" w]
		    puts  $pipe $text
		    # This waits until the pager exits.
		    close $pipe
		}
	    }
	}
    }
    return
}

proc ::cmdr::help::Pager {} {
    global env
    if {[info exists env(PAGER)]} {
	lappend pager $env(PAGER)
    }
    lappend pager less
    lappend pager more

    foreach p $pager {
	set cmd [auto_execok $p]
	if {[llength $cmd]} break
    }
    return $cmd
}

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::help::format {
    namespace export full list short by-category
    namespace ensemble create








|
<
<


<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








168
169
170
171
172
173
174
175


176
177






178






















179
180


181















182
183
184
185
186
187
188

		  [$actor root] \
		  $width \
		  [cmdr util dictsort \
		       [query $actor $words]]]

    # Determine how to show the help, in a pager, or not ?

    if {$nopage} {


	puts $text
    } else {






	cmdr pager $text






















    }



    return















}

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::help::format {
    namespace export full list short by-category
    namespace ensemble create
︙︙
583
584
585
586
587
588
589
590
591
592
593
594

	if {$pos >= 0} {
	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
	}
    }

    return $categories
}


# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 1.3








<





537
538
539
540
541
542
543

544
545
546
547

	if {$pos >= 0} {
	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
	}
    }

    return $categories
}


# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::help 1.3
Added pager.tcl. 




















































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Pager - Auto-page large output
##                Common use case is help.

# @@ Meta Begin
# Package cmdr::pager 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Utilities for interfacing with pager applications like less and more.
# Meta description Utilities for interfacing with pager applications like less and more.
# Meta subject {command line}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require linenoise
# Meta require cmdr::tty
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
package require linenoise
package require cmdr::tty

# # ## ### ##### ######## ############# #####################

debug define cmdr/pager
debug level  cmdr/pager
debug prefix cmdr/pager {[debug caller] | }

# # ## ### ##### ######## ############# #####################
## Definition

namespace eval ::cmdr {
    namespace export pager
    namespace ensemble create
}

namespace eval ::cmdr::pager {
    namespace import ::cmdr::tty
}

# # ## ### ##### ######## ############# #####################

proc ::cmdr::pager {text} {
    debug.cmdr/pager {}

    set pager [pager::Locate $text]

    debug.cmdr/pager {pager = ($pager)}
    if {[llength $pager]} {
	set    pipe [open "|$pager" w]
	puts  $pipe $text
	# This waits until the pager exits.
	close $pipe

    } else {
	# Paging not available, disabled, etc.
	puts stdout $text
    }

    debug.cmdr/pager {/done}
    return
}

proc ::cmdr::pager::Locate {text} {
    debug.cmdr/pager {}

    # Not in a terminal, no paging
    if {![tty stdout]} {
	debug.cmdr/pager {==> (), not in a tty - disabled}
	return {}
    }

    # Does line noise support querying terminal height ?  If not we go
    # with a default value.
    if {[catch {
	set height [linenoise lines]
	debug.cmdr/pager {terminal height $height /linenoise}
    }]} {
	set height 25
	debug.cmdr/pager {terminal height $height /default}
    }

    # Does the text fits into the terminal as is ? If yes, paging is
    # not required.
    set lines [llength [split $text \n]]
    if {$lines <= $height} {
	debug.cmdr/pager {==> (), text fits - disabled}
	return {}
    }

    # We want paging. Find the external command to use for this. This
    # can still disable paging, when nothing is found. We look for the
    # user's choice first.

    global env
    if {[info exists env(PAGER)]} {
	lappend pager $env(PAGER)
    }
    lappend pager less
    lappend pager more

    foreach p $pager {
	debug.cmdr/pager {Looking for cmd ($p)}
	set cmd [auto_execok $p]
	if {[llength $cmd]} break
    }

    debug.cmdr/pager {==> ($cmd)}
    return $cmd
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::pager 0