cmdr
Check-in [ff5bdec2ca]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to help.tcl.

    13     13   # Meta require {Tcl 8.5-}
    14     14   # Meta require debug
    15     15   # Meta require debug::caller
    16     16   # Meta require lambda
    17     17   # Meta require linenoise
    18     18   # Meta require textutil::adjust
    19     19   # Meta require cmdr::util
           20  +# Meta require cmdr::pager
    20     21   # @@ Meta End
    21     22   
    22     23   # # ## ### ##### ######## ############# #####################
    23     24   ## Requisites
    24     25   
    25     26   package require Tcl 8.5
    26     27   package require debug
    27     28   package require debug::caller
    28     29   package require lambda
    29     30   package require linenoise
    30     31   package require textutil::adjust
    31     32   package require cmdr::util
    32         -package require cmdr::tty
           33  +package require cmdr::pager
    33     34   
    34     35   # # ## ### ##### ######## ############# #####################
    35     36   
    36     37   debug define cmdr/help
    37     38   debug level  cmdr/help
    38     39   debug prefix cmdr/help {[debug caller] | }
    39     40   
................................................................................
   167    168   		  [$actor root] \
   168    169   		  $width \
   169    170   		  [cmdr util dictsort \
   170    171   		       [query $actor $words]]]
   171    172   
   172    173       # Determine how to show the help, in a pager, or not ?
   173    174   
   174         -    if {$nopage || ![tty stdout]} {
   175         -	# Not a terminal, no pager possible.
   176         -	# This is also the case handling windows.
          175  +    if {$nopage} {
   177    176   	puts $text
   178    177       } else {
   179         -	# Terminal
   180         -	if {[catch {
   181         -	    set height [linenoise lines]
   182         -	}]} {
   183         -	    # Unable to get the terminal height.
   184         -	    # Don't do paging.
   185         -	    puts $text
   186         -	} else {
   187         -	    # Compare the help's height to the terminal.
   188         -	    set lines [llength [split $text \n]]
   189         -	    if {$lines <= $height} {
   190         -		# The help fits fully into the terminal, no pager
   191         -		# needed.
   192         -		puts $text
   193         -	    } else {
   194         -		# The help is too high, and does not fit into the
   195         -		# current terminal.
   196         -		set pager [Pager]
   197         -		if {![llength $pager]} {
   198         -		    # We found no pager, and give up on trying to use
   199         -		    # one.
   200         -		    puts $text
   201         -		} else {
   202         -		    # We needed and have a pager, run it with the help.
   203         -		    # as input.
   204         -		    set    pipe [open "|$pager" w]
   205         -		    puts  $pipe $text
   206         -		    # This waits until the pager exits.
   207         -		    close $pipe
   208         -		}
   209         -	    }
   210         -	}
          178  +	cmdr pager $text
   211    179       }
          180  +
   212    181       return
   213    182   }
   214    183   
   215         -proc ::cmdr::help::Pager {} {
   216         -    global env
   217         -    if {[info exists env(PAGER)]} {
   218         -	lappend pager $env(PAGER)
   219         -    }
   220         -    lappend pager less
   221         -    lappend pager more
   222         -
   223         -    foreach p $pager {
   224         -	set cmd [auto_execok $p]
   225         -	if {[llength $cmd]} break
   226         -    }
   227         -    return $cmd
   228         -}
   229         -
   230    184   # # ## ### ##### ######## ############# #####################
   231    185   
   232    186   namespace eval ::cmdr::help::format {
   233    187       namespace export full list short by-category
   234    188       namespace ensemble create
   235    189   }
   236    190   
................................................................................
   583    537   	if {$pos >= 0} {
   584    538   	    set categories [linsert [lreplace $categories $pos $pos] end Miscellaneous]
   585    539   	}
   586    540       }
   587    541   
   588    542       return $categories
   589    543   }
   590         -
   591    544   
   592    545   # # ## ### ##### ######## ############# #####################
   593    546   ## Ready
   594    547   package provide cmdr::help 1.3

Added pager.tcl.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## CMDR - Pager - Auto-page large output
            4  +##                Common use case is help.
            5  +
            6  +# @@ Meta Begin
            7  +# Package cmdr::pager 0
            8  +# Meta author   {Andreas Kupries}
            9  +# Meta location https://core.tcl.tk/akupries/cmdr
           10  +# Meta platform tcl
           11  +# Meta summary     Utilities for interfacing with pager applications like less and more.
           12  +# Meta description Utilities for interfacing with pager applications like less and more.
           13  +# Meta subject {command line}
           14  +# Meta require {Tcl 8.5-}
           15  +# Meta require debug
           16  +# Meta require debug::caller
           17  +# Meta require linenoise
           18  +# Meta require cmdr::tty
           19  +# @@ Meta End
           20  +
           21  +# # ## ### ##### ######## ############# #####################
           22  +## Requisites
           23  +
           24  +package require Tcl 8.5
           25  +package require debug
           26  +package require debug::caller
           27  +package require linenoise
           28  +package require cmdr::tty
           29  +
           30  +# # ## ### ##### ######## ############# #####################
           31  +
           32  +debug define cmdr/pager
           33  +debug level  cmdr/pager
           34  +debug prefix cmdr/pager {[debug caller] | }
           35  +
           36  +# # ## ### ##### ######## ############# #####################
           37  +## Definition
           38  +
           39  +namespace eval ::cmdr {
           40  +    namespace export pager
           41  +    namespace ensemble create
           42  +}
           43  +
           44  +namespace eval ::cmdr::pager {
           45  +    namespace import ::cmdr::tty
           46  +}
           47  +
           48  +# # ## ### ##### ######## ############# #####################
           49  +
           50  +proc ::cmdr::pager {text} {
           51  +    debug.cmdr/pager {}
           52  +
           53  +    set pager [pager::Locate $text]
           54  +
           55  +    debug.cmdr/pager {pager = ($pager)}
           56  +    if {[llength $pager]} {
           57  +	set    pipe [open "|$pager" w]
           58  +	puts  $pipe $text
           59  +	# This waits until the pager exits.
           60  +	close $pipe
           61  +
           62  +    } else {
           63  +	# Paging not available, disabled, etc.
           64  +	puts stdout $text
           65  +    }
           66  +
           67  +    debug.cmdr/pager {/done}
           68  +    return
           69  +}
           70  +
           71  +proc ::cmdr::pager::Locate {text} {
           72  +    debug.cmdr/pager {}
           73  +
           74  +    # Not in a terminal, no paging
           75  +    if {![tty stdout]} {
           76  +	debug.cmdr/pager {==> (), not in a tty - disabled}
           77  +	return {}
           78  +    }
           79  +
           80  +    # Does line noise support querying terminal height ?  If not we go
           81  +    # with a default value.
           82  +    if {[catch {
           83  +	set height [linenoise lines]
           84  +	debug.cmdr/pager {terminal height $height /linenoise}
           85  +    }]} {
           86  +	set height 25
           87  +	debug.cmdr/pager {terminal height $height /default}
           88  +    }
           89  +
           90  +    # Does the text fits into the terminal as is ? If yes, paging is
           91  +    # not required.
           92  +    set lines [llength [split $text \n]]
           93  +    if {$lines <= $height} {
           94  +	debug.cmdr/pager {==> (), text fits - disabled}
           95  +	return {}
           96  +    }
           97  +
           98  +    # We want paging. Find the external command to use for this. This
           99  +    # can still disable paging, when nothing is found. We look for the
          100  +    # user's choice first.
          101  +
          102  +    global env
          103  +    if {[info exists env(PAGER)]} {
          104  +	lappend pager $env(PAGER)
          105  +    }
          106  +    lappend pager less
          107  +    lappend pager more
          108  +
          109  +    foreach p $pager {
          110  +	debug.cmdr/pager {Looking for cmd ($p)}
          111  +	set cmd [auto_execok $p]
          112  +	if {[llength $cmd]} break
          113  +    }
          114  +
          115  +    debug.cmdr/pager {==> ($cmd)}
          116  +    return $cmd
          117  +}
          118  +
          119  +# # ## ### ##### ######## ############# #####################
          120  +## Ready
          121  +package provide cmdr::pager 0