/usr/bin/tkinfo is in tkinfo 2.8-5.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 | #!/bin/sh
# This is a Tcl/Tk script to be interpreted by wish (Tk4.0 or better): \
exec wish "$0" "$@"
##########################################################################
# Version of TkInfo:
set tki_version 2.8
#
# Authors: Kennard White <kennard@ohm.eecs.berkeley.edu> (up to 0.7)
# Axel Boldt <axelboldt@yahoo.com> (beginning with 0.8 through 2.5)
# Copyright: BSD-type license, see below
# RCS: $Id: tkinfo,v 1.97 2004/03/22 23:53:57 axel Exp $
#
# A graphical browser for files in the GNU hypertext "info" format,
# written in Tcl/Tk.
#
# Please see the "About" and "Info" file sections below. (search for
# "README" to find these sections quickly). These explain much more
# about what tkInfo is and what info files are, and gives references to
# other programs and sources of info. For information on the internals
# of tkInfo, see the roadmap below.
#
# The program provides on-line help about itself: start it and hit `h'.
#
# This release should work with tcl7.4/tk4.0 or later. tkInfo no
# longer works with older versions (sorry). tkInfo has gone through
# several releases, but it is by no means complete. Feel free to make
# suggestions, or better yet, send me patch files.
#
# See below for copyright. Basically you can re-distribute this any
# way you like, just don't sue me and don't pretend you wrote tkInfo.
#
# Contributions and/or good ideas (some minor, some major) by Larry
# Virden <lvirden@cas.org>, Bob Bagwill <bagwill@swe.ncsl.nist.gov>,
# ??? <tlukka@snakemail.hut.fi>, Kurt Hornik
# <hornik@neuro.tuwien.ac.at>, Hume Smith <850347s@dragon.acadiau.ca>,
# Stephen Gildea <gildea@x.org>, Warren Jones <wjones@tc.fluke.COM>,
# Robert Wilensky <wilensky@CS.Berkeley.EDU>, Frank Joachim Leitner
# <ldvhp47@ldv.e-technik.tu-muenchen.de>, John Haxby <jch@pwd.hp.com>,
# Craig Sanders <cas@taz.net.au>.
# Tom Phelps <phelps@CS.Berkeley.EDU> contributed the searching code, as
# well as many other good ideas.
# L J Bayuk <bayuk@mindspring.com> patched 2.5 for Tcl/Tk 8.4.
#
set tki_help_usage \
{
TkInfo: Stand-alone usage
-------------------------
(requires the wish shell (Tk version 4.0 or better))
When invoked with no arguments, tkInfo looks for an "info tree" (a
collection of info files installed on your system) and displays the
top level node. On a well maintained system, you can get to every
info file starting from this top level node. Alternatively, you can
specify the file and node you want to see on the command line.
Usage: tkinfo [--help] [[-|+]headers] [[-|+]buttons]
[[-|+]scrollthrough] [[-|+]showdir] [[-|+]pagesep]
[-linklook type] [-highlight type] [-searchlook type]
[-geometry geom] [-display display] [-iconic]
[-dir dir1] [-dir dir2] ... [node]
Options:
--help Produces this help message.
-/+headers Turns on/off display of the raw info node headers.
-/+buttons Turns on/off display of the button row.
-/+balloons Turns on/off balloonhelp for the buttons.
-/+scrollthrough Turns on/off going to successor when scrolling through end.
-/+showdir Turns on/off showing the full pathname of the info file.
-/+pagesep Turns on/off inserting page separators when scrolling.
-linklook Specifies how to display xrefs and menu entries. Must
be one of "color", "font", or "underline".
-highlight How to highlight links. Can be "color", "underline", or
"inverse".
-searchlook How to highlight the matches after searches. Can be "color",
"underline", or "inverse".
-geometry Geometry of the window. format: XxY+A+B or XxY or +A+B.
X,Y specify size in characters, A,B give location in pixels.
-display X display to use for the tkInfo window.
-iconic Start the first window in iconic state.
-dir Specifies a directory to search for info files, in addition
to those contained in the INFOPATH environment variable.
Several -dir options can be present; the directories will be
searched before INFOPATH, in the order given.
node Specifies the node to visit initially. Possible formats:
"(filename)nodename" most general
"(filename)" equivalent to (filename)Top
"filename" equivalent to (filename).
If filename is not absolute, the info directories (from
INFOPATH and -dir) will be searched. If filename cannot be
found, its lower case version will be tried.
An alternative way to specify the node "(FILE)NODE" is
with "-file FILE -node NODE".
If no node is given, the default "(dir)Top" is used.
Environment variables:
INFOPATH A colon (`:') separated list of directories to search
for info files. More directories can be given with -dir
option, above. If not set, TkInfo will try various
standard directories that should be ok for most systems.
INFOSUFFIX A colon separated list of file suffixes to try when searching
for an info file. If not set, tkinfo will try the suffixes
"", ".info", and "-info". In addition, tkinfo will
always automatically try the suffixes .Z, .z, bz2, and .gz
and uncompress transparently if necessary.
}; set tki_custom \
{
How to customize tkInfo
-----------------------
The colors, fonts, and geometry of tkInfo can be customized using the
standard X options database. A random example follows. You can either put
(parts of) this in your .Xdefaults or .Xresources file or you can
create a global file /etc/X11/app-defaults/tkinfo that will apply
to all users of your site. To have the new options take effect,
restart your X server or use the program xrdb. More information about
the X options mechanism is available from the X man page. Use tkman
for reading man pages or you lose.
Windows and Mac users can't do this, but they can change the "option"
lines in the procedure tkiInit in the tkInfo script itself.
=========== snip ==================================================
! These tkInfo settings are annoying on purpose, just to demonstrate
! what harm an evil mind can do.
!
! Specify the size in characters, the position in dots. You can also
! leave the position out. Default geometry is 80x28 to fit on 640x480
! screens.
Tkinfo.geometry: 80x40+10+10
! How many entries to keep in the info node history list.
! Default is 20.
Tkinfo*history: 28
! How many entries to keep in the history list for the prompt window.
! Defaults to 35.
Tkinfo*prompthistory: 20
! Whether to jump to the successor node when attempting to scroll at the
! bottom of a node. Can be 1 (default) or 0.
Tkinfo*scrollthrough: 0
! Whether to show the directory of the displayed node. Can be 0 (default)
! or 1.
Tkinfo*showdir: 1
! Whether to insert page separators when scrolling. Defaults to 1.
Tkinfo*pagesep: 0
! How the links are displayed. Can be one of "color" (default),
! "underline" (default on b&w terminals), or "font".
Tkinfo*linklook: font
! The following is only used if linklook is set to "color"
Tkinfo*linkcolor: red
! The following is only used if linklook is set to "font".
Tkinfo*linkfont: -*-courier-bold-o-normal-*-16-*-*-*-*-*-*-*
! How a link is highlighted. Can be one of "inverse" (default), "underline",
! or "color".
Tkinfo*highlight: color
! Set this if highlight = color:
Tkinfo*highlightcolor: green
! Set this if highlight = font:
Tkinfo*highlightfont: -*-courier-bold-o-normal-*-16-*-*-*-*-*-*-*
! How to display the matches after a search. Can be "color", "font", or
! "inverse" (default).
Tkinfo*searchlook: font
Tkinfo*searchfont: -*-courier-bold-o-normal-*-16-*-*-*-*-*-*-*
Tkinfo*searchcolor: violet
! To switch off the lower row of buttons. (The default is "1" which means
! display the buttons.)
Tkinfo*showbuttons: 0
! To switch off balloonhelp for the buttons. (Default is "1" which means
! display balloonhelp.)
Tkinfo*showballoons: 0
! Delay after which balloonhelp appears, in thousands of a second.
! Default: 400
Tkinfo*balloondelay: 300
! To switch off display of the full info file headers. (The default is "1"
! which means show the info headers).
Tkinfo*showheaders: 0
! You can specify colors either as names (on my system, they are defined in
! /usr/lib/X11/rgb.txt), or in the format #C0F1DD as a sequence of three
! hex numbers giving the red-green-blue components.
Tkinfo*background: yellow
Tkinfo*Text.background: orange
! The "trough" is the area where the scrollbar moves.
Tkinfo*troughColor: blue
! This is for disabled menuentries and buttons.
Tkinfo*disabledForeground: #F00909
Tkinfo*activeBackground: blue
Tkinfo*foreground: black
! Backgroundcolor of balloons (default: LightGoldenrodYellow)
Tkinfo*balloonbackground: violet
! Font for the buttons and messages. You can find nice fonts with the program
! xfontsel.
Tkinfo*font: -*-helvetica-bold-r-normal-*-16-*-*-*-*-*-*-*
Tkinfo*Text.font: -*-courier-medium-r-normal-*-16-*-*-*-*-*-*-*
! If you don't like that the window which owns the focus is highlighted:
Tkinfo*highlightThickness: 0
! Change the different mouse pointers here; the available cursornames
! are contained in the file /usr/include/X11/cursorfont.h on my system.
Tkinfo*linkcursor: "double_arrow"
Tkinfo*normcursor: "fleur"
Tkinfo*waitcursor: "heart"
! This one appears on Button-2:
Tkinfo*handcursor: "double_arrow"
=========== snip ==================================================
}; set tki_roadmap \
{
Roadmap to the tkInfo source code
---------------------------------
TkInfo is a Tcl/Tk script. The following information is for people
familiar with Tcl/Tk who want to hack on tkInfo. You should read the
tkinfo source along with this roadmap.
We keep a global array of variables tki() to store things such as the
current status of the user-toggable options, the current window, list
of all windows, the mouse position at button-press events, and the
extracted information of already parsed info files (including their
full node text, see below). We also have a global array of variables
for every toplevel window; the array has the same name as the window
and is usually called wvars() through a call to upvar. We use wvars() to
store displayed status messages, the name of the displayed node, the
list of previously visited nodes, the string being searched for etc.
The widget tree looks like this: the toplevel windows are called
.tki1, .tki2, etc. .tki1.bar is the menubar with buttons .file, .node,
.search, .options, and .help. The associated menus are called
.tki1.bar.file.m and so on. The main text window is called
.tki1.main.text and its scrollbar is .tki1.main.vsb. Then there is the
the button row .tki1.buts with buttons .next, .prev, .up, and .last
and the status line .tki1.s with filename window .tki1.s.filename and
status message .tki1.s.status. If the user is prompted for an input,
.tki1.s.filename contains the prompt and .tki1.s.input is the entry
area. Then there is the pop-up menu .tki1.transientmenu which appears
on Button-3.
tkInfo requires the following global variables:
tki This is a huge array where all the loaded info-files
are stored. It also contains some configuration state.
The contents of this is described below.
.tki## Each toplevel info window has a global variable associated
with it. The name of the variable is the same as the
toplevel window name, which is ".tki" followed by some number.
tkiEmbed tkInfo can operate stand-alone (like the "info" program) or
embedded (part of your application). Embedded mode is
used iff this variable exists. When this file is
sourced in the stand-alone case, the argv options will be
parsed (see tkiBoot() below) and a new toplevel window
will be opened.
tkInfo may be used in one of three modes: stand alone, embedded or
as a server tool. These modes are described below:
Stand-alone
In this mode, the user directly invokes tkinfo, and directly
manipulates it to display the nodes of interest. This mode
requires that the shell script "tkinfo" be properly
configured, and that the info path be properly configured,
either by editing the default info path in "tkinfo"/tkiInit(),
or by the user's INFOPATH environment variable. The built-in
help contains additional information (command line arguments)
for this mode.
Embedded
In this mode, your application will include tkinfo as part of
its distribution, and tkinfo will run within the same process
and the the same TCL interpreter as your application. tkInfo
is written with this in mind, and avoids name space pollution.
In this mode, tkInfo doesn't do anything until the application
explicitly request an action by calling tkiWinShow(); normally
the application will do this in response to the user selecting
a "Help" button or pressing a "Help" key.
To use this mode, your application must set the global variable
``tkiEmbed'' to any value and then source "tkinfo" (the
auto-load facility may replace explicitly source'ing
"tkinfo", but ``tkiEmbed'' must be set before this
happens).
tkiAddInfoPaths() should be called by the application to let
tkInfo know where the application's info files are installed.
The application should call tkiWinShow() to display a window.
Also, the application may find tkiWinContextHelp() useful
for processing "Help" key bindings.
Server Tool
From the user's perspective, this is very similar to the
Embedded mode, but the implementation is different. In this
mode, tkInfo runs as in the stand-alone mode, but responds to
requests from other applications via Tk's "send" mechanism.
The application must rendezvous with tkInfo (locating the
existing server or starting a new server running) and makes
calls to tkiAddInfoPaths() and tkiWinShow() as in the embedded
case (but via "send"). The application may wish tkInfo to
dedicate a single window to the application, the "window tag"
feature of tkiWinShow() may be useful for this.
The core structure of an info file is a {node}. Each info file
consists of a set of nodes separated by a magic character. Each nodes
consists of of a headerline and a body, which can contain a menu.
There are also special nodes that contain control information used to
reference "split" files and speed up access. A node may be specified
in one of several ways (called a {nodeSpec}):
(filename)nodename Explicit.
nodename The given node within the current file.
(filename) The "Top" node of the file.
If a filename can't be found, we try the lower case version; if a nodename
can't be found we try case insensitive match.
In the implementation below, the info format consists of {nodes} stored
in files. A given info file has three identifiers associated with it:
- The {filename}, which is the name used either by the user to
reference a file, or by one info file to reference another.
Such a reference could be complete UNIX path name (either
absolute or relative), or may be a partial specification (see below).
- The {filepath}, which is a valid UNIX path name to access the
file. The filepath is derived from the filename. If the filename
is already a valid path, no work needs be done. Otherwise,
the filepath is formed by prepending a path prefix and appending
a file suffix. These are defined by the INFOPATH and INFOSUFFIX
variables.
- The {filekey}, which is an internal, auto-generated token associated
with each file.
A typical (filename,filepath,filekey) would be
(emacs-2,/usr/info/emacs-2.gz,fk3). This file has the info file called "emacs"
as a parent.
The global array "tki" contains the following elements about the
already parsed files:
fileKeys-$fileName The fileKeys for $fileName. If there are info files
of the same name in different directories, they will
get differnet fileKeys.
fileinfo-$fileKey The fileinfo struct for $fileKey. Each fileinfo is
{ fileKey fileName filePath pntKey }
pntKey is the filekey of the parent, or the empty
list if there is no parent.
incore-$fileKey Boolean 0/1; true if file has been loaded into core.
nodesinfo-$fileKey A list of nodeinfo for every node in $fileKey.
Each nodeinfo is a list { idx node file up prev next }.
Node, file, up, prev, next are the names given
in the info node's first line.
nodesbody-$fileKey A list of the textual body for every node in $fileKey.
The nodes are given in the same order as in nodesinfo.
indirf-$fileKey List of indirect-file-info for $fileKey. Each
info is a list { indirFileKey byteOfs }.
indirn-$fileKey List of indirect-node-info for $fileKey. Each
info is a list { nodeName byteOfs fileKey }.
xrefinfo-$fileKey-$nodeIdx
A list of all cross reference
pointers within the node body's text. Every element
has the form { idx toNode stpos endpos label }
stpos and endpos give the position of the link in
the text.
menuinfo-$fileKey-$nodeIdx
Contains information on all menu entries
within the node's menu text. Consists of list of:
{ linecnt menucnt toNode nBeg nEnd menutxt }
nBeg and nEnd give the positions of the menu entry
in its line.
Notes (some important, some not).
1. Because of the graphical system, there may be several parallel
info windows active. These windows must operate independently.
Because of this, there can be no concept of the "current file"
or "current node" within the tkinfo core. Rather, this information
must be maintained by the window.
2. Because of #1, we must maintain multiple files in core. Currently
we never flush.
3. The background color used in tkiInit() is BISQUE1, from tk/defaults.h
4. The byte offsets in the indirect tables are not used as such;
this is because we parse the file when loaded. However, they are
used to identify which indirect file the node is in.
5. The function tkiLoadFile() attempts to deal with compressed files.
Currently it uses "zcat" for .Z files, "bunzip2 -c" for .bz2
and "gunzip -c" for .z and .gz files.
If you have better suggestions, please let me know.
Here are descriptions of the more important procedures:
tkiInit
Initializes the default INFOPATH and other global variables such as
the default geometry, link color, cursor etc. It also sets the
regular expression used for parsing info files by calling
_tkiNodeParseInit and sets up the builtin info pages by calling
_tkiBuiltinFile (which does its job by setting up the relevant
tki() variables so that it looks like tkInfo has actually parsed
the builtin info "files").
tkiTimeStatus
takes a script as argument, executes it, and prints the time it
took on stdout. This can be used to profile tkinfo if the option
"Time Status" is enabled from the option menu. Several crucial
calls are wrapped in a tkiTimeStatus.
tkiInfoWindow
Accepts the same arguments as tkinfo. It first parses the options
using topgetopt, processes them, and then calls tkiWinShow to
actually create the new window and display the node.
tkiWinShow
The main entry point: takes the specification of an info node and a
window, creates that window if necessary, and displays the
node. This is also suitable for being called from other tcl
programs via send.
tkiWinCreate
creates a toplevel window with all its subwindows. Also initializes
the winfo() variables for that window. Creates all bindings except
those for the main text window which are handled by _tkiWinBind.
_tkiWinBind
Creates all the bindings for the text window and search entry
boxes. Many of these bindings are created automatically via
_tkiBindAccels from the accelerators of the various menu
entries. If you have bindings to add, here's the place.
_tkiWinAction
The central manager of all actions that can be performed by the user
on a window, such as quitting, scrolling, searching, and moving to
other nodes. The actions themselves are actually handled by other
procedures. This function is designed to be bound to various
events.
_tkiWinPromptMap
Brings up the lower prompt area for searches etc.
_tkiWinPromptOk
Is called when the user presses Enter in the lower prompt area. It
takes the appropriate action and unmaps the prompt area using
_tkiWinPromptUnmap.
tkiWinDpy
Inserts a node into the current text window, complete with
tags. Updates the history and last lists. The actual parsing is
done in tkiNodeParseBody. Also updates the Next/Previous/Last
button bindings and enables/disables menu entries as appropriate
for the displayed node.
tkiWinContextHelp
helper function for the case where tkinfo is embedded in a larger
application. The app can associate an infonode spec to every major
window, and this function will display the associated node in a new
tkinfo window.
tkiFileGet
loads a file into memory and returns the filekey using tkiFileFind
and tkiFileLoad.
tkiFileFind
returns the full filename of a partially specified info file using
the list of info directories and info suffixes and compression
suffixes.
tkiFileLoad
loads an info file and parses its nodes using tkiFileParseNode in
order to fill up the respective entries in tki(). tkiFileParseNode
has to deal with tag tables (which describe where in a file a node
is located) and indirect tables which point to other info files.
tkiGetNodeRef
locates an info node wherever it is; loads the info file if
necessary. Info files can be split; for example, emacs.info is only
a short table containing pointers to the info files emacs-1 to
emacs-29. This is called an "Indirect" table, and emacs.info is
called the parent of the other emacs info files. tkiGetNodeRef
deals with this mess transparently, calling itself recursively on a
child if necessary.
tkiNodeParseBody
parses the body of a node to locate all crossreferences, and
returns a list of them and stores it in tki().
tkiNodeParseMenu
parses the body of a node to locate all menu entries, and returns a
list of them and stores it in tki().
_tkiWinManPage
displays a man page in a tkman window. Either starts a new tkman or
contacts an existing one. Communication is via the tcl send
mechanism. This does not work if you X server is insecure; use xdm
to get a secure session.
_tkiBindAccels
a nice utility function to support accelerator keys in menus.
searchboxSearch and searchboxNext
support for searching, regexp or normal, ready to be bound to
events.
TextSearch and regexpTextSearch
used by the searchbox functions to locate all matching strings in a
text window and to apply a given tag to them.
}
#
# README: You might want to customize "defInfoPath" below for your site,
# just put your paths there and remove the others for faster
# startup.
# If you feel there is a "standard" location not listed below,
# please send me mail.
#
proc tkiInit { } {
global tki env auto_path tkiEmbed geometry
# No need to do this if we have been called before
if { [info exist tki(sn)] } return
set defInfoPath [list . \
/usr/info /usr/share/info /usr/local/info /usr/local/gnu/info \
/usr/local/emacs/info /usr/local/lib/emacs/info \
/usr/lib/xemacs/info /usr/local/lib/xemacs/info \
/usr/gnu/info \
]
set defInfoSuffix [list .info -info ""]
option add *geometry 80x28 widgetDefault
option add *scrollthrough 1 widgetDefault
option add *showdir 0 widgetDefault
option add *pagesep 1 widgetDefault
option add *background #d9d9d9 widgetDefault
option add *foreground Black widgetDefault
option add *history 20 widgetDefault
option add *prompthistory 35 widgetDefault
option add *Text.background #d9d9d9 widgetDefault
option add *Text.foreground Black widgetDefault
option add *font "-*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*" widgetDefault
option add *Text.font "-*-courier-medium-r-normal-*-12-*-*-*-*-*-*-*" widgetDefault
option add *linklook "color" widgetDefault
if { [info commands winfo] != "" } {
if { [winfo depth .] == 1 } {
option add *linklook "underline" widgetDefault
}
}
option add *linkcolor blue widgetDefault
option add *linkfont "-*-courier-bold-o-normal-*-12-*-*-*-*-*-*-*" widgetDefault
option add *highlight inverse widgetDefault
option add *highlightfont "-*-courier-bold-o-normal-*-12-*-*-*-*-*-*-*" widgetDefault
option add *highlightcolor violet widgetDefault
option add *searchlook inverse widgetDefault
option add *searchfont "-*-courier-bold-o-normal-*-12-*-*-*-*-*-*-*" widgetDefault
option add *searchcolor red widgetDefault
option add *showbuttons "1" widgetDefault
option add *showballoons "1" widgetDefault
option add *showheaders "1" widgetDefault
option add *linkcursor "hand2" widgetDefault
option add *normcursor "left_ptr" widgetDefault
option add *waitcursor "watch" widgetDefault
option add *handcursor "sb_v_double_arrow" widgetDefault
option add *balloondelay 400
option add *balloonbackground LightGoldenrodYellow
_tkiLoadAppDefaults {tkinfo Tkinfo TkInfo}
set tki(sn) 0
set tki(self) [info script]
set tki(timestatusB) 0
set tki(iconic) 0
set tki(compresscat-Z) "zcat"
set tki(compresscat-z) "gunzip -c"
set tki(compresscat-gz) "gunzip -c"
set tki(compresscat-bz2) "bunzip2 -c"
set tki(rawHeadersB) [option get . showheaders Showheaders]
set tki(showButtonsB) [option get . showbuttons Showbuttons]
set tki(showBalloonsB) [option get . showballoons Showballoons]
set tki(scrollThroughB) [option get . scrollthrough Scrollthrough]
set tki(showDirB) [option get . showdir Showdir]
set tki(pageSepB) [option get . pagesep Pagesep]
set tki(nodeSep) "\037"
set tki(nodeByteSep) "\177"
set tki(topLevelNode) "Top"
set tki(lastNodes) ""
set tki(promptHistory) ""
set tki(dirs) ""
set tki(history) ""
set tki(historyLength) [option get . history History]
set tki(promptHistoryLength) [option get . prompthistory PromptHistory]
# The global $geometry is set by wish if -geometry was given on
# the command line. The command line option is eaten by wish and
# we will never see it.
set tki(geometry) [option get . geometry Geometry]
if { [info exists geometry] } {
if { [string match "+*" $geometry] } {
regexp "\[^\\+\]*" $tki(geometry) dummy
set tki(geometry) $dummy$geometry
} else {
set tki(geometry) $geometry
}
}
set tki(linklook) [option get . linklook Linklook]
set tki(linklookColor) [option get . linkcolor Linkcolor]
set tki(linklookFont) [option get . linkfont Linkfont]
set tki(highlight) [option get . highlight Highlight]
set tki(highlightColor) [option get . highlightcolor Highlightcolor]
set tki(highlightFont) [option get . highlightfont Highlightfont]
set tki(searchlook) [option get . searchlook Searchlook]
set tki(searchColor) [option get . searchcolor Searchcolor]
set tki(searchFont) [option get . searchfont Searchfont]
set tki(linkCursor) [option get . linkcursor Linkcursor]
set tki(normCursor) [option get . normcursor Normcursor]
set tki(waitCursor) [option get . waitcursor Waitcursor]
set tki(handCursor) [option get . handcursor Handcursor]
set tki(balloonBackground) [option get . balloonbackground Balloonbackground]
set tki(balloonDelay) [option get . balloondelay Balloondelay]
tkiBalloonInit
set tki(windows) ""
set tki(breakBindings) 0
set tki(curWindow) ""
set tki(lastDir) ""
if [info exist env(INFOSUFFIX)] {
set tki(infoSuffix) [split $env(INFOSUFFIX) ":"]
} else {
set tki(infoSuffix) $defInfoSuffix
}
if [info exist env(INFOPATH)] {
tkiAddInfoPaths [split $env(INFOPATH) ":"]
} else {
tkiAddInfoPaths $defInfoPath
}
_tkiNodeParseInit
rename _tkiNodeParseInit ""
_tkiBuiltinFile
rename _tkiBuiltinFile ""
trace var tki(rawHeadersB) w "_tkiTraceOptionsCB"
trace var tki(showDirB) w "_tkiTraceOptionsCB"
trace var tki(pageSepB) w "_tkiTraceOptionsCB"
trace var tki(showButtonsB) w "_tkiTraceOptionsCB"
trace var tki(linklook) w "_tkiTraceOptionsCB"
}
proc _tkiTraceOptionsCB { n1 n2 op } {
tkiWinRefreshAll
}
proc tkiUninit { } {
global tki
# Must destroy all existing windows so that there is no trace
# on anything in $tki. Note that the "Options" menu does direct
# traces on stuff in tki.
catch {eval destroy $tki(windows)}
catch {unset tki}
}
proc tkiReset { } {
global tk_version
if { [info exists tk_version]} {
tkiUninit
tkiInit
}
}
proc tkiStatus { msg {w ""} {permanent 1}} {
global tki
if { $w == "" } {
set w $tki(curWindow)
}
if { $w == "" } {
puts stdout "tkInfo: $msg"
} else {
upvar #0 $w wvars
if { $permanent == 1} {
set wvars(oldStatus) $msg
}
set wvars(statusPermanent) $permanent
$w.s.status conf -text $msg
# idletasks should be sufficient, but the geometry management
# apparently needs some X-events to make the redisplay occur
#update
update idletasks
}
}
proc tkiStatusUpdate { w } {
upvar #0 $w wvars
if {$wvars(statusPermanent) == 1} { return }
set wvars(statusPermanent) 1
$w.s.status conf -text $wvars(oldStatus)
}
proc tkiScrollUpdate { w } {
upvar #0 $w wvars
set wvars(scrollBackwardHitTop) 0
set wvars(scrollForwardHitBottom) 0
}
proc tkiWarning { msg } {
# Warnings always go to stderr
puts stderr "tkInfo Warning: $msg"
}
proc tkiFileWarning { fileSpec msg } {
global tki
if [info exist tki(fileinfo-$fileSpec)] {
set fileSpec [lindex $tki(fileinfo-$fileSpec) 2]
}
tkiWarning "$fileSpec: $msg"
}
proc tkiError { msg } {
global tki
if { $tki(curWindow) == "" } {
puts stdout "tkInfo Error: $msg"
} else {
set infowin $tki(curWindow)
upvar #0 $infowin wvars
$infowin conf -cursor $tki(normCursor)
$infowin.main.text conf -cursor $tki(normCursor)
tkiBell
tkiStatus "Error: $msg" $infowin 0
}
}
#
# This is complicated by the fact that "time" doesn't provide access to
# the return value. Thus "cnt" is used as follows:
# 0 ==> Do once for timing, and repeat for return value (no side-affects)
# 1 ==> Do once for timing&side-affects, empty return value
#
proc tkiTimeStatus { msg cnt args } {
global tki
if { $tki(timestatusB) } {
puts stdout "tkInfo time: $msg [lindex [time $args] 0] microseconds"
if { $cnt == 0 } {
return [eval $args]
} else {
return ""
}
} else {
return [eval $args]
}
}
# _tkiLoadAppDefaults classNameList ?priority?
# Searches for the app-default files corresponding to classNames in
# the order specified by X Toolkit Intrinsics (R5), and loads them with
# the priority specified (default: startupFile). From the Tcl FAQ.
#
# Modified by Tomas Pospisek <tpo_deb@sourcepole.ch>:
#
# 1. use Debian specific system wide app-defaults path under /etc/X11
# 2. remove "lang" - I haven't ever seen paths that contain a "lang" specific part
#
proc _tkiLoadAppDefaults {classNameList {priority startupFile}} {
set filepath "\
/etc/X11/app-defaults \
[split [_tkiEnvVal XFILESEARCHPATH] :] \
[_tkiEnvVal XAPPLRESDIR]$ \
[split [_tkiEnvVal XUSERFILESEARCHPATH] :] \
"
foreach i $classNameList {
foreach j $filepath {
if {[file exists $j/$i]} {
option readfile $j/$i $priority;
}
}
}
}
# _tkiEnvVal varName
# Looks up the environment variable named $varName and returns its value
# OR {} if it does not exist
proc _tkiEnvVal varName {
global env
if {[info exists env($varName)]} { return $env($varName) }
}
#
# This proc is called once during initialization, and then destroyed.
# (It is destroyed to save memory).
# Currently we fake all the appropriate table entires to create a "builtin"
# file. It might be easier, however, to just pass one large text string
# into the parser and have it be dealt with like any other file.
#
proc _tkiBuiltinFile { } {
global tki tki_help_usage tki_roadmap tki_version tki_custom
set fileKey builtin
set tki(fileKeys-$fileKey) [list $fileKey]
set tki(fileinfo-$fileKey) [list $fileKey $fileKey $fileKey ""]
set tki(incore-$fileKey) 1
set tki(nodesinfo-$fileKey) ""
set tki(nodesbody-$fileKey) ""
tkiFileParseNode $fileKey "
File: builtin, Node: Top, Up: (dir)Top, Next: About
TkInfo
======
TkInfo is a browser for files in the info documentation format, such
as the very file you are reading right now. If you need help on using
tkInfo, try selecting \"Quick Help\" or \"Info\" below. Select an item
by moving the mouse over the highlighted text and pressing the left or
middle mouse button.
* Menu:
* About:: Which version of tkInfo you use, who wrote it, and when.
* Info:: The structure of Info files.
* Quick Help:: What the keys and mouse buttons do.
* Usage Tips:: How to use tkInfo efficiently.
* Command Line:: Telling tkInfo where to search for info files, and more.
* Customization:: Changing tkInfo's window size, fonts, and default behaviors.
* Source:: Hacking on tkInfo and embedding it into other programs.
* Copyright:: TkInfo is free. See here for more information.
"
#VERSION README
tkiFileParseNode $fileKey "
File: builtin, Node: About, Up: Top, Next: Info, Prev: Top
About tkInfo
============
This is tkInfo version $tki_version, built on \$Date: 2004/03/22 23:53:57 $.
TkInfo is a browser for documentation in the info file format.
The versions of tkInfo up to 0.7-beta were written by Kennard White
(kennard@ohm.eecs.Berkeley.EDU). You can obtain the tkInfo
distribution up to version 0.7-beta by anonymous ftp from:
ftp://ptolemy.eecs.berkeley.edu/pub/misc
Axel Boldt (axelboldt@yahoo.com) adapted tkInfo in 1997 for newer
tcl/tk versions and added some features. The versions 0.8 and later
can be gotten from http://math-www.uni-paderborn.de/~axel/tkinfo/
Version 2.6 is needed for Tcl/Tk 8.4 and higher.
Please report any and all problems, fixes, and suggestions to
axelboldt@yahoo.com.
TkInfo may be freely modified and distributed; for details, *note
Copyright::.
RCS: \$Id: tkinfo,v 1.97 2004/03/22 23:53:57 axel Exp $
"
tkiFileParseNode $fileKey {
File: builtin, Node: Info, Up: Top, Prev: About, Next: Quick Help
Info Files
==========
tkInfo is a browser for "info" files, a file format that supports a
robust hypertext system which is ideal for on-line help.
Each info file consists of several "nodes", units of information that
can contain crossreferences to other nodes. TkInfo displays one node
per window at a time, and highlights the crossreferences.
The entry point and top most node of an info file is usually called
"Top" and contains the table of contents for the info file. Many
nodes, including Top, contain menus pointing to subnodes, thus
creating a tree of nodes. The subnodes specify their parent as their
"up node". Furthermore, most nodes specify a "next node" and a
"previous node" on the same level, and this yields a convenient way to
traverse the tree.
The top-level info file is called "dir" and contains only a single
node "Top" which is a directory listing all the other info files on
your system. This is where tkInfo starts out by default.
GNU programs such as the editor emacs, the compiler gcc and the shell
bash are documented in the texinfo format, which can be transformed
into info files using the makeinfo program. It is also possible to
print out high quality hardcopies from texinfo sources via the TeX
system.
}
tkiFileParseNode $fileKey {
File: builtin, Node: Quick Help, Up: Top, Prev: Info, Next: Usage Tips
tkInfo Quick Help
=================
The name of the current info node is given in the bottom left. Links
to other nodes are highlighted.
Mouse operations
----------------
Left click on link or button Show node in current window.
Middle click on link or button Show node in new window.
Middle button drag Scroll.
Right click on link or button Show node in new window; future right clicks in
current window will send output to that window.
Right click elsewhere Pop up menu with often used commands.
Displaying other nodes
----------------------
n Move to the "next" node of this node.
p Move to the "previous" node of this node.
u Move "up" from this node.
l Move back to the "last" node you were at, stack based.
t Move to current info file's "top" node, with the table of contents.
d Move to the "directory" node which lists all installed info files.
],[ Move to logical successor (resp. predecessor) of this node.
1-9 Move to first, second, etc, item in node's menu and show in current
Tab Mark next link. Shift-Tab marks previous link.
Enter Move to marked link. Ctrl-Enter shows node in new window.
window. Ctrl-1 - Ctrl-9 shows node in a new window.
m,f Enter beginning of a menu entry (resp. crossreference) to move to.
If several links match, then the first currently visible one wins.
Case does not matter. Crsr-Up recalls previous inputs.
g,( Enter file or node name to move to. Crsr-Up recalls previous inputs.
Syntax: NODENAME or (FILENAME) or (FILENAME)NODENAME
Searching
---------
i Look up a substring in current info file's indices and node names.
, Continue previous index lookup.
s,/ Search for text in current file literally (resp. by grep-style
regular expression, using the special characters .*+?^$[]()|\ ).
At the end of the file, search will wrap around to the beginning.
Ctrl-g aborts; Crsr-Up recalls previous search strings.
Ctrl-s Continue previous search forward.
r,\ Search backwards, literally resp. by regular expression.
Ctrl-r Continue previous search backward.
Scrolling
---------
b, HOME, < Jump to the beginning of the node.
e, END, > Jump to the end of the node.
SPACE, Ctrl-f, Ctrl-v, PgDn Scroll down one page. If at end of node,
jump to logical successor node.
DEL, Ctrl-b, Alt-v, PgUp Scroll up one page. If at beginning
of node, jump to logical predecessor node.
Crsr DOWN, j, Ctrl-n Scroll down one line.
Crsr UP, k, Ctrl-p Scroll up one line.
Ctrl-m Jump to beginning of current node's menu.
Miscellaneous
-------------
? Show this quick help message.
h Show builtin tkinfo documentation.
M Show manual page using tkman. Uses selection or prompts.
A Show unix apropos using tkman. Uses selection or prompts.
! Issue tcl command, results printed on stdout.
c Close the current window.
q Quit the tkInfo program.
You can access a menu from the menubar by holding down ALT and pressing
the underlined letter. Get rid of posted menus with ESC.
Type "u" now in order to go up from this node and obtain more
information on tkInfo and the info system in general, or type "n" to
go to the next node with usage tips for tkInfo, or close this help
window with "c".
}
tkiFileParseNode $fileKey {
File: builtin, Node: Usage Tips, Up: Top, Prev: Quick Help, Next: Command Line
Usage Tips for TkInfo
=====================
Next, Previous, Last and Back
-----------------------------
The most important thing to understand is the function of the "Next"
and "Previous" buttons. They have nothing to do with netscape's "Back"
and "Forward" buttons. Rather, every info node specifies a "next node"
and a "previous node" in its first line, and the "Next" and "Previous"
buttons simply jump there. Most info files are organized in such a
fashion that the next node is on the same hierarchical level as the
current one, so that all menu entries of the current node are skipped
when you click on "Next". Think of nodes as pages of a book: "Next"
jumps from one section's title page to the next section's title page
(which need not be the immediately following page). That's why
continually hitting "Next" will generally NOT visit all the nodes of
an info file in order. If you want to do that, simply keep hitting
Space, or choose "Logical Successor" from the popup menu that's bound
to the right mouse button.
If you want to go to wherever you were before, use the "Last" button
or the History menu. This is the functional equivalent to netscape's
"Back".
Redirection Windows
-------------------
If you do not want to visit all nodes in order, you have to navigate
through the menus by clicking on entries. This can become confusing,
unless you make use of the middle and right mouse buttons. Clicking on
a link with the middle button will bring up that node in a new
window. This comes handy when you quickly want to check out a cross
reference that would only distract if brought up in the main window.
Clicking on a link with the right button creates a "redirection
window" for the current window and displays the node there. If you
continue to use the right button in the current window, the output
will also be sent to that redirection window. Every window (even
redirection windows) can have one redirection window associated with
them in this manner. This is nice because it avoids too many tkinfo
windows cluttering up your desktop and it is useful when browsing
through large menus: I usually keep the menu visible in one main
window and explore the interesting menu entries in its redirection
window, which I place right next to the main window.
Top and Dir
-----------
"Top" is the topmost node of the current info file and will usually
contain the table of contents. The "Top" nodes of bigger info files
often contain a detailed node listing following the menu of immediate
subnodes. This way, you can access every node of the info file with a
single click and there's no need to navigate the hierarchy at all.
"Dir" is the toplevel info file which contains a listing and short
description of all the installed info files on the system. Some
systems have several Dir files because they store their info files in
several directories; if tkInfo knows about these, they will show up
under the Directories Menu entry.
Working quickly, with and without the mouse
-------------------------------------------
Don't forget that you can scroll the current window by dragging with
the middle button. I think this is more comfortable than using the
scrollbar. The mouse bindings are designed so that most functions of
the program can be used easily with one hand on the mouse, and without
much need for the other hand or for mouse movements (right-click
brings up a popup menu).
If you are more of a keyboard person, get used to TAB, Shift-Tab, and
RET to walk through a menu and to select a link. Also, selecting the
forth menu entry for instance is most quickly done by simply hitting
`4'.
If you like working efficiently, you should try TkMan for reading unix
manpages.
Searching
---------
When prompted for a string in the input box below, remember that you
can recall the previous inputs with the cursor UP key. If a search
takes too long, you can interrupt it with Ctrl-g. The search will
start at the beginning of the current node and will wrap around to the
beginning of the info file if you continue to hit Ctrl-s. You can
always jump back to the last match with Ctrl-r.
Instead of doing a full-text search of the whole info file with `s',
it's usually better to start with an index lookup (`i'), which will
try to locate the term in the index nodes and then jump to the
relevant nodes explaining the term. If you want to browse through the
full index, hit `i RET'.
Printing
--------
If you feel the urge to print out an info file, don't. Rather, get
your hands on the corresponding texinfo source and print that one
using the TeX system. The output is much prettier. Info files are not
meant to be printed, and that's why tkInfo doesn't have a print
option.
Info Tutorial
-------------
There is a GNU program called "info" that is similar to tkInfo, but
completely text based. A tutorial info file written for this program
is available on most systems. This tutorial is useful if you want to
learn tkInfo's accelerator keys, since the keybindings of tkInfo and
info are almost identical. It will also tell you more about info files
in general. To see this tutorial, select the menu entry below.
* Menu:
* Plain Info Tutorial: (info)Help.
}
tkiFileParseNode $fileKey "
File: builtin, Node: Command Line, Up: Top, Next: Customization, Prev: Usage Tips
$tki_help_usage"
tkiFileParseNode $fileKey "
File: builtin, Node: Customization, Up: Top, Next: Source, Prev: Command Line
$tki_custom"
tkiFileParseNode $fileKey "
File: builtin, Node: Source, Up: Top, Next: Copyright, Prev: Customization
$tki_roadmap"
#README
tkiFileParseNode $fileKey {
File: builtin, Node: Copyright, Up: Top, Prev: Source
TkInfo's Copyright
==================
This copyright applies to the tkInfo system only. If tkInfo is
embedded within a larger system, that system will most likely have
a different copyright.
Sorry this is so long. Basically, do whatever you want with this
software, just don't sue me and don't pretend you wrote it -- kennard.
The parts I added are Copyright (c) 1997-2004 Axel Boldt and are covered
by the same license below -- Axel.
Copyright (c) 1993 The Regents of the University of California.
All rights reserved.
Permission is hereby granted, without written agreement and without
license or royalty fees, to use, copy, modify, and distribute this
software and its documentation for any purpose, provided that the above
copyright notice and the following two paragraphs appear in all copies
of this software.
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.
}
# Does this save memory? Who knows, it can't hurt.
set tki_custom ""
set tki_roadmap ""
}
#
# Do stand-alone help window
# The -node option is for compatibility to the info program only.
#
proc tkiInfoWindow { args } {
global tki_help_usage tki tk_version
set w ""
set nodeSpec ""
set fileSpec ""
set fileSpec2 ""
set dirList ""
set linklook ""
set highlight ""
set searchlook ""
set headersB -1
set buttonsB -1
set balloonsB -1
set scrollthroughB -1
set showDirB -1
set pageSepB -1
set help -1
set initialIconic -1
set opt_list {
{ "window" w }
{ "dir" dirList append }
{ "file" fileSpec }
{ "headers" headersB bool }
{ "buttons" buttonsB bool }
{ "balloons" balloonsB bool }
{ "help" help bool }
{ "h" help bool }
{ "-help" help bool }
{ "iconic" initialIconic bool }
{ "scrollthrough" scrollthroughB bool }
{ "showdir" showDirB bool }
{ "pagesep" pageSepB bool }
{ "linklook" linklook }
{ "searchlook" searchlook }
{ "highlight" highlight }
{ "infofile" fileSpec2 }
{ "node" nodeSpec append }
}
set args [topgetopt $opt_list $args]
if { $help != -1 } {puts $tki_help_usage; exit}
set tki_help_usage ""
if { ![info exists tk_version] } {
puts "TkInfo needs the X Window system."
exit
}
if { ![info exist tki] } { tkiInit }
if { $dirList != "" } {
tkiAddInfoPaths $dirList
}
if { $linklook != "" } { set tki(linklook) $linklook }
if { $searchlook != "" } { set tki(searchlook) $searchlook }
if { $highlight != "" } { set tki(highlight) $highlight }
if { $initialIconic != -1 } { set tki(iconic) $initialIconic }
if { $headersB != -1 } { set tki(rawHeadersB) $headersB }
if { $buttonsB != -1 } { set tki(showButtonsB) $buttonsB }
if { $balloonsB != -1 } { set tki(showBalloonsB) $balloonsB }
if { $scrollthroughB != -1 } { set tki(scrollThroughB) $scrollthroughB }
if { $showDirB != -1 } { set tki(showDirB) $showDirB }
if { $pageSepB != -1 } { set tki(pageSepB) $pageSepB }
if { $fileSpec == "" } { set fileSpec $fileSpec2 }
if { $args != "" } {
eval lappend nodeSpec $args
}
if { [llength $nodeSpec] > 1 } {
error "tkiInfoWindow: Only one node may be specified"
}
set nodeSpec [lindex $nodeSpec 0]
if { [tkiFileIsAbsolute $fileSpec] } {
tkiAddInfoPaths [file dirname $fileSpec]
}
set result [tkiWinShow $nodeSpec $fileSpec $w]
set noderef [lindex $result 0]
set win [lindex $result 1]
if {$noderef == ""} {
tkiWinShow {(builtin)Top} {} $win
tkiStatus "Error: requested info file not found. Showing tkinfo docs instead." $win 0
} else {
tkiStatus "Welcome to tkInfo! Hit `?' for help." $win 0
}
return ""
}
#
# We are operating in one of two modes:
# 1) Stand-alone. Popup an initial window, filling it according to argv.
# Kill the stupid "." window.
# 2) Embedded within a larger application. Don't do anything automatically;
# instead, let that application's startup script handle things.
#
# We are operating in embedded mode iff the global tkiEmbed exists.
#
proc tkiBoot { } {
global argv tki tkiEmbed tk_version
if { [info exists tkiEmbed] } return
# We need the following 'if' only for the -help command line option;
# apparently, Tk is not loaded if -help is given to wish...
if { [info exists tk_version]} {
wm withdraw .
}
# if { [lindex $argv 0] != "" && [file isfile [lindex $argv 0]] } {
# # Some wishs pass the filename as argv[0]. Kill it off.
# set argv [lreplace $argv 0 0]
# }
eval tkiInfoWindow $argv
}
##########################################################################
# The following material was formerly contained in the file tkiwin.tcl
#
# In the function names below, I use the abbreviations:
# Show Display a node specified by a nodeSpec and optional fileSpec.
# This provides the external interface, and requires
# processing by the tkicore functions to retrieve the
# actual data for display.
# Dpy Display a node specified by a fileKey and an internal
# representation of the node. This is an internal interface.
#
#
# Support calling a running tkman (or starting one up). Adapted from
# remote.tcl that comes with tkman. This supports both regular man pages
# and apropos searches (if $apropos == 1).
#
proc _tkiWinManPage { w manpage {apropos 0}} {
global tki
if {[set found [lsearch [winfo interps] tkman*]]==-1} {
# if TkMan doesn't already exist, start one up
if {[catch {exec tkman &}]} {tkiError "Tkman cannot be started"; return}
# wait for it to be registered
for {set found -1} {$found==-1} {after 200} {
set found [lsearch [winfo interps] tkman*]
}
# check whether server is secure
catch {send tkman set manx(init)} error
if {[string match "*insecure*" $error]} {
tkiError \
"Cannot communicate with tkman:
X server is insecure.
Use xauth or xdm."
return
}
# wait for it to initialize
for {set ready 0} {!$ready} {after 200} {
catch {if {[send tkman set manx(init)]=="1"} {set ready 1}}
}
}
set tkman [lindex [winfo interps] $found]
# .man is the main window, guaranteed to exist
send $tkman raise .man
if { $apropos } {
send $tkman manApropos $manpage
} else {
send $tkman manShowMan $manpage
}
return
}
#
# Various functions for manipulating the "prompting" window. This
# is the entry widget at the bottom of the info window used for entering
# node names and search text.
#
#
# Create the prompt window, and enter the text "extra" into it.
#
proc _tkiWinPromptMap { w mode promptstring {extra ""} } {
upvar #0 $w wvars
set wvars(promptmode) $mode
set wvars(promptHistoryIdx) -1
set dd $w.s
$dd.input delete 0 end
$dd.input insert end $extra
$dd.filename conf -text $promptstring
pack forget $dd.status
pack $dd.input -after $dd.filename -side left -expand 1 -fill both
switch $mode {
search {
pack $dd.regexp -after $dd.input -side left -fill y
pack $dd.case -after $dd.regexp -side left -fill y
pack $dd.back -after $dd.case -side left -fill y
}
manual {
pack $dd.man -after $dd.input -side left -fill y
pack $dd.apropos -after $dd.man -side left -fill y
}
}
focus $dd.input
}
#
# Unmap the prompt window.
#
proc _tkiWinPromptUnmap { w } {
upvar #0 $w wvars
if { $wvars(promptmode) != "" } {
set wvars(promptmode) ""
set dd $w.s
focus $w.main.text
pack forget $dd.input
pack forget $dd.regexp
pack forget $dd.case
pack forget $dd.back
pack forget $dd.apropos
pack forget $dd.man
pack $dd.status -after $dd.filename -side left -fill x -expand 1
$dd.filename conf -text $wvars(nodeSpec)
}
}
#
# add the specified text to the history list of the prompt window.
# Make sure that prompt history list contains no doubles and doesn't grow
# to long.
# Do nothing if text is empty.
#
proc _tkiWinPromptHistoryAdd { w text mode } {
global tki
upvar #0 $w wvars
if { $text == "" } {
return
}
set wvars(promptHistory) [linsert $wvars(promptHistory) 0 [list $mode $text]]
for {set idx 1} {$idx < [llength $wvars(promptHistory)]} {incr idx} {
if {[lindex $wvars(promptHistory) $idx] == [list $mode $text]} {
set wvars(promptHistory) [lreplace $wvars(promptHistory) $idx $idx]
break
}
}
if { [llength $wvars(promptHistory)] == $tki(promptHistoryLength) } {
set wvars(promptHistory) [lreplace $wvars(promptHistory) end end]
}
}
#
# scroll the text in the prompt window according to the prompt history list.
#
proc _tkiWinPromptScroll { w dir } {
upvar #0 $w wvars
if { $dir == "up" } {
set length [llength $wvars(promptHistory)]
for { set idx [expr $wvars(promptHistoryIdx) + 1] } { $idx < $length } {incr idx} {
set entry [lindex $wvars(promptHistory) $idx]
if { [lindex $entry 0] == $wvars(promptmode) } {
set wvars(promptHistoryIdx) $idx
$w.s.input del 0 end
$w.s.input insert end [lindex $entry 1]
return
}
}
} else {
for { set idx [expr $wvars(promptHistoryIdx) - 1] } { $idx >= 0 } { incr idx -1} {
set entry [lindex $wvars(promptHistory) $idx]
if { [lindex $entry 0] == $wvars(promptmode) } {
set wvars(promptHistoryIdx) $idx
$w.s.input del 0 end
$w.s.input insert end [lindex $entry 1]
return
}
}
set wvars(promptHistoryIdx) -1
$w.s.input del 0 end
}
}
#
# This is called when <Return> is pressed in the "goto" text window.
# We could either be in a goto-node command, or a search, or an
# exec-tcl, or an indexlookup, or a manual command.
# We take the appropriate action and cleanup.
#
proc _tkiWinPromptOk { w } {
global tki
upvar #0 $w wvars
set dd $w.s
set input [$dd.input get]
if { $wvars(promptmode) != "search" && $wvars(promptmode) != "indexlookup" } {
set input [string trim $input]
}
if { $input == ""} {
if { $wvars(promptmode) == "search"} {
set tki(curWindow) $w
_tkiWinPromptUnmap $w
if { $wvars(searchBackB) == "1" } {
_tkiWinAction $w search backIncr
} else {
_tkiWinAction $w search forwIncr
}
return
} elseif { $wvars(promptmode) != "indexlookup" } {
_tkiWinPromptUnmap $w
return
}
}
_tkiWinPromptHistoryAdd $w $input $wvars(promptmode)
set tw $w.main.text
$tw conf -cursor $tki(waitCursor)
$w conf -cursor $tki(waitCursor)
switch $wvars(promptmode) {
search {
set tki(curWindow) $w
_tkiWinPromptUnmap $w
if { $wvars(searchBackB) } {
set cnt [searchboxSearchBackw $input $wvars(searchRegexpB) \
$wvars(searchCaseB) searchkey $w]
} else {
set cnt [searchboxSearch $input $wvars(searchRegexpB) \
$wvars(searchCaseB) searchkey $w]
}
set wvars(searchStr) $input
}
goto {
_tkiWinPromptUnmap $w
set result [tkiWinShow $input $wvars(fileKey) $w]
if { [lindex $result 0] == "" } {
set wvars(gotoStr) $input
} else {
set wvars(gotoStr) ""
}
}
indexlookup {
_tkiWinPromptUnmap $w
set infoFileKey $tki(infoFileKey-$wvars(fileKey))
_tkiIndexEntries $w $wvars(fileKey) $infoFileKey $input
if { $wvars(indexEntries) == "" } {
if {$input == ""} {
tkiStatus "No index in this info file." $w 1
} else {
tkiStatus "No index entries contain \"$input\"." $w 1
}
} else {
_tkiWinAction $w indexnext
}
}
tclcmd {
if [catch {uplevel #0 $input} error] {
puts stdout "Error: $error"
} else {
puts stdout [expr { $error == "" ? "Ok" : "$error" }]
}
_tkiWinPromptUnmap $w
}
manual {
set tki(curWindow) $w
_tkiWinPromptUnmap $w
if { $wvars(manB) } {
_tkiWinManPage $w $input
} else {
_tkiWinManPage $w $input 1
}
}
menu {
set toNode [_tkiFindRef $w $input 0]
_tkiWinPromptUnmap $w
if { $toNode == ""} {
tkiStatus "No such menu entry!" $w 0
} else {
tkiWinShow $toNode $wvars(fileKey) $w
}
}
xref {
set toNode [_tkiFindRef $w $input 1]
_tkiWinPromptUnmap $w
if { $toNode == ""} {
tkiStatus "No such crossreference!" $w 0
} else {
tkiWinShow $toNode $wvars(fileKey) $w
}
}
}
$tw conf -cursor $tki(normCursor)
$w conf -cursor $tki(normCursor)
}
proc _tkiWinPromptAbort { w } {
upvar #0 $w wvars
_tkiWinPromptUnmap $w
}
#
# This updates the global $tki(geometry) variable to the size of the
# specified window.
#
proc _tkiWinGetGeom { w } {
global tki
scan [wm geometry [winfo toplevel $w]] "%dx%d+%s" x y leftover
set tki(geometry) "${x}x$y"
}
#
# returns the indices of the first visible character and the last
# visible character of the text widget $tw. Furthermore, it is
# determined if the first and last lines are wrapped.
#
proc _tkiWinVisibleInfo { tw } {
set topindex [$tw index @0,0]
if {[$tw bbox "$topindex linestart"] == "" } {
set firstiswrapped 1
} else {
set firstiswrapped 0
}
scan [wm geometry [winfo toplevel $tw]] "%dx%d+%s" columns lines leftover
#This is so complicated because of possible wrapping.
set charactergeom [$tw bbox $topindex]
set xmiddlefirst [expr [lindex $charactergeom 0] +2]
set ymiddlefirst [expr [lindex $charactergeom 1] +2]
set characterheight [lindex $charactergeom 3]
set lastindex [$tw index "@${xmiddlefirst},[expr $ymiddlefirst + ($lines - 1) * $characterheight]"]
if {[$tw bbox "$lastindex lineend"] != ""} {
set lastiswrapped 0
set lastonpageindex [$tw index "$lastindex lineend"]
} else {
set lastlineinfo [$tw dlineinfo $lastindex]
if {$lastlineinfo == ""} {
tkiError "Couldn't scan text widget information correctly."
return
}
scan $lastlineinfo "%d %d %d %s" x y width leftover
set lastonpageindex [$tw index "@[expr $x+$width -2],[expr $y+2]"]
set lastiswrapped 1
}
return [list $topindex $lastonpageindex $firstiswrapped $lastiswrapped $columns $lines]
}
#
# Add information about currently displayed node to the end of
# wvars(lastNodes), but only if it is different from
# (oldinfo,oldfileKey). Return the result.
#
proc _tkiLastInfo { w oldinfo oldfileKey} {
upvar #0 $w wvars
set result $wvars(lastNodes)
if { $wvars(noLastInfoUpdate) == 1 } {
set wvars(noLastInfoUpdate) 0
return $result
}
if { $wvars(fileKey) == "" } {
return $result
}
# We don't want doubles
if { $wvars(fileKey) == $oldfileKey && $wvars(nodeinfo) == $oldinfo } {
return $result
}
# Get topline
set topline [$w.main.text index @0,0]
lappend result [list $wvars(fileKey) [lindex $wvars(nodeinfo) 1] $topline $wvars(cursorInfo)]
return $result
}
#
# Return the node in the current node's menu whose label starts with
# $labelstart. We assume that the current node has a menu resp.
# crossreferences. If there are more than one matching node, the first
# currently visible one wins. Case does not matter.
# If xref is 1, look for crossreferences instead.
# Returns "" if nothing can be found.
#
proc _tkiFindRef { w labelstart xref } {
upvar #0 $w wvars
if {$xref == 1} {
set nodeIdx 1
set labelIdx 4
set indexIdx 0
set listvar "xrefinfo"
set type "xref"
} else {
set nodeIdx 2
set labelIdx 5
set indexIdx 1
set listvar "menuinfo"
set type "menu"
}
set labelstart [string tolower $labelstart]
set found ""
foreach mi $wvars($listvar) {
set label [lindex $mi $labelIdx]
set label [string tolower $label]
if { [string first $labelstart $label] == 0 } {
lappend found $mi
}
}
if { $found != "" } {
set tw $w.main.text
set geom [_tkiWinVisibleInfo $tw]
set top [lindex $geom 0]
set bottom [lindex $geom 1]
foreach mi $found {
# Now determine whether this element is currently visible.
if {$xref == 0} {
set currentindex [$w.main.text index "menu.first + [lindex $mi 0] lines - 2 lines"]
} else {
set currentindex [$w.main.text index "1.0 + [lindex $mi 2] c"]
}
if { [$tw compare $currentindex > $bottom] } {
break
} else {
if { [$tw compare $currentindex >= $top] } {
tkiSetCursor $w [list $type [lindex $mi $indexIdx]]
return [lindex $mi $nodeIdx]
}
}
}
# none is visible; return first one.
set entry [lindex $found 0]
tkiSetCursor $w [list $type [lindex $entry $indexIdx]]
return [lindex $entry $nodeIdx]
}
return ""
}
#
# Perform various actions on the info window.
# Note that if the action requires prompting (searching or goto-node)
# then we have to play with the focus. This can badly interact with
# the focus games played when unmapping popup menus, so the "idle"
# option should be used when called from a menu.
# (I don't know what this is about --A.B.)
#
proc _tkiWinAction { w args } {
upvar #0 $w wvars
global tki
set arg0 [lindex $args 0]
set arg1 [lindex $args 1]
_tkiWinPromptUnmap $w
tkiStatusUpdate $w
if {$arg0 != "scroll" && $arg0 != "nextlink"} {
tkiScrollUpdate $w
}
set toNode ""
set toFile $wvars(fileKey)
set toWindow $w
case $arg0 {
idle {
after 1 _tkiWinAction $w [lrange $args 1 end]
return
}
quit {
catch {unset wvars}
catch {destroy $w}
# XXX: !!This is a major hack!!
global tkiEmbed
if { ![info exist tkiEmbed] && [winfo children .] == "" } {
destroy .
}
return
}
goto {
_tkiWinPromptMap $w goto "Go to (FILE) or NODE:" $arg1
return
}
tclcmd {
_tkiWinPromptMap $w tclcmd "Tcl cmd:" $arg1
return
}
search {
case $arg1 {
"forwIncr" {
if {$wvars(inSearch) == 0} {
tkiStatus "No search to continue. Hit `s' to start one." $w 0
} else {
set tki(curWindow) $w
if {[searchboxNext searchkey $w]==-1} {
_tkiSearchFileForw $w $wvars(searchStr) $wvars(searchRegexpB) $wvars(searchCaseB) 1
}
}
}
"backIncr" {
if {$wvars(inSearch) == 0} {
tkiStatus "No search to continue. Hit `r' to start one." $w 0
} else {
set tki(curWindow) $w
if {[searchboxPrev searchkey $w]==-1} {
_tkiSearchFileBackw $w $wvars(searchStr) $wvars(searchRegexpB) $wvars(searchCaseB) 1
}
}
}
"forwRegexp" {
set wvars(searchRegexpB) 1
set wvars(searchBackB) 0
_tkiWinPromptMap $w search "Search:"
}
"forwExact" {
set wvars(searchRegexpB) 0
set wvars(searchBackB) 0
_tkiWinPromptMap $w search "Search:"
}
"backExact" {
set wvars(searchRegexpB) 0
set wvars(searchBackB) 1
_tkiWinPromptMap $w search "Search:"
}
"backRegexp" {
set wvars(searchRegexpB) 1
set wvars(searchBackB) 1
_tkiWinPromptMap $w search "Search:"
}
}
return
}
indexlookup {
_tkiWinPromptMap $w indexlookup "Index lookup (RET jumps to Index):"
return
}
indexnext {
set infoFileKey $tki(infoFileKey-$wvars(fileKey))
if { $wvars(indexInfoFileKey) != $infoFileKey } {
tkiStatus "No index lookup to continue. Hit `i' to start one." $w 0
return
}
set number [expr [llength $wvars(indexEntries)] - $wvars(indexEntriesIndex) - 1]
if { $number < 0 } {
tkiStatus "No more index matches. Hit `i' to start new lookup." $w 0
} else {
set toNode [lindex [lindex $wvars(indexEntries) $wvars(indexEntriesIndex)] 0]
if {[lindex [tkiWinShow $toNode $wvars(fileKey) $w] 0]!=""} {
TextSearch $w.main.text $wvars(indexString) searchkey 0
searchboxNext searchkey $w 0.0
if { $number == 1 } {
tkiStatus "Found \"[lindex [lindex $wvars(indexEntries) $wvars(indexEntriesIndex)] 1]\". Hit `,' for 1 more index match." $w 1
} elseif { $number > 1 } {
tkiStatus "Found \"[lindex [lindex $wvars(indexEntries) $wvars(indexEntriesIndex)] 1]\". Hit `,' for $number more index matches." $w 1
} else {
tkiStatus "Found \"[lindex [lindex $wvars(indexEntries) $wvars(indexEntriesIndex)] 1]\". No more index matches." $w 1
}
}
incr wvars(indexEntriesIndex)
}
return
}
manual {
set tki(curWindow) $w
if {[catch {selection get} manpage] || $manpage == "" } {
set wvars(manB) [expr { $arg1 != "apropos"}]
_tkiWinPromptMap $w manual "Unix manual page:"
} else {
$w conf -cursor $tki(waitCursor)
$w.main.text conf -cursor $tki(waitCursor)
_tkiWinManPage $w $manpage [expr { $arg1 == "apropos"}]
$w conf -cursor $tki(normCursor)
$w.main.text conf -cursor $tki(normCursor)
}
return
}
last {
set idx [expr { [llength $wvars(lastNodes)] - 1 } ]
if { $idx >= 0 } {
set lastinfo [lindex $wvars(lastNodes) $idx]
set toFile [lindex $lastinfo 0]
set toNode [lindex $lastinfo 1]
set topline [lindex $lastinfo 2]
set cursorInfo [lindex $lastinfo 3]
set dummy $wvars(lastNodes)
set wvars(lastNodes) [lreplace $wvars(lastNodes) $idx end]
if { $arg1 == "redirect" } {
set wvars(noLastInfoUpdate) 1
_tkiWinAction $w redirect [list $toNode $toFile]
set wvars(lastNodes) $dummy
return
}
if { $arg1 == "other" } {
set wvars(noLastInfoUpdate) 1
_tkiWinAction $w newwin [list $toNode $toFile]
set wvars(lastNodes) $dummy
return
}
set wvars(noLastInfoUpdate) 1
_tkiJumpTo $w $toNode $toFile $topline $cursorInfo
return
} else {
tkiStatus "Can't go back any further." $w 0
return
}
}
up {
set toNode [lindex $wvars(nodeinfo) 3]
if { $toNode == "" } {
tkiStatus "This node does not specify an \"up\" node." $w 0
return
}
if { $arg1 == "other" } {
set toWindow ""
} else {
if { $arg1 == "redirect" } {
_tkiWinAction $w redirect [list $toNode $toFile]
return
}
}
}
prev {
set toNode [lindex $wvars(nodeinfo) 4]
if { $toNode == "" } {
tkiStatus "No previous section. Hit `\[' for predecessor node." $w 0
return
}
if { $arg1 == "other" } {
set toWindow ""
} else {
if { $arg1 == "redirect" } {
_tkiWinAction $w redirect [list $toNode $toFile]
return
}
}
}
next {
set toNode [lindex $wvars(nodeinfo) 5]
if { $toNode == "" } {
tkiStatus "No next section. Hit `]' for successor node." $w 0
return
}
if { $arg1 == "other" } {
set toWindow ""
} else {
if { $arg1 == "redirect" } {
_tkiWinAction $w redirect [list $toNode $toFile]
return
}
}
}
dir {
if { $arg1 =="" } {
if { [lindex $wvars(nodeinfo) 2] != "dir" } {
set toNode "(dir)"
} else {
tkiStatus "This is already the dir info file." $w 0
return
}
} else {
set toNode "($arg1/dir)"
}
}
otherdir {
set toNode "(dir)"
if { $arg1 == "redirect" } {
_tkiWinAction $w redirect [list $toNode $toFile]
return
} else {
set toWindow ""
}
}
top {
if { $arg1 == "other" } {
set toWindow ""
set toNode "Top"
} else {
if { $arg1 == "redirect" } {
_tkiWinAction $w redirect [list Top $toFile]
return
} elseif { [lindex $wvars(nodeinfo) 1] != "Top" } {
set toNode "Top"
} else {
tkiStatus "This is already the top node." $w 0
return
}
}
}
nextlink {
if { [tkiNextLink $w $arg1] == ""} {
_tkiWinAction $w scroll $arg1
tkiNextLink $w $arg1
} else {
tkiScrollUpdate $w
}
return
}
followlink {
set toNode [tkiCursorLink $w]
if { $toNode == ""} {
return
}
if { $arg1 == "new"} {
set toWindow ""
}
}
othermenu {
if { [info exist wvars(menuinfo)] } {
set menuitem [lindex $wvars(menuinfo) $arg1]
set toNode [lindex $menuitem 2]
if { $toNode != "" } {
tkiSetCursor $w [list menu $arg1]
_tkiWinAction $w newwin [list $toNode $toFile]
return
}
}
}
successor {
if { $arg1 == "forw" } {
set toNode [_tkiLogicalNext $w]
if { $toNode == "" } {
tkiStatus "No logical successor node." $w 0
return
}
} else {
set toNode [_tkiLogicalPrev $w]
if { $toNode == "" } {
tkiStatus "No logical predecessor node." $w 0
return
}
}
}
newwin {
set tw $w.main.text
$tw conf -cursor $tki(waitCursor)
$w conf -cursor $tki(waitCursor)
# Information to be passed to the new window:
_tkiWinGetGeom $tw
set tki(lastDir) $wvars(lastDir)
set tki(promptHistory) $wvars(promptHistory)
if { $arg1 ==""} {
set tki(lastNodes) $wvars(lastNodes)
set tki(history) $wvars(history)
tkiWinShow [lindex $wvars(nodeinfo) 1] $wvars(fileKey)
} else {
set tki(lastNodes) [_tkiLastInfo $w "" ""]
set tki(history) [_tkiWinHistoryAdd $w "" "" 1]
eval tkiWinShow $arg1
}
$tw conf -cursor $tki(normCursor)
$w conf -cursor $tki(normCursor)
return
}
redirect {
set tw $w.main.text
$tw conf -cursor $tki(waitCursor)
$w conf -cursor $tki(waitCursor)
if { $wvars(redirectWindow) == "" || ![winfo exist $wvars(redirectWindow)] } {
# Information to be passed to the new window:
_tkiWinGetGeom $tw
set tki(lastDir) $wvars(lastDir)
set tki(lastNodes) [_tkiLastInfo $w "" ""]
set tki(history) [_tkiWinHistoryAdd $w "" "" 1]
set tki(promptHistory) $wvars(promptHistory)
set wvars(redirectWindow) ""
} else {
# This is necessary if redirect was called from last...
set wvars(noLastInfoUpdate) 0
set tki(lastNodes) ""
set tki(history) ""
set tki(promptHistory) ""
set tki(lastDir) $wvars(lastDir)
}
if { $arg1 == ""} {
set result [tkiWinShow [lindex $wvars(nodeinfo) 1] $wvars(fileKey) $wvars(redirectWindow)]
} else {
set result [eval tkiWinShow $arg1 $wvars(redirectWindow)]
}
set wvars(redirectWindow) [lindex $result 1]
$tw conf -cursor $tki(normCursor)
$w conf -cursor $tki(normCursor)
return
}
transientmenu {
$w.transientmenu post [expr [winfo pointerx $w] +4] [winfo pointery $w]
grab $w.transientmenu
return
}
menu {
if { [info exist wvars(menuinfo)] } {
if { $arg1 =="" } {
set tki(curWindow) $w
_tkiWinPromptMap $w menu "Beginning of Menu entry:"
return
} else {
set menuitem [lindex $wvars(menuinfo) $arg1]
if { $menuitem == "" } {
tkiStatus "No such menu entry." $w 0
return
} else {
set toNode [lindex $menuitem 2]
tkiSetCursor $w [list menu $arg1]
}
}
} else {
tkiStatus "No menu in this node." $w 0
return
}
}
xref {
if { $wvars(xrefinfo) != "" } {
set tki(curWindow) $w
_tkiWinPromptMap $w xref "Beginning of Xref label:"
return
} else {
tkiStatus "No crossreferences in this node." $w 0
return
}
}
scroll {
if { $wvars(scrollForwardHitBottom) == 1 && $arg1 != "forw" } {
set wvars(scrollForwardHitBottom) 0
}
if { $wvars(scrollBackwardHitTop) == 1 && $arg1 != "back" } {
set wvars(scrollBackwardHitTop) 0
}
case $arg1 {
forw { _tkiScroll $w forw; return }
back { _tkiScroll $w back; return }
top { $w.main.text yview moveto 0; return }
bottom { $w.main.text yview moveto 1; return }
lineup { $w.main.text yview scroll 1 units; return }
linedown { $w.main.text yview scroll -1 units; return }
menu {
if [info exist wvars(menuinfo)] {
$w.main.text yview [$w.main.text index "menu.first - 1 lines"]
return
}
}
}
}
}
if { $toNode == "" } {
tkiBell
} else {
if { $toWindow == "" } {
_tkiWinAction $w newwin [list $toNode $toFile]
} else {
tkiWinShow $toNode $toFile $toWindow
}
}
}
proc tkiBell {} {
bell
}
proc tkiInterrupt {} {
global tki
set tki(interrupt) 1
tkiBell
}
#
# Scroll one page down resp. up. If already at end, determine the
# logical successor of the current page and jump there.
#
proc _tkiScroll { w direction } {
global tki; upvar #0 $w wvars
set tki(curWindow) $w
if { $tki(scrollThroughB) } {
if { $direction == "forw"} {
if { $wvars(scrollForwardHitBottom) } {
_tkiWinAction $w successor forw
} else {
if { [$w.main.text dlineinfo "end - 1 lines"] == "" } {
_tkiInsertMarkScroll $w 1
}
if { [$w.main.text dlineinfo "end - 1 lines"] != "" } {
tkiStatus "At end. Hit key again for successor node." $w 0
set wvars(scrollForwardHitBottom) 1
}
}
} else {
if { $wvars(scrollBackwardHitTop) } {
_tkiWinAction $w successor back
} else {
if { [$w.main.text dlineinfo "0.1"] == "" } {
_tkiInsertMarkScroll $w -1
}
if { [$w.main.text dlineinfo "0.1"] != "" } {
tkiStatus "At beginning. Hit key again for predecessor node." $w 0
set wvars(scrollBackwardHitTop) 1
}
}
}
} else {
if { $direction == "forw"} {
if { [$w.main.text dlineinfo "end - 1 lines"] == "" } {
_tkiInsertMarkScroll $w 1
}
if { [$w.main.text dlineinfo "end - 1 lines"] != "" } {
tkiStatus "At end. Hit `]' for successor node." $w 0
}
} else {
if { [$w.main.text dlineinfo "0.1"] == "" } {
_tkiInsertMarkScroll $w -1
}
if { [$w.main.text dlineinfo "0.1"] != "" } {
tkiStatus "At beginning. Hit `\[' for predecessor node." $w 0
}
}
}
}
#
# Scroll the textwindow $w dir pages, inserting the page separator
# correctly.
#
proc _tkiInsertMarkScroll {w dir} {
global tki
if {$tki(pageSepB)} {
upvar #0 $w wvars
set tw $w.main.text
set geom [_tkiWinVisibleInfo $tw]
set topleft [lindex $geom 0]
set bottomright [lindex $geom 1]
set columns [lindex $geom 4]
set insertString ""
for {set idx 1} {$idx <= $columns} {incr idx} {
set insertString "${insertString}_"
}
set ranges [$tw tag ranges separator]
$tw conf -state normal
if {$dir == "1"} {
$tw mark set insertPos "$bottomright + 1 c"
if {$ranges != ""} {
eval $tw delete $ranges
$tw yview scroll -1 units
}
$tw yview scroll 1 pages
$tw insert insertPos "${insertString}\n" separator
} else {
$tw mark set insertPos "$topleft"
if {$ranges != ""} {
eval $tw delete $ranges
$tw yview scroll 1 units
}
$tw yview scroll -1 pages
$tw insert insertPos "${insertString}\n" separator
}
$tw conf -state disabled
} else {
$w.main.text yview scroll $dir pages;
}
}
#
# Highlight the next link. Return "" if no next link on the current page.
# In that case, if the cursor text is not currently visible on the screen,
# remove it everywhere.
#
proc tkiNextLink { w direction } {
set tw $w.main.text
set geom [_tkiWinVisibleInfo $tw]
set top [lindex $geom 0]
set bottom [lindex $geom 1]
set cursorranges [$tw tag ranges cursor]
if { $cursorranges == ""} {
set cursorStart "end"
set cursorEnd "1.0"
} else {
set cursorStart [lindex $cursorranges 0]
set cursorEnd [lindex $cursorranges 1]
}
if { $direction == "forw" } {
if { [$tw compare $top < $cursorEnd] } {
if { [$tw compare $bottom >= $cursorEnd] } {
set start $cursorEnd
} else {
set start $top
}
} else {
set start $top
}
set menu [$tw tag nextrange menukey $start $bottom]
set cross [$tw tag nextrange xrefkey $start $bottom]
if { $menu == "" } {
set link $cross
} elseif { $cross == "" } {
set link $menu
} elseif { [lindex $cross 0] < [lindex $menu 0] } {
set link $cross
} else {
set link $menu
}
} else {
if { [$tw compare $top <= $cursorStart] } {
if { [$tw compare $bottom > $cursorStart] } {
set start $cursorStart
} else {
set start $bottom
}
} else {
set start $bottom
}
set menu [_tkiprevrange $tw menukey $start $top]
set xref [_tkiprevrange $tw xrefkey $start $top]
if { $menu == "" } {
set link $xref
} elseif { $xref == "" } {
set link $menu
} elseif { [lindex $xref 0] > [lindex $menu 0] } {
set link $xref
} else {
set link $menu
}
}
if { $link == "" } {
if { [$tw compare $top > $cursorEnd] || [$tw compare $bottom <= $cursorStart] } {
$tw tag remove cursor $cursorStart $cursorEnd
}
return ""
}
$tw tag remove cursor $cursorStart $cursorEnd
$tw tag add cursor [lindex $link 0] [lindex $link 1]
$tw tag raise cursor
return 1
}
# Return the info node corresponding to the highlighted link
proc tkiCursorLink { w } {
upvar #0 $w wvars
set tw $w.main.text
set cursorranges [$tw tag ranges cursor]
if { $cursorranges == ""} {
return ""
} else {
set cursorStart [lindex $cursorranges 0]
}
set taglist [$tw tag names $cursorStart]
set length [llength $taglist]
set tagindex ""
foreach tag $taglist {
if [regexp {^menu([0-9]+)} $tag dummy tagindex] {
set wvars(cursorInfo) [list "menu" $tagindex]
return [lindex [lindex $wvars(menuinfo) $tagindex] 2]
} elseif [regexp {^xref([0-9]+)} $tag dummy tagindex] {
set wvars(cursorInfo) [list "xref" $tagindex]
return [lindex [lindex $wvars(xrefinfo) $tagindex] 1]
}
}
return ""
}
proc tkiHighlightCursor { w cursorInfo } {
upvar #0 $w wvars
if { $cursorInfo == "" } {
return
}
set tw $w.main.text
set type [lindex $cursorInfo 0]
set index [lindex $cursorInfo 1]
set ranges [$tw tag ranges "${type}key"]
set start [lindex $ranges [expr 2 * $index ]]
set end [lindex $ranges [expr 1+ 2 * $index ]]
set cursorranges [$tw tag ranges cursor]
if { $cursorranges != "" } {
eval $tw tag remove cursor $cursorranges
}
$tw tag add cursor $start $end
$tw tag raise cursor
}
proc tkiSetCursor { w cursorInfo } {
upvar #0 $w wvars
tkiHighlightCursor $w $cursorInfo
set wvars(cursorInfo) $cursorInfo
}
# Find the logical successor of the node displayed in window w.
proc _tkiLogicalNext { w } {
global tki; upvar #0 $w wvars
if { [info exist wvars(menuinfo)]
&& ![string match "*Index" [lindex $wvars(nodeinfo) 1]] } {
return [lindex [lindex $wvars(menuinfo) 0] 2 ]
} else {
set next [lindex $wvars(nodeinfo) 5]
set up [lindex $wvars(nodeinfo) 3]
if { $next != "" && $next != $up } {
return $next
} else {
while { $up != "" } {
set upNodeRef [tkiGetNodeRef $up $wvars(fileKey) "" $wvars(lastDir)]
set upNodeInfo [lindex $tki(nodesinfo-[lindex $upNodeRef 1]) [lindex $upNodeRef 0]]
set upNext [lindex $upNodeInfo 5]
if { $upNext != ""} {
return $upNext
} else {
set up [lindex $upNodeInfo 3]
}
}
return ""
}
}
}
# Find the logical predecessor of the node displayed in window w.
proc _tkiLogicalPrev { w } {
global tki; upvar #0 $w wvars
set prev [lindex $wvars(nodeinfo) 4]
set up [lindex $wvars(nodeinfo) 3]
if { $prev == "" && $up == "" } {
return ""
}
if { $prev == "" || $prev == $up } {
return $up
}
set node $prev
set fileKey $wvars(fileKey)
while 1 {
set nodeRef [tkiGetNodeRef $node $fileKey "" $wvars(lastDir)]
set nodeIdx [lindex $nodeRef 0]
set fileKey [lindex $nodeRef 1]
if { ![info exist tki(menuinfo-$fileKey-$nodeIdx) ] } {
return $node
}
set nodeMenu $tki(menuinfo-$fileKey-$nodeIdx)
set lastEntry [lindex $nodeMenu end]
set node [lindex $lastEntry 2]
}
}
#
# Utility function for turning the "-acc" options from
# menus into actual bindings.
# Traverse {menu}, and install accelerators onto {winSpec}.
# {winSpec} may be a list of windows. {menu} may be a menu, a
# menu button, or a frame containing menu buttons.
# Accelerator sequences may be any sequence of "normal" characters,
# or a normal char prefixed by "^" for Control.
# This code is cut&pasted from "tkgraph/lib/topwin.tcl topWin.BindAccels()".
#
proc _tkiBindAccels { winSpec menu } {
switch [winfo class $menu] {
Frame {
foreach submenu [winfo children $menu] {
_tkiBindAccels $winSpec $submenu
}
}
Menubutton {
_tkiBindAccels $winSpec [lindex [$menu conf -menu] 4]
}
Menu {
set lastIdx [$menu index last]
if { $lastIdx == "none" } { return }
for {set idx 0} {$idx <= $lastIdx} {incr idx} {
if [catch {$menu entryconf $idx -acc} acc] continue
set acc [lindex $acc 4]
if { $acc != "" && $acc != "==>" } {
regsub -all "\\^(.)" $acc "<Control-\\1>" acc
regsub -all "<(.)>" $acc "<Key-\\1>" acc
foreach win $winSpec {
bind $win $acc "[$menu entrycget $idx -command] ;break"
}
}
if { ! [catch {$menu entryconf $idx -menu} submenu] } {
set submenu [lindex $submenu 4]
if { $submenu != "" } {
_tkiBindAccels $winSpec $submenu
}
}
}
}
}
}
proc _tkiWinBind { w } {
global tki tkiEmbed;
set tw $w.main.text
_tkiBindAccels "$w.main.text" $w.bar
foreach win "$w.main.text" {
# Caution: Don't bind the keysyms SunPageDown and SunFind: it will
# break on Win95.
bind $win <Key-Help> {tkiWinShow {(builtin)Quick Help} {} {Docs}
break}
bind $win <Key-F1> {tkiWinShow {(builtin)Quick Help} {} {Docs}
break}
bind $win <Key-1> "_tkiWinAction $w menu 0"
bind $win <Key-2> "_tkiWinAction $w menu 1"
bind $win <Key-3> "_tkiWinAction $w menu 2"
bind $win <Key-4> "_tkiWinAction $w menu 3"
bind $win <Key-5> "_tkiWinAction $w menu 4"
bind $win <Key-6> "_tkiWinAction $w menu 5"
bind $win <Key-7> "_tkiWinAction $w menu 6"
bind $win <Key-8> "_tkiWinAction $w menu 7"
bind $win <Key-9> "_tkiWinAction $w menu 8"
bind $win <Control-Key-1> "_tkiWinAction $w othermenu 0;break"
bind $win <Control-Key-2> "_tkiWinAction $w othermenu 1;break"
bind $win <Control-Key-3> "_tkiWinAction $w othermenu 2;break"
bind $win <Control-Key-4> "_tkiWinAction $w othermenu 3;break"
bind $win <Control-Key-5> "_tkiWinAction $w othermenu 4;break"
bind $win <Control-Key-6> "_tkiWinAction $w othermenu 5;break"
bind $win <Control-Key-7> "_tkiWinAction $w othermenu 6;break"
bind $win <Control-Key-8> "_tkiWinAction $w othermenu 7;break"
bind $win <Control-Key-9> "_tkiWinAction $w othermenu 8;break"
bind $win <Key-space> "_tkiWinAction $w scroll forw"
bind $win <Control-Key-f> "_tkiWinAction $w scroll forw"
bind $win \} "_tkiWinAction $w scroll forw"
bind $win <Control-Key-d> "return"
bind $win <Control-Key-v> "_tkiWinAction $w scroll forw
break"
bind $win <Key-Next> "_tkiWinAction $w scroll forw
break"
# PgDn on Sun Keypads:
bind $win <Key-F35> "_tkiWinAction $w scroll forw"
bind $win <Key-Delete> "_tkiWinAction $w scroll back
break"
bind $win <Key-Prior> "_tkiWinAction $w scroll back
break"
bind $win <Key-BackSpace> "_tkiWinAction $w scroll back
break"
bind $win <Control-Key-b> "_tkiWinAction $w scroll back"
bind $win <Alt-Key-v> "_tkiWinAction $w scroll back"
bind $win \{ "_tkiWinAction $w scroll back"
bind $win <Meta-Key-v> "_tkiWinAction $w scroll back"
bind $win "<Key-Escape> v" "_tkiWinAction $w scroll back"
# PgUp on Sun Keypads:
bind $win <Key-F29> "_tkiWinAction $w scroll back"
bind $win <Key-less> "_tkiWinAction $w scroll top"
bind $win <Key-b> "_tkiWinAction $w scroll top"
bind $win <Key-Home> "_tkiWinAction $w scroll top
break"
# Home on Sun Keypads:
bind $win <Key-F27> "_tkiWinAction $w scroll top
break"
bind $win <Key-End> "_tkiWinAction $w scroll bottom
break"
# End on Sun Keypads:
bind $win <Key-F33> "_tkiWinAction $w scroll bottom
break"
bind $win <Key-greater> "_tkiWinAction $w scroll bottom"
bind $win <Key-G> "_tkiWinAction $w scroll bottom"
bind $win <Key-e> "_tkiWinAction $w scroll bottom"
bind $win <Control-Key-m> "_tkiWinAction $w scroll menu"
bind $win <Key-j> "_tkiWinAction $w scroll lineup"
bind $win <Key-Down> "_tkiWinAction $w scroll lineup
break"
bind $win <Key-Right> "_tkiWinAction $w scroll lineup
break"
bind $win <Control-Key-n> "_tkiWinAction $w scroll lineup
break"
bind $win <Key-k> "_tkiWinAction $w scroll linedown"
bind $win <Control-Key-p> "_tkiWinAction $w scroll linedown
break"
bind $win <Key-Up> "_tkiWinAction $w scroll linedown
break"
bind $win <Key-Left> "_tkiWinAction $w scroll linedown
break"
bind $win <Alt-Key-Left> "_tkiWinAction $w last; break"
bind $win <Meta-Key-Left> "_tkiWinAction $w last; break"
bind $win <Key-C> "_tkiWinAction $w quit; break"
if { ![info exists tkiEmbed] } {
bind $win <Key-Q> "exit"
}
bind $win <Key-Tab> "_tkiWinAction $w nextlink forw;break"
bind $win <Control-Key-Tab> "_tkiWinAction $w nextlink back;break"
bind $win <Shift-Key-Tab> "_tkiWinAction $w nextlink back;break"
bind $win <Meta-Key-Tab> "_tkiWinAction $w nextlink back;break"
bind $win <Alt-Key-Tab> "_tkiWinAction $w nextlink back;break"
bind $win ( "_tkiWinAction $w goto ("
bind $win <Key-Return> "_tkiWinAction $w followlink; break"
bind $win <Key-KP_Enter> "_tkiWinAction $w followlink; break"
bind $win <Control-Key-Return> "_tkiWinAction $w followlink new;break"
bind $win <Control-Key-KP_Enter> "_tkiWinAction $w followlink new;break"
bind $win <Control-Key-c> "tkiInterrupt"
bind $win <Control-Key-g> "tkiInterrupt"
bind $win <Button-3> "_tkiButton3 $w; break"
bind $win <Button-2> "_tkiButton2 $w"
bind $win <ButtonRelease-2> "_tkiButtonRelease2main $w"
# This is really ugly but I don't know how else to prohibit
# the key "Alt-f" (used to access the menu bar) from executing
# the script associated with "f" -- A.B.
bind $win <Control-Key-l> "return"
bind $win <Alt-F1> "return"
bind $win <Meta-F1> "return"
bind $win <Alt-f> "return"
bind $win <Meta-f> "return"
bind $win <Alt-d> "return"
bind $win <Meta-d> "return"
bind $win <Alt-n> "return"
bind $win <Meta-n> "return"
bind $win <Alt-s> "return"
bind $win <Meta-s> "return"
bind $win <Alt-o> "return"
bind $win <Meta-o> "return"
bind $win <Alt-h> "return"
bind $win <Meta-h> "return"
bind $win <Alt-p> "return"
bind $win <Meta-p> "return"
}
focus $w.main.text
}
#
# Functions to be bound to mouse events
#
proc _tkiButton2 {w} {
global tki; upvar #0 $w wvars
if { [$w.main.text cget -cursor] == $tki(normCursor) } {
$w.main.text configure -cursor $tki(handCursor)
}
if { $wvars(scrollForwardHitBottom) } {
set wvars(scrollForwardHitBottom) 0
}
if { $wvars(scrollBackwardHitTop) } {
set wvars(scrollBackwardHitTop) 0
}
}
proc _tkiButton3 {w} {
global tki
if {$tki(breakBindings) == 0} {
_tkiWinAction $w transientmenu
}
set tki(breakBindings) 0
}
proc _tkiButtonRelease2main {w} {
global tki
tkiStatusUpdate $w
tkiScrollUpdate $w
if { [$w.main.text cget -cursor] == $tki(handCursor) } {
$w.main.text configure -cursor $tki(normCursor)
}
}
proc _tkiLeaveLink {tw} {
global tki
if { [$tw cget -cursor] == $tki(linkCursor) } {
$tw configure -cursor $tki(normCursor)
}
}
proc _tkiButtonRelease2 {w y idx toNode fileKey type} {
global tki
if {abs($y - $tki(y)) < 7} {
tkiSetCursor $w [list $type $idx]
_tkiWinAction $w newwin [list $toNode $fileKey]
}
}
proc _tkiShiftButtonRelease1 {w idx toNode fileKey type} {
tkiSetCursor $w [list $type $idx]
_tkiWinAction $w newwin [list $toNode $fileKey]
}
proc _tkiButtonRelease3 {w idx toNode fileKey type} {
tkiSetCursor $w [list $type $idx]
_tkiWinAction $w redirect [list $toNode $fileKey]
}
proc _tkiButtonRelease1 {w x y idx toNode fileKey type} {
global tki
if {abs($x - $tki(x)) + abs($y - $tki(y)) < 8} {
tkiSetCursor $w [list $type $idx]
tkiWinShow $toNode $fileKey $w
}
}
# Bind to mouse events for the action buttons. This removes the use of
# and dependency on internal Tk procedure names like tkButtonDown
# (before tk8.4) or tk::ButtonDown (starting with tk8.4).
proc _tkiBindToButton {w b op {op2 ""} {op3 ""}} {
if {$op3 == ""} {
set op3 "$op redirect"
}
if {$op2 == ""} {
set op2 "$op other"
}
set press [bind Button <Button-1>]
set release [bind Button <ButtonRelease-1>]
bind $b <Button-1> "$press; break"
bind $b <ButtonRelease-1> "$release; _tkiWinAction $w $op;break"
bind $b <Button-2> "$press; break"
bind $b <ButtonRelease-2> "$release; _tkiWinAction $w $op2; break"
bind $b <Shift-Button-1> "$press; break"
bind $b <Shift-ButtonRelease-1> "$release; _tkiWinAction $w $op2; break"
bind $b <Control-Button-1> "$press; break"
bind $b <Control-ButtonRelease-1> "$release; _tkiWinAction $w $op2; break"
bind $b <Button-3> "$press; break"
bind $b <ButtonRelease-3> "$release; _tkiWinAction $w $op3; break"
}
#
# Make a new toplevel info window (with class ``TkInfo''),
# filled with buttons and bindings.
#
# If the argument {w} is non-empty, it specifies either the path name
# of the info window to create (if {w} doesn't already exist),
# or the parent of the info window to create (if {w} does already exist).
# It is an error for both {w} and {w}'s parent to not exist.
# If {w} is empty, the info window will be created as a child of the
# root window.
#
# If given, {tag} is some text that will appear in the window title and
# icon title.
#
# The path name of the new info window will be returned.
#
proc tkiWinCreate { {w ""} {tag ""} } {
global tki balloonHelp tk_version tkiEmbed
if { $w == "" || [winfo exist $w] } {
if { $w != "" && [winfo class $w] == "TkInfo" } {
# This check isn't strictly required, but it helps catch
# problems with Tk's multi-phase window destruction process.
error "Can't nest TkInfo windows."
}
set parent $w
while 1 {
# I think (but I dont really remember) that I use [winfo parent]
# here instead of [winfo exist] b/c multi-phase destroy.
set w $parent.tki[tkiGetSN]
if { [catch {winfo parent $w}] } break
}
}
lappend tki(windows) $w
upvar #0 $w wvars
set wvars(nodeinfo) ""
set wvars(nodeSpec) ""
set wvars(fileKey) ""
set wvars(infonodename) "(builtin)Top"
set wvars(lastDir) $tki(lastDir)
set wvars(gotoStr) ""
set wvars(promptmode) ""
set wvars(searchStr) ""
set wvars(statusPermanent) 0
set wvars(oldStatus) ""
set wvars(indexInfoFileKey) ""
set wvars(noLastInfoUpdate) 0
set wvars(redirectWindow) ""
set wvars(searchOriginFileKey) ""
set wvars(searchOriginNodeIdx) ""
set wvars(promptHistory) $tki(promptHistory)
set wvars(lastNodes) $tki(lastNodes)
set wvars(history) $tki(history)
set wvars(title) [expr {( $tag == "") ? "tkInfo" : "tkInfo:$tag"}]
toplevel $w -class TkInfo
wm title $w $wvars(title)
wm iconname $w $wvars(title)
wm protocol $w WM_DELETE_WINDOW "_tkiWinAction $w quit"
# iconbitmap only accepts xbm files, but xman.xpm is a pixmap.
# wm iconbitmap $w "@xman.xpm"
set dd $w.bar; pack [frame $dd -borderwidth 2 -relief raised] \
-side top -fill x
set ddm $dd.file.m
pack [menubutton $dd.file -text "File" -und 0 -menu $ddm] -side left
# tk4.0 doesn't know tear-off menus:
if {$tk_version > 4.0} {
if {$tk_version < 8} {
menu $ddm -tearoffcommand "_tkiMenuTearOff $w"
} else {
menu $ddm
}
} else {
menu $ddm -tearoff 0
}
$ddm add com -lab "Directory" -und 0 -acc d -command "_tkiWinAction $w dir"
$ddm add com -lab "Go to File/Node... " -und 0 -acc g -command "_tkiWinAction $w goto"
$ddm add com -lab "New Window " -und 0 -acc N -command "_tkiWinAction $w newwin"
$ddm add com -lab "Man Page..." -und 0 -acc M -command "_tkiWinAction $w manual"
$ddm add com -lab "Apropos..." -und 0 -acc A -command "_tkiWinAction $w manual apropos"
$ddm add com -lab "Tcl Cmd..." -und 0 -acc ! -command "_tkiWinAction $w tclcmd"
$ddm add sep
$ddm add com -lab "Close Window" -und 0 -acc c -command "_tkiWinAction $w quit"
if { ![info exists tkiEmbed] } {
$ddm add com -lab "Quit TkInfo" -und 0 -acc q -command "exit"
}
if { [llength $tki(dirs)] > 1 } {
set ddd $dd.dirs.m
pack [menubutton $dd.dirs -text "Directories" -und 0 -menu $ddd] -side left
menu $ddd
foreach pp $tki(dirs) {
$ddd add com -label " $pp" \
-command [list _tkiWinAction $w dir $pp]
}
}
set ddm $dd.node.m
pack [menubutton $dd.node -text "Node" -und 0 -menu $ddm] -side left
if {$tk_version > 4.0} {
if {$tk_version < 8} {
menu $ddm -tearoffcommand "_tkiMenuTearOff $w"
} else {
menu $ddm
}
} else {
menu $ddm -tearoff 0
}
$ddm add com -lab "Next Section" -und 0 -acc n -command "_tkiWinAction $w next"
$ddm add com -lab "Previous Section " -und 0 -acc p -command "_tkiWinAction $w prev"
$ddm add com -lab "Up" -und 0 -acc u -command "_tkiWinAction $w up"
$ddm add com -lab "Back to Last" -und 8 -acc l -command "_tkiWinAction $w last"
$ddm add com -lab "Successor" -und 0 -acc \] -command "_tkiWinAction $w successor forw"
$ddm add com -lab "Predecessor" -und 1 -acc \[ -command "_tkiWinAction $w successor back"
$ddm add com -lab "Top" -und 0 -acc t -command "_tkiWinAction $w top"
$ddm add com -lab "Menu entry..." -und 0 -acc m -command "_tkiWinAction $w menu"
$ddm add com -lab "Crossreference... " -und 7 -acc f -command "_tkiWinAction $w xref"
set ddm $dd.search.m
pack [menubutton $dd.search -text "Search" -und 0 -menu $ddm] -side left
if {$tk_version > 4.0} {
if {$tk_version < 8} {
menu $ddm -tearoffcommand "_tkiMenuTearOff $w"
} else {
menu $ddm
}
} else {
menu $ddm -tearoff 0
}
$ddm add com -lab "Index lookup (substring)... " -und 0 -acc i \
-command "_tkiWinAction $w indexlookup"
$ddm add com -lab "Continue index lookup" -acc , \
-command "_tkiWinAction $w indexnext"
$ddm add com -lab "Exact forward search... " -und 0 -acc s \
-command "_tkiWinAction $w search forwExact"
$ddm add com -lab "Regexp forward search... " -und 0 -acc / \
-command "_tkiWinAction $w search forwRegexp"
$ddm add com -lab "Continue forward search" -und 0 -acc ^s \
-command "_tkiWinAction $w search forwIncr"
$ddm add com -lab "Exact backward search... " -und 6 -acc r \
-command "_tkiWinAction $w search backExact"
$ddm add com -lab "Regexp backward search... " -und 8 -acc "\\" \
-command "_tkiWinAction $w search backRegexp"
$ddm add com -lab "Continue backward search" -acc ^r \
-command "_tkiWinAction $w search backIncr"
set ddm $dd.history.m
pack [menubutton $dd.history -text "History" -und 0 -menu $ddm] -side left
if {$tk_version > 4.0} {
if {$tk_version < 8} {
menu $ddm -tearoffcommand "_tkiMenuTearOff $w"
} else {
menu $ddm
}
} else {
menu $ddm -tearoff 0
}
set wvars(historyMenus) [list $ddm]
_tkiCreateHistory $w $wvars(history)
set ddm $dd.options.m
pack [menubutton $dd.options -text "Options" -und 0 -menu $ddm] -side left
menu $ddm -disabledforeground [ $dd.search.m cget -foreground ]
if {$tk_version > 4.0} {
if {$tk_version < 8} {
$ddm conf -tearoffcommand "_tkiMenuTearOff $w"
}
} else {
$ddm conf -tearoff 0
}
$ddm add check -lab "Show info headers" -und 10 -var tki(rawHeadersB)
$ddm add check -lab "Show buttons" -und 5 -var tki(showButtonsB)
$ddm add check -lab "Balloon help" -und 4 -var tki(showBalloonsB)
$ddm add check -lab "Scroll at bottom goes to successor" -und 4 -var tki(scrollThroughB)
$ddm add check -lab "Scrolling inserts page separators" -und 5 -var tki(pageSepB)
$ddm add check -lab "Show directory of node" -und 5 -var tki(showDirB)
$ddm add check -lab "Time Status" -und 0 -var tki(timestatusB)
$ddm add sep
$ddm add com -lab "Link Highlighting:" -state disabled
$ddm add radio -lab "Color" -und 0 -var tki(linklook) -val color
$ddm add radio -lab "Font" -und 0 -var tki(linklook) -val font
$ddm add radio -lab "Underline" -und 0 -var tki(linklook) -val underline
set ddm $dd.help.m
# We use -after so that the Help menu doesn't disappear when window
# is shrunk:
pack [menubutton $dd.help -text "Help" -und 3 -menu $ddm] -side right -after $dd.file
if {$tk_version > 4.0} {
if {$tk_version < 8} {
menu $ddm -tearoffcommand "_tkiMenuTearOff $w"
} else {
menu $ddm
}
} else {
menu $ddm -tearoff 0
}
$ddm add com -lab "Quick Help" -und 0 -acc ? \
-command [list tkiWinShow {(builtin)Quick Help} {} {Docs}]
$ddm add com -lab "Documentation " -und 0 -acc h \
-command [list tkiWinShow {(builtin)Top} {} {Docs}]
$ddm add sep
$ddm add com -lab "About tkInfo" -und 0 \
-command [list tkiWinShow {(builtin)About} {} {Docs}]
# We want to be able to access the menubar with Meta as well as with Alt:
bind $w <Meta-Key> [bind all <Alt-Key>]
# The transient menu that appears when Button-3 is pressed:
set wtm $w.transientmenu
menu $wtm -tearoff 0
# This appears to be necessary to circumvent a bug in Tk4.0.
# Let's hope that it doesn't break anything else... (A.B.)
if {$tk_version == 4.0} {
global tkPriv
set tkPriv(oldGrab) ""
}
bind $wtm <Unmap> "focus -force $w.main.text"
bind $wtm <Button-1> "break"
bind $wtm <Button-2> "break"
$wtm add com -lab "Logical Successor" -acc \] -command "_tkiWinAction $w successor forw"
# $wtm add com -lab "Logical Predecessor" -command "_tkiWinAction $w successor back"
$wtm add com -lab "Back to Last Node " -acc l -command "_tkiWinAction $w last"
$wtm add com -lab "Next Section" -acc n -command "_tkiWinAction $w next"
# $wtm add com -lab "Previous Section" -acc p -command "_tkiWinAction $w prev"
$wtm add com -lab "Up" -acc u -command "_tkiWinAction $w up"
$wtm add com -lab "Index Lookup" -acc i -command "_tkiWinAction $w indexlookup"
$wtm add com -lab "New Window" -acc N -command "_tkiWinAction $w newwin"
set dd $w.main
pack [frame $dd] -expand 1 -fill both
pack [scrollbar $dd.vsb -orient vert -command "$dd.text yview"] \
-side right -fill both
pack [text $dd.text -state disabled -setgrid 1 -width 80 -wrap word] \
-side left -expand 1 -fill both
$dd.text conf -yscroll "$dd.vsb set"
bind $dd.vsb <Any-Button> "tkiStatusUpdate $w; tkiScrollUpdate $w"
# We use "-after $w.bar" here so that the status line won't disappear
# upon resizing of the window:
set dd $w.s
pack [frame $dd] -after $w.bar -side bottom -fill x
pack [label $dd.filename -text " " -rel sunken -padx 5 -pady 3] -side left
pack [label $dd.status -anc w -rel sunken -padx 5 -pady 3 -width 8] \
-side left -fill x -expand 1
entry $dd.input -width 7 -rel sunken
checkbutton $dd.regexp -width 8 -text "Regexp" -var ${w}(searchRegexpB)
checkbutton $dd.case -width 8 -text "Case Sen" -var ${w}(searchCaseB)
checkbutton $dd.back -width 8 -text "Backward" -var ${w}(searchBackB)
radiobutton $dd.man -width 8 -text "Man page" -var ${w}(manB) -value 1
radiobutton $dd.apropos -width 8 -text "Apropos" -var ${w}(manB) -value 0
bind $dd.input <Return> "_tkiWinPromptOk $w"
bind $dd.input <Escape> "_tkiWinPromptAbort $w"
bind $dd.input <Any-Control-g> "_tkiWinPromptAbort $w"
bind $dd.input <Control-u> "$dd.input delete 0 end"
bind $dd.input <Key-Up> "_tkiWinPromptScroll $w up"
bind $dd.input <Meta-Key-p> "_tkiWinPromptScroll $w up; break"
bind $dd.input <Alt-Key-p> "_tkiWinPromptScroll $w up; break"
bind $dd.input <Control-Key-p> "_tkiWinPromptScroll $w up; break"
bind $dd.input <Key-Down> "_tkiWinPromptScroll $w down"
bind $dd.input <Control-Key-n> "_tkiWinPromptScroll $w down; break"
bind $dd.input <Meta-Key-n> "_tkiWinPromptScroll $w down; break"
bind $dd.input <Alt-Key-n> "_tkiWinPromptScroll $w down; break"
set dd $w.buts; frame $dd
if { $tki(showButtonsB) } { pack $dd -after $w.s -side top -fill x }
pack [button $dd.next -width 2 -text "Next"] \
-side left -expand 1 -fill both
bindtags $dd.next [list balloon $dd.next Button all]
_tkiBindToButton $w $dd.next next
pack [button $dd.prev -width 2 -text "Previous"] \
-side left -expand 1 -fill both
bindtags $dd.prev [list balloon $dd.prev Button all]
_tkiBindToButton $w $dd.prev prev
pack [button $dd.up -width 2 -text "Up"] \
-side left -expand 1 -fill both
bindtags $dd.up [list balloon $dd.up Button all]
_tkiBindToButton $w $dd.up up
pack [button $dd.last -width 2 -text "Last"] \
-side left -expand 1 -fill both
bindtags $dd.last [list balloon $dd.last Button all]
_tkiBindToButton $w $dd.last last
pack [button $dd.top -width 2 -text "Top"] \
-side left -expand 1 -fill both
bindtags $dd.top [list balloon $dd.top Button all]
set balloonHelp($dd.top) "Go to this info file's
topmost info node which
has the table of contents."
_tkiBindToButton $w $dd.top top
pack [button $dd.dir -width 2 -text "Dir"] \
-side left -expand 1 -fill both
bindtags $dd.dir [list balloon $dd.dir Button all]
set balloonHelp($dd.dir) "Go to directory
node which lists
all info files."
_tkiBindToButton $w $dd.dir dir otherdir "otherdir redirect"
_tkiWinBind $w
#frame $w.main.text.sep -borderwidth 1 -relief sunken -width 150 -height 2
# Fix display styles for search matches and highlighted links.
set tw $w.main.text
case $tki(searchlook) {
inverse {
$tw tag conf searchkey -foreground [lindex [$tw conf -background] 4] \
-background [lindex [$tw conf -foreground] 4]
}
color {
$tw tag conf searchkey -foreground $tki(searchColor)
}
font {
$tw tag conf searchkey -font $tki(searchFont)
}
}
case $tki(highlight) {
inverse {
if { $tki(linklook) == "color" } {
$tw tag conf cursor \
-foreground [lindex [$tw conf -background] 4] \
-background $tki(linklookColor)
} else {
$tw tag conf cursor \
-foreground [lindex [$tw conf -background] 4] \
-background [lindex [$tw conf -foreground] 4]
}
}
color {
$tw tag conf cursor -foreground $tki(highlightColor)
}
font {
$tw tag conf cursor -font $tki(highlightFont)
}
}
set tki(curWindow) $w
wm geometry $w $tki(geometry)
if { $tki(iconic) == 1 } {
wm iconify $w; set tki(iconic) 0
}
return $w
}
#
# What to do if a menu is torn off; this is not used under Tk8.0 since
# torn-off menus under Tk8.0 are synchronized automatically.
#
proc _tkiMenuTearOff {w menu tornMenu} {
case $menu {
"*.history.m" {
upvar #0 $w wvars
lappend wvars(historyMenus) $tornMenu
}
default {
# no entry of a torn off menu should be disabled.
set numentries [$tornMenu index end]
for {set idx 0} {$idx <= $numentries} {incr idx} {
if {[$tornMenu type $idx] == "command"} {
$tornMenu entryconf $idx -state normal
}
}
}
}
$tornMenu add separator
$tornMenu add command -label "Close Menu" -command "destroy $tornMenu"
}
##############################################################################
#
# Utility functions for updating info windows
#
##############################################################################
#
# Removes all empty lines in window $w starting at index $idx.
# This is more subtle than one might think. Note that the text index
# "+1line" wont work on the last line of text, because the newline is
# considered part of the previous line. Thus we use "lineend" instead.
#
proc _tkiTextTrim { w idx } {
while 1 {
set nidx [$w index "$idx lineend"]
if { [string trim [$w get $idx $nidx]] != "" || [$w index end] == "1.0" } break
$w delete $idx "$nidx +1char"
}
}
# Modified version of ouster's version
proc _tkiTextInsertWithTags { w index text args } {
set start [$w index $index]
$w insert $start $text
foreach tag $args {
$w tag add $tag $start insert
}
}
proc _tkiLinkLookTag { tw tag } {
global tki
case $tki(linklook) {
color { $tw tag conf $tag -fore $tki(linklookColor) }
underline { $tw tag conf $tag -underline 1 }
font { $tw tag conf $tag -font $tki(linklookFont) }
}
$tw tag bind $tag <Enter> [list $tw configure -cursor $tki(linkCursor)]
$tw tag bind $tag <Leave> "_tkiLeaveLink $tw"
}
#
# Add info about the currently displayed node to the window's history
# list wvars(history) and to the History menu. Return the new history
# list, but don't change wvars(history). If noadd == 1, then don't
# change the History menu either. Don't do anything if the currently
# displayed node is (oldinfo,oldfileKey).
#
proc _tkiWinHistoryAdd { w oldinfo oldfileKey {noadd 0}} {
global tki; upvar #0 $w wvars
set fileKey $wvars(fileKey)
if { $fileKey == "" } {
return $wvars(history)
}
set nodeinfo $wvars(nodeinfo)
if { $fileKey == $oldfileKey && $nodeinfo == $oldinfo } {
return $wvars(history)
}
set topline [$w.main.text index @0,0]
set cursorInfo $wvars(cursorInfo)
set node [lindex $nodeinfo 1]
set result [linsert $wvars(history) 0 \
[list $wvars(nodeSpec) $node $fileKey $topline $cursorInfo]]
# Remove doubles:
for {set idx 1} {$idx < [llength $result]} {incr idx} {
set entry [lindex $result $idx]
if {[lindex $entry 1] == $node && [lindex $entry 2] == $fileKey} {
set result [lreplace $result $idx $idx]
break
}
}
# Cut history list down to appropriate length:
if {[llength $result] > $tki(historyLength)} {
set result [lreplace $result end end]
}
if { $noadd == 0 } {
_tkiCreateHistory $w $result
}
return $result
}
#
# Make a new menu $w.history.m from $list
#
proc _tkiCreateHistory { w list } {
upvar #0 $w wvars
foreach hm $wvars(historyMenus) {
if {![winfo exist $hm]} {continue}
set end [$hm index end]
# Is the menu transient or torn off?
if { [$hm cget -tearoff] } {
set startidx 1
} else {
set startidx 0
}
if { [$hm type end] == "command" && [$hm entrycget end -label] == "Close Menu"} {
set endidx [expr $end - 2]
} else {
set endidx $end
}
$hm del $startidx $endidx
set menuidx [expr $startidx - 1]
set idx 0
foreach entry $list {
incr idx
incr menuidx
set nodespec [lindex $entry 0]
set node [lindex $entry 1]
set fileKey [lindex $entry 2]
set topline [lindex $entry 3]
set cursorInfo [lindex $entry 4]
if { $idx < 36 } {
if { $idx < 10 } {
set label $idx
} else {
set label [format "%c" [expr $idx + 55]]
}
$hm insert $menuidx command -label "$label $nodespec" -und 0 \
-command [list _tkiJumpTo $w $node $fileKey $topline $cursorInfo]
} else {
$hm add command -label " $nodespec" \
-command [list _tkiJumpTo $w $node $fileKey $topline $cursorInfo]
}
}
}
}
#
# Jump to the specified node, to the specified line, and restore the
# specified cursorInfo
#
proc _tkiJumpTo { w node fileKey topline cursorInfo } {
tkiWinShow $node $fileKey $w
$w.main.text yview $topline
tkiHighlightCursor $w $cursorInfo
}
proc tkiWinDpy { w fileKey info body } {
global tki balloonHelp; upvar #0 $w wvars
#add info about last node to history list:
set wvars(history) [_tkiWinHistoryAdd $w $info $fileKey]
#add info about last node to wvars(lastNodes)
set wvars(lastNodes) [_tkiLastInfo $w $info $fileKey]
set wvars(fileKey) $fileKey
set wvars(nodeinfo) $info
set wvars(lastDir) [file dirname [lindex $tki(fileinfo-$fileKey) 2]]
if { $tki(showDirB) == "1" ||
( [llength $tki(dirs)] > 1 && [lindex $info 2] == "dir" )} {
set dir $wvars(lastDir)
if { $dir == "." } {
set dir ""
} else {
set dir "${dir}/"
}
} else {
set dir ""
}
set filename [lindex $info 2]
# Now strip the suffix:
foreach suffix $tki(infoSuffix) {
if {$suffix != ""} {
set idx [string last $suffix $filename]
if { $idx != -1 } {
if { [string length $filename] - $idx == [string length $suffix]} {
set filename [string range $filename 0 [expr $idx - 1]]
break
}
}
}
}
set wvars(nodeSpec) "(${dir}$filename)[lindex $info 1]"
set wvars(scrollForwardHitBottom) 0
set wvars(scrollBackwardHitTop) 0
set wvars(inSearch) 0
set wvars(cursorInfo) ""
set nodeIdx [lindex $info 0]
set nodeName [lindex $info 1]
tkiStatus "Formatting $wvars(nodeSpec)..." $w 0
set tw $w.main.text
# $tw conf -cursor $tki(waitCursor)
# $w conf -cursor $tki(waitCursor)
set menuidx -1
set menuidx [string first "\n* Menu:" $body]
if { $menuidx > 0 } {
set menutext [string range $body [expr {$menuidx+1}] end]
set beforemenu [string range $body 0 $menuidx]
}
$tw conf -state normal
$tw delete 1.0 end
#
# Insert the body text and add the crossref tags
#
if { $menuidx > 0 } {
$tw insert end $beforemenu
_tkiTextInsertWithTags $tw end $menutext menu
} else {
$tw insert end $body
}
if { [info exist tki(xrefinfo-$fileKey-$nodeIdx)] } {
set xrefinfo $tki(xrefinfo-$fileKey-$nodeIdx)
} else {
set xrefinfo [tkiTimeStatus "Parsing $nodeIdx body" 0 \
tkiNodeParseBody $nodeIdx $fileKey $body]
}
set ms "1.0"
$tw tag delete xrefkey
foreach xi $xrefinfo {
# xi = { xrefidx toNode startIdx endIdx label}
set xrefidx [lindex $xi 0]
set toNode [lindex $xi 1]
$tw tag add xrefkey "$ms+[lindex $xi 2] c" "$ms +[lindex $xi 3] c"
$tw tag add xref$xrefidx "$ms +[lindex $xi 2] c" "$ms +[lindex $xi 3] c"
# We memorize the position where a button is pressed; if it is
# released far away, we won't enable the associated action
# (chances are, that the user wanted to select or drag)
$tw tag bind xref$xrefidx <Button-1> \
"set tki(x) %x; set tki(y) %y"
$tw tag bind xref$xrefidx <ButtonRelease-1> \
[list _tkiButtonRelease1 $w %x %y $xrefidx $toNode $fileKey xref]
$tw tag bind xref$xrefidx <Button-2> \
"set tki(y) %y"
# The next one is really wild... $toNode can contain backslashes and
# stuff. I didn't know how to do it more elegantly --A.B.
$tw tag bind xref$xrefidx <ButtonRelease-2> \
"[list _tkiButtonRelease2 $w %y $xrefidx $toNode $fileKey xref]
break"
$tw tag bind xref$xrefidx <Shift-ButtonRelease-1> \
"[list _tkiShiftButtonRelease1 $w $xrefidx $toNode $fileKey xref]
break"
$tw tag bind xref$xrefidx <Control-ButtonRelease-1> \
"[list _tkiShiftButtonRelease1 $w $xrefidx $toNode $fileKey xref]
break"
# We need to disable the transient-menu function of button-3
# on tags. Simply binding <Button-3> to "break" does not work:
# the text widget bindings would still be executed. We use a
# global variable tki(breakBindings): if it is 1, the script
# from the text widget binding is not allowed to execute.
$tw tag bind xref$xrefidx <Button-3> "set tki(breakBindings) 1"
$tw tag bind xref$xrefidx <ButtonRelease-3> \
[list _tkiButtonRelease3 $w $xrefidx $toNode $fileKey xref]
}
_tkiLinkLookTag $tw xrefkey
set wvars(xrefinfo) $xrefinfo
_tkiTextTrim $tw 1.0
if { ! $tki(rawHeadersB) } {
$tw delete 1.0 "1.0 +1line"
_tkiTextTrim $tw 1.0
}
#
# Now add the menu tags
#
if { [info exist menutext] } {
if { [info exist tki(menuinfo-$fileKey-$nodeIdx)] } {
set menuinfo $tki(menuinfo-$fileKey-$nodeIdx)
} else {
set menuinfo [tkiTimeStatus "Parsing $nodeIdx menu" 0 \
tkiNodeParseMenu $nodeName $nodeIdx $fileKey $body]
}
$tw tag delete menukey
foreach mi $menuinfo {
# mi = { lineidx menuidx toNode nBeg nEnd label }
set lineidx [lindex $mi 0]
set menuidx [lindex $mi 1]
set toNode [lindex $mi 2]
set ms "menu.first +$lineidx lines -2 lines"
$tw tag add menukey "$ms +[lindex $mi 3] c" "$ms +[lindex $mi 4] c +1 c"
$tw tag add menu$menuidx "$ms linestart" "$ms +[lindex $mi 4] c +1 c"
# We memorize the position where a button is pressed; if it is
# released far away, we won't enable the associated action
# (chances are, that the user wanted to select or drag)
$tw tag bind menu$menuidx <Button-1> \
"set tki(x) %x; set tki(y) %y"
$tw tag bind menu$menuidx <ButtonRelease-1> \
[list _tkiButtonRelease1 $w %x %y $menuidx $toNode $fileKey menu]
$tw tag bind menu$menuidx <Button-2> \
"set tki(y) %y"
$tw tag bind menu$menuidx <ButtonRelease-2> \
"[list _tkiButtonRelease2 $w %y $menuidx $toNode $fileKey menu]
break"
$tw tag bind menu$menuidx <Shift-ButtonRelease-1> \
"[list _tkiShiftButtonRelease1 $w $menuidx $toNode $fileKey menu]
break"
$tw tag bind menu$menuidx <Control-ButtonRelease-1> \
"[list _tkiShiftButtonRelease1 $w $menuidx $toNode $fileKey menu]
break"
$tw tag bind menu$menuidx <Button-3> "set tki(breakBindings) 1"
$tw tag bind menu$menuidx <ButtonRelease-3> \
[list _tkiButtonRelease3 $w $menuidx $toNode $fileKey menu]
}
_tkiLinkLookTag $tw menukey
set wvars(menuinfo) $tki(menuinfo-$fileKey-$nodeIdx)
} else {
catch {unset wvars(menuinfo)}
}
#
# Window titles and status messages
#
$w.s.filename conf -text $wvars(nodeSpec)
$w conf -cursor $tki(normCursor)
wm title $w "$wvars(title): $wvars(nodeSpec)"
wm iconname $w "$wvars(title): $wvars(nodeSpec)"
#
# Disable buttons and menu entries if necessary
#
set toNode [lindex $info 3]
if {$toNode == ""} {
$w.buts.up conf -state disabled
$w.bar.node.m entryconf Up* -state disabled
$w.transientmenu entryconf Up* -state disabled
} else {
set balloonHelp($w.buts.up) "Go to that info node which
contains this one as a menu entry.
That is the node \"$toNode\"."
$w.buts.up conf -state normal
$w.bar.node.m entryconf Up* -state normal
$w.transientmenu entryconf Up* -state normal
}
set toNode [lindex $info 4]
if {$toNode == ""} {
$w.buts.prev conf -state disabled
$w.bar.node.m entryconf Prev* -state disabled
# $w.transientmenu entryconf Prev* -state disabled
} else {
set balloonHelp($w.buts.prev) "Go to previous section on
the current hierarchical level.
That is the node \"$toNode\"."
$w.buts.prev conf -state normal
$w.bar.node.m entryconf Prev* -state normal
# $w.transientmenu entryconf Prev* -state normal
}
set toNode [lindex $info 5]
if {$toNode == ""} {
$w.buts.next conf -state disabled
$w.bar.node.m entryconf Next* -state disabled
$w.transientmenu entryconf Next* -state disabled
} else {
set balloonHelp($w.buts.next) "Go to next section on the
current level, i.e. skip all menu entries.
That is the node \"$toNode\"."
$w.buts.next conf -state normal
$w.bar.node.m entryconf Next* -state normal
$w.transientmenu entryconf Next* -state normal
}
$w.bar.search.m entryconf "Continue forward search" -state disabled
$w.bar.search.m entryconf "Continue backward search" -state disabled
$w.bar.search.m entryconf "Continue index lookup" -state disabled
if { [llength $wvars(history)] > 0 } {
$w.bar.history conf -state normal
} else {
$w.bar.history conf -state disabled
}
if { [llength $wvars(lastNodes)] >= 1 } {
$w.buts.last conf -state normal
$w.bar.node.m entryconf "Back*" -state normal
$w.transientmenu entryconf "Back*" -state normal
set balloonHelp($w.buts.last) "Go back to the last node
you visited before coming here.
That is the node \"[lindex [lindex $wvars(lastNodes) [expr [llength $wvars(lastNodes)] - 1]] 1]\"."
} else {
$w.buts.last conf -state disabled
$w.bar.node.m entryconf "Back*" -state disabled
$w.transientmenu entryconf "Back*" -state disabled
}
if { $menuidx > 0 } {
$w.bar.node.m entryconf "Menu*" -state normal
} else {
$w.bar.node.m entryconf "Menu*" -state disabled
}
if { $xrefinfo == "" } {
$w.bar.node.m entryconf "Cross*" -state disabled
} else {
$w.bar.node.m entryconf "Cross*" -state normal
}
if { [lindex $wvars(nodeinfo) 1] == "Top" } {
$w.buts.top conf -state disabled
$w.bar.node.m entryconf "Top" -state disabled
} else {
$w.buts.top conf -state normal
$w.bar.node.m entryconf "Top" -state normal
}
if { [lindex $wvars(nodeinfo) 2] == "dir" } {
$w.buts.dir conf -state disabled
$w.bar.file.m entryconf "Dir*" -state disabled
} else {
$w.buts.dir conf -state normal
$w.bar.file.m entryconf "Dir*" -state normal
}
_tkiFindIndices $fileKey [lindex $wvars(nodeinfo) 2]
$w.bar.search.m entryconf "Index*" -state normal
$w.transientmenu entryconf "Index*" -state normal
set infoFileKey $tki(infoFileKey-$wvars(fileKey))
if { $infoFileKey == $wvars(indexInfoFileKey) && $wvars(indexEntriesIndex) < [expr [llength $wvars(indexEntries)] - 1 ] } {
$w.bar.search.m entryconf "Continue index lookup" -state normal
}
if { [llength $tki(dirs)] > 1 } {
$w.bar.dirs.m del 1 end
foreach pp $tki(dirs) {
if { $wvars(lastDir) == $pp } {
set label "* $pp"
} else {
set label " $pp"
}
$w.bar.dirs.m add com -label $label \
-command [list _tkiWinAction $w dir $pp]
}
}
# Clean up the window
$tw mark set insert 1.0
$tw mark set anchor insert
$tw tag remove sel 1.0 end
$tw conf -state disabled
# This is really gross
# focus $tw
# after 1 [list $tw tag remove sel 1.0 end]
tkiStatus "" $w 1
}
##############################################################################
#
# The public interface
#
##############################################################################
#
# The argument {w} specified an info window in one of three ways:
# - if empty, a new top-level window will be created and returned.
# - if a window (starts will a ``.''), the window must exist and must have
# been previously obtained using tkiWinCreate() or some variant
# of tkiWinShow().
# - otherwise it is a "window tag", which is arbitrary text that
# must not begin with a ``.''. Each tag has a unique window associated
# with it that will be created (and re-created) upon demand.
# The tag will also appear in the window title&icon.
#
proc _tkiWinResolveWinName { w } {
global tki
if { ! [info exist tki] } { tkiInit }
if { $w == "" } { return [tkiWinCreate] }
if { [string index $w 0] == "." } { return $w }
# It must be a tag: retrieve (or make) the window assoicated with the tag
set tag $w
if { ![info exist tki(wintag-$tag)] } {
set tki(wintag-$tag) [tkiWinCreate "" $tag]
}
set w $tki(wintag-$tag)
# Now see if it still exists: the user might have killed it. If
# gone, recreate it.
if {![winfo exist $w]} {
tkiWinCreate $w $tag
}
return $w
}
#
# This is the primary entry point of this module. The argument {nodeSpec}
# give the node to show, and may contains a filespec as in (filename)nodename.
# If no filename is contained in {nodeSpec}, it will be augmented by
# the argument {fileSpec} (if non-empty). The argument
# {w} specifies which info window the node should be displayed in,
# as described by _tkiWinResolveWinName() above.
#
# The return value is a list "nodeRef window" where {nodeRef} is
# the internal "handle" to the node given by {nodeSpec} and {fileSpec},
# and {window} is the full path of the info window.
# If the node couldn't be loaded, the {nodeRef} will be empty.
#
proc tkiWinShow { nodeSpec {fileSpec ""} {w ""} } {
global tki
set w [_tkiWinResolveWinName $w]
upvar #0 $w wvars
set tki(curWindow) $w
$w.main.text conf -cursor $tki(waitCursor)
$w conf -cursor $tki(waitCursor)
_tkiWinPromptUnmap $w
set nodeRef [tkiGetNodeRef $nodeSpec $fileSpec "" $wvars(lastDir)]
if { $nodeRef == "" } {
#Node couldn't be found
set fmtSpec [tkiFmtNodeSpec $nodeSpec $fileSpec]
if { $nodeSpec != "" && ![string match "(*" $nodeSpec] } {
tkiError "Can't locate info nodes ``$fmtSpec'' and ``($nodeSpec)$tki(topLevelNode)''"
} else {
tkiError "Can't locate the info node ``$fmtSpec''"
}
return [list "" $w]
}
set nodeIdx [lindex $nodeRef 0]
set fileKey [lindex $nodeRef 1]
tkiWinDpy $w $fileKey [lindex $tki(nodesinfo-$fileKey) $nodeIdx] \
[lindex $tki(nodesbody-$fileKey) $nodeIdx]
$w conf -cursor $tki(normCursor)
$w.main.text conf -cursor $tki(normCursor)
raise $w
return [list $nodeRef $w]
}
#
# Get the current info node for {w}, and redisplay it in the window.
# This is used whenever the display mode (linklook,etc) is changed.
#
proc tkiWinRefresh { w } {
global tki; upvar #0 $w wvars
if { $tki(showButtonsB) } {
pack $w.buts -after $w.s -fill x
} else {
pack forget $w.buts
}
if ![info exist wvars(nodeinfo)] return
set nodeinfo $wvars(nodeinfo)
return [tkiWinShow [lindex $nodeinfo 1] $wvars(fileKey) $w]
}
proc tkiWinRefreshAll { } {
global tki
foreach w $tki(windows) {
if { ![winfo exist $w] } continue
if [catch {tkiWinRefresh $w} error] {
global errorInfo
puts stderr "tkInfo: refresh $w: $error\n$errorInfo"
}
}
}
#
# A helper function to provide "context" help. The idea is that the
# application, when it creates each window/widget, creates a global array
# variable corresponding to each "key" window in the application. The
# array element "infonodename" contains the node name to display for
# context help for that window and its children.
#
# Start at window {w}, and traverse up the window tree looking for a variable
# of the form "$w(infonodename)". If found, a window displaying that node
# will be generated. {fileSpec} may be used to augment the infonode,
# and {infowin} may specific a pre-existing info window returned by
# tkiWinShow().
#
proc tkiWinContextHelp { w {fileSpec ""} {infowin ""} } {
for {} { $w != ""} {set w [winfo parent $w]} {
# Line below is kludgy, b/c I can't see any other way to do it.
if [uplevel #0 [list info exist ${w}(infonodename)]] {
upvar #0 $w wvars
return [tkiWinShow $wvars(infonodename) $fileSpec $infowin]
}
}
if { $fileSpec != "" } {
return [tkiWinShow Top $fileSpec $infowin]
}
return [tkiWinShow "(builtin)Quick Help" "" $infowin]
}
##########################################################################
# The following material was formerly contained in the file tkicore.tcl:
#
# This is the core of the tkinfo package. It handles reading, parsing,
# and storing info files. Everything in here should be tcl-only, no
# tk stuff. Note that this can't be used independently: it requires
# initialization and error handling stuff found in tkinfo.tcl.
# Get a globally unique serial number.
#
proc tkiGetSN { } {
global tki
incr tki(sn)
return $tki(sn)
}
#
# Add tcl list of paths {newPaths} to the directory search list. The
# list is added in order at the *head* of the list. Duplicate paths
# are removed, leaving the first of several identical paths in. If
# the directory contains an info file "dir", then it is added to
# tki(dirs) as well.
proc tkiAddInfoPaths { newPaths } {
global tki
if { ! [info exist tki(infoPath) ] } {
set tki(infoPath) ""
}
for {set idx [expr [llength $newPaths] - 1]} {$idx >= 0} {incr idx -1} {
set newPath [lindex $newPaths $idx]
if { $newPath == "" } {continue}
if { ![tkiFileIsAbsolute $newPath] } {
set newPath "./$newPath"
}
if { ![file isdir $newPath] } {continue}
set tki(infoPath) [linsert $tki(infoPath) 0 $newPath]
set dup [lsearch [lrange $tki(infoPath) 1 end] $newPath]
if { $dup < 0 } {
# no duplicate. Check whether it belongs into tki(dirs):
if {[_tkiFileFindSuf "$newPath/dir"] != ""} {
set tki(dirs) [linsert $tki(dirs) 0 $newPath]
}
} else {
# Kill off duplicate
set tki(infoPath) [lreplace $tki(infoPath) [expr {$dup+1}] [expr {$dup+1}]]
}
}
}
proc _tkiFileFindSuf { fileName } {
global tki
foreach suf $tki(infoSuffix) {
foreach extrasuf {"" .gz .Z .z .bz2} {
set filePath "$fileName$suf$extrasuf"
if { [file isfile $filePath] } {
return $filePath
}
}
}
return ""
}
#
# Given {fileName} (see intro section above), find the corresponding
# filepath. The filepath of {pntFileKey}, if specified, is
# used as a starting point for locating {fileName}.
# Returns the file path if found, else empty string.
#
proc tkiFileFind { fileName {startSearchDir ""} } {
global tki
if { [tkiFileIsAbsolute $fileName] } {
set filePath [_tkiFileFindSuf $fileName]
if { $filePath != "" } { return $filePath }
set filePath [_tkiFileFindSuf [string tolower $fileName]]
return $filePath
} else {
# Try all the infopaths, and all suffixs
foreach prepath "$startSearchDir $tki(infoPath)" {
set filePath [_tkiFileFindSuf $prepath/$fileName]
if { $filePath != "" } { return $filePath }
set filePath [_tkiFileFindSuf $prepath/[string tolower $fileName]]
if { $filePath != "" } { return $filePath }
}
return ""
}
}
#
# Determines whether filename is an absolute path. Should work also
# for names starting with Windows style drive letters.
#
proc tkiFileIsAbsolute { filename } {
return [regexp -nocase {^(/|\./|\.$|\.\./|\.\.$|~|[a-z]:)} $filename]
}
#
# Given {fileName}, find the corresponding filepath via tkiFileFind().
# Return a {fileKey} for the file, and make the appropriate table entries.
# Note that {fileName} must be just that, and not a filekey.
#
proc tkiFileAdd { fileName {pntFileKey ""} {startSearchDir ""} } {
global tki
if {$pntFileKey != ""} {
set startSearchDir [file dirname [lindex $tki(fileinfo-$pntFileKey) 2]]
}
if { [info exist tki(fileKeys-$fileName)] } {
foreach key $tki(fileKeys-$fileName) {
if { [file dirname [lindex $tki(fileinfo-$key) 2]] == $startSearchDir } {
return $key
}
}
} else {
set tki(fileKeys-$fileName) ""
}
set filePath [tkiFileFind $fileName $startSearchDir]
if { $filePath == "" } { return "" }
set fileKey fk[tkiGetSN]
lappend tki(fileKeys-$fileName) $fileKey
set tki(fileinfo-$fileKey) [list $fileKey $fileName $filePath $pntFileKey]
set tki(incore-$fileKey) 0
return $fileKey
}
proc tkiFileGet { fileSpec {pntFileKey ""} {startSearchDir ""} } {
global tki
# Is fileSpec a filekey?
if { [info exist tki(fileinfo-$fileSpec)] } {
set fileKey $fileSpec
} else {
set fileKey [tkiFileAdd $fileSpec $pntFileKey $startSearchDir]
if { $fileKey == "" } {
return ""
}
}
set fileinfo $tki(fileinfo-$fileKey)
if { ! $tki(incore-$fileKey) } {
tkiFileLoad $fileKey [lindex $fileinfo 1] [lindex $fileinfo 2]
}
return $fileKey
}
proc _tkiFileLoadIndirectTbl { fileKey lines } {
global tki
set indirinfos ""
foreach line $lines {
if { $line != "" } {
set pair [split $line ":"]
if { [llength $pair] != 2 } {
tkiFileWarning $fileKey "has bad file-indirect line ``$line''"
continue
}
set indirKey [tkiFileAdd [lindex $pair 0] $fileKey]
if { $indirKey == "" } {
tkiError "Can't locate indirect file ``[lindex $pair 0]''."
continue
}
set byteOfs [string trim [lindex $pair 1]]
lappend indirinfos [list $indirKey $byteOfs]
}
}
set tki(indirf-$fileKey) $indirinfos
}
proc _tkiFileLookupIndir { indirf byte } {
set lastKey ""
foreach fi $indirf {
if { [lindex $fi 1] > $byte } break
set lastKey [lindex $fi 0]
}
return $lastKey
}
proc _tkiFileLoadTagTbl { fileKey lines } {
global tki
set subkey [lindex $lines 0]
if { $subkey != "(Indirect)" } return
set indirf $tki(indirf-$fileKey)
set indirinfos ""
foreach line [lrange $lines 1 end] {
if { $line =="" } continue
set pair [split $line $tki(nodeByteSep)]
if { [llength $pair] != 2 } {
tkiFileWarning $fileKey "has bad tag-indirect line ``$line''"
continue
}
set nodeName [string trim [string range [lindex $pair 0] 5 end]]
set byteOfs [string trim [lindex $pair 1]]
set indirFile [_tkiFileLookupIndir $indirf $byteOfs]
lappend indirinfos [list $nodeName $byteOfs $indirFile]
}
set tki(indirn-$fileKey) $indirinfos
}
proc tkiFileParseNode { fileKey node } {
global tki
set lines [split $node "\n"]
set keyline [string trim [lindex $lines 1]]
case $keyline {
{ {[Ii]ndirect:} } {
_tkiFileLoadIndirectTbl $fileKey [lrange $lines 2 end]
return "IndirectTable"
}
{ {[Tt]ag [Tt]able:} } {
_tkiFileLoadTagTbl $fileKey [lrange $lines 2 end]
return "TagTable"
}
{ {[Ee]nd [Tt]ag [Tt]able} } {
return "EndTagTable"
}
}
# Some screwed up files omit the ``,'' for the file key.
regsub "(File:\[^,\]*)Node:" $keyline "\\1,Node:" keyline
set nodekey ""; set filekey ""
set nextkey ""; set prevkey ""; set upkey ""
foreach key [split $keyline ",\t"] {
set key [string trim $key]
# Note that the linux-doc sgml package produces "Previous:" headers
# instead of "Prev:".
case $key {
"File:*" { set filekey [string trim [string range $key 5 end]] }
"Node:*" { set nodekey [string trim [string range $key 5 end]] }
"Up:*" { set upkey [string trim [string range $key 3 end]] }
"Prev:*" { set prevkey [string trim [string range $key 5 end]] }
"Previous:*" { set prevkey [string trim [string range $key 9 end]] }
"Next:*" { set nextkey [string trim [string range $key 5 end]] }
}
}
if { $nodekey == "" } { return "" }
lappend tki(nodesinfo-$fileKey) [list [llength $tki(nodesinfo-$fileKey)] $nodekey $filekey $upkey $prevkey $nextkey]
# We need to get rid of all strange control characters:
regsub -all "\[\a\b\v\f\]" $node "" node
lappend tki(nodesbody-$fileKey) $node
return $nodekey
}
proc _tkiFileRead {fileName filePath} {
global tki
tkiStatus "Loading $fileName..." "" 0
case $filePath in {
*.Z { set fp "|$tki(compresscat-Z) $filePath" }
*.z { set fp "|$tki(compresscat-z) $filePath" }
*.gz { set fp "|$tki(compresscat-gz) $filePath" }
*.bz2 { set fp "|$tki(compresscat-bz2) $filePath" }
default { set fp $filePath }
}
if [catch {open $fp "r"} fid] {
tkiError "Can't open ``$fp''."
return ""
}
set text [read $fid]
close $fid
return $text
}
proc tkiFileLoad { fileKey fileName filePath {fileText ""}} {
global tki
if { $fileText == "" } {
set fileText [_tkiFileRead $fileName $filePath]
}
if { $fileText == "" } {
return ""
}
set nodelist [split $fileText $tki(nodeSep)]
set nodecnt 0
set tki(nodesinfo-$fileKey) ""
set tki(nodesbody-$fileKey) ""
foreach node $nodelist {
incr nodecnt
if { $nodecnt==1 || [string length $node] < 10 } continue
set nodeName [tkiFileParseNode $fileKey $node]
if { $nodeName == "" } {
puts stdout "Warning: node #$nodecnt of file $filePath is bogus"
continue
}
}
set tki(incore-$fileKey) 1
return $fileKey
}
#
# Parse nodeSpec and fileSpec. {nodeSpecVar} and {fileSpecVar} must
# refer to variables within the caller's context. They will be substituted
# and replaced with canonical forms.
#
proc tkiParseNodeSpec { nodeSpecVar fileSpecVar } {
global tki
upvar $nodeSpecVar nodeSpec $fileSpecVar fileSpec
if { [string index $nodeSpec 0] == "(" } {
set ridx [string first ")" $nodeSpec]
if { $ridx < 0 } {
set ridx [string length $nodeSpec]
}
set fileSpec [string range $nodeSpec 1 [expr $ridx-1]]
set nodeSpec [string range $nodeSpec [expr $ridx+1] end]
}
if { $nodeSpec == "" } {
set nodeSpec $tki(topLevelNode)
if { $fileSpec == "" } {
set fileSpec "dir"
}
}
set nodeSpec [string trim $nodeSpec]
set fileSpec [string trim $fileSpec]
return 1
}
proc tkiFmtFileSpec { fileSpec } {
global tki
if [info exist tki(fileinfo-$fileSpec)] {
return [lindex $tki(fileinfo-$fileSpec) 1]
}
return $fileSpec
}
proc tkiFmtNodeSpec { nodeSpec {fileSpec ""} } {
global tki
if ![tkiParseNodeSpec nodeSpec fileSpec] {
return "Bad file/node spec ``$nodeSpec''"
}
set fileSpec [tkiFmtFileSpec $fileSpec]
return "($fileSpec)$nodeSpec"
}
#
# This is the core search function. It attempts to locate {nodeSpec}
# where ever it is. {fileSpec} is a default file name that is used
# only if {nodeSpec} doesn't contain a reference.
# Returns a list {nodeIdx fileKey}, where {nodeIdx} is the index of the
# node within {fileKey}.
#
# As discussed in the intro above, at this level we cannot allow any
# concept of "current file" or "current node": it is up to the caller
# to maintain that information and pass up the appropriate arguments.
#
proc tkiGetNodeRef { nodeSpec {fileSpec ""} {pntFileKey ""} {startSearchDir ""}} {
global tki
# Case sensitive search
set nodeRef [_tkiGetNodeRef $nodeSpec $fileSpec $pntFileKey $startSearchDir 0]
if { $nodeRef != "" } {
return $nodeRef
}
# Case insensitive search
set nodeRef [_tkiGetNodeRef $nodeSpec $fileSpec $pntFileKey $startSearchDir 1]
if { $nodeRef != "" } {
return $nodeRef
}
return ""
}
proc _tkiGetNodeRef { nodeSpec fileSpec pntFileKey startSearchDir caseinsen } {
global tki
# the following may change nodeSpec and fileSpec!
if ![tkiParseNodeSpec nodeSpec fileSpec] {
return ""
}
set fileKey [tkiFileGet $fileSpec $pntFileKey $startSearchDir]
if { $fileKey != "" } {
set fileName [lindex $tki(fileinfo-$fileKey) 1]
tkiStatus "Searching for node ``$nodeSpec'' in $fileName..." "" 0
set realPntKey [lindex $tki(fileinfo-$fileKey) 3]
if { $caseinsen } {
set nodeSpec [string tolower $nodeSpec]
}
# Popup to our indirect-parent, if it has a tag table
if { $pntFileKey == "" && $realPntKey != "" && [info exist tki(indirn-$realPntKey)] } {
return [_tkiGetNodeRef $nodeSpec $realPntKey "" $startSearchDir $caseinsen]
}
# Use index on this file, pushdown to our children
if { [info exist tki(indirn-$fileKey)] } {
# Use node index (indirect)
if { $caseinsen } {
foreach indir $tki(indirn-$fileKey) {
if { $nodeSpec == [string tolower [lindex $indir 0]] } {
set nodeRef [_tkiGetNodeRef $nodeSpec [lindex $indir 2] $fileKey "" 1]
if { $nodeRef != "" } { return $nodeRef }
tkiFileWarning $fileKey "Incorrect tag table"; break
}
}
} else {
foreach indir $tki(indirn-$fileKey) {
if { $nodeSpec == [lindex $indir 0] } {
set nodeRef [_tkiGetNodeRef $nodeSpec [lindex $indir 2] $fileKey "" 0]
if { $nodeRef != "" } { return $nodeRef }
tkiFileWarning $fileKey "Incorrect tag table"; break
}
}
}
} else {
# Brute force on this file
if { [info exist tki(nodesinfo-$fileKey)] } {
if { $caseinsen } {
foreach nodeinfo $tki(nodesinfo-$fileKey) {
if { $nodeSpec == [string tolower [lindex $nodeinfo 1]] } {
return [list [lindex $nodeinfo 0] $fileKey]
}
}
} else {
foreach nodeinfo $tki(nodesinfo-$fileKey) {
if { $nodeSpec == [lindex $nodeinfo 1] } {
return [list [lindex $nodeinfo 0] $fileKey]
}
}
}
}
# Look for node in all indirect files (brute force)
if { [info exist tki(indirf-$fileKey)] } {
foreach indir $tki(indirf-$fileKey) {
set nodeRef [_tkiGetNodeRef $nodeSpec [lindex $indir 0] $fileKey "" $caseinsen]
if { $nodeRef != "" } { return $nodeRef }
}
}
}
# Look for node in my parent, but only if not called from my pnt
if { $pntFileKey == "" && $realPntKey != "" } {
set nodeRef [_tkiGetNodeRef $nodeSpec $realPntKey "" $startSearchDir $caseinsen]
if { $nodeRef != "" } { return $nodeRef }
}
# In case we were called with an info file name of emacs-2 for instance:
if { [info exists tki(nodesinfo-$fileSpec)] } {
set infofile [lindex [lindex $tki(nodesinfo-$fileSpec) 0] 2]
set nodeRef [_tkiGetNodeRef $nodeSpec $infofile $pntFileKey $startSearchDir $caseinsen]
if { $nodeRef != "" } {
return $nodeRef
}
}
}
# This is to support XEmacs-style menus which contain only
# the filename, but not in parentheses. Also, we have gotten such a
# filename on the command line.
if { $nodeSpec != $tki(topLevelNode) } {
set nodeRef [_tkiGetNodeRef $tki(topLevelNode) $nodeSpec "" $startSearchDir $caseinsen]
if { $nodeRef != "" } {
return $nodeRef
}
# If we can't find the node elsewhere, we try the menu entries of (dir)Top
foreach directory $tki(dirs) {
set dirNodeRef [tkiGetNodeRef $tki(topLevelNode) "dir" "" $directory]
if { $dirNodeRef != "" } {
set topNodeIdx [lindex $dirNodeRef 0]
set dirFileKey [lindex $dirNodeRef 1]
if { ![info exist tki(menuinfo-$dirFileKey-$topNodeIdx)] } {
set body [lindex $tki(nodesbody-$dirFileKey) $topNodeIdx]
tkiNodeParseMenu $tki(topLevelNode) $topNodeIdx $dirFileKey $body
}
set dirMenu $tki(menuinfo-$dirFileKey-$topNodeIdx)
if {$caseinsen} {
foreach mi $dirMenu {
if { [string tolower [lindex $mi 5]] == $nodeSpec } {
return [tkiGetNodeRef [lindex $mi 2]]
}
}
} else {
foreach mi $dirMenu {
if { [lindex $mi 5] == $nodeSpec } {
return [tkiGetNodeRef [lindex $mi 2]]
}
}
}
}
}
}
# All efforts failed.
return ""
}
#
# Initialize the regexp strings that are used later in
# tkiNodeParseBody() (for xrefs) and tkiNodeParseMenu() (for menus).
# This func is called once from tkiInit() and then destroyed.
#
proc _tkiNodeParseInit { } {
global tki
# For xrefs, there are two forms:
# *note nodeSpec::terminator (form 1)
# *note label: nodeSpec terminator (form 2)
# Terminator is ``.'' or ``,'', forms may wrap across lines.
set tki(re_xref1_p) "\\*(note\[ \t\n\]*)(\[^:\]+)::"
set tki(re_xref1_s) "x\\1\037e\\2\037fxx"
set tki(re_xref2_p) "\\*(note\[ \t\n\]*)(\[^:\]+)(:\[ \t\n\]*)(\\(\[^ \t\n)\]+\\))?(\[^.,\]*)\[.,\]"
set tki(re_xref2_s) "x\\1\037a\\2\037b\\3\037c\\4\\5\037dx"
# For menus, there are two forms:
# * nodeSpec:: comments... (form 1)
# * label: nodeSpec[\t.,] comments... (form 2)
set tki(re_menu1_p) "(\\*\[ \t\]*)(\[^:\]+)::"
set tki(re_menu1_s) "\\1\037A\\2\037B"
# rp2 = "* ws label: ws", rp2a="rp2 nodename ws", rp2b="rp2 (file)node ws"
set tki(re_menu2_p) "(\\*\[ \t\]*)(\[^:\]+)(:\[ \t\]*)(\\(\[^ \t)\]+\\))?(\[^\t.,\]*)"
set tki(re_menu2_s) "\\1\037A\\2\037B\\3\037C\\4\\5\037D"
}
#
# Parse a nody-body and return a list of the cross references.
# Store the information in tki(xrefinfo-$fileKey-$nodeIdx).
#
proc tkiNodeParseBody { nodeIdx fileKey bodytext } {
global tki
regsub -all -nocase $tki(re_xref1_p) $bodytext $tki(re_xref1_s) bodytext
regsub -all -nocase $tki(re_xref2_p) $bodytext $tki(re_xref2_s) bodytext
set xrefinfo ""
set curIdx 1
foreach seg [split $bodytext "\037"] {
if { [string index $seg 0] == "a" || [string index $seg 0] == "e" } {
regsub -all "\[ \t\n\]+" "[string range $seg 1 end]" " " label
set stIdx $curIdx
}
set curIdx [expr { $curIdx + [string length $seg] - 1 }]
if { [string index $seg 0] != "c" && [string index $seg 0] != "e" } {
continue
}
set toNode [string range $seg 1 end]
regsub -all "\[ \t\n\]+" $toNode " " toNode
lappend xrefinfo [list [llength $xrefinfo] $toNode $stIdx $curIdx $label]
}
set tki(xrefinfo-$fileKey-$nodeIdx) $xrefinfo
return $xrefinfo
}
#
# Parse the menu and extract the keywords
# Store the information in tki(menuinfo-$fileKey-$nodeIdx).
#
proc tkiNodeParseMenu { nodeName nodeIdx fileKey bodytext } {
global tki
# There are two forms:
# * nodeSpec:: comments... (form 1)
# * label: nodeSpec[ \t.,] comments... (form 2)
set rp1 $tki(re_menu1_p)
set sp1 $tki(re_menu1_s)
set rp2 $tki(re_menu2_p)
set sp2 $tki(re_menu2_s)
set menuidx [string first "\n* Menu:" $bodytext]
if { $menuidx > 0 } {
set menutext [string range $bodytext [expr {$menuidx+1}] end]
} else {
return ""
}
set menuinfo ""
set linecnt 0; set menucnt 0
foreach line [split $menutext "\n"] {
incr linecnt
if { [string index $line 0] != "*"
|| [string range $line 0 6] == "* Menu:" } continue
if { [regsub $rp1 $line $sp1 prsline] } {
set nBeg [expr { [string first "\037A" $prsline] + 0 } ]
set nEnd [expr { [string first "\037B" $prsline] - 3 } ]
set toNode [string range $line $nBeg $nEnd]
regexp "\037A(.*)\037B" $prsline dummy label
} else {
if { [regsub $rp2 $line $sp2 prsline] } {
set nBeg [expr { [string first "\037A" $prsline] - 0 } ]
set nEnd [expr { [string first "\037D" $prsline] - 7 } ]
regexp "\037C(.*)\037D" $prsline dummy toNode
regexp "\037A(.*)\037B" $prsline dummy label
} else {
tkiFileWarning $fileKey "node $nodeName: bad syntax in line $linecnt of menu"
continue
}
}
lappend menuinfo [list $linecnt $menucnt $toNode $nBeg $nEnd $label]
incr menucnt
}
set tki(menuinfo-$fileKey-$nodeIdx) $menuinfo
return $menuinfo
}
#
# This is equivalent to $w tag prevrange $tag $start $stop
# but this command doesn't exist in tk4.0....
# Binary search is probably overkill here.
#
proc _tkiprevrange {w tag start {stop 1.0}} {
set ranges [$w tag ranges $tag]
if { $ranges == "" } {
return ""
}
set beg 0; set end [expr [llength $ranges] - 2]
while { $end - $beg > 2 } {
set middle [expr int(($beg + $end) / 4) * 2 ]
if [$w compare [lindex $ranges $middle] < $start] {
set beg $middle
} else {
set end $middle
}
}
if { [$w compare [lindex $ranges $beg] >= $start] } {
return ""
} elseif { [$w compare [lindex $ranges $end] < $start] } {
set best $end
} else {
set best $beg
}
if { [$w compare [lindex $ranges $best] > $stop] } {
return [list [lindex $ranges $best] [lindex $ranges [expr $best + 1]]]
} else {
return ""
}
}
#
# Search through w's current info file for pattern, starting with the
# node following the current one. Bring up the first node containing
# string, and call searchboxSearch on that node. At the end of the
# infofile, wrap around to the beginning. If no node contains string,
# return 0, else return whatever searchboxSearch returned. It should
# have been checked elsewhere that the regexp actually compiles
# correctly.
#
proc _tkiSearchFileForw {w pattern regexpB casesenB incr} {
global tki; upvar #0 $w wvars
# _tkiLocalMatch is supposed to return 1 iff its argument matches
# $pattern. I don't understand the next lines -- I've found them by
# experimentation --A.B.
if {$regexpB} {
set transformedPattern [_tkiRegexpTransform $pattern]
if {$casesenB} {
proc _tkiLocalMatch {s} [list eval regexp -- [list $transformedPattern] \$s ]
} else {
proc _tkiLocalMatch {s} [list eval regexp -nocase -- [list $transformedPattern] \$s ]
}
} else {
if {$casesenB} {
proc _tkiLocalMatch {s} [list expr \[ string first [list $pattern] \$s \] != -1]
} else {
proc _tkiLocalMatch {s} [list expr \[ string first [list [string tolower $pattern]] \[ string tolower \$s \] \] != -1]
}
}
# Are we currently inside an ongoing search?
if { $wvars(inSearch) && $wvars(searchOriginFileKey) != "" } {
set origFileKey $wvars(searchOriginFileKey)
set origNodeIdx $wvars(searchOriginNodeIdx)
} else {
set origFileKey $wvars(fileKey)
set wvars(searchOriginFileKey) $origFileKey
set origNodeIdx [lindex $wvars(nodeinfo) 0]
set wvars(searchOriginNodeIdx) $origNodeIdx
}
set fileKey $wvars(fileKey)
set pntKey [lindex $tki(fileinfo-$fileKey) 3]
if { $pntKey != "" } {
set fileKeyList $tki(indirf-$pntKey)
set fileKeyListLength [llength $fileKeyList]
for {set idx 0} {$idx < $fileKeyListLength} {incr idx} {
if { [lindex [lindex $fileKeyList $idx] 0] == $fileKey } {
break
}
}
set fileKeyListIdx $idx
}
set nodeIdx [expr [lindex $wvars(nodeinfo) 0] + 1]
set nodeList $tki(nodesinfo-$fileKey)
set nodeListLength [llength $tki(nodesinfo-$fileKey)]
set tki(interrupt) 0
while { $fileKey != $origFileKey || $nodeIdx != $origNodeIdx } {
update
if {$tki(interrupt) == 1} {
tkiStatus "Search for \"$pattern\" interrupted." $w 0
return
}
if { $nodeIdx < $nodeListLength } {
set nodesinfo [lindex $tki(nodesinfo-$fileKey) $nodeIdx]
tkiStatus "Searching for \"$pattern\" in node [lindex $nodesinfo 1]..." $w 0
if {[_tkiLocalMatch [lindex $tki(nodesbody-$fileKey) $nodeIdx]]} {
tkiWinShow [lindex $nodesinfo 1] [lindex $nodesinfo 2] $w
return [searchboxSearch $pattern $regexpB $casesenB searchkey $w ]
}
incr nodeIdx
} else {
set nodeIdx 0
if { $pntKey != "" } {
# Now find next fileKey for current info file and load it into core.
incr fileKeyListIdx
if { $fileKeyListIdx == $fileKeyListLength } {
# wrap around...
set fileKeyListIdx 0
}
set fileKey [lindex [lindex $fileKeyList $fileKeyListIdx] 0]
set fileInfo $tki(fileinfo-$fileKey)
# Don't load if it's already in core!
if { $tki(incore-$fileKey) } {
set nodeList $tki(nodesinfo-$fileKey)
set nodeListLength [llength $nodeList]
} else {
set fileText [_tkiFileRead [lindex $fileInfo 1] [lindex $fileInfo 2]]
if [_tkiLocalMatch $fileText] {
tkiFileLoad $fileKey [lindex $fileInfo 1] [lindex $fileInfo 2] $fileText
set nodeList $tki(nodesinfo-$fileKey)
set nodeListLength [llength $nodeList]
} else {
set nodeListLength 0
}
}
}
}
}
# Haven't found anything.
if $incr {
tkiBell
set wvars(searchOriginFileKey) ""
tkiStatus "No more matches for \"$pattern\". Back with Ctrl-r." $w 1
} else {
tkiStatus "No matches for \"$pattern\"." $w 1
}
return 0
}
#
# Search backward through w's current info file for pattern, starting
# with the node preceding the current one. Bring up the first node
# containing string, and call searchboxSearchBackw on that node. At the
# beginning of the infofile, wrap around to the end. If no node
# contains string, return 0, else return whatever searchboxSearch
# returned. It should have been checked elsewhere that the regexp
# actually compiles correctly.
#
proc _tkiSearchFileBackw {w pattern regexpB casesenB incr} {
global tki; upvar #0 $w wvars
# _tkiLocalMatch is supposed to return 1 iff its argument matches
# $pattern. I don't understand the next lines -- I've found them by
# experimentation --A.B.
if {$regexpB} {
set transformedPattern [_tkiRegexpTransform $pattern]
if {$casesenB} {
proc _tkiLocalMatch {s} [list eval regexp -- [list $transformedPattern] \$s ]
} else {
proc _tkiLocalMatch {s} [list eval regexp -nocase -- [list $transformedPattern] \$s ]
}
} else {
if {$casesenB} {
proc _tkiLocalMatch {s} [list expr \[ string first [list $pattern] \$s \] != -1]
} else {
proc _tkiLocalMatch {s} [list expr \[ string first [list [string tolower $pattern]] \[ string tolower \$s \] \] != -1]
}
}
# Are we currently inside an ongoing search?
if { $wvars(inSearch) && $wvars(searchOriginFileKey) != "" } {
set origFileKey $wvars(searchOriginFileKey)
set origNodeIdx $wvars(searchOriginNodeIdx)
} else {
set origFileKey $wvars(fileKey)
set wvars(searchOriginFileKey) $origFileKey
set origNodeIdx [lindex $wvars(nodeinfo) 0]
set wvars(searchOriginNodeIdx) $origNodeIdx
}
set fileKey $wvars(fileKey)
set pntKey [lindex $tki(fileinfo-$fileKey) 3]
if { $pntKey != "" } {
set fileKeyList $tki(indirf-$pntKey)
set fileKeyListLength [llength $fileKeyList]
for {set idx 0} {$idx < $fileKeyListLength} {incr idx} {
if { [lindex [lindex $fileKeyList $idx] 0] == $fileKey } {
break
}
}
set fileKeyListIdx $idx
}
set nodeIdx [expr [lindex $wvars(nodeinfo) 0] - 1]
set nodeList $tki(nodesinfo-$fileKey)
set nodeListLength [llength $tki(nodesinfo-$fileKey)]
set tki(interrupt) 0
while { $fileKey != $origFileKey || $nodeIdx != $origNodeIdx } {
update
if {$tki(interrupt) == 1} {
tkiStatus "Search for \"$pattern\" interrupted." $w 0
return
}
if { $nodeIdx >= 0 } {
set nodesinfo [lindex $tki(nodesinfo-$fileKey) $nodeIdx]
tkiStatus "Searching for \"$pattern\" in node [lindex $nodesinfo 1]..." $w 0
if {[_tkiLocalMatch [lindex $tki(nodesbody-$fileKey) $nodeIdx]]} {
tkiWinShow [lindex $nodesinfo 1] [lindex $nodesinfo 2] $w
return [searchboxSearchBackw $pattern $regexpB $casesenB searchkey $w]
}
incr nodeIdx -1
} else {
set nodeIdx -1
if { $pntKey != "" } {
# Now find prev fileKey for current info file and load it into core.
if { $fileKeyListIdx == 0 } {
# wrap around...
set fileKeyListIdx $fileKeyListLength
}
incr fileKeyListIdx -1
set fileKey [lindex [lindex $fileKeyList $fileKeyListIdx] 0]
set fileInfo $tki(fileinfo-$fileKey)
# Don't load if it's already in core!
if { $tki(incore-$fileKey) } {
set nodeList $tki(nodesinfo-$fileKey)
set nodeIdx [expr [llength $nodeList] - 1]
} else {
tkiStatus "Searching for \"$pattern\" in file [lindex $fileInfo 1]..." $w 0
set fileText [_tkiFileRead [lindex $fileInfo 1] [lindex $fileInfo 2]]
if [_tkiLocalMatch $fileText] {
tkiFileLoad $fileKey [lindex $fileInfo 1] [lindex $fileInfo 2] $fileText
set nodeList $tki(nodesinfo-$fileKey)
set nodeIdx [expr [llength $nodeList] - 1]
}
}
} else {
set nodeIdx [expr $nodeListLength -1]
}
}
}
# Haven't found anything.
if $incr {
tkiBell
set wvars(searchOriginFileKey) ""
tkiStatus "No more matches for \"$pattern\". Forward with Ctrl-s." $w 1
} else {
tkiStatus "No matches for \"$pattern\"." $w 0
}
return 0
}
#
# This transforms a regexp-style regular expression so that it will
# never match more than one line. Most people expect that if they
# search for a regexp. Implemented as a state machine.
#
proc _tkiRegexpTransform {regexp} {
set result ""
set length [string length $regexp]
set state "normal"
for {set idx 0} {$idx < $length} {incr idx} {
set letter [string index $regexp $idx]
case $state {
normal {
case $letter {
"\\\\\[" {
set out "\["
set state "bracket"
}
"." {
set out "\[^\n\]"
set state "normal"
}
"\\\\\\" {
set out ""
set state "backslash"
}
"*" {
set out $letter
set state "normal"
}
}
}
backslash {
set out "\\$letter"
set state normal
}
bracket {
case $letter {
"^" {
set out "^"
set state "caret_in_brackets"
}
"*" {
set out $letter
set state "in_brackets"
}
}
}
caret_in_brackets {
set out $letter
set state "in_brackets"
}
in_brackets {
case $letter {
"\\\\\]" {
set out "\]"
set state "normal"
}
"*" {
set out $letter
set state "in_brackets"
}
}
}
}
set result "${result}$out"
}
if { $state == "backslash"} {
set result "${result}\\"
}
return $result
}
#
# Store a list of the Index nodes in the info file containing filekey
# in the global tki(indices-$infoFileKey).
# Also locate a list of nodes and store its location in
# tki(nodelist-$infoFileKey).
#
proc _tkiFindIndices {fileKey infoFileName} {
global tki
if { ![info exists tki(infoFileKey-$fileKey)] } {
set infoFileKey "[file dirname [lindex $tki(fileinfo-$fileKey) 2]]/$infoFileName"
set tki(infoFileKey-$fileKey) $infoFileKey
} else {
set infoFileKey tki(infoFileKey-$fileKey)
}
if { [info exists tki(indices-$infoFileKey)] } {
return
} else {
set topnoderef [tkiGetNodeRef $tki(topLevelNode) $fileKey]
if { $topnoderef == "" } {
tkiError "Cannot find top node of $infoFileName"
return 0
}
set topnodefilekey [lindex $topnoderef 1]
# Locate list of nodes:
set parent [lindex $tki(fileinfo-$fileKey) 3]
if {$parent == ""} {
set tki(nodelist-$infoFileKey) [list "nodelistfk" $topnodefilekey]
} else {
set tki(nodelist-$infoFileKey) [list "indirfk" $parent]
}
# Now find Index entries in top node's menu:
set topnodeidx [lindex $topnoderef 0]
if [info exist tki(menuinfo-$topnodefilekey-$topnodeidx)] {
set topmenu $tki(menuinfo-$topnodefilekey-$topnodeidx)
} else {
set topmenu [tkiNodeParseMenu $tki(topLevelNode) $topnodeidx $topnodefilekey [lindex $tki(nodesbody-$topnodefilekey) $topnodeidx]]
}
set result ""
set found 0
foreach entry $topmenu {
if { [regexp -nocase -- "(^|.* )index( .*|\$)" [lindex $entry 5] ] } {
lappend result [list [lindex $entry 2] [lindex $entry 5]]
set found 1
} elseif { $found == 1 } {
break
}
}
set tki(indices-$infoFileKey) $result
}
}
#
# Store a list of the index entries that match the search string in
# wvars(indexEntries), update wvars(indexEntriesIndex) and
# wvars(indexInfoFileKey).
#
proc _tkiIndexEntries { w filekey infoFileKey string } {
global tki; upvar #0 $w wvars
set wvars(indexInfoFileKey) $infoFileKey
set wvars(indexString) $string
if { $string == "" } {
set wvars(indexEntries) $tki(indices-$infoFileKey)
set wvars(indexEntriesIndex) 0
return ""
}
set result1 ""
set result2 ""
set result3 ""
set searchstring [string tolower $string]
foreach indexlist $tki(indices-$infoFileKey) {
set index [lindex $indexlist 0]
set indexref [tkiGetNodeRef $index $filekey]
if {$indexref == ""} {
set wvars(indexEntries) ""
return
}
set indexfilekey [lindex $indexref 1]
set indexnodeidx [lindex $indexref 0]
if [info exist tki(menuinfo-$indexfilekey-$indexnodeidx)] {
set indexmenu $tki(menuinfo-$indexfilekey-$indexnodeidx)
} else {
set indexmenu [tkiNodeParseMenu $index $indexnodeidx $indexfilekey [lindex $tki(nodesbody-$indexfilekey) $indexnodeidx]]
}
foreach entry $indexmenu {
set label [lindex $entry 5]
set labellc [string tolower [lindex $entry 5]]
set node [lindex $entry 2]
if { $searchstring == $labellc } {
lappend result1 [list $node $label]
} else {
set idx [string first $searchstring $labellc]
if { $idx == 0 } {
lappend result2 [list $node $label]
} elseif { $idx > 0 } {
lappend result3 [list $node $label]
}
}
}
}
tkiStatus "Searching for relevant index entries..." $w 0
set nodesfk [lindex $tki(nodelist-$infoFileKey) 1]
case [lindex $tki(nodelist-$infoFileKey) 0] {
"indirfk" {
set nodelist $tki(indirn-$nodesfk)
set index 0
}
"nodelistfk" {
set nodelist $tki(nodesinfo-$nodesfk)
set index 1
}
}
foreach entry $nodelist {
set labellc [string tolower [lindex $entry $index]]
set node [lindex $entry $index]
if { $searchstring == $labellc } {
lappend result1 [list $node $node]
} else {
set idx [string first $searchstring $labellc]
if { $idx == 0 } {
lappend result2 [list $node $node]
} elseif { $idx > 0 } {
lappend result3 [list $node $node]
}
}
}
set result [concat $result1 $result2 $result3]
# Now remove doubles:
set final ""
set length [llength $result]
for {set i 0} { $i < $length } {incr i} {
set node [lindex [lindex $result $i] 0]
set unique 1
for {set j 0} { $j < $i } {incr j} {
if { [lindex [lindex $result $j] 0] == $node } {
set unique 0; break
}
}
if {$unique} {lappend final [lindex $result $i]}
}
set wvars(indexEntries) $final
set wvars(indexEntriesIndex) 0
return
}
##########################################################################
# The following material was formerly contained in searchbox.tcl:
#
# SearchBox mega widget
# incremental and regular expression searching in a text widget
#
# by Tom Phelps (phelps@cs.Berkeley.EDU)
#
# extracted from and then used by TkMan and NBT 6-Aug-93
#
# 19-Aug made more robust (Kennard White)
# 5-Nov-97 heavily lobotomized (Axel Boldt)
# requires: proc regexpTextSearch
# name space use: prefixes searchbox, sb
#--------------------------------------------------
#
# searchboxSearch -- initiate a search
#
# params
# str = string to search for
# regexp = boolean - regular expression search?
# casesen = case sensitive?
# tag = tag to associate with matches
# (do a `tag bind' in the text widget for this tag)
# w = text widget
#
# returns: number of matches found, or -1 if error occured.
#--------------------------------------------------
proc searchboxSearch {str regexp casesen tag w} {
upvar #0 $w wvars
set tw $w.main.text
if {$str==""} {
tkiError "Nothing to search for!"
return -1
}
if {$regexp} {set type regexp} {set type ""}
set cnt [${type}TextSearch $tw $str $tag $casesen]
if {$cnt==-1} {tkiError "Malformed regular expression."; return -1}
if {$cnt==0} {return [_tkiSearchFileForw $w $str $regexp $casesen 0]}
set txt "Hit Ctrl-s to search for next \"$str\"."
set wvars(inSearch) 1
$w.bar.search.m entryconf "Continue forward search" -state normal
$w.bar.search.m entryconf "Continue backward search" -state normal
tkiStatus $txt $w 1
# show the first one
searchboxNext $tag $w 0.0
return $cnt
}
proc searchboxSearchBackw {str regexp casesen tag w} {
upvar #0 $w wvars
set tw $w.main.text
if {$str==""} {
tkiError "Nothing to search for!"
return -1
}
if {$regexp} {set type regexp} {set type ""}
set cnt [${type}TextSearch $tw $str $tag $casesen]
if {$cnt==-1} {tkiError "Malformed regular expression."; return -1}
if {$cnt==0} {return [_tkiSearchFileBackw $w $str $regexp $casesen 0]}
set txt "Hit Ctrl-r to search for previous \"$str\"."
set wvars(inSearch) 1
$w.bar.search.m entryconf "Continue forward search" -state normal
$w.bar.search.m entryconf "Continue backward search" -state normal
tkiStatus $txt $w 1
# show the first one
searchboxPrev $tag $w [$tw index end]
return $cnt
}
#--------------------------------------------------
#
# searchboxNext -- show the next match
#
# params
# tag = tag to search for (see searchboxSearch)
# w = text widget
# next = index to start search; defaults to last visible line
#
# returns: -1 if there is no next match
#--------------------------------------------------
proc searchboxNext {tag w {next ""}} {
upvar #0 $w wvars
set tw $w.main.text
if { [$tw tag ranges $tag] == ""} {return 0}
if { $next == ""} {
set next [lindex [_tkiWinVisibleInfo $tw] 1]
}
set tmp [$tw tag nextrange $tag $next]
if { $tmp == "" } {
return -1
} else {
$tw yview -pickplace [lindex $tmp 0]
}
}
#--------------------------------------------------
#
# searchboxPrev -- show the previous match
#
# params
# tag = tag to search for (see searchboxSearch)
# w = text widget
# next = index to start search; defaults to top of window
#
# returns: -1 if there is no next match
#--------------------------------------------------
proc searchboxPrev {tag w {next ""}} {
upvar #0 $w wvars
set tw $w.main.text
if { [$tw tag ranges $tag] == ""} {return 0}
set top [$tw index @0,0]
if { $next == ""} {set next $top}
set tmp [_tkiprevrange $tw $tag $next]
if { $tmp == ""} {
return -1
} else {
$tw yview -pickplace [lindex $tmp 0]
}
}
# swiped from mkTextSearch w
#
# The utility procedure below searches for all instances of a
# given string in a text widget and applies a given tag to each
# instance found.
# Arguments:
#
# w - The window in which to search. Must be a text widget.
# string - The string to search for. The search is done using
# exact matching only; no special characters.
# tag - Tag to apply to each instance of a matching string.
# case - (optional) case sensitive?
proc TextSearch {w string tag {case 1}} {
set cnt 0
$w tag remove $tag 0.0 end
scan [$w index end] %d numLines
set l [string length $string]
if {!$case} {set string [string tolower $string]}
for {set i 1} {$i <= $numLines} {incr i} {
set match [$w get $i.0 $i.end]
if {!$case} {set match [string tolower $match]}
if {[string first $string $match] == -1} {
continue
}
set line $match
set offset 0
while 1 {
set index [string first $string $line]
if {$index < 0} {
break
}
incr offset $index
$w tag add $tag $i.[expr $offset] $i.[expr $offset+$l]
$w tag raise $tag
incr cnt
incr offset $l
# below bug fix from mkSearch.tcl
set line [string range $line [expr $index+$l] end]
}
}
return $cnt
}
# modified to handle regexp's and return # of matches -TAP
proc regexpTextSearch {w string tag {case 1}} {
set cnt 0
if {$case} {set case ""} {set case "-nocase"}
if {[catch {regexp -- $string bozomaniac}]} {return -1}
$w tag remove $tag 0.0 end
scan [$w index end] %d numLines
for {set i 1} {$i <= $numLines} {incr i} {
set line [$w get $i.0 $i.end]
set offset 0
while 1 {
if {![eval regexp $case -indices -- {$string} {$line} match]} break
scan $match "%d %d" index iend
$w tag add $tag $i.[expr $offset+$index] $i.[expr $offset+$iend+1]
$w tag raise $tag
set line [string range $line [expr $iend+1] end]
incr offset [expr $iend+1]
incr cnt
}
}
return $cnt
}
##########################################################################
# The following material was formerly contained in topgetopt.tcl:
#
# The function has "top" prefix b/c it is conceptually part of my "top" library.
#
# Authors: Kennard White (kennard@ohm.eecs.berkeley.edu)
# Phil Lapsley (phil@ohm.eecs.berkeley.edu)
#
# Based on "@(#)getopt.tcl 1.5 12/7/91" by Phil Lapsley
#
# Simple "getopt" for TCL.
#
# topgetopt ?-any? ?-all? opt_list arg_list
# The proc will process the arguments in {arg_list} according to the
# information in {opt_list}. Processed arguments are passed back
# to the caller by setting variables in the caller's proc-environment
# (i.e., using upvar).
#
# option_list is a list of option specs. Each spec is a 3-tuple:
# { optname varname mode }
# optname is the name of the option to be parsed (without the leading dash).
# varname is the name of a tcl variable in the caller's environment.
# If ommitted, the varname defaults to the optname.
# mode describes the type of option. If ommitted, it defaults to "single".
# The modes:
# single: sets the variable to the next argument.
# append: lappends the next argument to the variable.
# this allows multiple instances of the same option.
# boolean: sets the variable to 0 if the argument prefix is "+"
# and to 1 of the argument prefix is "-".
#
# "topgetopt" sets the variables named in the option_list that were
# specified in arg_list, and returns the remainder of arg_list after
# the first non "-" or "+" option. If a bad option specifier is
# encountered, scanning stops and getopt aborts using error.
#
# If -all is specified, then everything in arg_list must match an
# option in opt_list; that is, there may be no "leftover" arguments.
#
# If -any is specified, then processing will stop at the first
# unmatched option. That is, the returned list of unprocessed
# arguments may contain unregcognized options.
#
# For example, the option_list:
#
# { min max { file filename } { toplevel toplevel boolean } }
#
# means that the option "-min value" or "-max value" should set the
# variables "min" or "max" to the specified value, and "-file foo.txt"
# should set the variable "filename" to foo.txt. "toplevel"
# sets the variable "toplevel", and is a boolean: the option "-toplevel"
# would set the variable "toplevel" to 1, while the option "+toplevel"
# would set the variable "toplevel" to 0.
#
# In typical usage, the caller will first initialize all the option
# variables to default values, and then call topgetopt.
#
proc topgetopt { args } {
set do_all 0
set do_any 0
if { [lindex $args 0] == "-all" } {
set do_all 1
set args [lreplace $args 0 0]
}
if { [lindex $args 0] == "-any" } {
set do_any 1
set args [lreplace $args 0 0]
}
if { [llength $args] != 2 } {
error "topgetopt: programming error: wrong number arguments\n$args"
}
set opt_list [lindex $args 0]
set arg_list [lindex $args 1]
set n [llength $arg_list]
for { set i 0 } { $i < $n } { incr i } {
set arg [lindex $arg_list $i]
set argkey [string index $arg 0]
if { $argkey != "-" && $argkey != "+" } {
if { $do_all } {
error "Extra arguments after options not allowed: ``$arg''"
}
break
}
set argname [string range $arg 1 end]
set matched 0
foreach opt $opt_list {
if { [lindex $opt 0] == $argname } {
set optlen [llength $opt]
set pntVar pntVar$i
upvar 1 [lindex $opt [expr { ($optlen > 1) ? 1 : 0 }]] $pntVar
# lindex returns empty string for out-of-range
case [lindex $opt 2] {
b* {
set $pntVar [expr { $argkey == "-" ? 1 : 0}]
}
a* {
lappend $pntVar [lindex $arg_list [incr i 1] ]
}
default {
set $pntVar [lindex $arg_list [incr i 1] ]
}
}
set matched 1
break
}
}
if { $matched == 0 } {
if { $do_any } {
break
} else {
error "No match for argument ``$arg''"
}
}
}
return [lrange $arg_list $i end]
}
#########################################################################
# Balloon help, by John Haxby <jch@pwd.hp.com>, with slight changes
# by Axel Boldt <axelboldt@yahoo.com>.
#
proc tkiBalloonInit {} {
global tki
bind balloon <Enter> {
if { [info exists balloonHelp(%W)] && [%W cget -state] != "disabled"} {
set balloonHelp(%W,after) [after $tki(balloonDelay) {showBalloonHelp %W}]
}
}
bind balloon <Leave> {
unShowBalloonHelp %W
}
bind balloon <Any-KeyPress> {
unShowBalloonHelp %W
}
bind balloon <Any-Button> {
unShowBalloonHelp %W
}
proc showBalloonHelp {w} {
global tki balloonHelp
if {![info exists balloonHelp($w)] || ! $tki(showBalloonsB) } {
return
}
update idletasks
set curpos [winfo pointerxy $w]
set curwin [eval winfo containing $curpos]
if { $w == $curwin } {
if ![winfo exists .balloon] {
toplevel .balloon
wm overrideredirect .balloon true
pack [label .balloon.l \
-foreground black \
-background $tki(balloonBackground) \
-highlightthickness 1 \
-highlightbackground black]
wm withdraw .balloon
}
.balloon.l configure -text $balloonHelp($w)
set x [expr [lindex $curpos 0]-14]
set y [expr [lindex $curpos 1]+19]
wm geometry .balloon +$x+$y
# This update is important to have the geometry command take
# effect in all cases (A.B.)
update idletasks
raise .balloon
wm deiconify .balloon
}
}
proc unShowBalloonHelp {w} {
global balloonHelp
if [info exists balloonHelp($w,after)] {
after cancel $balloonHelp($w,after)
unset balloonHelp($w,after)
}
catch {wm withdraw .balloon}
}
# end of proc tkiBalloonInit
}
##########################################################################
##########################################################################
# Now start the main routines:
tkiReset
tkiBoot
##########################################################################
##########################################################################
# For emacs:
# Local Variables:
# mode: tcl
# mode: outline-minor
# outline-regexp: "proc \\|#!/bin/sh"
# End:
|