#! /bin/csh -f # the next line restarts using wish \ exec /usr/local/bin/wish $0 $* set manx(version) 1.7.3 set manx(newuser) "" set manx(dirnameindex) 3 set man(zcat) "gzip -dcfq" set man(compress) "gzip -q" set man(apropos) {man -k} set man(glimpse) "" set man(glimpseindex) "" set man(glimpsestrays) /tmp set man(format) {tbl | neqn | nroff -man | col} set manx(manpathdef) "" set man(print) {tbl | eqn | troff -man -t | lpr -t} set man(zregexp) {\.(gz|z|Z)$} set man(zglob) {{gz,z,Z}} set man(grep) grep set man(sed) sed set man(rm) rm set man(find) find set man(chmod) chmod set man(mkdir) mkdir set man(sort) sort set man(date) date set man(ls) ls set man(database) $env(HOME)/.tkmandatabase set man(mv) mv set man(cp) cp set manx(rman) rman set man(catprint) lpr set man(catsig) {cat[^/]+(/[^/]+)?$} set man(shortnames) 0 set man(dpis) {* 75 100} set man(iconbitmap) "" proc manHelpDump {t} { $t insert end {A bird? A plane? TkMan! (TkPerson?) by Tom Phelps written in Tcl 7.4/Tk 4.0 Compatible with Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, DEC Ultrix, SGI IRIX, Linux, SCO, IBM AIX, FreeBSD Copyright (c) 1993-1995 T. A. Phelps All Rights Reserved. University of California, Berkeley Department of Electrical Engineering and Computer Science Computer Science Division The latest version of TkMan is always available by anonymous FTP at ftp.cs.Berkeley.EDU in the /ucb/people/phelps/tcltk directory. PERMISSION IS GRANTED TO DISTRIBUTE THIS SOFTWARE FREELY, WITH THE EXCEPTION THAT ONE MAY NOT CHARGE FOR IT OR INCLUDE IT WITH SOFTWARE WHICH IS SOLD. If you send me bug reports and/or suggestions for new features, include the versions of TkMan, Tcl, Tk, X, and UNIX, your machine and X window manager names, and a copy of your ~/.tkman file. Introduction A graphical manual page browser, TkMan offers two major advantages over xman: hypertext links to other man pages (click on a word in the text which corresponds to a man page, and you jump there), and better navigation within long man pages with searches (both incremental and regular expression) and jumps to section headers. TkMan also offers some convenience features, like a user-configurable list of commonly used man pages, a one-click printout, and integration of whatis and apropos. Further, one may highlight, as if with a yellow marker, arbitrary passages of text in man pages and subsequently jump directly to these passages by selecting an identifying excerpt from a pulldown menu. Finally, TkMan gives one control over the directory-to-menu volume mapping of man pages with a capability similar to but superior to xman's mandesc in that rather than forcing all who share a man directory to follow a single organization, TkMan gives control to the individual. For instance, one may decide he has no use for a large set of man pages--say for instance the programmer routines in volumes 2, 3, 4, 8--and eliminate them from his personal database. Or a Tcl/Tk programmer may decide to group Tcl/Tk manual pages in their own volume listing. Other features include: * full text search of manual pages (with Glimpse; optional) * a pulldown list of all man pages matching the search name * regular expression searches for manual page names * a list of recently added or changed manual pages * a "history" list of the most recently visited pages * a preferences panel to control fonts, colors, and other system settings * compatibility with compressed pages (both as source and formatted) * diagnostics on your manual page installation * elision of those unsightly page headers and footers * and, when attempting to print a page that available only in formatted form, reverse compilation into [tn]roff source, which can then be reformatted as good-looking PostScript. This help page is shipped with the distribution in HTML form for easy printing. Using TkMan Locating a man page There are several ways to specify the manual page you desire. You can type its name into the entry box at the top of the screen and press Return or click the man button. The name may be just the name of the command or may include a .n or (n) at the end where n specifies in which section to look. Man pages are matched using regular expressions, so you can use . to match any single character, * to match any (zero or more) of the previous regular expression, [ .. ] to match any single character in the enclosed class; see Tcl's regexp(n) for more information. For instance, .*mail.*\\.1 searches section 1 (user commands) for commands with "mail" anywhere in their names. Likewise, one can collect all the various manual pages relating to Perl 5 with perl.*, or see a list of all X window managers with .*wm. If you're running TkMan from a shell and giving it an initial man page name to load up as an argument, use this syntax (adequately quoted for protection from the shell), as opposed to the syntax of the standard man command (which is man section name--that is, the section number comes first, whereas in TkMan it is part of the name. Usually TkMan searches the directories in your MANPATH environment variable for the man page, but you may instead provide a path name for the man page by beginning it with `~', `/', `.' or `..'; this is the way to access a man page which isn't installed in a MANPATH man directory. Further, other Tcl interpreters may display a man page in TkMan by sending a message to the function manShowMan with the name of the desired man page, e.g. send tkman manShowMan tcl.n. If multiple man page names match the specification, the first match (as searched for in MANPATH order) is shown and a pulldown menu appears which contains a list of the other matches. Return from reading help or a volume listing to the last man page seen with C-m when the focus is in the main text display area. apropos information is available by typing the name and clicking apropos or hitting Shift-Return. The output of apropos is piped through sort and uniq to remove duplicates. To pass the matches through additional filters, simply give the pipe as in a shell, e.g., `search | grep ^g' (each space character is significant) returns all the search-related commands which begin with the letter g. The results of the last apropos query are available under the Volumes menu. You may also see a button for glimpse, a full text search program that requires only small index files ("typically 2-5% the size of the original text" but larger percentages for smaller amounts of text), written by Udi Manber, Sun Wu, and Burra Gopal of the University of Arizona's Department of Computer Science. In their performance measurements, "a search for Schwarzkopf allowing two misspelling errors in 5600 files occupying 77MB took 7 seconds on a SUN IPC." For example, one may search for the string `WWW' anywhere in any manual page by typing in `WWW' in the entry line at the top of the screen and clicking on the glimpse button or typing Meta-Return (for meta-information, of course). Escape and C-g can interrupt a search after the current directory is done. To employ glimpse's command line options, simply place them before the search pattern in the entry box, or add them to the default options by editing the man(glimpse) variable in your ~/.tkman startup file (see Customizing TkMan, below). For instance, to search for "perl" as a word and not part of another word (as in "properly"), glimpse for -w perl. Glimpse supports an AND operation denoted by the symbol `;' and an OR operation denoted by the symbol `,'. Refer to the glimpse manual page for more information. The regular expression used by glimpse automatically sets the intrapage search expression. The case sensitivity of the search is set to the same as the that of intrapage regular expression searching. A complete set of matches from the last full text search is available under the Volumes menu. The Paths pulldown gives you complete control over which directory hierarchies of your MANPATH are searched for man pages and apropos information. You can call up a listing of all man pages in a volume through the Volumes pulldown menu and then select one to view by double-clicking on its name. New `pseudo-volumes' can be added, and arbitrary directories may be added to or deleted from a volume listing using tkmandesc commands, described below. In a volume listing, typing a letter jumps to the line in the listing starting with that letter (capital and lower case letters are distinct). Return to the last volume seen with C-d when the focus is in the main text display area. Whenever you have a man page name in the text display box, whether from apropos, a volume listing or a reference within another man page, you can double-click on it to hypertext-jump to it. Pressing shift while double-clicking opens up a new viewer box to display the page. The last few man pages you looked at can be accessed directly through the History pulldown menu. Shortcuts lists your personal favorites and is used just like History, with the additional options of adding the current man page (by clicking +) or removing it (-) from the list. (Man pages specified as above are processed through an nroff filter. TkMan can also read raw text from a file or from a command pipeline, which can then be read, searched and highlighted same as a man page. To read from a file, make the first character in the name a <, as in <~/foo.txt. To open a pipe, make the first character a | (vertical bar), as in `|gzcat foo.txt.gz' or `|cat ../foo.txt | grep bar' (that's no space after the first |, a space before and after any subsequent ones). After reading a file in this way, the current directory is set to its directory. Commands are not processed by a shell, but the metacharacters ., .., ~ and $ (for environment variables), are expanded nonetheless. Typing is eased further by file name completion, bound to Escape. Lone files (i.e., not part of a pipe) are automatically uncompressed--no need to read compressed files through a zcat pipe. It is not expected that reading raw text will be done much; it is included so the occasional non-man page documentation may be read from the same environment. For more sophisticated file browsing, use NBT, my Tcl/Tk-based file browser, which is available from TkMan's home FTP site, given above.) Working within a man page The full pathname of the current manual page is shown at the top of the screen. Via the Preferences dialog, this can be changed to the whatis information for the page. To the extent it follows convention, a manual page is parsed to yield its section and subsection titles (which are directly available from the Sections pulldown) and references to other man pages from its SEE ALSO section (Links pulldown). One may jump directly to a section within a man page or a man page referenced in the SEE ALSO section, respectively, by selecting the corresponding entry from one of these pulldowns. Within a man page or raw text file or pipe, you may add ad hoc highlighting, as though with a yellow marker (underlining on monochrome monitors). Highlighted regions may then be scrolled to directly through the Highlights pulldown menu. To highlight a region, select the desired text by clicking button 1, dragging to the far extent of the desired region and releasing the button, then click on the + next to Highlights. To remove any highlights or portions thereof in a region, select it as before but then click on -. Highlighting information is persistent across executions of TkMan. A complete set of pages with highlighting is available under the Volumes menu. You can move about the man page by using the scrollbar or typing a number of key combinations familiar to Emacs aficionados. Space and C-v page down, and delete and M-v page up. C-n and C-p scroll up and down, respectively, by a single line (vi fans will be happy to hear that C-f and C-b also page down and page up, respectively). M-< goes to the head and M-> to the tail of the text. One may "scan" the page, which is to say scroll it up and down with the mouse but without the use of the scrollbar, by dragging on the text display with the middle mouse button pressed. Like Emacs, C-space will mark one's current location, which can be returned to later with C-x, which exchanges the then-current position with the saved mark; a second C-x swaps back. C-s initiates a search. Subsequently typing a few letters attempts to find a line with that string, starting its search with at the current match, if any, or otherwise the topmost visible line. A second C-s finds the next match of the string typed so far. (If the current search string is empty, a second C-s retrieves the previous search pattern.) C-r is similar to C-s but searches backwards. This incremental search can be used to quickly locate a particular command-line option or a particular command in a group (as in csh with its long list of internal commands). At the bottom of the screen, type in a regular expression to search for and hit return or click Search to begin a search. Hit Next or keep hitting return to search for the next occurance. [Prev will be added when Tk supports a tag prevrange command.] Escape or C-g cancels searching, both incremental and regular expression types. The Tab key moves the focus from the man page type-in line to the text view of the man page to the search line and back around. Shift-Tab jumps about in the opposite direction. Other commands The Occasionals menu holds commands and options which you probably won't use much. Help returns to this information screen. Although virtually made obsolete by TkMan, Print makes a copy of the current man page on dead trees, helping to starve the planet of life-giving oxygen. (If the [tn]roff source is not available, TkMan asks if it should try to reverse compile the man page. If successful, this produces much more appealing output than an ASCII dump.) By default, incremental searching is not case sensitive, but regular expression searching is; these settings can be toggled with the next two menus. The mysterious iff upper means that searching is case sensitive if and only if their is at least one uppercase letter in the search expression--that is, all lowercase searches are not case sensitive; this idea is taken from Emacs (I think). With proportional fonts giving a ragged right margin, any change bars in the right margin will form an uneven line; by opting for Changebars on left, they will form a straight line at the left margin. As with xman one may instantiate multiple viewers. When there is more than one viewer you may choose man pages in one viewer and have their contents shown in another. Use the Output pulldown (which appears and disappears as relevant) to direct one viewer's output destination to another. With this feature one may easily compare two similar man pages for differences, keep one man page always visible, or examine several man pages from a particular volume listing or a SEE ALSO section. Output only affects the display destination of man pages. TkMan uses a database of all manual page names in searching for a match for a particular name. This database is constructed automatically if it doesn't exist (this includes the first time TkMan is run for a particular user) and whenever it is out of date due to pages being added or changed, or changes in one's MANPATH or tkmandesc commands. (If you want to add paths to your MANPATH, or edit ~/.tkman, you will have to restart to see any changes take effect, however.) If you install new manual pages, invoking Rebuild Database will permit them to show up in the next search or volume listing without the bother of quitting and re-executing TkMan. Rebuild Glimpse Database creates and then maintains the index that is used for full text searches. The Glimpse database is not maintained automatically. When exited via the Quit button TkMan saves its state. One may guard against losing highlighting, shortcuts and other what-should-be persistent information without quitting by by invoking Checkpoint state to .tkman; Quit, don't update performs the opposite operation. At the bottom right corner of the screen, Mono toggles between the proportionally-spaced font and a monospaced one, for use in those man pages that rely on a fixed-width font to align columns. Quit exits TkMan, of course, after saving some state information (see below). To exit without saving status information, select the Quit option from the Occasionals pulldown. Preferences The Preferences... choice in the Occasionals pulldown menu brings up a graphical user interface to setting various attributes of TkMan, including fonts, colors, and icons. Click on a checkbutton at the top of the window to bring up the corresponding group of choices. After making a set of choices, the Apply button reconfigures the running application to show these changes, OK sets the changes for use now and in the future, Cancel quits the dialog and sets all choices to their settings as of the time Preferences was called up, and Defaults resets the settings in the current group to those set by TkMan out of the box. The first line in the Fonts group specifies the font to use for the general user interface, which amounts to the labels on buttons and the text in menus. The first menu in the line labeled Interface sets the font family, the next menu sets the font size, and the last the font styling (normal, bold, italics, bold-italics). Text display makes these settings for the text box in which the manual pages contents are displayed. For listings of all man pages in a particiular volume (as chosen with the Volumes menu), you may wish to use a smaller font so that more names fit on the screen at once. Screen DPI specifies the right set of fonts to use for your monitor. Colors sets the foreground and background colors to use for the manual page text display box, the general user interface, and the buttons of the user interface. In addition it sets the color (or font) in which to show various classes of text in the text box, including manual page references, incremental search hits, regular expression search hits, and highlighted regions. The See group specifies what information to display. Usually manual page headers and footers are uninteresting and therefore are stripped out, but a canonical header and footer (along the date the page was installed in the man/mann directory or formatted to the man/catn directory) to be shown at the bottom of every page can be requested. Solaris and IRIX systems come with many "subvolumes"--that is volumes with names like "3x" and "4dm" that form subgroupings under the main volumes "3" and "4", respectively--and you make use tkmandesc commands to add your own subvolumes. You can reduce the length of the main Volumes menu by placing all volumes in such groups as cascaded menus. When a highlighted passage is jumped to via the Highlights menu, some number of lines of back context are included; the exact number of lines is configurable. The information bar at the top of the window can display either the short, one-line description from a manual page's NAME section or the pathname of the page. Around the man page display area runs a buffer region, the exact width of which is configurable. Tk deviates from Motif behavior slightly, as for instance in highlighting buttons when they're under the cursor, but you can observe strict Motif behavior. The Icon group sets all the options relating to iconification. The pathnames of the icon bitmap and icon mask should be the full pathnames (beginning with a `/'). If a man page has not been formatted by nroff, TkMan must first pipe the source text through nroff. By turing on Cache formatted (nroff'ed) pages in the Misc(ellaneous) group, the nroff-formatted text is saved to disk (if possible), thereby eliminating this time-consuming step the next time the man page is read. The on & compress setting will compress the page, which saves on disk space (often substantially as much of a formatted page is whitespace), but will make it unavailable to other manual pagers that don't handle compression. TkMan can extract section headers from all manual pages, but only some manual page macros format subsection headers in a way that can be distinguished from ordinary text; if your macros do, turn this option on to add subsections to the Sections menu. The History pulldown must balance depth of the list against ease of finding an entry; set your own inflection point with this menu. Volumes' (recent) choice will show all manual pages that have been added or changed n days, where n is set with this next menu. Glimpse works best when searching for relatively uncommon words; guard against getting too many hits with the last menu in this group. Proportional spacing wrecks the spacing used to set tables in columns, hence the Mono(space) button on the bottom line of the main screen; setting the Aggressive table parsing option on will try to identify tables and format them in a fixed-width font while keeping the rest of the text proportionally spaced. It is quite difficult to identify tables with the single-pass filter that TkMan uses, however, so you'll probably want to leave it off. Customizing TkMan There are four levels of configuration to TkMan. (1) Transparent. Simply use TkMan and it will remember your window size and placement, short cuts, and highlights (if you quit out of TkMan via the Quit button). (2) Preferences editor (see Preferences above). (3) Configuration file. Most interesting settings, like the command(s) used to print the man page and some key bindings, can be changed by editing one's own ~/.tkman. Thus, a single copy of TkMan (i.e., the executable tkman) can be shared, but each user can have his own customized setup. (The file ~/.tkman is created/rewritten every time one quits TkMan via the Quit button in the lower right corner. Therefore, to get a ~/.tkman to edit, first run and quit TkMan. Do not create one from scratch as it will not have the proper format used for saving other persistent information, and your work will be overwritten, which is to say lost.) Be careful not to edit a ~/.tkman file only to have it overwritten when a currently-running TkMan quits. Options that match the defaults are commented out (i.e., preceded by a #). This is so that any changes in the defaults will propagate nicely, while the file still lists all interesting variables. To override the default settings for these options, first comment in the line. The ~/.tkman save file is the place to add or delete colors to the default set, which will subsequently become menu choices in Preferences, by editing in place the variable man(colors). One may also edit the order of Shortcuts in the man(shortcuts) variable. Other interesting variables include man(highlight), which can be edited to change the background in place of the foreground, or both the foreground and background, or a color and the font as with the following setting: set man(highlight) {bold-italics -background #ffd8ffffb332} Arbitrary Tcl commands, including tkmandesc commands (described below), can be appended to ~/.tkman (after the ### your additions go below line). To set absolutely the volume names for which all directories should be searched, edit the parallel arrays on these existing lines: set man(manList) ... set man(manTitleList) ... Changing the order volumes in these lists (make sure to keep the two lists in parallel correspondence) changes the precedence of matches when two or more pages have the same name: the page found in the earlier volume in this list is show first. Additional useful commands include wm(n), which deals with the window manager; bind(n), which changes keyboard and mouse bindings not related to the text display window; and text(n) which describes the text widget. (4) Source code. Of course, but if you make generally useful changes or have suggestions for some, please report them back to me so I may share the wealth with the next release. Command line options The environment variable named TKMAN, if it exists, is used to set command line options. Any options specified explicitly (as from a shell or in a script) override the settings in TKMAN. Any settings made with command-line options apply for the current execution only. Many of these options can be set persistently via the Preferences dialog (under the Occasionals menu). -title title Place title in the window's title bar. -geometry geometry Specify the geometry for this invocation only. To assign a persistent geometry, start up TkMan, size and place the window as desired, then (this is important) quit via the Quit button in the lower right corner. -iconify and --iconify Start up iconified or uniconified (the default), respectively. -iconname name Use name in place of the uniconified window's title for the icon name. -iconbitmap bitmap-path and -iconmask bitmap-path Specify the icon bitmap and its mask. -iconposition (+|-)x(+|-)y Place the icon at the given position; -iconposition "" "" cancels any such hints to the window manager. -startup filename Use filename in place of ~/.tkman as the startup file; "" indictates no startup file. -database filename Use filename in place of ~/.tkmandatabase as the name of the file in which to create the database of man page names. This can point to a shared file to save disk space or share a custom design, or to an OS-specific file for systems with multiple machine architectures that share home directories. -rebuildandquit Simply rebuild the database and quit. This option may be useful in a cron script. -quit save and -quit nosave Specify that the startup file (usually ~/.tkman) should be updated (save) or not (nosave) when quitting by the Quit button. -v Show the current version of TkMan and exit immediately thereafter. -M path-list or -M+ path-list or -+M path-list As with man, change the search path for manual pages to the given colon-separated list of directory subtrees. -M+ appends and -+M prepends these directories to the current list. -now Start up TkMan without checking to see if the database is out of date. Key bindings Key bindings related to the text display box are kept in the sb array in ~/.tkman (for more information on Tcl's arrays, refer to the array(n) man page. In editing the sb(key,...) keyboard bindings, modifiers MUST be listed in the following order: M (for meta), C (control), A (alt). DO NOT USE SHIFT. It is not a general modifier: Some keyboards require shift for different characters, resulting in incompatibilities in bindings. For this reason, the status of the shift key is supressed in matching for bindings. For instance, set sb(key,M-less) pagestart is a valid binding on keyboards worldwide, whereas set sb(key,MS-less) is not. To make a binding without a modifier key, precede the character by `-', as in set sb(key,-space) pagedown. tkmandesc Like xman, TkMan gives you directory-by-directory control over named volume contents. Unlike and superior to xman, however, each individual user controls directory-to-volume placement, rather than facing a single specification for each directory tree that must be observed by all. By default a matrix is created by taking the product of directories in the MANPATH crossed with volume names, with the yield of each volume containing all the corresponding subdirectories in the MANPATH. By adding Tcl commands to your ~/.tkman (see above), you may add new volume names and add, move, copy and delete directories to/from/among directories. The interface to this functionality takes the form of Tcl commands, so you may need to learn Tcl--particularly the commands that deal with Tcl lists (including lappend(n), linsert(n), lrange(n), lreplace(n)) and string matching (string(n), match subcommand)--to use this facility to its fullest. tkmandesc commands are used to handle the nonstandard format of SGI's manual page directories, and the sgi_bindings.tcl in the contrib directory is a good source of examples in the use of tkmandesc commands. Directory titles and abbrevations are kept in lists. Abbreviations MUST be unique (capital letters are distinct from lower case), but need not correspond to actual directories. In fact, volume letters specified here supercede the defaults in identifying a volume in man page searches. COMMANDS The following commands are appended to the file ~/.tkman (see Customizing TkMan, above). To recreate a cross product of current section lists: manDescDefaults This cross product is made implicitly before other tkmandesc commands. Almost always this is what one expects. If it is not, one may supress the cross product by setting the variable manx(defaults) to a non-null, non-zero value before other tkmandesc commands are invoked. To add "pseudo" sections to the current volume name list, at various positions including at end of the list, in alphabetical order, or before or after a specific volume: manDescAddSects list of (letter, title pairs) or manDescAddSects list of (letter, title) pairs sort or manDescAddSects list of (letter, title) pairs before sect-letter or manDescAddSects list of (letter, title) pairs after sect-letter In manual page searches that produce multiple matches, the page found in the earlier volume is the one shown by default. To move/copy/delete/add directories: manDescMove from-list to-list dir-patterns-list manDescCopy from-list to-list dir-patterns-list manDescDelete from-list dir-patterns-list manDescAdd to-list dir-list The dir-patterns-list uses the same meta characters as man page searching (see above). It is matched against MANPATH directories with volume subdirectory appended, as in /usr/man/man3, where /usr/man is a component of the MANPATH and man3 is a volume subdirectory. from-list and to-list are Tcl lists of the unique volume abbreviations (like 1 or 3X); * is an abbreviation for all volumes. Adding directories with manDescAdd also makes them available to Glimpse for its indexing. Warning: Moving directories from their natural home slightly impairs searching speed when following a reference within a man page. For instance, say you've moved man pages for X Windows subroutines from their natural home in volume 3 to their own volume called `X'. Following a reference in XButtonEvent to XAnyEvent(3X11) first searches volume 3; not finding it, TkMan searches all volumes and finally finds it in volume X. With no hint to look in volume 3 (as given by the 3X11 suffix), the full volume search would have begun straight away. (Had you double-clicked in the volume listing for volume X or specified the man page as XButtonEvent.X, volume X would have been searched first, successfully.) To help debug tkmandesc scripts, invoke manDescShow to dump to stdout the current correspondence of directories to volumes names. EXAMPLES (1) To collect together all man pages in default volumes 2 and 3 in all directories into a volume called "Programmer Subroutines", add these lines to the tail of ~/.tkman: manDescAddSects {{p "Programmer Subroutines"}} manDescMove {2 3} p * To place the new section at the same position in the volume pulldown list as volumes 2 and 3: manDescAddSects {{p "Programmer Subroutines"}} after 2 manDescMove {2 3} p * To move only a selected set of directories: manDescAddSects {{p "Programmer Subroutines"}} manDescMove * p {/usr/man/man2 /usr/local/man/man3} (2) To have a separate volume with all of your and a friend's personal man pages, keeping a duplicate in their default locations: manDescAddSects {{t "Man Pages du Tom"} {b "Betty Page(s)"}} manDescCopy *phelps* t * manDescCopy *page* t * (3) To collect the X windows man pages into two sections of their own, one for programmer subroutines and another for the others: manDescAddSects {{x "X Windows"}} after 1 manDescAddSects {{X "X Subroutines"}} after 3 manDescMove * x *X11* manDescMove x X *3 (4) If you never use the programmer subroutines, why not save time and memory by not reading them into the database? manDescDelete * {*[2348]} (braces prevent Tcl from trying to execute [2348] as a command) Alternatively but not equivalently: manDescDelete {2 3 4 8} * tkmandesc vs. xman and SGI TkMan's tkmandesc capability is patterned after xman's mandesc files. By placing a mandesc file at the root of a man page directory tree, one may create pseudo volumes and move and copy subdirectories into them. Silicon Graphics has modified xman so that simply by creating a subdirectory in a regular man subdirectory one creates a new volume. This is evil. It violates the individual user's rights to arrange the directory-volume mapping as he pleases, as the mandesc file or subdirectory that spontaneously creates a volume is set a single place and must be observed by all who read that directory. By contrast, TkMan places the directory-to-volume mapping control in an individual's own ~/.tkman file. This gives the individual complete control and inflicts no pogrom on others who share man page directories. Therefore, mandesc files are not supported in any way by TkMan. One may still share custom setups, however, by sharing the relevant lines of ~/.tkman. In fact, a tkmandesc version of the standard SGI man page directory setup is included in the contrib directory of the TkMan distribution. For assistance with SGI-specific directory manipulation, contact Paul Raines (raines@bohr.physics.upenn.edu). Addresses Tom Phelps University of California, Berkeley Computer Science Division 387 Soda Hall Berkeley, CA 94720 USA phelps@cs.Berkeley.EDU More Information My article "TkMan: A Man Born Again" appears in The X Resource, issue 10, pages 33--46. Here are the section titles: Introduction, Availability, The User Interface, Navigating among Man Pages, Inspecting Individual Man Pages, Customization, Logical Volumes with tkmandesc, Persistency, The RosettaMan Filter, Extensions, Problems, Future Work, Acknowledgements, Bibliography. A World Wide Web page that lists other Tcl/Tk software and a related Berkeley Computer Science Division technical report, CSD-94-802, can be found at http://http.cs.berkeley.edu/~phelps/. Disclaimer Permission to use, copy, modify, and distribute this software and its documentation for educational, research and non-profit purposes, without fee, and without a written agreement is hereby granted, provided that the above copyright notice and the following three paragraphs appear in all copies. Permission to incorporate this software into commercial products may be obtained from the Office of Technology Licensing, 2150 Shattuck Avenue, Suite 510, Berkeley, CA 94704. IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. Without permission from the Office of Technology Licensing, commerical organizations are free to use TkMan for internal use and internal use only. Help page last revised on $Date: 1995/08/18 23:35:32 $ } foreach qq {{h1 1.0 1.38} {sc 14.61 14.64} {tt 14.68 14.87} {tt 14.95 14.119} {sc 16.0 16.150} {tt 18.177 18.185} {h1 21.0 21.12} {manref 23.72 23.76} {manref 23.471 23.477} {manref 23.482 23.489} {tt 23.828 23.832} {h1 40.0 40.11} {h2 42.0 42.19} {tt 44.159 44.162} {tt 44.234 44.235} {i 44.235 44.236} {tt 44.240 44.241} {i 44.241 44.242} {tt 44.242 44.243} {i 44.261 44.262} {tt 44.364 44.365} {tt 44.397 44.398} {tt 44.463 44.464} {tt 44.468 44.469} {manref 44.527 44.530} {manref 44.533 44.542} {tt 44.580 44.592} {tt 44.757 44.763} {tt 44.809 44.813} {tt 44.1026 44.1029} {tt 44.1048 44.1051} {i 44.1052 44.1059} {i 44.1060 44.1064} {sc 46.47 46.54} {tt 46.173 46.176} {tt 46.178 46.181} {tt 46.183 46.186} {tt 46.190 46.194} {sc 46.260 46.267} {tt 46.351 46.355} {tt 46.385 46.395} {tt 46.440 46.467} {sc 46.558 46.565} {tt 46.731 46.734} {tt 48.0 48.7} {tt 48.65 48.72} {tt 48.113 48.120} {tt 48.138 48.142} {tt 48.147 48.151} {tt 48.266 48.282} {tt 48.390 48.391} {tt 48.455 48.462} {tt 50.30 50.37} {tt 50.628 50.635} {tt 50.653 50.664} {tt 50.700 50.706} {tt 50.711 50.714} {tt 50.785 50.792} {tt 50.929 50.941} {tt 50.959 50.967} {tt 50.1119 50.1126} {tt 50.1148 50.1151} {tt 50.1184 50.1187} {tt 50.1195 50.1197} {tt 50.1230 50.1233} {manref 50.1248 50.1255} {tt 50.1321 50.1328} {tt 50.1572 50.1579} {tt 52.4 52.9} {sc 52.87 52.94} {tt 52.215 52.222} {tt 52.630 52.633} {tt 56.74 56.81} {tt 56.98 56.107} {tt 56.160 56.167} {tt 56.241 56.242} {tt 56.260 56.261} {tt 58.55 58.60} {tt 58.268 58.269} {tt 58.277 58.287} {tt 58.333 58.334} {tt 58.358 58.375} {tt 58.381 58.407} {tt 58.442 58.443} {tt 58.635 58.636} {tt 58.638 58.640} {tt 58.642 58.643} {tt 58.648 58.649} {tt 58.764 58.770} {tt 58.886 58.890} {h2 61.0 61.25} {manref 63.136 63.142} {tt 65.143 65.151} {sc 65.205 65.213} {tt 65.223 65.228} {sc 65.326 65.334} {tt 67.212 67.222} {tt 67.401 67.402} {tt 67.411 67.421} {tt 67.520 67.521} {tt 67.657 67.664} {tt 69.136 69.139} {tt 69.166 69.169} {tt 69.180 69.183} {tt 69.188 69.191} {tt 69.244 69.246} {tt 69.279 69.282} {tt 69.287 69.290} {tt 69.334 69.337} {tt 69.359 69.362} {tt 69.588 69.595} {tt 69.666 69.669} {tt 69.743 69.746} {tt 71.0 71.3} {tt 71.206 71.209} {tt 71.309 71.312} {tt 71.353 71.356} {tt 71.371 71.374} {tt 71.528 71.531} {tt 71.670 71.676} {tt 71.701 71.705} {tt 71.765 71.769} {tt 71.803 71.816} {tt 71.827 71.833} {tt 71.837 71.840} {tt 73.4 73.7} {tt 73.129 73.138} {h2 76.0 76.14} {tt 78.4 78.15} {tt 78.84 78.88} {tt 78.169 78.174} {tt 78.288 78.296} {sc 78.448 78.453} {tt 78.627 78.636} {tt 78.983 78.1001} {tt 80.8 80.12} {tt 80.177 80.183} {sc 80.472 80.480} {tt 80.491 80.497} {sc 80.862 80.869} {sc 80.928 80.935} {tt 80.945 80.953} {tt 80.1065 80.1081} {tt 80.1203 80.1227} {tt 80.1377 80.1381} {tt 80.1546 80.1572} {tt 80.1574 80.1592} {tt 82.42 82.46} {tt 82.194 82.198} {tt 82.327 82.331} {tt 82.348 82.359} {h2 85.0 85.11} {tt 87.4 87.18} {tt 87.33 87.44} {tt 87.305 87.310} {tt 87.378 87.380} {tt 87.429 87.435} {tt 87.538 87.546} {tt 89.190 89.199} {tt 89.325 89.337} {tt 89.501 89.508} {tt 89.597 89.607} {tt 93.223 93.230} {i 93.230 93.231} {tt 93.262 93.269} {i 93.269 93.270} {tt 93.618 93.625} {tt 93.736 93.746} {tt 97.40 97.45} {tt 97.93 97.98} {tt 97.114 97.146} {tt 97.181 97.186} {tt 97.320 97.333} {i 97.639 97.642} {tt 97.778 97.786} {tt 97.797 97.804} {tt 97.926 97.934} {tt 97.935 97.943} {i 97.1010 97.1011} {i 97.1024 97.1025} {tt 97.1271 97.1275} {tt 97.1341 97.1365} {h1 100.0 100.17} {tt 104.149 104.153} {tt 108.158 108.166} {tt 108.220 108.225} {tt 108.302 108.310} {tt 108.367 108.371} {tt 108.427 108.435} {tt 110.71 110.72} {b 112.143 112.159} {tt 112.173 112.184} {tt 112.235 112.249} {tt 112.296 112.310} {i 112.408 112.411} {i 112.435 112.438} {tt 113.0 113.59} {tt 115.91 115.99} {tt 115.111 115.138} {b 117.81 117.85} {b 117.115 117.123} {tt 118.0 118.20} {tt 119.0 119.25} {manref 122.35 122.40} {manref 122.79 122.86} {manref 122.174 122.181} {h2 127.0 127.20} {sc 129.32 129.37} {sc 129.182 129.187} {tt 129.355 129.366} {tt 131.0 131.7} {i 131.7 131.12} {tt 132.12 132.12} {i 132.12 132.17} {tt 134.0 134.10} {i 134.10 134.18} {tt 135.179 135.183} {tt 137.0 137.8} {tt 137.13 137.22} {tt 140.0 140.10} {i 140.10 140.14} {tt 141.10 141.10} {i 141.10 141.14} {tt 143.0 143.12} {i 143.12 143.23} {tt 143.28 143.38} {i 143.38 143.49} {tt 146.0 146.26} {tt 147.44 147.63} {tt 149.0 149.9} {i 149.9 149.17} {tt 150.10 150.10} {i 150.10 150.18} {tt 150.31 150.39} {tt 152.0 152.10} {i 152.10 152.18} {tt 153.10 153.10} {i 153.10 153.18} {tt 153.31 153.47} {tt 155.0 155.15} {tt 158.0 158.10} {tt 158.15 158.27} {tt 159.45 159.53} {tt 159.74 159.78} {tt 159.88 159.94} {tt 159.117 159.121} {tt 161.0 161.2} {tt 164.0 164.3} {i 164.3 164.12} {tt 165.4 165.8} {i 165.8 165.17} {tt 166.4 166.8} {i 166.8 166.17} {tt 167.14 167.17} {tt 167.117 167.120} {tt 167.133 167.136} {tt 169.0 169.4} {h2 173.0 173.12} {tt 175.61 175.63} {tt 175.73 175.81} {manref 175.134 175.142} {tt 175.169 175.180} {tt 175.249 175.250} {tt 175.263 175.264} {tt 175.276 175.277} {tt 175.534 175.562} {tt 175.614 175.633} {tt 175.721 175.748} {h2 178.0 178.9} {tt 180.5 180.9} {tt 180.110 180.114} {sc 182.75 182.82} {sc 182.195 182.202} {tt 182.236 182.244} {manref 184.161 184.171} {manref 184.173 184.183} {manref 184.185 184.194} {manref 184.196 184.207} {manref 184.230 184.239} {tt 184.241 184.246} {tt 184.401 184.417} {tt 184.425 184.432} {h3 189.0 189.8} {b 191.27 191.35} {tt 191.48 191.56} {tt 194.0 194.15} {tt 195.185 195.199} {tt 198.0 198.16} {i 198.16 198.45} {tt 199.4 199.20} {i 199.20 199.49} {tt 200.4 200.20} {i 200.20 200.49} {i 200.57 200.68} {tt 201.4 201.20} {i 201.20 201.49} {i 201.56 201.67} {tt 205.0 205.12} {i 205.12 205.21} {i 205.22 205.29} {i 205.30 205.47} {tt 206.0 206.12} {i 206.12 206.21} {i 206.22 206.29} {i 206.30 206.47} {tt 207.0 207.14} {i 207.14 207.23} {i 207.24 207.41} {tt 208.0 208.11} {i 208.11 208.18} {i 208.19 208.27} {i 210.4 210.21} {sc 210.110 210.117} {tt 210.171 210.184} {tt 210.192 210.200} {sc 210.223 210.230} {tt 210.235 210.239} {i 210.266 210.275} {i 210.280 210.287} {tt 210.343 210.344} {tt 210.348 210.350} {tt 210.353 210.354} {tt 212.24 212.34} {tt 214.293 214.305} {tt 214.309 214.324} {tt 214.478 214.482} {tt 214.636 214.650} {tt 216.40 216.51} {h3 219.0 219.8} {tt 221.162 221.170} {tt 222.0 222.46} {tt 223.0 223.21} {tt 226.0 226.54} {tt 227.0 227.21} {tt 230.0 230.46} {tt 231.0 231.51} {tt 234.0 234.60} {tt 235.0 235.24} {tt 236.0 236.22} {tt 239.0 239.41} {tt 240.0 240.45} {tt 241.0 241.21} {tt 242.0 242.18} {tt 245.0 245.25} {tt 248.0 248.25} {h3 251.0 251.26} {tt 253.48 253.52} {tt 253.244 253.248} {tt 253.696 253.704} {tt 255.77 255.85} {tt 255.181 255.188} {tt 255.305 255.334} {h1 258.0 258.9} {tt 267.0 267.22} {h1 270.0 270.16} {i 272.49 272.63} {tt 274.150 274.186} {h1 277.0 277.10} {sc 283.0 283.289} {sc 285.0 285.359} } { eval $t tag add $qq } $t mark set introduction1 21.0 $t mark set using1 40.0 $t mark set locating2 42.0 $t mark set working2 61.0 $t mark set other2 76.0 $t mark set preferences2 85.0 $t mark set customizing1 100.0 $t mark set command2 127.0 $t mark set key2 173.0 $t mark set tkmandesc2 178.0 $t mark set addresses1 258.0 $t mark set more1 270.0 $t mark set disclaimer1 277.0 } image create bitmap -data { #define tkman_width 64 #define tkman_height 64 static char tkman_bits[] = { 0x33, 0x33, 0x23, 0x00, 0x0e, 0xc6, 0xfc, 0xff, 0x33, 0xb3, 0xe1, 0x00, 0x06, 0x83, 0xfc, 0xff, 0xcc, 0xfc, 0xc0, 0x01, 0x80, 0x81, 0x77, 0x77, 0xcc, 0xff, 0x00, 0x03, 0xc0, 0x80, 0xff, 0xff, 0xff, 0xdf, 0x00, 0x0e, 0x60, 0xc0, 0xff, 0xff, 0xff, 0xc1, 0x00, 0x18, 0x38, 0xc0, 0xfc, 0xff, 0x0f, 0xc0, 0x01, 0xf0, 0x0f, 0xc0, 0x76, 0x77, 0x00, 0x80, 0x01, 0xe0, 0x07, 0x60, 0xfe, 0xdf, 0x00, 0x98, 0x03, 0xc0, 0x03, 0x70, 0xfc, 0x0f, 0x00, 0x88, 0x03, 0xe0, 0x07, 0x30, 0xff, 0x07, 0x00, 0x04, 0x07, 0x70, 0x0f, 0x18, 0x77, 0x03, 0x00, 0x04, 0x0f, 0xf8, 0x1f, 0xcc, 0xff, 0x03, 0x00, 0x02, 0x0e, 0xfc, 0x3f, 0xe4, 0xff, 0x01, 0x00, 0x0a, 0x1c, 0xf6, 0xff, 0xff, 0xff, 0x01, 0x00, 0x07, 0x38, 0x73, 0x77, 0x77, 0xf7, 0x00, 0x00, 0x83, 0xf0, 0xe9, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x43, 0xe0, 0x00, 0xff, 0xff, 0x1f, 0x00, 0x80, 0x31, 0x30, 0x22, 0xfe, 0xff, 0x1f, 0x00, 0x00, 0x78, 0x18, 0x00, 0x74, 0x77, 0x07, 0x00, 0x00, 0x1c, 0x8c, 0x88, 0xf8, 0xff, 0x03, 0x00, 0x00, 0x06, 0x06, 0x00, 0xc0, 0xdd, 0x07, 0x00, 0x00, 0x00, 0x23, 0x22, 0x22, 0x22, 0x0f, 0x00, 0x00, 0x80, 0x99, 0x99, 0x99, 0x99, 0x1d, 0x3c, 0x78, 0xc0, 0x99, 0x99, 0x99, 0x99, 0xf9, 0xff, 0xff, 0x63, 0x66, 0x66, 0x66, 0x66, 0xf6, 0x83, 0x87, 0x7f, 0x66, 0x66, 0x66, 0x66, 0xe6, 0x00, 0x01, 0x9c, 0x99, 0x99, 0x99, 0x99, 0xd9, 0x3f, 0xe0, 0x9f, 0x99, 0x99, 0x99, 0x99, 0xf9, 0x1f, 0xc0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x8f, 0x07, 0x00, 0x00, 0x80, 0xff, 0xff, 0xf7, 0x87, 0x07, 0x00, 0x00, 0x80, 0xff, 0xff, 0xf7, 0xa7, 0x0f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xf7, 0x87, 0xff, 0x03, 0x00, 0xfc, 0xff, 0xff, 0xff, 0x8b, 0xff, 0x01, 0x00, 0xc0, 0x9f, 0xcf, 0xe7, 0x83, 0x0f, 0x00, 0x00, 0x80, 0xbf, 0xef, 0xe7, 0xe3, 0x0f, 0x00, 0x00, 0xc0, 0x80, 0x0f, 0xe0, 0xe3, 0x0f, 0x00, 0x00, 0xfe, 0x88, 0x8f, 0xe8, 0xfb, 0xf3, 0x07, 0x00, 0x7c, 0x80, 0x0f, 0xe0, 0xfb, 0xe1, 0x03, 0x00, 0x60, 0xa2, 0x2f, 0xe2, 0xff, 0x20, 0x00, 0x00, 0x20, 0x80, 0x0f, 0xe0, 0xff, 0x28, 0x00, 0x00, 0x9f, 0x88, 0x8f, 0xe8, 0xff, 0xe0, 0x07, 0x00, 0x1e, 0x80, 0x0f, 0xe0, 0xff, 0xc1, 0x03, 0x00, 0x38, 0xa2, 0x2f, 0xe2, 0xfb, 0xc3, 0x00, 0x01, 0x78, 0x80, 0x0f, 0xe0, 0xf3, 0xc7, 0x01, 0xff, 0x9f, 0x88, 0x8f, 0xe8, 0xeb, 0x8f, 0xff, 0xff, 0x9f, 0x81, 0x0f, 0xe0, 0xc3, 0x9f, 0xff, 0x00, 0x63, 0xa2, 0x2f, 0xe2, 0xa3, 0x7f, 0x7e, 0x00, 0x67, 0x86, 0x0f, 0xe0, 0x03, 0x7f, 0x3e, 0x00, 0x9e, 0xc9, 0x9f, 0xf8, 0x8f, 0x9f, 0x1d, 0x10, 0x9c, 0xd9, 0x1f, 0xf0, 0x87, 0x9f, 0x0f, 0x30, 0x78, 0xe6, 0x3f, 0xf2, 0xa7, 0x67, 0x06, 0x30, 0x30, 0xe6, 0x1f, 0xf0, 0x87, 0x67, 0x03, 0x70, 0x60, 0x99, 0x80, 0x08, 0x08, 0xd9, 0x11, 0xf0, 0xc0, 0x98, 0x01, 0x00, 0x80, 0xd9, 0x00, 0xd0, 0x80, 0x65, 0x22, 0x22, 0x42, 0x66, 0x08, 0xd0, 0x01, 0x63, 0x06, 0x00, 0x60, 0x36, 0x04, 0x80, 0x03, 0x97, 0x89, 0x88, 0x90, 0x19, 0x06, 0x80, 0x03, 0x8e, 0x19, 0x00, 0x98, 0x0d, 0x07, 0x00, 0x04, 0x5c, 0x26, 0x22, 0x66, 0x06, 0x03, 0x00, 0x00, 0x18, 0x66, 0x00, 0x66, 0x83, 0x02, 0x00, 0x00, 0x30, 0x99, 0x08, 0x99, 0x21, 0x01, 0x00, 0x00, 0x60, 0x98, 0x81, 0xd9, 0x00, 0x01, 0x00, 0x00, 0xc0, 0x64, 0x62, 0x66, 0x00, 0x00}; } set sbx(boilerplate) { Searchbox Copyright (c) 1993-1994 T.A. Phelps Permission to use, copy, modify, and distribute this software and its documentation for educational, research and non-profit purposes, without fee, and without a written agreement is hereby granted, provided that the above copyright notice and the following three paragraphs appear in all copies. Permission to incorporate this software into commercial products may be obtained from the Office of Technology Licensing, 2150 Shattuck Avenue, Suite 510, Berkeley, CA 94704. IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. } set sb(key,*) "add modifiers in this order: M, C, A" set sb(key,C-x) exchangepointandmark set sb(key,C-space) setmark set sb(key,-Delete) pageup set sb(key,C-h) pageup set sb(key,M-v) pageup set sb(key,-BackSpace) pageup set sb(key,-space) pagedown set sb(key,C-v) pagedown set sb(key,-Escape) searchkill set sb(key,C-g) searchkill set sb(key,C-n) nextline set sb(key,C-p) prevline set sb(key,-Up) prevline set sb(key,-Down) nextline set sb(key,-Left) prevline set sb(key,-Right) nextline set sb(key,C-s) incrsearch set sb(key,C-r) revincrsearch set sb(key,M-question) help set sb(key,-Help) help set sb(key,C-l) clearscreen set sb(key,C-f) pagedown set sb(key,C-b) pageup set sb(key,-F27) pagestart set sb(key,-F29) pageup set sb(key,-F35) pagedown set sb(key,-R13) pageend set sb(key,M-less) pagestart set sb(key,M-greater) pageend foreach e [array names sb] { set sbdef($e) $sb($e) } if {[info tclversion]<7.4 || $tk_version<4.0} { puts stderr "Tcl 7.4/Tk 4.0 minimum versions required" puts stderr "You have Tcl [info tclversion]/Tk $tk_version" exit 1 } proc searchboxSearch {pat regexp casesen tag t {wmsg ""} {wcnt ""}} { global sbx if {$casesen==-1} {set casesen [expr {[string tolower $pat]!=$pat}]} set caseopt [expr !$casesen?"-nocase":""] if {$regexp} {set type "regexp"} {set type "exact"} if {$pat==""} { winstderr $wmsg "Nothing to search for! Type in a [expr $regexp?{regular expression}:{string}]." return 0 } if {$type=="regexp"&&[catch {regexp $pat bozomaniac}]} { winstderr $wmsg "Malformed regular expression." return 0 } $t tag remove $tag 0.0 end set cnt 0 set index 1.0 set len 0 while {[set index [eval "$t search -forwards -$type $caseopt -count len -- {$pat} {$index+$len chars} end"]]!=""} { $t tag add $tag $index "$index + $len chars" incr cnt } if {$cnt==0} {set txt "no matches"} elseif {$cnt==1} {set txt "$cnt match"} {set txt "$cnt matches"} winstdout $wcnt $txt searchboxNext $tag $t $wmsg 0 return $cnt } proc searchboxNext {tag t {wmsg ""} {next ""}} { if {[$t tag ranges $tag]==""} { winstderr $wmsg "No matches!" return } if {$next!=""} {set moveto $next} {set moveto [lsecond [$t yview]]} if {$moveto=="1"} {set moveto 0} $t yview moveto $moveto set tmp [$t tag nextrange $tag [$t index @0,0]] if {$tmp==""} {set tmp [$t tag nextrange $tag 1.0]} $t see [lindex $tmp 0] } proc searchboxKeyNav {m k casesen w {wmsg ""} {firstmode 0}} { global sb sbx if {[regexp {(Shift|Control|Meta|Alt)_.} $k]} {return 0} if {![info exists sbx(try$w)]} { set sbx(try$w) 0 set sbx(vect$w) 1 set sbx(lastkeys$w) "" if ![info exists sbx(lastkeys-old$w)] {set sbx(lastkeys-old$w) ""} } if {!$firstmode && ($sbx(try$w) || $sbx(lastkeys$w)!="")} { switch -exact -- $k { space {set k " "} BackSpace - Delete { set k "" set last [expr [string length $sbx(lastkeys$w)]-2] set sbx(lastkeys$w) [string range $sbx(lastkeys$w) 0 $last] set sbx(try$w) 1 } default { if {$m==""||$m=="S"} {set k [name2char $k]} } } } set m [string trimright $m "S"]; # strip shift as a modifier set mk $m-$k if {$m=="literal"} {set op $k} \ elseif {[info exists sb(key,$mk)]} {set op $sb(key,$mk)} \ elseif {$m=="" && [string length $k]<=1} {set op default} \ else {return 0} switch -exact -- $op { exchangepointandmark { set tmp [$w index @0,0] $w yview xmark update $w mark set xmark $tmp } setmark {$w mark set xmark [$w index @0,0]} pageup {$w yview scroll -1 pages} pagedown {$w yview scroll 1 pages} pagestart {$w yview moveto 0} pageend {$w yview moveto 1} searchkill { if {$sbx(lastkeys$w)!=""} {set sbx(lastkeys-old$w) $sbx(lastkeys$w)} set sbx(lastkeys$w) ""; set sbx(try$w) 0 winstdout $wmsg "" } clearscreen {winstdout $wmsg ""} nextline {$w yview scroll 1 units} prevline {$w yview scroll -1 units} default { if {$op=="incrsearch"} { if {$sbx(try$w)&&$sbx(lastkeys$w)==""} {set sbx(lastkeys$w) $sbx(lastkeys-old$w)} if {$sbx(lastkeys$w)==""} {$w tag remove isearch 1.0 end} set sbx(vect$w) 1; set sbx(try$w) 1 } elseif {$op=="revincrsearch"} { if {$sbx(try$w)&&$sbx(lastkeys$w)==""} {set sbx(lastkeys$w) $sbx(lastkeys-old$w)} if {$sbx(lastkeys$w)==""} {$w tag remove isearch 1.0 end} set sbx(vect$w) -1; set sbx(try$w) 1 } elseif {$firstmode} { $w tag remove isearch 1.0 end set sbx(lastkeys$w) $k set sbx(try$w) 1 } elseif {$sbx(try$w)} { append sbx(lastkeys$w) $k } set keys $sbx(lastkeys$w) if {$casesen==-1} {set casesen [expr {[string tolower $keys]!=$keys}]} set caseopt [expr !$casesen?"-nocase":""] if {$sbx(try$w)==0 && $keys==""} {return 0} winstdout $wmsg "Searching for \"$keys\" ..." if {$firstmode} { set start 1.0 } elseif {[set ranges [$w tag ranges isearch]]!=""} { set start [lindex $ranges 0] if {$op=="incrsearch"} {set start [$w index "$start+1c"]} $w tag remove isearch 1.0 end } else { set start [$w index @0,0] } set dir [expr {$sbx(vect$w)==1?"-forwards":"-backwards"}] set type [expr $firstmode?"-regexp":"-exact"] set pfx [expr $firstmode?"^":""] set found [eval "$w search $dir $type $caseopt -count klen -- \$pfx\$keys $start"] if {$found!=""} { $w tag add isearch $found "$found + $klen c" $w see $found } else { winstdout $wmsg "\"$keys\" not found" set sbx(try$w) 0 } } } return 1 } proc searchboxSaveConfig {fid} { global sb sbx sbdef puts $fid "#\n# SearchBox\n#\n" foreach i [lsort [array names sb]] { set co "" if {[info exists sbdef($i)] && $sbdef($i)==$sb($i)} {set co "#"} puts $fid "${co}set sb($i) [list $sb($i)]" } puts $fid "\n" } if {[info procs winstdout]==""} { proc winstderr {w msg} { if {![winfo exists $w]} return set fg [lindex [$w configure -foreground] 4] set bg [lindex [$w configure -background] 4] winstdout $w $msg $w configure -foreground $bg -background $fg update idletasks; after 500 $w configure -foreground $fg -background $bg } proc winstdout {w msg} { global winout if {![winfo exists $w]} return $w configure -text $msg set winout(lastMessage$w) $msg } } proc pipeexp {p} { set p [string trim $p] set expp "" foreach i $p { if {[regexp {^[.~/$]} $i]} {lappend expp [fileexp $i]} \ else {lappend expp $i} } return $expp } proc fileexp {f} { global env set f [string trim $f] set l [string length $f] set expf "" set dir [pwd] foreach i [split $f "/"] { switch -glob $i { "" {set dir ""} ~ {set dir $env(HOME)} $* {set val $env([string trim [string range $i 1 end] ()]) if {[string match /* $val]} {set dir $val} {append expf /$val)}} . {set dir $dir} .. {set dir [file dirname $dir]} default {append expf /$i} } } return $dir$expf } proc filecomplete {f} { set expf [fileexp [file dirname $f]]/[file tail $f] set tail [file tail $f] set posn [string last $tail $f] if [string match */ $f] {append expf /; set tail /; set posn [string length $f]} set l [glob -nocomplain $expf*] set ll [llength $l] if {!$ll} { set tail "" } elseif {$ll==1} { set tail [file tail $l] if {[file isdirectory $l]} {append tail /} } else { set lf [lfirst $l]; set lfl [string length $lf] set last $lfl set ni [expr [string last / $lf]+1] foreach i $l { set il [string length $i] for {set j $ni} {$j<=$last} {incr j} { if {[string range $lf $j $j]!=[string range $i $j $j]} break } set last [min $last [expr $j-1]] } set tail [file tail [string range [lfirst $l] 0 $last]] } if {$posn>0 && $ll} { set tail [string range $f 0 [expr $posn-1]]$tail } if {$ll<2} {return $tail} {return "$tail $l"} } proc isalpha {c} {return [regexp -nocase {[a-z]} $c]} proc isnum {c} {return [expr [string first $c "123456790"]!=-1]} proc isalphanum {c} {return [expr [isalpha $c]||[isnum $c]]} proc stringicap {s} {return [string toupper [string range $s 0 0]][string range $s 1 end]} proc tr {s c1 c2} { regsub -all \\$c1 $s $c2 s2 return $s2 } proc bolg {f {l ""}} { if {$l==""} {global file; set l $file(globList)} foreach i $l { if [regsub ([glob -nocomplain $i])(.*) $f "$i\\2" short] {return $short} } return $f } proc setinsert {l i e} { return [linsert [lfilter $e $l] $i $e] } proc unsplit {l c} { foreach i $l { append l2 $i $c } return [string range $l2 0 [expr [string length $l2]-2]] } proc bytes2prefix {x} { set pfx {bytes KB MB GB TB QB} set bp 20 set k 1024.0 set sz $k set y BIG for {set i 0} {$i<[llength $pfx]} {incr i} { if {$x<$sz} { set y [format " %0.0f [lindex $pfx $i]" [expr $x/($sz/$k)]] break } elseif {$x<[expr $sz*$bp]} { set y [format " %0.1f [lindex $pfx [expr $i+1]]" [expr ($x+0.0)/$sz]] break } set sz [expr $sz*$k] } return $y } proc quote {x} {return $x} proc uniqlist {l} { set l1 [lsort $l] set e "" set l2 "" foreach i $l1 { if {$e!=$i} { set e $i lappend l2 $e } } return $l2 } proc uniqilist {l} { set l1 [lsort -integer $l] set e "" set l2 "" foreach i $l1 { if {$e!=$i} { set e $i lappend l2 $e } } return $l2 } proc min {args} { if {[llength $args]==1} {set args [lindex $args 0]} set x [lindex $args 0] foreach i $args { if {$i<$x} {set x $i} } return $x } proc avg {args} { set sum 0.0 if {$args==""} return foreach i $args {set sum [expr $sum+$i]} return [expr ($sum+0.0)/[llength $args]] } proc max {args} { if {[llength $args]==1} {set args [lindex $args 0]} set x [lindex $args 0] foreach i $args { if {$i>$x} {set x $i} } return $x } proc lfirst {l} {return [lindex $l 0]} proc lsecond {l} {return [lindex $l 1]} proc lthird {l} {return [lindex $l 2]} proc lfourth {l} {return [lindex $l 3]} proc lfifth {l} {return [lindex $l 4]} proc lsixth {l} {return [lindex $l 5]} proc lseventh {l} {return [lindex $l 6]} proc lrest {l} {return [lrange $l 1 end]} proc llast {l} { set end [llength $l] if {!$end} {return ""} return [lindex $l [expr $end-1]] } proc setappend {l e} { return "[lfilter $e $l] $e" } proc lfilter {p l} { set l2 "" foreach i $l { if ![string match $p $i] "lappend l2 [list $i]" } return $l2 } proc lmatches {p l} { set l2 "" foreach i $l { if [string match $p $i] {lappend l2 [list $i]} } return $l2 } proc lassoc {l k} { foreach i $l { if {[lindex $i 0]==$k} {return [lindex $i 1]} } } proc lbssoc {l k} { foreach i $l { if {[lindex $i 1]==$k} {return [lindex $i 0]} } } proc lreverse {l} { set l2 "" for {set i [expr [llength $l]-1]} {$i>=0} {incr i -1} { lappend l2 [lindex $l $i] } return $l2 } proc geom2posn {g} { if [regexp {(=?[0-9]+x[0-9]+)([-+]+[0-9]+[-+]+[0-9]+)} $g both d p] { return $p } else { return $g } } proc geom2size {g} { if [regexp {(=?[0-9]+x[0-9]+)([-+]+[0-9]+[-+]+[0-9]+)} $g both d p] { return $d } else { return $g } } set name2charList { minus plus percent ampersand asciitilde at less greater equal numbersign dollar asciicircum asterisk quoteleft quoteright parenleft parenright bracketleft bracketright braceleft braceright semicolon colon question slash bar period underscore backslash exclam comma } proc name2char {c} { global name2charList if {[set x [lsearch $name2charList $c]]!=-1} { return [string index "-+%&~@<>=#$^*`'()\[\]{};:?/|._\\!," $x] } else {return $c} } proc key_state2mnemon {n} { set mod "" if {$n>=16} {append mod A; set n [expr $n-16]} if {$n>=8} {append mod M; set n [expr $n-8]} if {$n>=4} {append mod C; set n [expr $n-4]} if {$n>=2} {append mod A; set n [expr $n-2]} if {$n} {append mod S} return $mod } proc lmatch {mode list {pattern ""}} { if {$pattern==""} {set pattern $list; set list $mode; set mode "-glob"} return [expr [lsearch $mode $list $pattern]!=-1] } proc stringremove {s {c " "}} { regsub -all -- \\$c $s "" s2 return $s2 } proc stringregexpesc {s} { stringesc $s {\||\*|\+|\?|\.|\^|\$|\\|\[|\]} } proc stringesc {s {c {\\|\$|\[|\{|\}|\]|\"}}} { regsub -all -- $c $s {\\&} s2 return $s2 } proc tk_listboxNoSelect args { foreach w $args { bind $w {format x} bind $w {format x} bind $w {format x} bind $w {format x} } } proc listboxshowS {lb s {first 0} {cnstr yes}} { set sz [$lb size] for {set i $first} {$i<$sz} {incr i} { if [string match $s [$lb get $i]] { listboxshowI $lb $i $cnstr return $i } } return -1 } proc listboxshowI {lb high {cnstr yes}} { set high [max 0 [min $high [expr [$lb size]-1]]] set hb [lindex [split [lindex [$lb configure -geometry] 4] x] 1] set hx [max 0 [expr [$lb size]-$hb]] if {$cnstr=="yes"} {set hl [expr $high<$hb?0:[min $high $hx]]} {set hl $high} $lb select from $high $lb yview $hl } proc listboxreplace {lb index new} { $lb delete $index $lb insert $index $new $lb select from $index } proc listboxmove {l1 l2} { listboxcopy $l1 $l2 $l1 delete 0 end } proc listboxcopy {l1 l2} { $l2 delete 0 end listboxappend $l1 $l2 catch {$l2 select from [$l1 curselection]} } proc listboxappend {l1 l2} { set size [$l1 size] for {set i 0} {$i<$size} {incr i} { $l2 insert end [$l1 get $i] } } option add *Text.borderwidth 2 proc tabgroup {args} { if [llength $args]==1 {set wins [lindex $args 0]} {set wins $args} set l [llength $wins] for {set i 0} {$i<$l} {incr i} { set w [lindex $wins $i] set pw [lindex $wins [expr ($i-1)%$l]] set nw [lindex $wins [expr ($i+1)%$l]] bind $w "focus $nw; break" bind $w "focus $pw; break" } } proc winstderr {w msg} { if {![winfo exists $w]} return set fg [lindex [$w configure -foreground] 4] set bg [lindex [$w configure -background] 4] winstdout $w $msg $w configure -foreground $bg -background $fg bell update idletasks; after 500 $w configure -foreground $fg -background $bg } proc winstdout {w msg} { global winout if {![winfo exists $w]} return $w configure -text $msg set winout(lastMessage$w) $msg } proc yviewcontext {w l c} { if {$l=="sel"} { set cnt [scan [$w tag ranges sel] %d l] if {$cnt<=0} return } incr l -1; # 0-based! scan [$w index end] %d n set prev [expr $l-$c]; set next [expr $l+$c] if {$prev>=0} {$w yview -pickplace $prev} if {$next<=$n} {$w yview -pickplace $next} $w yview -pickplace $l } proc screencenter {xy wh} { if {$xy=="x"} { return [expr ([winfo screenwidth .]-$wh)/2] } { return [expr ([winfo screenheight .]-$wh)/2] } } proc cursorBusy {{up 1}} { if {[. cget -cursor]!="watch"} { cursorSet watch; if $up {update idletasks} } } proc cursorSet {c {w .}} { global cursor set cursor($w) [lindex [$w configure -cursor] 4] $w configure -cursor $c foreach child [winfo children $w] {cursorSet $c $child} } proc cursorUnset {{w .}} { global cursor catch {$w configure -cursor $cursor($w)} foreach child [winfo children $w] {cursorUnset $child} } proc mon2Month {m} { set mons {jan feb mar apr may jun jul aug sep oct nov dec} set Months {January February March April May June July August September October November December} set ml [string tolower $m] if {[set x [lsearch -exact $mons $ml]]!=-1} { set m [lindex $Months $x] } return $m } proc configurestate {wins flag} { foreach w $wins { $w configure -state [expr $flag?"normal":"disabled"] } } proc linebreak {string {breakat 70}} { set ch 0; set lastw "" set broke "" foreach word $string { if {[string match "*." $lastw]} {append broke " "} set wlen [string length $word] if {$ch+$wlen<$breakat} { if {$ch>0} {append broke " "; incr ch} append broke $word; incr ch $wlen } else { append broke "\n" $word set ch $wlen } set lastw $word } return $broke } wm withdraw .; update idletasks option add *Menubutton.relief raised option add *padX 2 option add *padY 2 option add *Button.padX 2 option add *Button.padY 2 option add *Menubutton.padX 2 option add *Menubutton.padY 2 option add *Radiobutton.padX 2 option add *Radiobutton.padY 2 proc TkMan {} { global man manx mani env winout if {$manx(uid)==1} { set dup 0 set w .man } else { set dup 1 set w .man$manx(uid) toplevel $w -class TkMan } bind $w "if \$man(updateicon) { wm iconname $w \$manx(name$w) }" set t $w.show; set wi $w.info set manx(man$w) "" set manx(manfull$w) "" set manx(catfull$w) "" set manx(name$w) "" set manx(num$w) "" set manx(cursect$w) 1 set manx(lastvol$w) 1 set winout(lastMessage$wi) "" set manx(hv$w) [set manx(oldmode$w) [set manx(mode$w) help]] wm minsize $w 200 200 wm iconname $w "TkMan" if {!$dup} { wm title $w $manx(title) wm geometry $w $manx(geom) wm protocol $w WM_DELETE_WINDOW {exit 0} if {$manx(iconify)} { wm iconify $w update idletasks } } else { wm title $w "$manx(title) - #$manx(uid)" wm geometry $w [lfirst [split $manx(geom) "+-"]] } label $wi -anchor w frame $w.kind button $w.man -text "man" -command "manShowMan \$manx(typein$w) {} $w" button $w.apropos -text "apropos" -command "manApropos \$manx(typein$w) $w" if {$man(glimpse)!=""} {button $w.glimpse -text "glimpse" -command "manGlimpse \$manx(typein$w) $w"} entry $w.mantypein -relief sunken -textvariable manx(typein$w) -width 25 bind Entry [bind Entry ] bind Entry {%W delete 0 end} bind $w.mantypein "$w.man invoke" bind $w.mantypein "$w.apropos invoke" if {$man(glimpse)!=""} { foreach m {"Meta" "Alt"} { bind $w.mantypein <$m-KeyPress-Return> "$w.glimpse invoke" } } menubutton [set mb $w.dups] -text "\337" -menu [set m $mb.m]; menu $m pack $w.man -in $w.kind -side left -padx 2 -anchor e pack $w.apropos -in $w.kind -side left -padx 3 if {$man(glimpse)!=""} { pack $w.glimpse -in $w.kind -side left -padx 3 } pack $w.mantypein -fill x -expand yes -in $w.kind -side left -ipadx 5 -anchor w menubutton [set mb $w.paths] -text "Paths" -menu [set m $mb.m]; menu $m if {[llength $manx(paths)]>2} { $m add command -label "All Paths On" -command { foreach i $manx(paths) {set man($i) 1} manResetEnv } $m add command -label "All Paths Off" -command { foreach i $manx(paths) {set man($i) 0} manResetEnv } $m add command -label "Save Paths Selections" -command { set manx(pathstat) "" foreach i $manx(paths) {lappend manx(pathstat) $man($i)} } $m add command -label "Restore Paths Selections" -command { set ctr 0 foreach i $manx(paths) {set man($i) [lindex $manx(pathstat) $ctr]; incr ctr} manResetEnv } $m add separator } foreach i $manx(paths) { $m add checkbutton -label $i -variable man($i) -command {manResetEnv} } manMenuFit $m menubutton [set mb $w.vols] -text "Volumes" -menu [set m $mb.m]; menu $m -tearoff no pack [frame $w.filler] -in $w.kind -side left -fill x -expand yes pack $w.vols $w.paths -in $w.kind -side left -padx 4 frame $w.nav menubutton [set mb $w.sections] -text "Sections" -menu [set m $mb.m]; menu $m -tearoff no menubutton [set mb $w.links] -text "Links" -menu [set m $mb.m]; menu $m -tearoff no frame $w.hlf menubutton [set mb $w.high] -text "Highlights" -menu [set m $mb.m]; menu $m -tearoff no button $w.hadd -text "+" -padx 4 -command " if \[llength \[$t tag nextrange sel 1.0\]\]==0 { winstderr $wi {Select a range of characters to highlight.} return } set mani(high,form) {} $t tag add highlight sel.first sel.last selection clear $t manHighlights $w " button $w.hsub -text "-" -padx 4 -command " if \[llength \[$t tag nextrange sel 1.0\]\]==0 { winstderr $wi {Select a range of highlighted characters to unhighlight.} return } $t tag remove highlight sel.first sel.last set mani(high,form) {} selection clear $t manHighlights $w " pack $w.high $w.hadd $w.hsub -in $w.hlf -side left -padx 1 frame $w.scf menubutton [set mb $w.shortcuts] -text "Shortcuts" -menu [set m $mb.m]; menu $m -tearoff no button $w.sadd -text "+" -padx 4 -command "manShortcuts $w add" button $w.ssub -text "-" -padx 4 -command "manShortcuts $w sub" pack $w.shortcuts $w.sadd $w.ssub -in $w.scf -side left -padx 1 manShortcuts $w init menubutton [set mb $w.history] -text "History" -menu [set m $mb.m] -state disabled; menu $m -tearoff no set manx(history$w) "" menubutton [set mb $w.output] -text "Output" -menu [set m $mb.m]; menu $m -tearoff no set manx(out$w) $w menubutton [set mb $w.occ] -text "Occasionals" -menu [set m $mb.m]; menu $m $m add command -label "Help" -command "manHelp $w" $m add command -label "Print" -command "manPrint $w" $m add command -label "Instantiate New View" -command manInstantiate $m add command -label "Rebuild Database" -command "manReadSects $w 1 {Rebuilding database ...}" \ -state [expr [file writable [file dirname $manx(database)]]?"normal":"disabled"] if {$man(glimpseindex)!=""} { $m add command -label "Rebuild Glimpse Database" -command "manGlimpseIndex $w" } $m add cascade -label "Incremental Search Case Sensitive" -menu [set m2 $m.m2] menu $m2 -tearoff no $m2 add radiobutton -label "yes" -variable man(incr,case) -value 1 $m2 add radiobutton -label "no" -variable man(incr,case) -value 0 $m2 add radiobutton -label "iff upper" -variable man(incr,case) -value -1 $m add cascade -label "Regexp Search Case Sensitive" -menu [set m2 $m.m3] menu $m2 -tearoff no $m2 add radiobutton -label "yes" -variable man(regexp,case) -value 1 $m2 add radiobutton -label "no" -variable man(regexp,case) -value 0 $m2 add radiobutton -label "iff upper" -variable man(regexp,case) -value -1 $m add checkbutton -label "Changebars on Left" -variable man(changeleft) -onvalue "-c" -offvalue "" $m add command -label "Preferences..." -command manPreferences $m add command -label "Checkpoint state to .tkman" \ -command "manSave; winstdout $wi {[bolg $manx(startup) ~] updated}" $m add separator $m add command -label "Quit, don't update .tkman" -command "exit 0" foreach i {sections hlf links history scf occ} {pack $w.$i -in $w.nav -side left} foreach i {hlf history occ} {pack configure $w.$i -padx 6} pack configure $w.links -expand yes -anchor e pack configure $w.scf -expand yes -anchor w frame $w.vf text $t \ -relief sunken -borderwidth 2 -padx $man(textboxmargin) -pady $man(textboxmargin) \ -yscrollcommand "$w.v set" -exportselection yes -wrap word -cursor $manx(cursor) \ -height 10 -width 5 -insertwidth 0 foreach b {Double-Button-1 Shift-Button-1} { bind Text <$b> {} } $t tag configure apropos -wrap word bind $t "if \[manKeyNav $w \[key_state2mnemon %s\] %K\] break" bind $t "manShowSection $w \$manx(lastvol$w)" bind $t "manShowMan \$manx(lastman) {} $w" scrollbar $w.v -orient vertical -command "$t yview" pack $w.v -in $w.vf -side $man(scrollbarside) -fill y pack $t -in $w.vf -side $man(scrollbarside) -fill both -expand yes bind $t " if !\$tkPriv(mouseMoved) { manHotSpot show %W @%x,%y catch {if {\[string trim \[set tmp \[manHotSpot get %W @%x,%y\]\]\]!={}} {set manx(typein$w) \$tmp}} } " bind $t { if !$tkPriv(mouseMoved) {catch { if {[string trim [set tmp [manHotSpot get %W @%x,%y]]]!=""} { set manx(shift) 1; manShowMan $tmp }} } } foreach b [list $w.man $w.apropos] { bind $b {set manx(shift) 1 } } if {$man(glimpse)!=""} {bind $w.glimpse {set manx(shift) 1} } foreach mb [list $w.vols $w.links $w.history $w.shortcuts] { bind $mb.m {set manx(shift) 1 } } bind $t " if !\$tkPriv(mouseMoved) { if {\[set tmp \[string trimright \[manHotSpot get %W @%x,%y\] {.;,!?}\]\]!={}} {manShowText <\$tmp \$w} } " frame $w.search button $w.search.s -text "Search" -command " set manx(search,cnt$w) \[searchboxSearch \$manx(search,string$w) 1 \$man(regexp,case) search $t $wi $w.search.cnt\] " button $w.search.n -text "Next" \ -command "searchboxNext search $t $wi" label $w.search.cnt entry $w.search.t -relief sunken -textvariable manx(search,string$w) set manx(search,cnt$w) 0 set manx(search,oldstring$w) "" bind $w.search.t " if {\$manx(search,oldstring$w)!=\$manx(search,string$w) || !\$manx(search,cnt$w)} { set manx(search,oldstring$w) \$manx(search,string$w) $w.search.s invoke } else {$w.search.n invoke}" pack $w.search.s -side left pack $w.search.n -side left -padx 6 pack $w.search.t -side left -fill x -expand yes -ipadx 10 -anchor w pack $w.search.cnt -side left checkbutton $w.mono -text "Mono" -variable man(currentfont) \ -command " $t configure -font \$man(currentfont) " button $w.quit -text "Quit" -command "manSave; exit 0" -padx 4 if {!$manx(quit)} {$w.quit configure -command "exit 0"} if {$dup} {$w.quit configure -text "Close" -command "destroy $w; incr manx(outcnt) -1; manOutput"} bind all "$w.quit invoke" pack $w.mono -in $w.search -side left -padx 3 -anchor e pack $w.quit -in $w.search -side left -padx 3 pack $wi $w.kind -fill x -pady 4 pack $w.nav -fill x -pady 6 pack $w.vf -fill both -expand yes pack $w.search -fill x -pady 6 foreach i {info kind nav} {bind $w.$i "focus $w.mantypein"} foreach i {vf show v} {bind $w.$i "focus $t"} bind $w.search "focus $w.search.t" tabgroup $w.mantypein $t $w.search.t foreach i {mantypein show search.t} { foreach k {KeyPress-Escape Control-KeyPress-g} { bind $w.$i <$k> {+ set STOP 1 } } } foreach k {KeyPress-Escape Control-KeyPress-g} { bind $t <$k> "+ if \[manKeyNav $w \[key_state2mnemon %s\] %K\] break" } bind $w.mantypein "+ if \[regexp {^\[<|.~/$\]} \$manx(typein$w)\] {manFilecomplete $w} " manMakeVolList $w manPreferencesSetMain $w manHelp $w return $w } proc manMakeVolList {w} { global man manx if ![winfo exists $w.vols] return set m $w.vols.m destroy $m menu $m $m add command -label "Last volume viewed" -accelerator "C-d" -state disabled \ -command "manShowSection $w \$manx(lastvol$w)" $m add separator set iapropos [lsearch -exact $manx(manList) "apropos"] set ctr 0 foreach i $manx(manList) { set menu $m; set label "($i) [lindex $manx(manTitleList) $ctr]" if $man(subvols) { set l1 [string range $i 0 0] set p [lsearch -exact $manx(manList) $l1] set c [lsearch -glob $manx(manList) "$l1?*"]; if {$c>=$iapropos} {set c -1} if {$p!=-1 && $c!=-1} { set menu $m.$p if {$ctr==$p} {set label "general"} if ![winfo exists $menu] { menu $menu -tearoff no $m add cascade -label "($i) [lindex $manx(manTitleList) $p]" -menu $menu } } } $menu add command -label $label -command "manShowSection $w $i" incr ctr } manMenuFit $m } proc manShortcuts {w cmd} { global man manx set me "$manx(name$w).$manx(cursect$w)" set modeok [lmatch {man txt} $manx(mode$w)] if {$cmd!="init" && (!$modeok || $manx(man$w)=="")} return set present [expr [lsearch -exact $man(shortcuts) $me]!=-1] if {$cmd=="add" && !$present} {lappend man(shortcuts) $me} \ elseif {$cmd=="sub" && $present} {set man(shortcuts) [lfilter $me $man(shortcuts)]} set m [set mb $w.shortcuts].m foreach w [lmatches ".man*" [winfo children .]] { $m delete 0 last set len [llength $man(shortcuts)] if {$len} { foreach i $man(shortcuts) { if {![regexp {^[<|]} $i]} { if {[regexp $man(zregexp) $i]} {set i [file rootname $i]} if {[lsearch $manx(mandot) $i]>-1} {set name $i} {set name [file rootname $i]} } else {set name $i} $m add command -label $name -command "manShowMan [list $i] {} $w" } } configurestate $mb $len manShortcutsStatus $w manMenuFit $m } } proc manShortcutsStatus {w} { global man manx set me $manx(name$w).$manx(cursect$w) set modeok [lmatch {man txt} $manx(mode$w)] set present [expr [lsearch -exact $man(shortcuts) $me]!=-1] configurestate $w.sadd [expr $modeok&&!$present] configurestate $w.ssub [expr $modeok&&$present] } proc manHotSpot {cmd t xy} { global man set manchars {[ a-z0-9_.~/$+()-]} if {$cmd=="get"} { set hot [expr {[$t tag ranges hot]!=""?[$t get hot.first hot.last]:""}] return $hot } $t tag remove hot 1.0 end scan [$t index $xy] "%d.%d" line char scan [$t index "$line.$char lineend"] "%d.%d" bozo lineend set c [$t get $line.$char] if {$c=="("} { if {$char>0 && [$t get $line.$char-1c]!=" "} {incr char -1} {incr char} } elseif {$c==")"} { if {$char>0} {incr char -1} } set lparen 0; set rparen 0 set fspace 0 for {set cn $char} {$cn<=$lineend && [regexp -nocase $manchars [set c [$t get $line.$cn]]]} {incr cn} { if {$c=="("} { if {!$lparen} {set lparen $cn} else break } elseif {$c==")"} { if {!$rparen} {set rparen $cn; incr cn} break } elseif {$c==" "} { if {!$lparen && !$fspace && $cn<$lineend && [$t get $line.$cn+1c]=="("} {set fspace 1} else break } } incr cn -1 for {set c0 $char} {$c0>=0 && [regexp -nocase $manchars [set c [$t get $line.$c0]]]} {incr c0 -1} { if {$c=="("} { if {!$lparen} {set lparen $c0} else break } elseif {$c==")"} { break } elseif {$c==" "} { if {$lparen==[expr $c0+1] && !$fspace} {set fspace 1} else break } } incr c0 if {!$lparen^!$rparen} { if {$lparen} { if {$char>$lparen} {set c0 [expr $lparen+1]} {set cn [expr $lparen-1]} set lparen 0 } else { incr cn -1 } } elseif {$lparen && [lsearch $man(manList) [$t get $line.$lparen+1c]]==-1} { if {$char>$lparen} {set c0 [expr $lparen+1]} {set cn [expr $lparen-1]} set lparen 0 } elseif {$lparen==[expr $rparen-1] && $lparen>0} { set cn [expr $lparen-1] } elseif {$lparen && $rparen && [$t get $line.$c0]=="/"} { incr c0 } while {$c0>0 && [lsearch {" "} [$t get $line.$c0]]>=0} {incr c0} while {$cn>$c0 && [lsearch {. -} [$t get $line.$cn]]>=0} {incr cn -1} $t tag add hot $line.$c0 $line.$cn+1c } proc manInstantiate {} { global manx incr manx(uid) incr manx(outcnt) set w [TkMan] manOutput return $w } proc manOutput {} { global manx set wins [lmatches ".man*" [winfo children .]] foreach i [lsort -command manWinSort $wins] { set title "#[string range $i 4 end]" if {$title=="#"} {append title 1} lappend titleList [list $title $i] } foreach w $wins { set m $w.output.m $m delete 0 last foreach i $titleList { $m add radiobutton -label [lfirst $i] \ -variable manx(out$w) -value [lsecond $i] } } manMenuFit $m foreach w $wins { if ![winfo exists $manx(out$w)] {set manx(out$w) $w} } if {$manx(outcnt)==1} { pack forget .man.output } else { foreach w $wins {pack $w.output -before $w.occ -padx 2 -side left -expand yes} } } proc manWinSort {a b} { set an [string range $a 4 end] set bn [string range $b 4 end] if {$an==""} {return -1} elseif {$bn==""} {return 1} if {$an<$bn} {return -1} elseif {$an==$bn} {return 0} else {return 1} } proc manHighView {w} { global manx set t $w.show if ![catch {set y $manx(yview,$manx(hv$w))}] { $t yview moveto $y $t mark set xmark [$t index @0,0] } manHighlights $w get } proc manHighlights {w {cmd update}} { global high man manx set m [set mb $w.high].m $m delete 0 last set t $w.show set f $manx(hv$w) if [string match <* $f] {set f [string range $f 1 end]} if ![catch {set sf [file readlink $f]}] { if [string match /* $sf] { set f $sf } else { set f [file dirname $f] set strip 1 while {$strip} { switch -glob $f { ../* {set f [file dirname $f]; set sf [string range $sf 3 end]} ./* {set sf [string range $sf 2 end]} default {set strip 0} } } append f /$sf } } set v high($f) set tags "" if {$cmd=="update"} { if {[file isfile $f]} {set tags "[file mtime $f] "} {set tags "-1 "} append tags [$t tag ranges highlight] if {$f!="" && [llength $tags]>1} {set $v $tags} {catch {unset $v}} } elseif {[info exists $v]} { if {![file isfile $f] || [file mtime $f]<=[lfirst [set $v]]} { set tags [set $v] } else { if {![tk_dialog .dialog Warning "Highlights out of date for $f. Delete them?" "" 1 "No" "Yes"]} { set $v [set tags "[file mtime $f] [lrange [set $v] 1 end]"] } } } set len [llength $tags] for {set i 1} {$i<$len} {incr i 2} { set first [lindex $tags $i] set last [lindex $tags [expr $i+1]] if {$cmd=="get"} {$t tag add highlight $first $last} set label \ [tr [string range [string trim [$t get $first $last]] 0 $man(high,hcontext)] \012 " "] $m add command -label $label \ -command "$t yview \[$t index \"$first - \$man(high,vcontext) lines\"\]" } configurestate [list $mb $w.hsub] "$len>1" manMenuFit $m } proc manFilecomplete {w} { global manx set t $w.show; set wi $w.info set line $manx(typein$w) set file [string trim [llast $line] <] set posn [string last $file $line] set ll [llength [set fc [filecomplete $file]]] if {!$ll} { winstderr $wi "no matches" return } elseif {$ll>=2} { foreach i $fc {lappend matches [file tail $i]} if {$ll<10} { winstderr $wi [lrest $matches] } else { manOpenText $w $t insert end [lrest $matches] manCloseText $w } set fc [lfirst $fc] } set manx(typein$w) [string range $line 0 [expr $posn-1]]$fc $w.mantypein icursor end $w.mantypein xview moveto 1 } proc manNewMode {w mode {n {""}}} { global man manx set t $w.show set manx(yview,$manx(hv$w)) [lfirst [$t yview]] set manx(oldmode$w) $manx(mode$w) set manx(mode$w) $mode set manx(manfull$w) "" set manx(catfull$w) "" set manx(man$w) "" set manx(name$w) "" set manx(num$w) "" set manx(search,oldstring$w) "" $w.search.cnt configure -text "" searchboxKeyNav "" Escape 0 $t "" 0 after 5 selection clear $t set manx(vect) 1 set manx(try) 0 $w.sections.m delete 0 last $w.links.m delete 0 last set high(0) disabled; set high(1) normal set h $high([lmatch {man help} $mode]); $w.sections configure -state $h set h $high([lmatch {man txt help} $mode]) foreach i {hadd} {$w.$i configure -state $h} if {![lmatch {man txt help} $mode]} { foreach i {high hsub} {$w.$i configure -state disabled} } set h $high([lmatch {man help} $mode]); $w.links configure -state $h if {![lmatch {man txt} $mode]} { foreach i {sadd ssub} {$w.$i configure -state disabled} } set h $high([lmatch man $mode]); $w.occ.m entryconfigure "Print" -state $h bind $t " if !\$tkPriv(mouseMoved) { manShowMan \[manHotSpot get %W @%x,%y\] $n $w } " } proc manOpenText {w} { global man cursorBusy set t $w.show $t configure -state normal $t delete 1.0 end foreach i [$t mark names] {if {$i!="insert"&&$i!="current"} {$t mark unset $i}} $t configure -font $man(currentfont) } proc manCloseText {w} { set t $w.show if {[$t get "end -1c"]=="\n"} {$t delete "end -1c"} $t configure -state disabled cursorUnset $t mark set xmark 1.0 } proc manResetEnv {} { global env man manx mani set manpath {} foreach i $manx(paths) {if {$man($i)} {append manpath :$i}} set env(MANPATH) [string range $manpath 1 end] foreach i $manx(manList) { if {[lsearch $manx(specialvols) $i]==-1 || $i=="all"} {set mani($i,form) ""} } } proc manSetSect {w n} { global manx mani set manx(cursect$w) * if [regexp {^/} $n] { set dir [file dirname $n] foreach vol $mani(manList) { if [lsearch -exact $mani($vol,dirs) $dir]!=-1 { set manx(cursect$w) $vol break } } } elseif {[set f [lsearch $manx(manList) $n]]!=-1} { set manx(cursect$w) $n } } proc manMenuFit {m} { global man manx if {[winfo class $m]!="Menu"} {puts stderr "$m not of Menu class"; exit 1} if {[$m index last]=="none"} return set sh [winfo screenheight $m] set ok 0 for {set i [expr [lsearch $manx(sizes) $man(gui-points)]+1]} {$i>=0} {incr i -1} { set p [lindex $manx(pts) $i] set f [spec2font $man(gui-family) $man(gui-style) $p] $m configure -font $f; update idletasks set mh [winfo reqheight $m] if {$mh<$sh} {set ok 1; break} } if {!$ok} { set ctr 0 while {[winfo reqheight $m]>=$sh} { $m delete last; incr ctr; update idletasks } $m delete last; incr ctr $m add command -label "($ctr too many to show)" -state disabled } } proc manInit {} { global man manx mani if {$manx(init)} return manReadSects manResetEnv set manx(init) 1 } proc manReadSects {{w .man} {force 0} {msg "Building database ..."}} { global man manx mani winout env set wi $w.info if {[regexp $man(zregexp) $manx(database)]} {set manx(database) [file rootname $manx(database)]} set dbdir [file dirname $manx(database)] set database [lfirst [glob -nocomplain $manx(database).$man(zglob)]] if {$database=="" || $force || $manx(rebuildandquit)} { winstdout $wi $msg cursorBusy update idletasks catch {eval exec $man(rm) -f [glob $manx(database).$man(zglob)]} set tmpfile $dbdir/.tkmantmp if [catch {set fid [open $tmpfile w]}] { puts stderr "Cannot write temporary information to $tmpfile" exit 1 } set manx(manList) ""; set manx(manTitleList) ""; set manx(mandot) "" set manx(newmen) {} foreach i $mani(manList) { winstdout .man.info "$winout(lastMessage$wi) $i"; update idletasks if {[manReadSection $i $fid]!=0} { lappend manx(manList) $i lappend manx(manTitleList) [lindex $mani(manTitleList) [lsearch -exact $mani(manList) $i]] } } close $fid if [catch {set fid [open $manx(database) w]}] { puts stderr "Cannot write database to $manx(database)" exit 1 } puts $fid "#\n# TkMan v$manx(version) database, created at [exec $man(date)]\n#" foreach i {manList manTitleList mandot} { puts $fid "# set manx($i) {$manx($i)}" } puts $fid "# set manx(db-manpath) $manx(MANPATH0)" puts $fid "# set manx(db-signature) [manDBsignature]" puts $fid "# set manx(newmen) [list $manx(newmen)]" set fid2 [open $tmpfile] puts $fid [read $fid2] close $fid2 close $fid if [catch {eval exec $man(compress) $manx(database)} info] { if ![string match "*%*" $info] { puts stderr "Problem compressing database -- $info" exit 1 } } eval exec $man(rm) -f $tmpfile set database [glob $manx(database).$man(zglob)] cursorUnset winstdout $wi "Database created in file [bolg $database ~]" } if {$manx(rebuildandquit)} {exit 0} set manx(database) $database set fid [open "|$man(zcat) $manx(database)"] while {[gets $fid line]!=-1 && [regexp {^#} $line]} { if {[regexp {^# (set .*)} $line all set]} {eval $set} } catch {close $fid} set outofdate 0 if {!$force && !$manx(now) && [file exists $database]} { set lastupdate [file mtime $database]; set maxdir ""; set maxdirtime 0 foreach i $mani(manList) { foreach j $mani($i,dirs) { foreach k [glob -nocomplain $j*] { set dirupdate [file mtime $k] if {$maxdirtime<$dirupdate} {set maxdirtime $dirupdate; set maxdir $k} if {$lastupdate<$dirupdate} { DEBUG {puts "$k: [file mtime $k] > $lastupdate"} set outofdate 1 } } } } } set rmsg "" if {$outofdate} { set rmsg "Database out of date" } elseif {!$force && $manx(now)} { } elseif {$manx(MANPATH0)!=$manx(db-manpath)} { set rmsg "MANPATH changed" DEBUG {puts "$manx(db-manpath) => $manx(MANPATH0)"} } elseif {[manDBsignature]!=$manx(db-signature)} { set rmsg "New tkmandesc configuration" DEBUG {puts "$manx(db-signature) =>\n[manDBsignature]"} } if {[string length $rmsg]} { if [file writable $dbdir] { manReadSects $w 1 "$rmsg, rebuilding ..." set newupdate [file mtime $manx(database)] if {$newupdate<$maxdirtime} { set errmsg " Problem with file and directory times...\a\a The newly created database ($manx(database)) has its time set earlier than the $maxdir directory and perhaps others. Unless corrected, the database will be rebuilt every time TkMan is started. Perhaps you need to reset your system clock. " puts stderr [linebreak $errmsg 70] } return } else { after 2 "winstderr $wi \"$rmsg ... but database directory not writable\"" } } foreach i $manx(manList) {set mani($i,form) ""} foreach i $manx(extravols) { set letter [lfirst $i]; set title [lsecond $i]; set msg [lthird $i] lappend manx(manList) $letter; lappend manx(manTitleList) $title set mani($letter,form) $msg; set mani($letter,cnt) 0 } foreach i [lmatches ".man*" [winfo children .]] {manMakeVolList $w} } proc manReadSection {n fid} { global man manx mani env if ![info exists mani($n,dirs)] {return 0} set title [lindex $mani(manTitleList) [lsearch $mani(manList) $n]] DEBUG { puts -nonewline stderr $n } set first 1 set cnt 0 if {![catch {set lines [eval exec $man(find) $mani($n,dirs) -type f -mtime -$man(recentdays) -print]}] && $lines!=""} { DEBUG {puts -nonewline "F"} set short {} foreach k [lsort $lines] { set f [file tail $k] if [regexp $man(zregexp) $f] {set f [file rootname $f]} if {![string match "*~" $f]} {lappend short $f} } if {$short!=""} {lappend manx(newmen) [list $n $short]} } foreach i $mani($n,dirs) { foreach k [glob -nocomplain $i/*] { if {$first} {puts $fid "$n [list $title]"; set first 0} set f [file tail $k]; set sgi [string match "*/cat*/*.z" $k] if [regexp $man(zregexp) $f] {set f [file rootname $f]} if {![string match "*~" $f]} { if {[string match "*.*" $f] || $sgi} { puts $fid $k incr cnt if {[regexp {\..*\.} $f] || ($sgi && [regexp {\.} $f])} { lappend manx(mandot) [file rootname $f] } } } } } return $cnt } proc manFormatSect {n} { global man manx mani high set form "" if {$n=="high"} { set mani(high,form) "" set ltmp [lsort -command manSortByName [array names high]] foreach k $ltmp { if {[llength $k]>1 || $k=="*"} continue append mani(high,form) $k\n } set mani(high,cnt) [llength $mani(high,form)] if {$mani(high,cnt)==0} {set mani(high,form) "No manual pages have been annotated.\n"} return } elseif {$n=="recent"} { set first 1; set form ""; set cnt 0 foreach i $manx(newmen) { set vol [lfirst $i]; set names [lsecond $i] if {$first} {set first 0} {append form "\n\n\n"} if {[set index [lsearch $mani(manList) $vol]]!=-1} { set voltxt "volume $vol, \"[lindex $mani(manTitleList) $index]\"" } else { set voltxt $vol } append form "In $voltxt ...\n\n" foreach i $names {append form $i "\t"; incr cnt} } set mani(recent,cnt) $cnt if {$mani(recent,cnt)==0} { set form "There are no manual pages less than $man(recentdays) day" if {$man(recentdays)>1} {append form "s"} append form " old.\n" } set mani(recent,form) $form return } if {$n=="all"} {set sect ""} {set sect "-e {/^$n /,/ /!d}"} set sed "$man(sed) $sect -e {/ /d}" foreach i $manx(paths) { if {[info exists man($i)] && !$man($i)} { append sed " -e {\\?^$i?d}" } } append sed " -e {s/.*\\///g}" DEBUG {puts "sed = $sed"} set ltmp [eval exec "$man(zcat) $manx(database) | $sed | $man(sort)"] if {$man(volcol)=="0"} {set sep " "} {set sep "\t"} set cnt 0 set pr ""; set pe ""; set pl "" set online 0; set skip 0 foreach i $ltmp { if [regexp $man(zregexp) $i] {set i [file rootname $i]} set ir [file rootname $i]; set ie [file extension $i]; set il [string tolower [string range $i 0 0]] if {$pl!=$il && $online>0} { append form "\n\n" set online 0 } if {$pr!=$ir} { if {$online!=0} {append form $sep} append form $ir; incr online set skip 0 } elseif {$pe==$ie} { } else { if {$online!=0} { if {!$skip} {append form $pe} append form $sep } append form $i; incr online set skip 1 } set pr $ir; set pe $ie; set pl $il incr cnt } if {$cnt==0} {set form "No man pages in currently enabled paths.\nTry turning on some under the Paths pulldown menu."} set mani($n,form) $form set mani($n,cnt) $cnt } proc manDBsignature {} { global mani set sig "X" foreach i $mani(manList) { if [info exists mani($i,dirs)] {append sig $i[llength $mani($i,dirs)]} } return $sig } proc manDescDefaults {} { global man manx mani env manDescManiCheck return if [info exists env(LANG)] {set langs [split $env(LANG) ":"]} {set langs ""} foreach i $mani(manList) { set mani($i,dirs) {} } foreach i $manx(paths) { set mani($i,dirs) {} } set mani($man(glimpsestrays),dirs) {} set curdir [pwd] foreach i $manx(paths) { cd $i set alldirs [glob -nocomplain $manx(subdirs)] foreach l $langs { set alldirs [concat $alldirs [glob -nocomplain $l/$manx(subdirs)]] } DEBUG {puts " sorted alldirs = [lsort -command bytypenum $alldirs]"} foreach d [lsort -command bytypenum $alldirs] { if {[string match "*/*" $d]} { set lang "[file dirname $d]/"; set dir [file tail $d] } else {set lang ""; set dir $d } set dirsig [string range $dir $manx(dirnameindex) end] if {[string match "cat*" $dir]} {set dirsig [file rootname $dirsig]} set num [file rootname $dirsig]; set num1 [string index $num 0] if {[lsearch -exact $mani(manList) $num]!=-1} {set n $num} {set n $num1} set pat "^[stringregexpesc $i]/${lang}(man|cat)[stringregexpesc $dirsig]\$" set dir $i/$d if {[lsearch -regexp $mani($i,dirs) $pat]==-1 && [file isdirectory $dir] && [file readable $dir]} { lappend mani($i,dirs) $dir lappend mani($n,dirs) $dir } } DEBUG {puts "mani($i,dirs) = $mani($i,dirs)"} } DEBUG {foreach i $mani(manList) { puts "mani($i,dirs) = $mani($i,dirs)" }} cd $curdir set manx(defaults) 1 } proc bytypenum {a b} { if [string match "*/*" $a] { set al [file dirname $a]; set a [file tail $a] } {set al ""} if [string match "*.Z" $a] { set as [file extension $a]; set a [file rootname $a] } {set as ""} set at [string range $a 0 2] if [string match "*/*" $b] { set bl [file dirname $b]; set b [file tail $b] } {set bl ""} if [string match "*.Z" $b] { set bs [file extension $b]; set b [file rootname $b] } {set bs ""} set bt [string range $b 0 2] if {$al!=$bl} { if {$al==""} {return 1} elseif {$bl==""} {return -1} elseif {$al<$bl} {return -1} {return 1} } elseif {$at!=$bt} { if {$at=="man"} {return -1} {return 1} } elseif {$as!=$bs} { if {$as==""} {return 1} {return -1} } else { if {$a<$b} {return -1} {return 1} } return 0 } proc manDescMove {from to dirs} {manDesc move $from $to $dirs} proc manDescDelete {from dirs} {manDesc delete $from "" $dirs} proc manDescCopy {from to dirs} {manDesc copy $from $to $dirs} proc manDescAdd {to dirs} { global mani manx man set warnings "" manDescManiCheck foreach d $dirs { if {![file isdirectory $d]} { append warnings "$d -- not a directory\n" } elseif {![file readable $d]} { append warnings "$d -- not readable\n" } elseif {[glob -nocomplain $d/*]==""} { append warnings "$d -- is empty\n" } else { foreach t $to {lappend mani($t,dirs) $d} DEBUG {puts "MANPATH for $d?"} set mp $d while {[string match "/*" $mp] && $mp!="/"} { if {[lsearch -exact $manx(paths) $mp]>=0} { DEBUG {puts "\tyes, in $mp"} lappend mani($mp,dirs) $d; break } else {set mp [file dirname $mp]} } if {$mp=="/"} { lappend mani($man(glimpsestrays),dirs) $d DEBUG {puts "\tno, added to strays\n\t\tnow mani($man(glimpsestrays),dirs) = $mani($man(glimpsestrays),dirs)"} } } } if {$warnings!=""} { if ![string match *manDescAdd* $manx(warnings)] { append manx(warnings) "Problems with manDescAdd's...\n" } append manx(warnings) $warnings } } proc manDesc {cmd from to dirs} { global man manx mani manDescManiCheck if {$from=="*"} {set from $mani(manList)} if {$to=="*"} {set to $mani(manList)} foreach n [concat $from $to] { if [lsearch $mani(manList) $n]==-1 { puts stderr "$cmd: Section letter `$n' doesn't exist." exit 1 } } DEBUG {puts stdout "$cmd {$from} {$to} {$dirs}"} foreach d $dirs { foreach f $from { set newdir {} foreach fi $mani($f,dirs) { if [string match $d $fi] { if {$cmd=="copy"} {lappend newdir $fi} if {$cmd=="copy"||$cmd=="move"} { foreach t $to {if {$f!=$t} {lappend mani($t,dirs) $fi} {lappend newdir $fi}} } } else {lappend newdir $fi} } set mani($f,dirs) $newdir DEBUG {puts stdout $f:$mani($f,dirs)} } } } proc manDescAddSects {l {posn "end"} {what "n"}} { global man mani manDescManiCheck if {$posn=="before"||$posn=="after"} {set l [lreverse $l]} foreach i $l { set n [lfirst $i]; set tit [lsecond $i] if [lsearch $mani(manList) $n]!=-1 { puts stderr "Section letter `$n' already in use; request ignored." continue } if {$posn=="end"} { lappend mani(manList) $n lappend mani(manTitleList) $tit } elseif {$posn=="before"||$posn=="after"} { if [set ndx [lsearch $mani(manList) $what]]==-1 { puts stderr "Requested $posn $what, but $what doesn't exist; request ignored" continue } if {$posn=="after"} {incr ndx} set mani(manList) [linsert $mani(manList) $ndx $n] set mani(manTitleList) [linsert $mani(manTitleList) $ndx $tit] } elseif {$posn=="sort"} { lappend mani(manList) $n set mani(manList) [lsort $mani(manList)] set ndx [lsearch $mani(manList) $n] set mani(manTitleList) [linsert $mani(manTitleList) $ndx $tit] } set mani($n,dirs) {} } } proc manDescManiCheck {{action "exit"}} { global man mani manx env if {!$manx(manDot)} manDot if ![info exists mani(manList)] { set mani(manList) $man(manList) set mani(manTitleList) $man(manTitleList) manManpathSet manManpathCheck if {$action=="return"} return manDescDefaults } } proc manDescSGI {patterns} { global man manx mani set paterrs 0 foreach pat $patterns { set mapto [lindex $pat 0]; set patlist [lindex $pat 1] if [lsearch -regexp $mani(manList) ".?$mapto"]==-1 { puts stderr "no volume corresponding to $mapto mapping (patterns: $patlist)" incr paterrs } foreach p $patlist { foreach pat2 $patterns { if {$pat==$pat2} break set mapto2 [lindex $pat2 0]; set patlist2 [lindex $pat2 1] foreach p2 $patlist2 { if [string match $p2 $p] { puts stderr "pattern $p never reached -- $mapto2's $p2 precludes it" incr paterrs } } } } } lappend patterns {"" {""}} DEBUG {puts "mani(manList) => $mani(manList)"} set catmen {} foreach d [split $manx(MANPATH0) ":"] { if [string match "*/catman" $d] { lappend catmen $d } } if ![llength $catmen] { puts stderr "No seaky catman directories found in MANPATH:\n\t$manx(MANPATH0)" exit 1 } if [catch {set catmandirs [eval exec $man(find) $catmen -type d -print]} info] { puts stderr "Trouble reading $catmen -- $info" set catmandirs {} } foreach dir $catmandirs { if [regexp {(catman|_man)$} $dir] continue set tail [file tail $dir] set vol [file tail [file dirname $dir]] if ![regexp "^(man|cat)" $vol] { set vol $tail; set tail "" } set volnum [string range $vol 3 3] DEBUG {puts -nonewline "$dir ($vol:$tail ($volnum)) => "} set matched 0 foreach pat $patterns { set mapto [lindex $pat 0]; set patlist [lindex $pat 1] foreach dp $patlist { if [string match "*$dp" $dir] { DEBUG {puts -nonewline "match on $dp => "} set matched 1 if [lsearch -exact $mani(manList) "$volnum$mapto"]!=-1 { DEBUG {puts $volnum$mapto} manDescAdd "$volnum$mapto" $dir } elseif [lsearch -exact $mani(manList) $mapto]!=-1 { DEBUG {puts $mapto} manDescAdd $mapto $dir } elseif [lsearch -exact $mani(manList) $volnum]!=-1 { DEBUG {puts $volnum} manDescAdd $volnum $dir } else { DEBUG {puts "can't place"} } break } } if {$matched} break } DEBUG {if {!$matched} {puts "CAN'T MATCH\a\a"}} } } proc manDescShow {} { global man manx mani manDescManiCheck puts stdout "*** manDescShow" foreach i $mani(manList) { if [info exists mani($i,dirs)] {puts stdout $i:$mani($i,dirs)} } } proc manShowSection {w n} { global man manx mani high font if {[lsearch $manx(manList) $n]==-1} { winstderr $w.info "Volume $n not found"; return } if $manx(shift) { set manx(shift) 0; set w [manInstantiate] } set t $w.show; set wi $w.info manNewMode $w section $n set manx(lastvol$w) $n set manx(hv$w) $n set head [lindex $manx(manTitleList) [lsearch $manx(manList) $n]] if {$mani($n,form)==""} { cursorBusy winstdout $wi "Formatting $head ..."; update idletasks manFormatSect $n cursorUnset } winstdout $wi $head manSetSect $w $n manOpenText $w $t configure -font $font(vol) $t insert end $mani($n,form) $w.search.cnt configure -text "$mani($n,cnt) entries" manCloseText $w manHighView $w if {$n=="apropos"} {$t tag add apropos 1.0 end} set lastvol [$w.vols.m cget -tearoff] $w.vols.m entryconfigure $lastvol -label "($n) $head" -state normal set manx(name$w) $head } proc manSortByName {a b} { set c [string tolower [file tail $a]]; set d [string tolower [file tail $b]] if {$c<$d} {set cmp -1} elseif {$c==$d} {set cmp 0} {set cmp 1} return $cmp } proc manShowMan {fname {goodnum ""} {w .man}} { global man manx mani env if $manx(shift) { set manx(shift) 0; set w [manInstantiate] } set wi $w.info if {[string trim $fname]==""} return if {[lsearch $manx(specialvols) $goodnum]!=-1} {set goodnum ""} if {[regexp {^(\.\./|\./|[~/$])} $fname]} { manShowManFound [fileexp [lfirst $fname]] 0 $w return } if {[regexp {^[|<]} $fname]} {manShowText $fname $w; return} set oname [string trimright [string trim [lfirst $fname] { ,?!;"'}] .] if {$goodnum!=""} {set tmp "($goodnum)"} {set tmp ""} winstdout $wi "Searching for \"$oname$tmp\" ..."; update idletasks set fname [string tolower $oname]; # lc w/ () for regexp set sname [string trim $fname ()]; # lc w/o () set oname [string trim $oname ()]; # original case w/o () set name $sname; set num ""; set ext "" if {[regexp -nocase {([a-z0-9_.+-]+)([\t ]*)\(([^)]?)(.*)\)} $fname \ all name spc num ext]} { } elseif {[regexp {(.+)\.(.)([^.]*)$} $oname all namex sectx extx] && [lsearch -exact $manx(manList) $sectx]!=-1 && [lsearch -exact $manx(mandot) $oname]==-1} { set name $namex; set num $sectx; set ext $extx DEBUG {puts "num = $num"} } if {$goodnum!=""} { set num $goodnum } if {[lsearch -exact $manx(manList) "$num$ext"]!=-1} { set num "$num$ext"; set ext "" } set ext [string tolower $ext] if $man(shortnames) {set name [string range $name 0 10].*} cursorBusy DEBUG {puts stdout "$name : $num : $ext"} set foundList [manShowManSearch $name $num $ext] cursorUnset set found [llength $foundList] if {!$found} { if {$ext!=""} {manShowMan $name $num $w; return} \ elseif {$num!="" || [set rootname [file rootname $name]]!=$name} { manShowMan [file rootname $name] {} $w return } } if {!$found} { winstderr $wi "$sname not found" set r "ERROR: manual page not found" } else { set orname [file rootname $oname] set prioritylist [lsort -command {manShowManSort $orname $manx(cursect$w) $num $ext} $foundList] manShowManFound $prioritylist 0 $w set r [lfirst $prioritylist] } return $r } proc manShowManSort {orname onum num ext a b} { global manx set pa [manShowManPriority $a $num $ext $orname $onum] set pb [manShowManPriority $b $num $ext $orname $onum] if {$pa>$pb} {set r -1} elseif {$pa<$pb} {set r 1} else {set r 0} return $r } proc manShowManPriority {m num ext orname onum} { global man manx mani set d [file dirname $m]; set t [file tail $m] set r [file rootname $t]; set n [file extension $t] if {[regexp $man(zregexp) $n]} {set n [file extension $r]; set r [file rootname $r]} set e [string range $n 2 end]; set n [string range $n 1 1] set pri 0 if {$n==$num} {incr pri 16} elseif {$n==$onum} {incr pri 1} if {$r==$orname} {incr pri 8} elseif {[string tolower $r]==[string tolower $orname]} {incr pri 4} if {$n==$ext} {incr pri 2} set pri [expr $pri*128] set p -1; set l [llength $manx(paths)] while {$d!="/" && [set p [lsearch -glob $manx(paths) $d*]]==-1} { set d [file dirname $d] } if {$p==-1} {set p $l} incr pri [expr $l-$p] set pri [expr $pri*128] set l [llength $mani(manList)] set p [lsearch -exact $mani(manList) $n]; if {$p==-1} {set p $l} incr pri [expr $l-$p] return $pri } proc manShowManSearch {name num ext} { global man manx set sed "$man(sed)" if [lsearch $manx(manList) $num]==-1 { set num "" } else { append sed " -e {/^$num /,/^\[^$num\] /!d}" } append sed " -e {/^. /d}" DEBUG {puts "sed = $sed"} set foundList "" set pat "/$name\\..$ext\[^/\]*\$" DEBUG {puts stderr "searching for $pat"} DEBUG {puts stderr "set fid \[open \"|$man(zcat) $manx(database) | $sed | $man(grep) -i $pat\"\]"} set fid [open "|$man(zcat) $manx(database) | $sed | $man(grep) -i {$pat}"] while {[gets $fid f]!=-1} { set d [file dirname [file dirname $f]] if {(![info exists man($d)] || $man($d)) && [lsearch $foundList $f]==-1 } { lappend foundList $f } } catch {close $fid} return $foundList } proc manShowManFound {f {keep 0} {w .man}} { global man manx set t $manx(out$w).show; set wi $w.info set f [string trim $f] set flen [llength $f] if {$flen>1} { pack $w.dups -before $w.mantypein -side left -anchor e; $w.dups configure -state active set m $w.dups.m $m delete 0 last foreach i $f {$m add command -label $i -command "manShowManFound $i 1 $w"} manMenuFit $m set f [lfirst $f] } elseif {!$keep} {pack forget $w.dups} manNewMode $w man set manx(lastman) [set f0 $f] set manx(links) "" if {[winfo exists $manx(out$w)]} {set w $manx(out$w)} {set manx(out$w) $w} if {[set fg [lfirst [glob -nocomplain $f*]]]==""} { winstderr $wi "$f doesn't exist" return } else {set f $fg} if [file isdirectory $f] { winstderr $wi "$f is a directory" return } set tmpdir [file dirname $f] set so 0 set line1 [set line2 ""] if {[file readable $f]} { set fid [open "|[manManPipe $f]"] while {([string trim $line1]=="" || [regexp {^[.']\\"} $line1]) && ![eof $fid]} {gets $fid line1} while {[string trim $line2]=="" && ![eof $fid]} {gets $fid line2} catch {close $fid} if {[regexp {^\.so (man.+/.+)} $line1 all newman]} { DEBUG {puts stderr "*** single-line .so => $manx(manfull$w): $line1"} if [catch {set f [lfirst [glob [file dirname $tmpdir]/$newman*]]}] return set tmpdir [file dirname $f] set so 1 DEBUG {puts stderr "*** new f => $f"} } } set manx(manfull$w) $f set manx(man$w) [file tail $f] if {[regexp $man(zregexp) $manx(man$w)]} {set manx(man$w) [file rootname $manx(man$w)]} set manx(name$w) [string trimright [file rootname $manx(man$w)] "\\"] set fdir [file dirname $manx(manfull$w)] set topdir [file dirname $fdir] if {[regexp $man(zregexp) $fdir]} {set fdir [file rootname $fdir]} set manx(num$w) [string range [file tail $fdir] $manx(dirnameindex) end] if {[lsearch $man(manList) $manx(num$w)]==-1} {set manx(num$w) [string index $manx(num$w) 0]} set fsstnd "" if {[regexp $man(catsig) $fdir]} { set manx(catfull$w) $manx(manfull$w) if {$line2==" Purpose"} { manShowText $f $w 1 set manx(typein$w) [set manx(name$w) [file rootname [set manx(man$w) [file tail $f]]]] return } } else { DEBUG {puts "regexp on $topdir"} if {[regexp {^/usr/(.*)man$} $topdir all blah]} { set fsstnd "/var/catman/${blah}cat$manx(num$w)/$manx(name$w).*" DEBUG {puts "*** fsstnd = $fsstnd"} } set manx(catfull$w) $topdir/cat$manx(num$w)*/$manx(name$w).* } set manx(cat) $topdir/cat$manx(num$w) if [catch {set manfullmtime [file mtime $manx(manfull$w)]}] {set manfullmtime 0} if {[set path [lfirst [glob -nocomplain $manx(catfull$w)]]]!="" && [file readable $path] && [file mtime $path]>=$manfullmtime} { set manx(catfull$w) $path set pipe [manManPipe $path] } elseif {$fsstnd!="" && [set path [lfirst [glob -nocomplain $fsstnd]]]!="" && [file readable $path] && [file mtime $path]>=$manfullmtime} { set manx(catfull$w) $path set manx(cat) [file dirname $path] set pipe [manManPipe $path] } elseif {[file exists $manx(manfull$w)]} { if {[string match */man?* $tmpdir]} { set topdir [file dirname $tmpdir] } else {set topdir $tmpdir} if [catch {cd $topdir}] { winstderr $wi "Can't cd into $topdir. This is bad." return } if {[string match "*compress" $man(nroffsave)] && [file writable $manx(cat).Z]} { append manx(cat) ".Z" } if {[string match "on*" $man(nroffsave)]} { if {![file writable $manx(cat)] && [file writable "/var/catman"] && $fsstnd!=""} { set manx(cat) [file dirname $fsstnd] } set idir "" foreach dir [split [string range $manx(cat) 1 end] "/"] { if {![file exists $idir/$dir]} { DEBUG {puts "\tmaking $idir/$dir"} if [catch "exec $man(mkdir) $idir/$dir" info] { DEBUG {puts "\t ERROR: $info"} winstderr $wi $info; update idletasks break } } append idir "/$dir" } if {[file writable $manx(cat)]} { set path [set manx(catfull$w) $manx(cat)/$manx(man$w)] winstdout $wi "Saving copy formatted by nroff ..."; update idletasks if [catch {eval "exec [manManPipe $manx(manfull$w)] | $man(format) > $path"} info] { winstderr $wi "CAN'T SAVE: $info"; return } else { if {[string match "*compress" $man(nroffsave)]} { winstdout $wi "Compressing ..."; update idletasks if [catch "exec $man(compress) $manx(catfull$w)" info] { winstderr $wi "CAN'T COMPRESS: $info" } elseif {[file extension $manx(cat)]==".Z"} { # H-P eval exec $man(mv) [glob $manx(catfull$w).$man(zglob)] $manx(catfull$w) set path $manx(catfull$w) } else { set path [set manx(catfull$w) [lfirst [glob $manx(catfull$w).$man(zglob)]]] } } set pipe [manManPipe $path] } } else { set path $manx(manfull$w) set manx(catfull$w) "" set pipe "[manManPipe $path] | $man(format)" } } else { set path $manx(manfull$w) set manx(catfull$w) "" set pipe "[manManPipe $path] | $man(format)" } } elseif [catch {[file readlink $manx(manfull$w)]}] { winstderr $wi "$manx(manfull$w) is a symbolic link that points nowhere" return } else { winstderr $wi "$manx(manfull$w) not found" return } set errflag 0 set msg [expr [string match "*/*roff*" $pipe]?"Formatting and filtering":"Filtering"] winstdout $wi "$msg $manx(name$w) ..."; update idletasks append pipe " | $manx(rman) -f TkMan $man(subsect) $man(tables) $man(headfoot) $man(changeleft) $man(zaphy)" DEBUG {puts stderr "pipe = $pipe"} if [catch {set fid [open "|$pipe"]} info] { winstderr $wi "ERROR: $info" DEBUG {puts "can't open pipe: $info"} return } manOpenText $w set time [time { while {![eof $fid]} {eval [gets $fid]} }] DEBUG {puts "formatting time: $time"} if {$man(headfoot)!=""} { if {$manx(catfull$w)!=""} { set f $manx(catfull$w); set info "formatted" } else {set f $manx(manfull$w); set info "installed"} set fileinfo [eval "exec $man(ls) -l $f"] if {[regexp -nocase {(jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec) (..) (.....)} $fileinfo all mon day year]} { set year [string trimleft $year] set info "$f $info on [mon2Month $mon] $day" if {![string match "*:*" $year]} {append info ", $year"} $t insert end "( $info )\n" sc } } manCloseText $w winstdout $wi "" if [catch {close $fid} info] { winstderr $wi "ERROR: $info" DEBUG {puts "can't close pipe: $info"} return } if {$so} { set manx(manfull$w) $f0 set manx(man$w) [file tail $f0] if {[regexp $man(zregexp) $manx(man$w)]} {set manx(man$w) [file rootname $manx(man$w)]} set manx(name$w) [file rootname $manx(man$w)] } manShowManFoundSetText $w cd $tmpdir manShowManStatus $w return $manx(manfull$w) } proc manShowManFoundSetText {w} { global man manx set t $manx(out$w).show set m [set mb $w.sections].m set ml [lsort -command "bytextposn $t " [$t mark names]] foreach i $ml { if ![string match "js*" $i] continue set pfx [expr {[string match "jss*" $i]?" ":""}] set txt [$t get "$i linestart" "$i lineend"] $m add command -label [string tolower $txt] -command "$t yview $i" } if {$man(headfoot)!=""} { $m add separator $m add command -label "Header and Footer" -command "$t yview headfoot" } configurestate $mb [llength $ml] manMenuFit $w.sections.m scan [$t index end] "%d" linecnt $w.search.cnt configure -text "$linecnt lines" set manx(hv$w) $manx(manfull$w) manHighView $w focus $t } proc manManPipe {f} { global man if {[regexp $man(zregexp) $f] || [regexp $man(zregexp) [file dirname $f]]} { set pipe $man(zcat) } else {set pipe "cat"} return "$pipe $f" } proc manShowManStatus {w} { global man manx set t $manx(out$w).show; set wi $w.info manSetSect $w $manx(manfull$w) set manx(typein$w) $manx(name$w) set manx(history$w) \ [lrange [setinsert $manx(history$w) 0 [list $manx(manfull$w)]] 0 [expr $man(maxhistory)-1]] set m [set mb $w.history].m $m delete 0 last foreach i $manx(history$w) { if {[llength [lfirst $i]]>=2} {set l [lfirst $i]} {set l $i} if {![regexp {^[|<]} $l]} { set l [file tail $l] if [regexp $man(zregexp) $l] {set l [file rootname $l]} } $m add command -label $l -command "manShowMan $i {} $w" } configurestate $mb [llength $manx(history$w)] manMenuFit $m set E 0 DEBUG {puts "LINKS"} set m [set mb $w.links].m catch { foreach i [split $manx(links) /,.] { DEBUG {puts $i} foreach j $i { if {[regexp {.+\([1-9lonp].*\)} $j]} { DEBUG {puts "link: $j"} $m add command -label $j -command "manShowMan $j {} $w" incr E } } }} if {$manx(mode$w)=="man"} { configurestate $mb $E } manMenuFit $m manShortcutsStatus $w winstdout $wi "" if {$man(whatwhere)} { winstdout $wi $manx(manfull$w) } else { scan [$t index end] %d n set n [max $n 20] for {set i 1} {$i<=$n} {incr i} { if {[regexp -- {- (.*)} [$t get $i.0 "$i.0 lineend"] all info]} { incr i while {[regexp { +(.*)} [$t get $i.0 "$i.0 lineend"] all spaces more]} { append info " $more" incr i } winstdout $wi "$info" break } } } } proc manShowText {f0 {w .man} {keep 0}} { global man manx set wi $w.info set t $manx(out$w).show if {[string match <* $f0]} { set f [fileexp [string range $f0 1 end]] if {[regexp $man(zregexp) $f]} {set f "|$man(zcat) $f"} } else {set f [pipeexp $f0]} manNewMode $w txt manOpenText $w if {[catch { set cnt 0 set fid [open $f] while {![eof $fid]} {$t insert end [gets $fid]\n; incr cnt} close $fid }]} {manCloseText $w; winstderr $wi "Trouble reading $f0"; return} manCloseText $w if {!$keep} {pack forget $w.dups} if [file isfile $f] {cd [file dirname [glob $f]]} set manx(man$w) $f0 set manx(num$w) X set manx(hv$w) $f set manx(manfull$w) $f0 set manx(catfull$w) $f set manx(name$w) $f0 set manx(links) {} set tmp $man(whatwhere) set man(whatwhere) 1 manShowManStatus $w set man(whatwhere) $tmp $w.search.cnt configure -text "$cnt lines" manHighView $w focus $t } proc manApropos {name {w .man}} { global man manx mani if $manx(shift) { set manx(shift) 0; set w [manInstantiate] } set wi $w.info; set t $w.show if {$name==""} {set name $manx(man$w)} if {$name==""} { winstderr $wi "Type in keywords to search for" return } winstdout $wi "Apropos search for \"$name\" ..."; update idletasks DEBUG {puts "manApropos: exec $man(apropos) $name $man(aproposfilter) 2>/dev/null"} if {[catch {set tmp [eval exec "$man(apropos) $name $man(aproposfilter) 2>/dev/null"]}] || $tmp==""} { set mani(apropos,form) "No apropos match for $name" set mani(apropos,cnt) 0 } else { set mani(apropos,form) "" set cnt 0 foreach line [split $tmp "\n"] { regsub "^\\.\[^ \t\]+" $line "" line regsub "\[ \t\]+- " $line "\t - " line append mani(apropos,form) $line "\n" incr cnt } set mani(apropos,cnt) $cnt set manx(yview,apropos) 0 } manShowSection $w apropos } proc manGlimpse {name {w .man}} { global man manx mani sbx env STOP if $manx(shift) {set manx(shift) 0; set w [manInstantiate]} set t $manx(out$w).show; set wi $w.info if {$name==""} {set name $manx(man$w)} if {$name==""} { winstderr $wi "Type in regular expression for full text search" return } set showname $name regsub -all {([^\]);} $name {\1\;} name set opts "-ly" set casesen $man(regexp,case); if {$casesen==-1 && [string tolower $name]!=$name} {set casesen 1} if {!$casesen} {append opts "i"} if {$man(maxglimpse)!="none"} {append opts " -L $man(maxglimpse)"} set redirect "" if [regexp { -[^ ]*N[^ ]* } "$man(glimpse) $name"] {append redirect "2>/dev/null"} set STOP 0 cursorBusy set foundList "" set errorList "" foreach d [concat $manx(paths) $manx(glimpsestrays)] { if {$d!=$man(glimpsestrays) && !$man($d)} continue if ![file readable $d/.glimpse_index] { continue } winstdout $wi "Glimpsing for \"$showname\" in $d ..."; update DEBUG {puts "$man(glimpse) $opts -H $d $name"} if {$STOP} {set STOP 0; break} if ![catch {set matches [eval exec -keepnewline "$man(glimpse) $opts -H $d $name $redirect"]} info] { append foundList $matches } else { append errorList "can't glimpse $d: $info\n" winstderr $wi "error with glimpsing: $info" } } winstdout $wi "" cursorUnset set found [llength $foundList]; set error [string length $errorList] if {!$found && !$error} { winstderr $wi "$name not found in full text search" } else { set mani(glimpse,form) "" if $error { append mani(glimpse,form) "Errors while Glimpsing\n\n" $errorList "\n\n" } foreach i [lsort -command manSortByName $foundList] { append mani(glimpse,form) "$i\n" } set mani(glimpse,cnt) $found set manx(yview,glimpse) 0 set manx(search,string$w) [tr [tr [llast $name] ";" ".*"] "," "|"] set sbx(lastkeys-old$t) [llast $name] manShowSection $w glimpse } } proc manGlimpseIndex {{w .man}} { global man manx mani env manNewMode $w super set t $manx(out$w).show; set wi $w.info winstdout $wi "Rebuilding Glimpse database ... " manOpenText $w; update idletasks set indexdirs [concat $manx(paths) $manx(glimpsestrays)] set cnt [llength $indexdirs]; set cur 1 set foneup 0 foreach dir $indexdirs { $t insert end "Working on $dir ($cur of $cnt)\n\n" b; $t see end; update idletasks set dirs $mani($dir,dirs) set gzt ".glimpse_filters" set gf "$dir/.glimpse_filenames" set gz "$dir/$gzt" set gfe [expr [llength [glob -nocomplain $dir/.glimpse_{filenames,index}]]==2] set outofdate [expr {!$gfe || [file size $gf]==0 || ([file exists $gz] && [file mtime $gz]>[file mtime $gf])}] if {!$outofdate} { set gtime [file mtime $gf] foreach d $dirs { if {[file mtime $d]>$gtime} {set outofdate 1; break} } } if {!$outofdate} { $t insert end "Glimpse index still current.\n" indent set foneup 1 incr cur; $t insert end "\n\n" continue } if {![file writable $dir]} { $t insert end "Glimpse index out of date but directory not writable" indent if {$gfe} { $t insert end " ... but old Glimpse files found\n" indent $t insert end "Full text seaching available here using existing files.\n" indent } else { $t insert end " ... and Glimpse files not found\n" indent $t insert end "No full text searching available here.\n" {indent bi} } incr cur; $t insert end "\n\n" continue } if ![file exists $gz] { set fcat [expr [lsearch -regexp $dirs {/cat[^/]*$}]!=-1] set fhp [expr [lsearch -regexp $dirs {\.Z$}]!=-1] set fz 0 foreach d $dirs { cd $d if {[lsearch -regexp [glob -nocomplain *] $man(zregexp)]!=-1} {set fz 1; break} } set fid [open $gz "w"] if $fhp {puts $fid "*.Z/*\tzcat <"} if {$fz} { set zcat [file tail [lindex $man(zcat) 0]] switch -glob -- $zcat { gz* {puts $fid "*.z\t$man(zcat)\n*.Z\t$man(zcat)\n*.gz\t$man(zcat)"} default { puts $fid "*.$man(zglob)\t[string trimright $man(zcat) { <}]" } } } if $fcat {puts $fid "*/cat*/*\trman <"} close $fid } if [catch {set fid [open "|$man(glimpseindex) -z -H $dir $dirs"]} info] { DEBUG {puts "error on: $man(glimpseindex) -z -H $dir $dirs]"} $t insert end "$info\n" bi catch {close $fid} } else { DEBUG {puts "$man(glimpseindex) -z -H $dir $dirs"} set blankok 0 while {![eof $fid]} { gets $fid line if {![regexp {(^This is)} $line] && ($line!="" || $blankok)} { $t insert end "$line\n" tt; $t see end; update idletasks set blankok 1 } } if [catch {close $fid} info] { $t insert end "ERRORS\n" {indent bi} $info indent2 "\n" } if {[file size $gf]==0} { $t insert end "No files could be indexed. No full text searching available here.\n" {indent bi} if [file exists $gz] { $t insert end "Try checking your $gzt file in $dir. If $gzt wasn't created by TkMan, try deleting it and letting TkMan create one of its own.\n" indent } } else { if ![string match "$env(HOME)*" $dir] { catch { eval exec $man(chmod) a+r [glob $dir/.glimpse_*] } } } } incr cur $t insert end "\n\n" } if {$foneup} { $t insert end "\nTo force re-indexing of directories that TkMan claims are current, remove all Glimpse index files in that directory, as with `rm .glimpse_*'.\n" i } $t see end manCloseText $w winstdout $wi "" } proc manPrint {w} { global man manx winout set t $w.show; set wi $w.info set f [string trim $manx(manfull$w)] if {$f=="" || ![file exists $f]} return set name [file rootname [file tail $f]]; set sect [file extension $f] if {[regexp $man(zregexp) $f]} {set sect [file extension $name]; set name [file rootname $name]} if {$sect==""} {set sect [string index [file dirname $f] 3]} set tmp $winout(lastMessage$wi) winstdout $wi "Printing $f ..."; update idletasks set tmpdir [pwd] set topdir [file dirname $f] set printpipe $man(print) if {[regexp -- $man(catsig) $topdir]} { set printpipe $man(catprint) if {[tk_dialog .dialog "NO GUARANTEES" "No troff source. Try to reverse compile cat-only page?" \ "" 1 No Yes]} { set printpipe "$manx(rman) -f roff $man(changeleft) $man(tables) $man(subsect) -n $name -s $sect $man(zaphy) | $man(print)" } } if {[regexp $man(catsig) $topdir] || [string match */man?* $topdir]} { set topdir [file dirname $topdir] } catch {cd $topdir} DEBUG {puts stderr "print pipe = [manManPipe $f] | $printpipe"} eval exec [manManPipe $f] | $printpipe winstdout $wi $tmp cd $tmpdir } proc manHelp {w} { global man manx set t $w.show; set wi $w.info manNewMode $w help set manx(manfull$w) "help" set manx(hv$w) help manOpenText $w manHelpDump $t $t tag remove h1 1.0 "1.0 lineend"; $t tag add title 1.0 "1.0 lineend" $t delete 2.0 $t delete 7.10 7.14; $t insert 7.10 "\251"; $t tag add symbol 7.10 $t window create 2.0 -window [label $t.icon -image image1] -padx 8 -pady 8 if [string length $manx(warnings)] { $t insert 1.0 $manx(warnings)\n\n $t insert 1.0 "Warnings\n\n" b } $t insert 1.0 $manx(updateinfo) manHighView $w manCloseText $w update idletasks set m $w.sections.m foreach i [lsort -command "bytextposn $t " [$t mark names]] { if {![string match "*1" $i] && ![string match "*2" $i]} continue set indent ""; if [string match "*2" $i] {set indent " "} set txt [$t get "$i linestart" "$i lineend"] $m add command -label "$indent$txt" -command "$t yview $i" } manMenuFit $m set seealso {rman man(1) man(7) catman(8) xman(1) Tcl text regexp bind options} if {$man(glimpse)!=""} {lappend seealso "glimpse"} set m $w.links.m foreach i $seealso { $m add command -label $i -command "manShowMan $i {} $w" } manMenuFit $m scan [$t index end] %d eot $w.search.cnt configure -text "$eot lines" set manx(name$w) "help" after 1 "winstdout $wi \"TkMan v$manx(version) by Tom Phelps (phelps@cs.Berkeley.EDU)\"" } proc bytextposn {t a b} { set ap [$t index $a]; set bp [$t index $b] if {$ap<$bp} {set cmp -1} elseif {$ap>$bp} {set cmp 1} else {set cmp 0} return $cmp } proc manKeyNav {w m k} { global man manx set t $w.show; set wi $w.info set firstmode [expr {$manx(mode$w)=="section" || $manx(mode$w)=="apropos"}] set casesen [expr $firstmode?1:$man(incr,case)] set fFound [searchboxKeyNav $m $k $casesen $t $wi $firstmode] return $fFound } proc manPreferencesMake {{w0 ""}} { global prefedit manx man bozo set w .prefs if {[winfo exists $w]||$w0==""} {return $w} toplevel $w wm geometry $w $prefedit(geom-prefs) wm title $w "Preferences" wm withdraw $w set f [frame $w.pages] foreach i {Fonts Colors See Icon Misc} { set il [string tolower $i] radiobutton $f.$il -text $i -command manPreferences -variable manx(prefscreen) -value $il } pack $f.fonts $f.colors $f.see $f.icon $f.misc -side left -fill x -padx 4 frame $w.sep1 -height 2 -background $prefedit(guifg) set g [frame $w.[set group "fonts"]] foreach i {{gui Interface} {text "Text display"} {vol "Volume listings"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) $var-family $var-style $var-points set f [frame $g.font$var] label $f.l -text $txt [eval tk_optionMenu $f.family prefedit($var-family) $man(families)] configure -tearoff no [eval tk_optionMenu $f.style prefedit($var-style) $manx(styles)] configure -tearoff no [eval tk_optionMenu $f.points prefedit($var-points) $manx(sizes)] configure -tearoff no pack $f.l -side left -fill x pack $f.style $f.points $f.family -side right -padx 2 } set f [frame $g.dpi] label $f.l -text "Screen dots per inch (DPI)" [eval tk_optionMenu $f.dpi prefedit(dpi) $prefedit(dpis)] configure -tearoff no lappend manx(vars-$group) "dpi" pack $f.l -side left -fill x pack $f.dpi -side right pack $g.fontgui $g.fonttext $g.fontvol $g.dpi -fill x -pady 3 -padx 4 set g [frame $w.[set group "colors"]] foreach i {{text "Text"} {gui "Interface"} {butt "Buttons"} {active "Active Regions"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) ${var}fg ${var}bg set f [frame $g.$var] label $f.l -text $txt foreach j {{fg "foreground"} {bg "background"}} { set jvar [lfirst $j]; set jtxt [lsecond $j] if {$jvar=="fg"} {set jopp "bg"} {set jopp "fg"} set mb $f.$var$jvar [set m [eval tk_optionMenu $mb prefedit($var$jvar) $man(colors)]] configure -tearoff no if {$manx(mono)} { foreach k $man(colors) { set copp [lindex $prefedit(colors) [expr 1-[lsearch $prefedit(colors) $k]]] $m entryconfigure $k -command "set prefedit($var$jopp) $copp; set prefedit($var$jvar) $k" } } } pack $f.l -side left -fill x pack $f.${var}bg [label $f.${var}on -text "on"] $f.${var}fg -side right -padx 4 } foreach i {{manref f "Man page references"} {isearch b "Incremental search hits"} {search b "Regexp search hits"} {highlight b "Highlights"}} { set var [lfirst $i]; set fb [lsecond $i]; set txt [lthird $i] lappend manx(vars-$group) $var set f [frame $g.$var] label $f.l -text $txt [set m [eval tk_optionMenu [set mb $f.$var] prefedit($var) $manx(highs)]] configure -tearoff no foreach k $manx(highs) { if {[lsearch $man(colors) $k]==-1} {set val $k} \ else {if {$fb=="f"} { set val "-foreground [list $k]"} { set val "-background [list $k]" } } $m entryconfigure $k -command "set prefedit($var) [list $val]" } pack $f.l -side left -fill x pack $mb -side right -padx 4 } pack $g.text $g.gui $g.butt $g.active $g.manref $g.isearch $g.search $g.highlight \ -fill x -expand yes -pady 3 -padx 4 set g [frame $w.[set group "see"]] foreach i {{headfoot "Show header, footer, date at bottom"} {scrollbarside "Scrollbar side"} {whatwhere "Information bar shows"} {textboxmargin "Text box margin"} {volcol "Width of columns in Volumes list"} {high,vcontext "Back context for Highlights jump"} {strictmotif "Strict Motif behavior"} {subvols "Subvolumes as submenus in Volumes"} {apropostab "Tab stop in apropos list"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) $var set f [frame $g.$var] label $f.l -text $txt [set m [eval tk_optionMenu $f.high bozo($var) $manx(${var}-t)]] configure -tearoff no set j 0 foreach mv $manx(${var}-v) { $m entryconfigure $j -command "set prefedit($var) [list $mv]" incr j } trace variable prefedit($var) w manPrefBozo pack $f.l -side left -fill x pack $f.high -side right } pack $g.headfoot $g.subvols $g.high,vcontext $g.volcol $g.apropostab $g.whatwhere $g.scrollbarside $g.textboxmargin $g.strictmotif \ -fill x -pady 3 -padx 4 set g [frame $w.[set group "icon"]] foreach i {{iconify "Iconify on startup"} {updateicon "... or reflect current page in iconname"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) $var set f [frame $g.$var] label $f.l -text $txt [set m [eval tk_optionMenu $f.high bozo($var) $manx(${var}-t)]] configure -tearoff no set j 0 foreach mv $manx(${var}-v) { $m entryconfigure $j -command "set prefedit($var) [list $mv]" incr j } trace variable prefedit($var) w manPrefBozo pack $f.l -side left -fill x pack $f.high -side right } foreach i {{iconname "Name when iconified..."} {iconbitmap "Path name of icon bitmap"} {iconmask "Path name of icon mask"} {iconposition "Icon position (+|-)x(+|-)y"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) $var set f [frame $g.$var] label $f.l -text $txt entry $f.e -textvariable prefedit($var) -relief sunken pack $f.l -side left -fill x pack $f.e -side right } set ring {iconname iconbitmap iconmask iconposition}; set ringl [llength $ring] for {set i 0} {$i<$ringl} {incr i} { set wig $g.[lindex $ring $i].e foreach k {Tab Return} { bind $wig "focus $g.[lindex $ring [expr ($i+1)%$ringl]].e"; break } bind $wig "focus $g.[lindex $ring [expr ($i-1)%$ringl]].e; break" } foreach wig {iconbitmap iconposition} { set e $g.$wig.e bind $e "manFilecompleteLocal $e" } pack $g.iconify $g.iconname $g.updateicon $g.iconbitmap $g.iconmask $g.iconposition \ -fill x -pady 3 -padx 4 set g [frame $w.[set group "misc"]] foreach i {{nroffsave "Cache formatted (nroff'ed) pages"} {subsect "Parse man page subsections"} {tables "Aggressive table parsing"} {recentdays {"Recent" volume age (in days)}} {maxhistory "Maximum length of history list"} {maxglimpse "Maximum Glimpse hits (per man hierarchy)"} {zaphy "Prevent hyphenation (silly)"}} { set var [lfirst $i]; set txt [lsecond $i] lappend manx(vars-$group) $var set f [frame $g.$var] label $f.l -text $txt [set m [eval tk_optionMenu $f.high bozo($var) $manx(${var}-t)]] configure -tearoff no set j 0 foreach mv $manx(${var}-v) { $m entryconfigure $j -command "set prefedit($var) [list $mv]" incr j } trace variable prefedit($var) w manPrefBozo pack $f.l -side left -fill x pack $f.high -side right } pack $g.nroffsave $g.subsect $g.maxhistory $g.recentdays $g.maxglimpse $g.tables $g.zaphy \ -fill x -pady 3 -padx 4 frame $w.bsep -relief sunken -height 2 -background $prefedit(guifg) set f [frame $w.butts] button $f.ok -text "OK" -padx 6 -command "grab release $w; wm withdraw $w; manPreferencesSet" button $f.apply -text "Apply" -command "manPreferencesSet" button $f.cancel -text "Cancel" -command " grab release $w; wm withdraw $w manPreferencesGet cancel; manPreferencesSet " button $f.default -text "Defaults" -command "manPreferencesGet default" pack $f.ok $f.apply $f.default $f.cancel -side right -padx 4 pack $w.pages $w.sep1 $w.bsep $w.butts \ -side top -fill x -pady 3 -padx 4 return $w } proc manPrefBozo {array var op} { global prefedit manx bozo set bozo($var) [lindex $manx($var-t) [lsearch $manx($var-v) $prefedit($var)]] } proc manFilecompleteLocal {t} { set line [$t get] set fc [filecomplete $line] set ll [llength $fc] if {!$ll} { bell return } $t delete 0 end $t insert 0 [lfirst $fc] $t icursor end $t xview moveto 1 } proc manPreferencesGet {{cmd "fill"}} { global man manx default prefedit cancel curedit if {$cmd=="fill"} { foreach i [array names default] {set prefedit($i) [set curedit($i) [set cancel($i) $man($i)]]} } elseif {$cmd=="default"} { foreach i $manx(vars-$manx(prefscreen)) {set prefedit($i) $default($i)} } elseif {$cmd=="cancel"} { foreach i [array names default] {set prefedit($i) $cancel($i)} } elseif {$cmd=="man"} { foreach i [array names default] {set man($i) $prefedit($i)} } elseif {$cmd=="curedit"} { foreach i [array names default] {set curedit($i) $prefedit($i)} } } set manx(prefscreen) "fonts" set manx(oldprefscreen) "" proc manPreferences {{screen ""}} { global manx set w [manPreferencesMake bozo] raise $w if {$screen==""} {set screen $manx(prefscreen)} {set manx(prefscreen) $screen} set prev $manx(oldprefscreen) if {$screen!=$prev} { if {$prev!=""} { pack forget $w.$prev } pack $w.$screen -after $w.sep1 -fill x set manx(oldprefscreen) $screen } if ![winfo ismapped $w] { manPreferencesGet fill wm deiconify $w; grab set $w } } proc manPresDefaultsSet {} { global man font foreach i {{gui ""} {butt "Button."} {butt "Menubutton."} {butt "Radiobutton."} \ {butt "Checkbutton."} {text "Text."}} { set var [lfirst $i]; set txt [lsecond $i] if [info exists man(${var}-family)] { option add Tkman*${txt}Font \ [spec2font $man(${var}-family) $man(${var}-style) $man(${var}-points)] 61 } option add Tkman*${txt}Foreground $man(${var}fg) 61 option add Tkman*${txt}Background $man(${var}bg) 61 } option add Tkman*activeForeground $man(activefg) 61 option add Tkman*activeBackground $man(activebg) 61 option add Tkman*highlightBackground $man(activebg) 61 option add Tkman*selectColor $man(buttfg) 61 set font(pro) [spec2font $man(text-family) $man(text-style) $man(text-points)] set font(mono) [spec2font "Courier" $man(text-style) $man(text-points) "s"] set font(vol) [spec2font $man(vol-family) $man(vol-style) $man(vol-points)] if {[string match "*Courier*" $man(currentfont)]} { set man(currentfont) $font(mono) } else {set man(currentfont) $font(pro)} } proc manPreferencesSet {} { global man manx prefedit curedit default tag set change 0 foreach i [array names default] { if {$curedit($i)!=$prefedit($i)} { set change 1 break } } if !$change return manPreferencesGet man manPresDefaultsSet resetfonts [spec2font $man(gui-family) $man(gui-style) $man(gui-points)] resetcolors foreach w [lmatches ".man*" [winfo children .]] {manPreferencesSetMain $w} manPreferencesGet curedit } proc manPreferencesSetMain {w} { global man manx font curedit tk_strictMotif if ![string match ".man*" $w] return foreach i {iconname iconposition iconbitmap iconmask} { if {$man($i)!=$curedit($i)} {set manx($i) $man($i)} } set num [string range $w 4 end] if {$num==""} {set name $manx(iconname)} {set name "$manx(iconname) - $num"} wm iconname $w $name if {[regexp $manx(posnregexp) $manx(iconposition) all x y]} { wm iconposition $w $x $y } foreach i {iconbitmap iconmask} {wm $i $w ""} foreach i {iconbitmap iconmask} { if {$manx($i)!=""} {wm $i $w @$manx($i)} } if 0 { if {$manx(iconbitmap)=="(default)"} { set iw .iconwindow if ![winfo exists $iw] {toplevel $iw; label $iw.l -image image1; pack $iw.l} wm iconwindow $w $iw } } $w.mono configure -onvalue $font(mono) -offvalue $font(pro) pack $w.v -side $man(scrollbarside) set tk_strictMotif $man(strictmotif) $w.dups configure -font [spec2font "symbol" "normal" $man(gui-points)] $w.mono configure -font [spec2font "Courier" $man(gui-style) $man(gui-points)] foreach i [list $w.occ.m $w.paths.m $w.occ.m.m2 $w.occ.m.m3] { $i configure -selectcolor $man(guifg) } #$w.v configure -troughcolor $man(guibg) #$w.v configure -background [expr {$man(buttbg)!=$man(guibg)?$man(buttbg):$man(guifg)}] set t $w.show $t configure -padx $man(textboxmargin) -pady $man(textboxmargin) if {$manx(mode$w)=="section"} {set newtextfont $font(vol)} {set newtextfont $man(currentfont)} $t configure -font $newtextfont $t configure -tabs $man(volcol) $t tag configure apropos -tabs $man(apropostab) -lmargin2 $man(apropostab) $t tag configure sel -foreground "$man(textbg)" -background "$man(textfg)" foreach v $manx(tags) { $t tag configure $v -font "" -foreground "" -background "" -underline no set change ""; set newfont 0 set fam $man(text-family); set sty $man(text-style); set poi $man(text-points); set poi2 "m" foreach g $man($v) { switch -exact -- $g { normal {} underline {append change " -underline yes"} reverse {append change " -foreground {$man(textbg)} -background {$man(textfg)}"} italics { set sty $g; set newfont 1 } bold - bold-italics { set sty $g; set poi2 "s"; set newfont 1 } mono { set fam "Courier"; set poi2 "s"; set newfont 1 } symbol { set fam "Symbol"; set sty "normal"; set newfont 1 } small - medium - large { set poi $g; set newfont 1 } s - m - l { set poi2 $g; set newfont 1 } left - right - center { append change " -justify $g" } default {append change " " [list $g]} } } if {$newfont} {append change " -font \"[spec2font $fam $sty $poi $poi2]\""} eval $t tag configure $v $change } $t tag raise sel if {$curedit(subvols)!=$man(subvols)} {manMakeVolList $w} } proc resetfonts {font {w .}} { if ![catch {set oldfont [$w configure -font]}] { if {$oldfont==$font} return $w configure -font $font } foreach c [winfo children $w] { resetfonts $font $c } } proc resetcolors {{w .}} { global man curedit set c [winfo class $w] set g "gui"; if {$c=="Text"} {set g "text"} elseif {[string match "*utton" $c]} {set g "butt"} set foreground [set selector [set insertbackground $man(${g}fg)]] set background $man(${g}bg) set ofg $curedit(${g}fg) set obg $curedit(${g}bg) foreach i {foreground background insertbackground selector} { if ![catch {set color [$w cget -$i]}] { if {$color==$ofg} {$w configure -$i $foreground} \ elseif {$color==$obg} {$w configure -$i $background} } } set activeforeground $man(activefg) set activebackground $man(activebg) set highlightbackground $activebackground foreach i {activeforeground activebackground highlightbackground} { catch {$w configure -$i [set $i]} } foreach c [winfo children $w] { resetcolors $c } } proc spec2font {{family "times"} {style "normal"} {points "medium"} {size "m"}} { global man manx set dpi $man(dpi) switch -exact -- $style { normal {set style "medium-r"} bold {set style "bold-r"} italics { if [regexp -nocase $manx(xmono) $family] {set style "medium-o"} {set style "medium-i"} } bold-italics { if [regexp -nocase $manx(xmono) $family] {set style "bold-o"} {set style "bold-i"} } default {puts stderr "nonexistent style: $style"; exit 1} } if {[set pts [lsearch $manx(sizes) $points]]!=-1} { set p "[lindex [lrange $manx(pts) $pts end] [lsearch {s m l} $size]]" } else {set p $points} append p "0" set font "-*-$family-$style-normal-*-*-$p-$dpi-$dpi-*" return $font } proc manSave {} { global man manx env if {$manx(savegeom)} {set man(geom) [wm geometry .man]} set w [manPreferencesMake] if [winfo exists $w] {set man(geom-prefs) [geom2posn [wm geometry $w]]} set nfn $manx(startup) set ofn $env(HOME)/.tkman-bkup if {![file exists $nfn] || [file writable $nfn]} { if {[file exists $nfn]} {eval exec $man(cp) $nfn $ofn} if [catch {set fid [open $nfn w]}] { winstderr .man.info "$nfn is probably on a read-only filesystem" return } foreach p [info procs *SaveConfig] {eval $p $fid} puts $fid "manDot\n" puts $fid $manx(userconfig) if {[file exists $ofn]} { set ofid [open $ofn] set p 0 while {[gets $ofid line]!=-1} { if {$p} {puts $fid $line} \ elseif {$manx(userconfig)=="$line"} {set p 1} } } close $fid } } proc manSaveConfig {fid} { global man manx high default puts $fid "#\n# TkMan v$manx(version)\n#\n" set preamble { Elements of the man array control many aspects of operation. Some, but not all, user-controllable parameters are available in the Preferences panel. All parameters are listed below. Those that are identical to their default values are commented out (preceded by \"#\") so that changes in the defaults will propagate nicely. If you want to override the default, uncomment it and change the value to its new, perisistent setting. } foreach line [split [linebreak $preamble] "\n"] { puts $fid "# $line" } puts $fid "" foreach i [lsort [array names man]] { if {[info exists default($i)]} { if {$default($i)==$man($i)} {set co "#"} {set co ""} puts $fid "${co}set [list man($i)] [tr [list $man($i)] \n \n$co]" } elseif {[string match "/*" $i]} {puts $fid "set man($i) $man($i)"} } puts $fid "\n\n#\n# Highlights\n#\n" foreach i [lsort [array names high]] { puts $fid "set [list high($i)] [list $high($i)]" } puts $fid "\n" } proc manDot {} { global manx manManManx manPresDefaultsSet toplevel .man -class TkMan manPreferencesGet fill set manx(manDot) 1 } proc manManManx {} { global man manx foreach i { iconify iconname iconbitmap iconmask iconposition geom database glimpsestrays } { if {![info exists manx($i)]} {set manx($i) $man($i)} } } proc manManpathSet {} { global manx env if {![info exists env(MANPATH)] || $env(MANPATH)==""} { set manpath ""; set manpathsrc ""; set def [string trim $manx(manpathdef)] if ![catch {set gmanpath [exec gmanpath -q]}] { set manpathsrc "given by gmanpath" set manpath $gmanpath } elseif [file readable [set manconf "/etc/man.conf"]] { set manpathsrc "read from $manconf" set fid [open $manconf] while {![eof $fid]} { gets $fid line if {[regexp "^_default\[ \t\]+(.*)" $line all dirs]} { foreach dir $dirs { append manpath "$dir:" } } } close $fid } elseif {$def!=""} { set manpathsrc "set to local default" set manpath $def } elseif {[file readable /usr/catman] || [file readable /usr/share/catman]} { set manpathsrc "set to the IRIX default" set manpath "/usr/share/catman:/usr/share/man:/usr/catman:/usr/man" } elseif {[info exists env(PATH)] && $env(PATH)!=""} { set manpathsrc "calculated from your PATH" foreach i [split $env(PATH) ":"] { if {$i==""} continue if [regexp {(.*)/bin(/.*)?} $i all dirtop] { set i $dirtop/man if {[file isdirectory $i] && [file readable $i]} { append manpath "$i:" } } } } else { set manpathsrc "set from the hardcoded default" set manpath "/usr/local/man:/usr/man" } set manpath [string trim $manpath ":"] set env(MANPATH) $manpath regsub -all ":" $manpath ":\n " manpathshow append manx(warnings) "You don't have a MANPATH environment variable set, but you should.\n" append manx(warnings) "Assuming a MANPATH, $manpathsrc, of:\n $manpathshow\n\n" } set manx(MANPATH0) $env(MANPATH) DEBUG {puts stderr "env(MANPATH) => $env(MANPATH)"} } proc manManpathCheck {} { global man manx env set manx(paths) {} set manpatherr "" set whatiserr 0 set glimpseerr 0 foreach i [split $env(MANPATH) ":"] { if {$i=="."} {set i [pwd]} if [string match "~*" $i] {set i [glob -nocomplain $i]} if {$i==""} continue if {[string match "*/" $i ]} { append manpatherr "$i -- spurious trailing slash character (\"/\")\n" set i [string trimright $i "/"] } if {[lsearch $manx(paths) $i]>=0} { append manpatherr "$i -- duplicated path\n" } elseif {![file exists $i]} { append manpatherr "$i -- doesn't exist\n" if {[file exists $i/man]} { append manpatherr " but $i/man does, try it instead\n" } } elseif {![file isdirectory $i]} { append manpatherr "$i -- not a directory\n" } elseif {![file readable $i]} { append manpatherr "$i -- not readable\n => check permissions\n" } elseif {[glob -nocomplain $i/*]==""} { append manpatherr "$i -- is empty\n" } elseif {![string match "*/catman" $i] && [glob -nocomplain $i/$manx(subdirs)]==""} { append manpatherr "$i -- no subdirectories matching $manx(subdirs) glob pattern\n" if {![string match "*/man" $i] && [string match "*man" [file dirname $i]]} { append manpatherr " => try changing $i to [file dirname $i]\n" } } else { lappend manx(paths) $i if {![info exists man($i)]} {set man($i) 1} lappend manx(pathstat) $man($i) if {![file exists $i/whatis]} { append manpatherr "$i -- no `whatis' file for apropos\n" if {!$whatiserr} { append manpatherr " => generate `whatis' with mkwhatis\n" set whatiserr 1 } } if {$man(glimpse)!=""} { if {[glob -nocomplain $i/.glimpse*]==""} { append manpatherr "$i -- no Glimpse support\n" if {!$glimpseerr} { append manpatherr " => try building Glimpse database (under Occasionals)\n" set glimpseerr 1 } } elseif {![file readable $i/.glimpse_index]} { append manpatherr "$i -- Glimpse files exist but not readable\n" } } } } if {[string length $manpatherr]} { append manx(warnings) "Problems in paths of MANPATH environment variable...\n" $manpatherr "\n" } } proc manBinCheck {} { global man manx env set err 0 foreach var {manx(rman) man(sed) man(grep) man(format) man(apropos) man(zcat) man(compress) man(print) man(catprint) man(glimpse) man(glimpseindex)} { set val [set $var] if {$val==""} continue foreach pipe [split $val "|"] { set bin [lfirst $pipe] set found 0; set exe 0 if {[string match "/*" $bin]} { set fullpath $bin if {[file exists $fullpath]} { set found 1 if {[file executable $fullpath]} {set exe 1} } } elseif {[info exists env(PATH)]} { foreach dir [split $env(PATH) ":"] { if {$dir=="."} continue set fullpath $dir/$bin if {[file exists $fullpath]} { set found 1 if {[file executable $fullpath]} { set exe 1 } break } } } } set tail [file tail $fullpath] if {!$found} { puts stderr "$bin not found--check the $var variable in ~/.tkman or the Makefile."; incr err } \ elseif {!$exe} { puts stderr "$bin found but not executable--check permissions."; incr err } \ else { if {[set index [lsearch -exact {rman glimpse glimpseindex} $tail]]!=-1} { set opt [lindex {"-v" "-V" "-V"} $index] set minvers [lindex {2.4 2.1 2.1} $index] set line ""; set vers unknown if [catch {set fid [open "|$fullpath $opt"]} info] { puts "ERROR executing \"$fullpath $opt\": $info\a" incr err } else { while {![eof $fid] && $line==""} {gets $fid line} catch {close $fid} if {$line=="" || ![regexp {[0-9]+\.[0-9]+} $line vers] || $vers<$minvers} { puts stderr "$bin is version $vers--must be at least $minvers." incr err } } } } } if {$err} {exit 1} } proc manParseCommandline {} { global manx argv argv0 env for {set i 0} \$i<[llength $argv] {incr i} { set arg [lindex $argv $i]; set val [lindex $argv [expr $i+1]] switch -glob -- $arg { -M {set env(MANPATH) $val; incr i} -M+ {append env(MANPATH) ":$val"; incr i} -+M {set env(MANPATH) "$val:$env(MANPATH)"; incr i} -now {set manx(now) 1} --now {set manx(now) 0} -iconname {set manx(iconname) $val; incr i} -iconmask {set manx(iconmask) $val; incr i} -iconposition {set manx(iconposition) $val; incr i} -iconbitmap {set manx(iconbitmap) $val; incr i} -icon* {set manx(iconify) 1} --icon* {set manx(iconify) 0} -rebuild* {set manx(rebuildandquit) 1} -quit {if [string match no* $val] {set manx(quit) 0}; incr i} -v* {puts stdout "TkMan v$manx(version)"; exit 0} -t* {set manx(title) $val; incr i} -s* {set manx(startup) $val; incr i} -database {set manx(database) $val; incr i} -d* {set manx(debug) 1; set manx(quit) 0; set manx(iconify) 0} --d* {set manx(debug) 0} -* {puts stdout "[file tail $argv0]: unrecognized option: $arg"; exit 1} default { after 2000 manShowMan $arg {{}} .man break } } } if {[info exists geometry]} {set manx(geom) $val} } proc DEBUG {args} { global manx if $manx(debug) {uplevel 1 eval $args} } if {[info tclversion]<7.4 || $tk_version<4.0} { puts stderr "Tcl 7.4/Tk 4.0 minimum versions required" puts stderr "You have Tcl [info tclversion]/Tk $tk_version" exit 1 } elseif {[info tclversion]>=8.0 || $tk_version>=5.0} { puts stderr "New major versions of Tcl and/or Tk may have introduced\nincompatibilies in TkMan.\nCheck the home ftp site for a new version.\n" } set w .man set man(manList) {1 2 3 4 5 6 7 8 9 l o n p} set man(manTitleList) { "User Commands" "System Calls" Subroutines Devices "File Formats" Games "Miscellaneous" "System Administration" ? Local Old New Public } set man(families) {Times "New Century Schoolbook" Lucida Courier Helvetica} set manx(styles) {normal bold italics bold-italics} set manx(pts) {10 12 14 18 24} set manx(sizes) {small medium large} set man(gui-family) "Times" set man(gui-style) "bold" set man(gui-points) "medium" set man(text-family) "New Century Schoolbook" set man(text-style) "normal" set man(text-points) "medium" set man(vol-family) "Times" set man(vol-style) "normal" set man(vol-points) "medium" set man(dpi) [lfirst $man(dpis)] if {$man(dpis)=={* 75 100}} { button .x if {[winfo fpixels . 1i]<100 && [set man(dpi) 75] && ![catch {.x configure -font [spec2font]}]} { } elseif {[set man(dpi) 100] && ![catch {.x configure -font [spec2font]}]} { } else {set man(dpi) *} destroy .x } set man(currentfont) [spec2font $man(text-family) $man(text-style) $man(text-points)] set manx(tags) {h1 h2 h3 tt sc y b bi i search isearch manref title highlight hot indent indent2} set man(tt) mono set man(sc) s set man(y) symbol set man(b) bold set man(bi) bold-italics set man(i) italics set man(h1) {bold l} set man(h2) {bold m} set man(h3) italics set man(isearch) {-background gray} set man(search) reverse set man(manref) {mono -foreground blue} set man(title) {bold large l} set man(hot) {-underline yes} set man(highlight) {-background #ffd8ffffb332}; # a pale yellow set man(indent) {-lmargin1 5m -lmargin2 10m} set man(indent2) {-lmargin1 10m -lmargin2 15m} set man(maxhistory) 15; set manx(maxhistory-v) [set manx(maxhistory-t) {5 10 15 20 30 40 50}] set man(recentdays) 14; set manx(recentdays-v) [set manx(recentdays-t) {1 2 7 14 30 60 90 180}] set man(shortcuts) {} set man(maxglimpse) 200; set manx(maxglimpse-v) [set manx(maxglimpse-t) {25 50 100 200 500 1000 "none"}] set man(whatwhere) 1; set manx(whatwhere-v) {1 0}; set manx(whatwhere-t) {"pathname" "description"} set man(iconify) 0; set manx(iconify-v) {1 0}; set manx(iconify-t) {"yes" "no"} set man(subsect) ""; set manx(subsect-v) {"-b" ""}; set manx(subsect-t) {"yes" "no"} set man(nroffsave) "off"; set manx(nroffsave-v) [set manx(nroffsave-t) {"off" "on" "on & compress"}] set man(headfoot) "-k"; set manx(headfoot-v) {"-k" ""}; set manx(headfoot-t) {"yes" "no"} set man(incr,case) -1 set man(regexp,case) -1 set man(aproposfilter) {| sort | uniq} set man(scrollbarside) right; set manx(scrollbarside-v) [set manx(scrollbarside-t) {"left" "right"}] set man(zaphy) ""; set manx(zaphy-v) {"-y" ""}; set manx(zaphy-t) {"yes" "no"} set man(updateicon) 0; set manx(updateicon-v) {1 0}; set manx(updateicon-t) {"yes" "no"} set man(strictmotif) 0; set manx(strictmotif-v) {1 0}; set manx(strictmotif-t) {"yes" "no"} set man(subvols) 1; set manx(subvols-v) {1 0}; set manx(subvols-t) {"yes" "no"} set man(textboxmargin) 5; set manx(textboxmargin-v) [set manx(textboxmargin-t) {0 1 2 3 4 5 7 10}] set man(volcol) 4.0c; set manx(volcol-v) {0 1.5c 2.0c 2.5c 3.0c 3.5c 4.0c 4.5c 5.0c 7.5c 10.0c}; set manx(volcol-t) {"no columns" "1.5 cm" "2 cm" "2.5 cm/~1 inch" "3 cm" "3.5 cm" "4 cm" "4.5 cm" "5.0 cm/~2 inches" "7.5 cm" "10 cm"} set man(apropostab) "4.5c"; set manx(apropostab-v) {0 3.0c 4.0c 4.5c 5.0c 5.5c 6.0c 7.5c 10.0c}; set manx(apropostab-t) {"none" "3 cm" "4 cm" "4.5 cm" "5 cm" "5.5 cm" "6 cm" "7.5 cm" "10 cm"} set man(changeleft) "-c" set man(tables) ""; set manx(tables-v) {"-T" ""}; set manx(tables-t) {"on" "off"} set man(high,hcontext) 35 set man(high,vcontext) 10; set manx(high,vcontext-v) [set manx(high,vcontext-t) {0 2 5 7 10 15 20}] set man(geom) 570x800+150+10 set man(geom-prefs) +300+300 set man(iconname) "TkMan" set man(iconmask) "" set man(iconposition) "" set man(startup) $env(HOME)/.tkman set man(colors) {black white red "light yellow" yellow orange green blue beige SlateGray4 gray75 gray90} checkbutton .a set man(textfg) [set man(buttfg) [set man(guifg) [.a cget -foreground]]] set man(textbg) [set man(guibg) [set man(buttbg) [.a cget -background]]] set man(activefg) [.a cget -activeforeground] set man(activebg) [.a cget -activebackground] destroy .a set manx(mono) [expr [winfo depth .]==1] if $manx(mono) { set man(foreground) "black" set man(background) "white" set man(colors) {black white} set man(textfg) [set man(activebg) [set man(buttfg) [set man(guifg) "black"]]] set man(textbg) [set man(activefg) [set man(buttbg) [set man(guibg) "white"]]] set man(search) [set man(isearch) "reverse"] set man(highlight) "bold-italics" set man(manref) "mono underline" } foreach i [array names man] {set default($i) $man($i)} set manx(title) "TkMan v$manx(version)" set manx(warnings) "" set manx(manList) $man(manList) set manx(manTitleList) $man(manTitleList) set manx(userconfig) "### your additions go below" set manx(posnregexp) {([-+]?[0-9]+)([-+][0-9]+)} set manx(init) 0 set manx(manDot) 0 set manx(cursor) left_ptr set manx(yview,help) 0 set manx(paths) "" set manx(pathstat) "" set manx(uid) 1 set manx(outcnt) 1 set manx(debug) 0 set manx(defaults) 0 set manx(startup) $man(startup) set manx(savegeom) 1 set manx(lastman) TkMan set manx(quit) 1 set manx(mandot) "" set manx(db-manpath) "" set manx(db-signature) "" set manx(rebuildandquit) 0 set manx(now) 0 set manx(newmen) "" set manx(xmono) {courier|helvetica} set manx(subdirs) "{man,cat}*" set manx(shift) 0 set high(*) "format: time, start/end pairs for use by text widget" if [info exists env(TKMAN)] {set argv "$env(TKMAN) $argv"} manParseCommandline if {![file exists $manx(startup)]} {eval $manx(newuser)} set manx(savefilevers) "unknown" set manx(updateinfo) "" if {$manx(startup)!="" && [file readable $manx(startup)]} { set fid [open $manx(startup)] while {[gets $fid line]!=-1} { if {[regexp {^# TkMan v([0-9.]+.*)} $line all manx(savefilevers)]} { break } } catch {close $fid} DEBUG {puts "*** savefilevers = $manx(savefilevers)"} source $manx(startup) if {$manx(savefilevers)=="unknown" || [string range $manx(savefilevers) 0 2]<1.6} { set manx(updateinfo) "Startup file information updated from version $manx(savefilevers) to version $manx(version).\n" foreach var {catsig compress zcat} { set man($var) $default($var) } foreach k {greater less question} { set var "sb(key,MS-$k)" if [info exists $var] {unset $var} } append manx(updatedinfo) " Added call to manDot\n" append manx(updateinfo) "Save updates via the Quit button or Occasionals/Checkpoint, or cancel updates via \"Occasionals / Quit, don't update\".\n" if ![catch "exec $man(cp) $manx(startup) [set ofn $manx(startup)-$manx(savefilevers)]"] { append manx(updateinfo) "Old startup file saved as $ofn\n" } append manx(updateinfo) "\n\n" } if {!$manx(manDot)} { manDot } } set manx(highs) [concat $manx(styles) reverse underline mono $man(colors)] set manx(extravols) [list {apropos "apropos list" "No apropos list"}] if {$man(glimpse)!=""} { lappend manx(extravols) {glimpse "glimpse list" "No glimpse list"} } lappend manx(extravols) {recent "Recently added/changed" {}} {high "All with Highlights" {}} {all "All Enabled Volumes" {}} foreach i $manx(extravols) { lappend manx(specialvols) [lfirst $i] } manBinCheck set manx(glimpseindex) "" if {$man(glimpse)!="" && $man(glimpseindex)!=""} { foreach p $manx(paths) { if {![file writable $p]} {set manx(glimpseindex) $man(glimpseindex); break} } } if !$manx(defaults) manDescDefaults if {[llength $mani($manx(glimpsestrays),dirs)]==0} {set manx(glimpsestrays) ""} set STOP 0 TkMan set starttime [time manInit] DEBUG { puts stdout "init takes $starttime" set t $w.show entry $w.in -relief sunken -textvariable manx(debugcmd) bind $w.in {winstdout .man.info "[eval $manx(debugcmd)]"} pack $w.in -fill x }