/usr/share/amsn/gui.tcl is in amsn-data 0.98.9-1ubuntu3.
This file is owned by root:root, with mode 0o644.
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 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 7021 7022 7023 7024 7025 7026 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 7085 7086 7087 7088 7089 7090 7091 7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 7261 7262 7263 7264 7265 7266 7267 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 7323 7324 7325 7326 7327 7328 7329 7330 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469 7470 7471 7472 7473 7474 7475 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 7521 7522 7523 7524 7525 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 7559 7560 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 7584 7585 7586 7587 7588 7589 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 7675 7676 7677 7678 7679 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702 7703 7704 7705 7706 7707 7708 7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 7798 7799 7800 7801 7802 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 7821 7822 7823 7824 7825 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 7857 7858 7859 7860 7861 7862 7863 7864 7865 7866 7867 7868 7869 7870 7871 7872 7873 7874 7875 7876 7877 7878 7879 7880 7881 7882 7883 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 7895 7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 7944 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 7966 7967 7968 7969 7970 7971 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 8253 8254 8255 8256 8257 8258 8259 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 8343 8344 8345 8346 8347 8348 8349 8350 8351 8352 8353 8354 8355 8356 8357 8358 8359 8360 8361 8362 8363 8364 8365 8366 8367 8368 8369 8370 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 9144 9145 9146 9147 9148 9149 9150 9151 9152 9153 9154 9155 9156 9157 9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 9186 9187 9188 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 9229 9230 9231 9232 9233 9234 9235 9236 9237 9238 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 9280 9281 9282 9283 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 9327 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 9403 9404 9405 9406 9407 9408 9409 9410 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 9437 9438 9439 9440 9441 9442 9443 9444 9445 9446 9447 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 9472 9473 9474 9475 9476 9477 9478 9479 9480 9481 9482 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 | ::Version::setSubversionId {$Id: gui.tcl 12360 2012-03-03 06:21:12Z kakaroto $}
if { $initialize_amsn == 1 } {
if {![::picture::Loaded]} {
if { [OnDarwin] } {
tk_messageBox -default ok -message "There's a problem loading a module of aMSN (TkCxImage) on this \
computer. You need to update your system to Mac OS 10.3.9" -icon warning
} else {
tk_messageBox -default ok -message "Loading TkCximage failed. This module is needed to run \
aMSN. Please compile aMSN first, instructions on how to compile are located in the file INSTALL" \
-icon warning
}
exit
}
package require BWidget
source BWidget_mods.tcl
if {[catch {package require -exact tkdnd 2.0}] } {
proc dnd { args } {}
proc shape { args } {}
}
if { [version_vcompare [info patchlevel] 8.4.13] >= 0} {
package require snit
} else {
source utils/snit/snit.tcl
}
#package require pixmapbutton
if { [OnMac] } {
# Use brushed metal style windows on Mac OS X.
catch {package require tkUnsupported}
# tclCarbon has tclCarbonHICommand, and tclCarbonNotification...
catch {package require tclCarbon}
catch {package require QuickTimeTcl}
catch {load utils/macosx/Quicktimetcl3.1/quicktimetcl3.1.dylib}
} else {
package require pixmapscroll
}
::skin::setKey mainwindowbg #7979f2
::skin::setKey contactlistbg #ffffff
::skin::setKey contactlistborderbg #ffffff
::skin::setKey contactlistbd 0
::skin::setKey topcontactlistbg #ffffff
::skin::setKey bannerbg #ffffff
::skin::setKey contact_mobile #404040
::skin::setKey chatwindowbg #EAEAEA
::skin::setKey loginbg #ffffff
::skin::setKey loginwidgetbg #ffffff
::skin::setKey loginfg #000000
::skin::setKey loginurlfg #0000ff
::skin::setKey logincheckfg #ffffff
::skin::setKey loginbuttonbg #c3c2d2
::skin::setKey loginbuttonfg black
::skin::setKey loginbuttonfghover black
::skin::setKey tabbarbg "[::skin::getKey chatwindowbg]"
::skin::setKey tabfg #000000
::skin::setKey tab_text_x 5
::skin::setKey tab_text_y 5
::skin::setKey tab_text_width 80
::skin::setKey tab_close_x 100
::skin::setKey tab_close_y 10
::skin::setKey chat_tabbar_padx 0
::skin::setKey chat_tabbar_pady 0
::skin::setKey buttonbarbg #eeeeff
::skin::setKey sendbuttonbg #c3c2d2
::skin::setKey sendbuttonfg black
::skin::setKey sendbuttonfghover black
::skin::setKey topbarbg #5050e5
::skin::setKey topbarbg_sel #d3d0ce
::skin::setKey topbartext #ffffff
::skin::setKey topbarborder #000000
::skin::setKey topbarawaybg #00AB00
::skin::setKey topbarawaybg_sel #d3d0ce
::skin::setKey topbarawaytext #000000
::skin::setKey topbarawayborder #000000
::skin::setKey topbarbusybg #CF0000
::skin::setKey topbarbusybg_sel #d3d0ce
::skin::setKey topbarbusytext #000000
::skin::setKey topbarbusyborder #000000
::skin::setKey topbarofflinebg #404040
::skin::setKey topbarofflinebg_sel #d3d0ce
::skin::setKey topbarofflinetext #ffffff
::skin::setKey topbarofflineborder #000000
::skin::setKey topbaridlebg #dfe7f0
::skin::setKey topbaridletext #000000
::skin::setKey topbaridleborder #7da0af
::skin::setKey topbarbrbbg #dfe7f0
::skin::setKey topbarbrbtext #000000
::skin::setKey topbarbrbborder #7da0af
::skin::setKey topbarphonebg #dfe7f0
::skin::setKey topbarphonetext #000000
::skin::setKey topbarphoneborder #7da0af
::skin::setKey topbarlunchbg #dfe7f0
::skin::setKey topbarlunchtext #000000
::skin::setKey topbarlunchborder #7da0af
::skin::setKey topbarpadx 6
::skin::setKey topbarpady 6
::skin::setKey loginbuttonx 6
::skin::setKey loginbuttony 6
::skin::setKey sendbuttonx 6
::skin::setKey sendbuttony 6
::skin::setKey chat_top_pixmap 0
::skin::setKey statusbarbg #eeeeee
::skin::setKey statusbarbg_sel #d3d0ce
::skin::setKey statusbartext #000000
::skin::setKey groupcolorextend #000080
::skin::setKey groupcolorcontract #000080
::skin::setKey chat_top_padx 0
::skin::setKey chat_top_pady 0
::skin::setKey chat_paned_padx 0
::skin::setKey chat_paned_pady 0
::skin::setKey chat_output_padx 0
::skin::setKey chat_output_pady 0
::skin::setKey chat_buttons_padx 0
::skin::setKey chat_buttons_pady 0
::skin::setKey chat_input_padx 0
::skin::setKey chat_input_pady 0
::skin::setKey chat_dp_padx 0
::skin::setKey chat_dp_pady 0
::skin::setKey chat_leftframe_padx 0
::skin::setKey chat_leftframe_pady 0
::skin::setKey chat_sendbutton_padx 0
::skin::setKey chat_sendbutton_pady 0
::skin::setKey chat_status_padx 0
::skin::setKey chat_status_pady 0
::skin::setKey chat_sash_width 2
::skin::setKey chat_sash_relief raised
::skin::setKey chat_sash_showhandle 0
::skin::setKey chat_sash_pady 0
::skin::setKey chat_status_border_color #000000
::skin::setKey chat_output_border_color #000000
::skin::setKey chat_output_back_color #ffffff
::skin::setKey chat_input_border_color #000000
::skin::setKey chat_input_back_color #ffffff
::skin::setKey chat_buttons_border_color #000000
::skin::setKey chat_dp_border_color #000000
::skin::setKey chat_top_border 0
::skin::setKey chat_output_border 0
::skin::setKey chat_buttons_border 0
::skin::setKey chat_input_border 0
::skin::setKey chat_status_border 0
::skin::setKey chat_dp_border 1
::skin::setKey chat_show_sendbuttonframe 1
::skin::setKey chat_show_statusbarframe 1
::skin::setKey chat_show_topframe 1
::skin::setKey menuforeground #000000
::skin::setKey menuactivebackground #565672
::skin::setKey menuactiveforeground #ffffff
::skin::setKey mystatus grey
::skin::setKey buddylistpad 4
::skin::setKey showdisplaycontactlist 0
::skin::setKey emailabovecolorbar 0
::skin::setKey underline_contact 0
::skin::setKey underline_group 0
::skin::setKey changecursor_contact 1
::skin::setKey changecursor_group 1
::skin::setKey bigstate_xpad 0
::skin::setKey bigstate_ypad 0
::skin::setKey mystatus_xpad 3
::skin::setKey mystatus_ypad 0
::skin::setKey mailbox_xpad 2
::skin::setKey mailbox_ypad 2
::skin::setKey contract_xpad 8
::skin::setKey contract_ypad 6
::skin::setKey expand_xpad 8
::skin::setKey expand_ypad 6
::skin::setKey x_dp_top 4
::skin::setKey y_dp_top 4
::skin::setKey balloonbackground #daeefe
::skin::setKey balloonborderwidth 1
::skin::setKey balloonborder #2e8afe
::skin::setKey balloontext #0000dd
::skin::setKey buddy_xpad 15
::skin::setKey buddy_ypad 3
::skin::setKey notifwidth 150
::skin::setKey notifheight 100
::skin::setKey notifyfg black
::skin::setKey x_notifyclose 140
::skin::setKey y_notifyclose 2
::skin::setKey x_notifydp 1
::skin::setKey y_notifydp 22
::skin::setKey x_notifytext 55
::skin::setKey y_notifytext 22
::skin::setKey width_notifytext 93
::skin::setKey notify_font sboldf
::skin::setKey notify_dp_border 0
if { [OnMac] } {
::skin::setKey balloonbackground #ffffca
::skin::setKey menubackground #ECECEC
} else {
::skin::setKey balloonbackground #ffffaa
::skin::setKey menubackground #eae7e4
}
::skin::setKey balloonfont sboldf
::skin::setKey balloonborder #000000
::skin::setKey balloonalpha 0.9
::skin::setKey assistanttitleheight 50
::skin::setKey assistanttitlefg #FFFFFF
::skin::setKey assistanttitlebg #565672
::skin::setKey extrastdwindowcolor #efefef
::skin::setKey extrastdbgcolor #ffffff
::skin::setKey extrastdtxtcolor #333333
::skin::setKey extraselectedtxtcolor #222222
::skin::setKey extraselectedbgcolor #dddddd
::skin::setKey extradisabledtxtcolor #666666
::skin::setKey extradisabledbgcolor #efefef
::skin::setKey extrastderrcolor #FF0000
::skin::setKey extrastdokcolor #559c2a
::skin::setKey extralistboxselected #0000FF
::skin::setKey extralistboxselectedbg #ffffff
::skin::setKey extralistboxtitlebg #ffffff
::skin::setKey extralistboxtitlefg #000000
::skin::setKey extrabuttonbgcolor #efefef
::skin::setKey extrabuttontxtcolor #333333
::skin::setKey extrabuttonbgcoloractive #dddddd
::skin::setKey extrabuttontxtcoloractive #222222
::skin::setKey extralinkcolor #0000FF
::skin::setKey extralinkcoloractive #6931CA
::skin::setKey extralinkbgcoloractive #ffffff
::skin::setKey extracheckbuttonselectedcolor #ff0000
::skin::setKey extraprivacy_old_bg #000000
::skin::setKey extraprivacy_old_fg #FF8F8F
::skin::setKey extraprivacy_notrl_bg #FF6060
::skin::setKey extraprivacy_notrl_fg #A00000
::skin::setKey extraprivacy_notfl_bg #FFFF80
::skin::setKey extraprivacy_notfl_fg #A00000
::skin::setKey extraprivacy_intoal_fg #008000
::skin::setKey extraprivacy_intobl_fg #A00000
::skin::setKey loginurlfghover #6931CA
::skin::setKey emailfg #000000
::skin::setKey emailhover #000000
::skin::setKey emailhoverbg #ffffff
::skin::setKey tabfg_hover #333333
::skin::setKey statusbartext_sel #000000
::skin::setKey trayblink_delay 500
::skin::setKey trayblink_by_status 1
#Virtual events used by Button-click
#On Mac OS X, Control emulate the "right click button"
#On Mac OS X, there's a mistake between button2 and button3
if { [OnMac] } {
event add <<Button1>> <Button1-ButtonRelease>
event add <<Button1-Press>> <ButtonPress-1>
event add <<Button1-Motion>> <B1-Motion>
event add <<Button2>> <Button3-ButtonRelease>
event add <<Button2-Press>> <ButtonPress-3>
event add <<Button2-Motion>> <B3-Motion>
event add <<Button3>> <Control-ButtonRelease>
event add <<Button3>> <Button2-ButtonRelease>
event add <<Button3-Press>> <ButtonPress-2>
event add <<Button3-Motion>> <B2-Motion>
event add <<Escape>> <Command-w> <Command-W>
event add <<Paste>> <Command-v> <Command-V>
event add <<Copy>> <Command-c> <Command-C>
event add <<Cut>> <Command-x> <Command-X>
} elseif { [OnMaemo] } {
event add <<Button1>> <Button1-ButtonRelease>
event add <<Button1-Press>> <ButtonPress-1>
event add <<Button1-Motion>> <B1-Motion>
event add <<Button2>> <Button2-ButtonRelease>
event add <<Button2-Press>> <ButtonPress-2>
event add <<Button2-Motion>> <B2-Motion>
event add <<Button3>> <Control-ButtonRelease>
event add <<Button3-Press>> <Control-ButtonPress>
event add <<Button3-Motion>> <B3-Motion>
event add <<Escape>> <Escape>
event add <<Paste>> <Control-v> <Control-V>
event add <<Copy>> <Control-c> <Control-C>
event add <<Cut>> <Control-x> <Control-X>
} else {
event add <<Button1>> <Button1-ButtonRelease>
event add <<Button1-Press>> <ButtonPress-1>
event add <<Button1-Motion>> <B1-Motion>
event add <<Button2>> <Button2-ButtonRelease>
event add <<Button2-Press>> <ButtonPress-2>
event add <<Button2-Motion>> <B2-Motion>
event add <<Button3>> <Button3-ButtonRelease>
event add <<Button3-Press>> <ButtonPress-3>
event add <<Button3-Motion>> <B3-Motion>
event add <<Escape>> <Escape>
event add <<Paste>> <Control-v> <Control-V>
event add <<Copy>> <Control-c> <Control-C>
event add <<Cut>> <Control-x> <Control-X>
}
if { [OnLinux] } {
#Mappings for Shift-BackSpace
bind Entry <Terminate_Server> [bind Entry <BackSpace>]
bind Text <Terminate_Server> [bind Text <BackSpace>]
}
#This proc bugs anyway
rename ::tk::FirstMenu ::tk::Original_FirstMenu
proc ::tk::FirstMenu { args } { }
#To avoid a bug inside panedwindow, by Youness
rename ::tk::panedwindow::Cursor ::tk::panedwindow::Original_Cursor
proc ::tk::panedwindow::Cursor { args } {
catch { eval ::tk::panedwindow::Original_Cursor $args }
}
#For proc WinWrite
namespace eval ::amsn {
variable urlcount 0
variable urlregexps
# MAKE SURE that none of the regexps have a capturing group!
# use (?:regexp) if you need to use the parenthesis..
# like for (?:org|com|net)...
#this regexp is a bit complex, but it reaches all URLs as specified in the RFC 1738 on http://www.ietf.org/rfc/rfc1738.txt
set urlregexps {
{\w+://[\%\/\$\*\~\|\,\!\'\#\.\@\(\)\+\-\=\?\;\:\^\&\_[:alnum:]]+}
{\mwww\.[\%\/\$\*\~\,\|\!\'\#\.\@\(\)\+\-\=\?\;\:\^\&\_[:alnum:]]+}
{(?:[\%\/\$\*\~\,\!\'\|\#\@\(\)\+\-\=\?\;\:\^\&\_[:alnum:]]+\.)+(?:org|com|net)(?:/[\%\/\$\*\~\,\!\'\|\#\.\@\(\)\+\-\=\?\;\:\^\&\_[:alnum:]]*)*(?=\y)}
{spotify:(?:track|album|artist|search|playlist|user|radio):[^<>\s]+}
}
}
#For idle checking
global idletime oldmousepos autostatuschange
set idletime 0
set oldmousepos [list]
set autostatuschange 0
}
namespace eval ::amsn {
namespace export initLook aboutWindow showHelpFile errorMsg infoMsg \
blockUnblockUser blockUser unblockUser deleteUser removeUserFromGroup \
fileTransferRecv fileTransferProgress \
errorMsg notifyAdd initLook messageFrom userJoins userLeaves \
updateTypers ackMessage nackMessage chatUser
##PUBLIC
proc initLook { family size bgcolor} {
font create menufont -family $family -size $size -weight normal
font create sboldf -family $family -size $size -weight bold
font create splainf -family $family -size $size -weight normal
font create sunderf -family $family -size $size -weight normal -underline yes
font create sboldunderf -family $family -size $size -weight bold -underline yes
font create sbolditalf -family $family -size $size -weight bold -slant italic
font create sitalf -family $family -size $size -slant italic
font create macfont -family [list {Lucida Grande}] -size 13 -weight normal
if { [::config::getKey strictfonts] } {
font create bboldf -family $family -size $size -weight bold
font create bboldunderf -family $family -size $size -weight bold -underline true
font create bplainf -family $family -size $size -weight normal
font create bsunderf -family $family -size $size -weight normal -underline yes
font create bigfont -family $family -size $size -weight bold
font create examplef -family $family -size $size -weight normal
} else {
font create bboldf -family $family -size [expr {$size+1}] -weight bold
font create bboldunderf -family $family -size [expr {$size+1}] -weight bold -underline true
font create bplainf -family $family -size [expr {$size+1}] -weight normal
font create bsunderf -family $family -size [expr {$size+1}] -weight normal -underline true
font create bigfont -family $family -size [expr {$size+2}] -weight bold
font create examplef -family $family -size [expr {$size-1}] -weight normal
}
catch {tk_setPalette [::skin::getKey menubackground]}
option add *Menu.font menufont
option add *Canvas.highlightThickness 0
option add *Photo.format cximage widgetDefault
option add *Font splainf userDefault
option add *background [::skin::getKey extrastdwindowcolor]
option add *foreground [::skin::getKey extrastdtxtcolor]
option add *activeBackground [::skin::getKey extrabuttonbgcoloractive]
option add *activeForeground [::skin::getKey extrabuttontxtcoloractive]
option add *selectColor [::skin::getKey extracheckbuttonselectedcolor]
option add *Combobox.buttonBackground [::skin::getKey extrastdbgcolor]
option add *Combobox.background [::skin::getKey extrastdbgcolor]
if { ![OnMac] } {
option add *borderWidth 1 widgetDefault
option add *activeBorderWidth 1 widgetDefault
option add *selectBorderWidth 1 widgetDefault
option add *highlightThickness 0 widgetDefault
option add *troughColor #c3c3c3 widgetDefault
option add *Frame.borderWidth 2 widgetDefault
option add *Frame.background [::skin::getKey extrastdwindowcolor]
option add *Frame.foreground [::skin::getKey extrastdtxtcolor]
option add *Labelframe.borderWidth 2 widgetDefault
option add *Labelframe.padY 8 widgetDefault
option add *Labelframe.padX 12 widgetDefault
option add *Labelframe.background [::skin::getKey extrastdwindowcolor]
option add *Labelframe.foreground [::skin::getKey extrastdtxtcolor]
option add *Label.foreground [::skin::getKey extrastdtxtcolor]
option add *Entry.borderWidth 1 widgetDefault
option add *Entry.selectBorderWidth 0 widgetDefault
option add *Entry.padX 2 widgetDefault
option add *Entry.padY 4 widgetDefault
option add *Entry.background [::skin::getKey extrastdbgcolor]
option add *Entry.foreground [::skin::getKey extrastdtxtcolor]
option add *Entry.disabledBackground [::skin::getKey extradisabledbgcolor]
option add *Entry.disabledForeground [::skin::getKey extradisabledtxtcolor]
option add *Entry.selectBackground [::skin::getKey extraselectedbgcolor]
option add *Entry.selectForeground [::skin::getKey extraselectedtxtcolor]
option add *Text.selectBorderWidth 0 widgetDefault
option add *Text.padX 2 widgetDefault
option add *Text.padY 4 widgetDefault
option add *Text.background [::skin::getKey extrastdbgcolor]
option add *Text.foreground [::skin::getKey extrastdtxtcolor]
option add *Text.disabledBackground [::skin::getKey extradisabledbgcolor]
option add *Text.disabledForeground [::skin::getKey extradisabledtxtcolor]
option add *Text.selectBackground [::skin::getKey extraselectedbgcolor]
option add *Text.selectForeground [::skin::getKey extraselectedtxtcolor]
option add *Button.background [::skin::getKey extrabuttonbgcolor]
option add *Button.foreground [::skin::getKey extrabuttontxtcolor]
option add *Button.activeBackground [::skin::getKey extrabuttonbgcoloractive]
option add *Button.activeForeground [::skin::getKey extrabuttontxtcoloractive]
option add *Checkbutton.background [::skin::getKey extrastdwindowcolor]
option add *Checkbutton.foreground [::skin::getKey extrabuttontxtcolor]
option add *Checkbutton.activeBackground [::skin::getKey extrabuttonbgcoloractive]
option add *Checkbutton.activeForeground [::skin::getKey extrabuttontxtcoloractive]
option add *Checkbutton.selectColor [::skin::getKey extracheckbuttonselectedcolor]
option add *Radiobutton.background [::skin::getKey extrastdwindowcolor]
option add *Radiobutton.foreground [::skin::getKey extrabuttontxtcolor]
option add *Radiobutton.activeBackground [::skin::getKey extrabuttonbgcoloractive]
option add *Radiobutton.activeForeground [::skin::getKey extrabuttontxtcoloractive]
option add *Radiobutton.selectColor [::skin::getKey extracheckbuttonselectedcolor]
option add *Listbox.selectBorderWidth 0 widgetDefault
option add *Listbox.relief sunken
option add *Listbox.background [::skin::getKey extrastdbgcolor]
option add *Listbox.foreground [::skin::getKey extrastdtxtcolor]
option add *Listbox.selectBackground [::skin::getKey extraselectedbgcolor]
option add *Listbox.selectForeground [::skin::getKey extraselectedtxtcolor]
option add *Menu.activeBorderWidth 0 widgetDefault
option add *Menu.highlightThickness 0 widgetDefault
option add *Menu.borderWidth 1 widgetDefault
option add *Menu.background [::skin::getKey menubackground]
option add *Menu.foreground [::skin::getKey menuforeground]
option add *Menu.activeBackground [::skin::getKey menuactivebackground]
option add *Menu.activeForeground [::skin::getKey menuactiveforeground]
option add *Menubutton.background [::skin::getKey extrabuttonbgcolor]
option add *Menubutton.foreground [::skin::getKey extrabuttontxtcolor]
option add *Menubutton.activeBackground [::skin::getKey extrabuttonbgcoloractive]
option add *Menubutton.activeForeground [::skin::getKey extrabuttontxtcoloractive]
option add *Menubutton.relief raised
option add *Menubutton.padX 2 widgetDefault
option add *Menubutton.padY 4 widgetDefault
#option add *NoteBook.background [::skin::getKey extrastdwindowcolor]
#option add *NoteBook.Canvas.background [::skin::getKey extrastdwindowcolor]
#option add *NoteBook.Canvas.ArrowButton.background [::skin::getKey extrastdwindowcolor]
# -activebackground [::skin::getKey extrabuttonbgcoloractive] -activeforeground [::skin::getKey extrabuttontxtcoloractive]
option add *Scrollbar.width 10
option add *Scrollbar.borderWidth 1
option add *Scrollbar.highlightThickness 0 widgetDefault
}
#Use different width for scrollbar on Mac OS X
#http://wiki.tcl.tk/12987
if { [OnMac] } {
option add *background #ECECEC
option add *highlightbackground #ECECEC
option add *Scrollbar.width 16 userDefault
option add *Button.Font macfont userDefault
option add *Button.highlightBackground #ECECEC userDefault
} elseif { [OnWin] } {
#option add *background [::skin::getKey extrastdwindowcolor]
option add *Scrollbar.width 14 userDefault
option add *Button.Font sboldf userDefault
}
#option add *Scrollbar.borderWidth 1 userDefault
#set Entry {-bg #FFFFFF -foreground #000000}
#set Label {-bg #FFFFFF -foreground #000000}
#::themes::AddClass Amsn Entry $Entry 90
#::themes::AddClass Amsn Label $Label 90
::abookGui::Init
#Register events
::Event::registerEvent loggedIn all loggedInGuiConf
::Event::registerEvent loggedOut all loggedOutGuiConf
}
#///////////////////////////////////////////////////////////////////////////////
# Draws the about window
proc aboutWindow {} {
global langenc date weburl
set filename "[file join docs README[::config::getGlobalKey language]]"
set current_enc $langenc
if {![file exists $filename]} {
status_log "File $filename NOT exists!!\n\tUsing english one instead." red
set filename README
set current_enc "iso8859-1"
if {![file exists $filename]} {
status_log "no english README either .. Houston, we have a problem, you ***'ed up your aMSN install!"
msg_box "[trans transnotexists]"
return
}
}
if { [winfo exists .about] } {
raise .about
return
}
toplevel .about
wm title .about "[trans aboutamsn]"
ShowTransient .about
wm state .about withdrawn
#Top frame (Picture and name of developers)
set developers " Youness Alaoui\n Boris Faure\n Vivia Nikolaidou\n Philippe Valembois\n Alexander Nestorov"
set version "aMSN $::version ([::abook::dateconvert $date])"
if {[string index $::version end] == "b" && $::Version::amsn_revision > 0} {
append version "\n[trans svnversion] : $::Version::amsn_revision"
}
label .about.image -image [::skin::loadPixmap msndroid]
label .about.title -text $version -font bboldf
label .about.what -text "[trans whatisamsn]\n"
pack .about.image .about.title .about.what -side top
#names-frame
frame .about.names
label .about.names.t -font splainf -text "[trans broughtby]:\n$developers"
pack .about.names.t -side top
pack .about.names -side top
#Middle frame (About text)
frame .about.middle
frame .about.middle.list -borderwidth 0
text .about.middle.list.text -width 80 -height 10 -wrap word \
-yscrollcommand ".about.middle.list.ys set" -font splainf
scrollbar .about.middle.list.ys -command ".about.middle.list.text yview"
pack .about.middle.list.ys -side right -fill y
pack .about.middle.list.text -side left -expand true -fill both
pack .about.middle.list -side top -expand true -fill both -padx 1 -pady 1
label .about.middle.url -text $weburl -font bplainf \
-background [::skin::getKey extrastdwindowcolor] -foreground [::skin::getKey extralinkcolor]
pack .about.middle.url -side top -pady 3
bind .about.middle.url <Enter> ".about.middle.url configure \
-font bsunderf -cursor hand2 \
-background [::skin::getKey extralinkbgcoloractive] -foreground [::skin::getKey extralinkcoloractive]"
bind .about.middle.url <Leave> ".about.middle.url configure \
-font bplainf -cursor left_ptr \
-background [::skin::getKey extrastdwindowcolor] -foreground [::skin::getKey extralinkcolor]"
bind .about.middle.url <<Button1>> "launch_browser $weburl"
#Bottom frame (Close button)
frame .about.bottom
button .about.bottom.close -text "[trans close]" -command "destroy .about"
button .about.bottom.credits -text "[trans credits]..." -command [list ::amsn::showHelpFileWindow CREDITS [trans credits]]
bind .about <<Escape>> "destroy .about"
pack .about.bottom.close -side right
pack .about.bottom.credits -side left
pack .about.bottom -side bottom -fill x -pady 3 -padx 5
pack .about.middle -expand true -fill both -side top
#Insert the text in .about.middle.list.text
set id [open $filename r]
fconfigure $id -encoding $current_enc
.about.middle.list.text insert 1.0 [read $id]
close $id
.about.middle.list.text configure -state disabled
update idletasks
wm state .about normal
set x [expr {([winfo vrootwidth .about] - [winfo width .about]) / 2}]
set y [expr {([winfo vrootheight .about] - [winfo height .about]) / 2}]
wm geometry .about +${x}+${y}
moveinscreen .about 30
#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
#wm resizable .about 0 0
}
#///////////////////////////////////////////////////////////////////////////////
proc checkcert {args} {
if { [lindex $args 0] == "verify" } {
set status [lindex $args 4]
set errormsg [lindex $args 5]
if {!$status} {
#set answer [::amsn::messageBox "Bad certificate: $errormsg, continue anyway?" yesno question "Certificate problem"]
#TODO:
# translation
# save the answer for this certificate (using sha1)
set answer "yes"
if { $answer == yes } {
set status 1
}
#puts [info level 0]
#puts $status
#puts $errormsg
}
return $status
}
}
#///////////////////////////////////////////////////////////////////////////////
# showHelpFileWindow(file, windowtitle, ?english?)
proc showHelpFileWindow {file title {english 0}} {
global langenc
set langcode [::config::getGlobalKey language]
set encoding $langenc
if {$english == 1} {
set langcode "en"
set encoding "iso8859-1"
}
set filename [file join "docs" "${file}$langcode"]
if {$langcode == "en"} {
set filename $file
}
if {![file exists $filename]} {
status_log "File $filename NOT exists!!\n\tOpening English one instead." red
set filename "${file}"
set langcode "en"
set encoding "iso8859-1"
if {![file exists $filename]} {
status_log "Couldn't open $filename!" red
msg_box "[trans transnotexists]"
return
}
}
if {$file == "CREDITS"} {
set encoding "utf-8"
}
if {$langcode == "en"} {
set w help${filename}en
} else {
set w help${filename}
}
status_log "filename: $filename"
# Used to avoid a bug for dbusviewer where the $filename points to /home/user/.amsn the dot makes
# tk think it's a window's path separator and it says that the window .help/home/user/ doesn't exit (for .amsn to be its child)
set w ".[string map {. "_" " " "__"} $w]"
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w
wm title $w "$title"
ShowTransient $w
#Top frame (Help text area)
frame $w.info
frame $w.info.list -borderwidth 0
text $w.info.list.text -width 80 -height 30 -wrap word \
-yscrollcommand "$w.info.list.ys set" -font splainf
scrollbar $w.info.list.ys -command "$w.info.list.text yview"
pack $w.info.list.ys -side right -fill y
pack $w.info.list.text -expand true -fill both -padx 1 -pady 1
pack $w.info.list -side top -expand true -fill both -padx 1 -pady 1
pack $w.info -expand true -fill both -side top
#Bottom frame (Close button)
button $w.close -text "[trans close]" -command "destroy $w"
button $w.eng -text "English version" -command [list ::amsn::showHelpFileWindow $file "$title - English version" 1]
bind $w <<Escape>> "destroy $w"
pack $w.close
if {$langcode != "en" && $english != 1} {
pack $w.eng -side right -anchor e -padx 5 -pady 3
}
pack $w.close -side right -anchor e -padx 5 -pady 3
#Insert FAQ text
set id [open $filename r]
fconfigure $id -encoding $encoding
$w.info.list.text insert 1.0 [read $id]
close $id
$w.info.list.text configure -state disabled
update idletasks
set x [expr {([winfo vrootwidth $w] - [winfo width $w]) / 2}]
set y [expr {([winfo vrootheight $w] - [winfo height $w]) / 2}]
wm geometry $w +${x}+${y}
#Should we disable resizable? Since when we make the windows smaller (in y), we lost the "Close button"
#wm resizable .about 0 0
return $w
}
#///////////////////////////////////////////////////////////////////////////////
proc messageBox { message type icon {title ""} {parent ""}} {
#If we are on MacOS X, don't put the box in the parent because there are some problems
if { [OnMac] } {
set answer [tk_messageBox -message "$message" -type $type -icon $icon]
} else {
if { $parent == ""} {
set parent [focus]
if { $parent == "" } { set parent "." }
}
set answer [tk_messageBox -message "$message" -type $type -icon $icon -title $title -parent $parent]
}
return $answer
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc customMessageBox { message type {icon ""} {title ""} {parent ""} {askRememberAnswer 0} {modal 0} {uniqueId ""}} {
# This tracker is so we can TkWait. It needs to be global so that the buttons can modify it.
global customMessageBoxAnswerTracker
# This is the tracker for the checkbox.
# It needs to be an array because we may have more than one message box open (hence the unique index).
global customMessageBoxRememberTracker
if {$uniqueId == ""} {
set uniqueId [clock seconds]
} else {
if {[winfo exists ".messagebox_$uniqueId"]} {
return "duplicate"
}
}
set w ".messagebox_$uniqueId"
if { [winfo exists $w] } {
raise $w
return
}
set w [toplevel $w]
if {$title == ""} {
set title [trans title]
}
wm title $w $title
wm group $w .
wm resizable $w 0 0
#Create the 2 frames
frame $w.top
frame $w.buttons
if {$icon == ""} {
label $w.top.bitmap -image [::skin::loadPixmap warning]
} else {
label $w.top.bitmap -image [::skin::loadPixmap $icon]
}
pack $w.top.bitmap -side left -pady 0 -padx [list 0 12 ]
label $w.top.message -text $message -wraplength 400 -justify left
pack $w.top.message -pady 0 -padx 0 -side top
if {$askRememberAnswer != 0} {
if {$askRememberAnswer == 1} {
set rememberText [trans remembersetting]
} else {
set rememberText [trans $askRememberAnswer]
}
checkbutton $w.top.remember -variable customMessageBoxRememberTracker($uniqueId) \
-text $rememberText -anchor w -state normal
pack $w.top.remember -pady 5 -padx 10 -side bottom -fill x
}
switch $type {
abortretryignore {
set buttons [list [list "abort" [trans abort]] [list "retry" [trans retry]] [list "ignore" [trans ignore]]]
}
ok {
set buttons [list [list "ok" [trans ok]]]
}
okcancel {
set buttons [list [list "ok" [trans ok]] [list "cancel" [trans cancel]]]
}
retrycancel {
set buttons [list [list "retry" [trans retry]] [list "cancel" [trans cancel]]]
}
yesno {
set buttons [list [list "yes" [trans yes]] [list "no" [trans no]]]
}
yesnocancel {
set buttons [list [list "yes" [trans yes]] [list "no" [trans no]] [list "cancel" [trans cancel]]]
}
deletecancel {
set buttons [list [list "delete" [trans delete]] [list "cancel" [trans cancel]]]
}
deleteblockcancel {
set buttons [list [list "delete" [trans delete]] [list "deleteblock" [trans deleteblock]] [list "cancel" [trans cancel]]]
}
default {
set buttons [list [list "ok" [trans ok]]]
}
}
set customMessageBoxAnswerTracker($uniqueId) ""
#Create the buttons
foreach button $buttons {
set buttonName [lindex $button 0]
set buttonLabel [lindex $button 1]
button $w.buttons.$buttonName -text $buttonLabel -command [list set customMessageBoxAnswerTracker($uniqueId) $buttonName]
pack $w.buttons.$buttonName -pady 0 -padx 0 -side right
}
#Pack frames
pack $w.top -pady 12 -padx 12 -side top
pack $w.buttons -pady 12 -padx 12 -fill x
moveinscreen $w 30
bind $w <<Escape>> "destroy $w"
wm protocol $w WM_DELETE_WINDOW [list set customMessageBoxAnswerTracker($uniqueId) ""]
set oldgrab ""
if { $modal } {
set oldgrab [grab current]
grab set $w
}
tkwait variable customMessageBoxAnswerTracker($uniqueId)
if { $oldgrab != "" } {
grab set $oldgrab
}
catch { destroy $w }
if {$askRememberAnswer != 0} {
set answer [list $customMessageBoxAnswerTracker($uniqueId) $customMessageBoxRememberTracker($uniqueId)]
unset customMessageBoxAnswerTracker($uniqueId)
unset customMessageBoxRememberTracker($uniqueId)
} else {
set answer $customMessageBoxAnswerTracker($uniqueId)
unset customMessageBoxAnswerTracker($uniqueId)
}
return $answer
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# Shows the error message specified by "msg"
proc errorMsg { msg } {
::amsn::messageBox $msg ok error "[trans title] Error"
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# Shows the error message specified by "msg"
proc infoMsg { msg {icon "info"} } {
::amsn::messageBox $msg ok $icon [trans title]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc blockUnblockUser { user_login } {
if { [::MSN::userIsBlocked $user_login] } {
unblockUser $user_login
} else {
blockUser $user_login
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc blockUser {user_login} {
set answer [::amsn::messageBox "[trans confirmbl] ($user_login)" yesno question [trans block]]
if { $answer == "yes"} {
set name [::abook::getNick ${user_login}]
::MSN::blockUser ${user_login}
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc unblockUser {user_login} {
set name [::abook::getNick ${user_login}]
::MSN::unblockUser ${user_login}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
proc removeUserFromGroup {user_login grId} {
::MSN::removeUserFromGroup $user_login $grId
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
#Delete user window, user can choose to delete user, cancel the action or block and delete the user
proc deleteUser { user_login } {
if {[lsearch [::abook::getLists $user_login] BL] == -1} {
# User is not blocked.
set type deleteblockcancel
} else {
# User is already blocked.
set type deletecancel
}
if {[::MSN::userIsNotIM $user_login] } {
set answer [customMessageBox [trans confirmdu] $type "" "[trans delete] - $user_login" "." 0]
set fulldelete 1
} else {
set answer [customMessageBox [trans confirmdu] $type "" "[trans delete] - $user_login" "." confirmfulldelete]
foreach {answer fulldelete} $answer break
}
if {$answer == "deleteblock"} {
# Delete the user and block.
::amsn::deleteUserAction $user_login 1 $fulldelete
} elseif {$answer == "delete"} {
# Only delete the user.
::amsn::deleteUserAction $user_login 0 $fulldelete
}
}
#///////////////////////////////////////////////////////////////////////////////
# deleteUserAction {user_login answer grId block}
# Action to do when someone click delete a user
proc deleteUserAction {user_login {block 0} {full 0}} {
#If the user wants to delete AND block a user
if { $block == 1 } {
set name [::abook::getNick ${user_login}]
::MSN::blockUser ${user_login}
}
::MSN::deleteUser ${user_login} $full
::abook::setContactData $user_login alarms ""
return
}
proc WriteNewData { msnobj } {
#@@@@@@@@@@@@@
global HOME
set user_login [$msnobj cget -creator]
set type [$msnobj cget -type]
set data [$msnobj cget -data]
set filename [::MSNP2P::GetFilenameFromMSNOBJ [$msnobj toString]]
status_log "Got data from $user_login in $filename"
if { $type == $::p2p::MSNObjectType::DISPLAY_PICTURE } {
set filename [::abook::getContactData $user_login displaypicfile ""]
create_dir [file join $HOME displaypic cache]
create_dir [file join $HOME displaypic cache $user_login]
set fd [open "[file join $HOME displaypic cache $user_login ${filename}.png]" w]
fconfigure $fd -translation {binary binary}
puts -nonewline $fd $data
close $fd
::skin::getDisplayPicture $user_login 1
::amsn::UpdateAllPictures
set desc_file "[file join $HOME displaypic cache $user_login ${filename}.dat]"
create_dir [file join $HOME displaypic]
set fd [open [file join $HOME displaypic $desc_file] w]
status_log "Writing description to $desc_file\n"
puts $fd "[clock seconds]\n$user_login"
close $fd
::Event::fireEvent contactDPChange protocol $user_login
} elseif { $type == $::p2p::MSNObjectType::CUSTOM_EMOTICON } {
set dot [string first ".tmp" $filename]
if { $dot >= 0 } {
set filename [string range $filename 0 [expr { $dot - 1} ] ]
}
status_log "Incoming emoticon"
create_dir [file join $HOME smileys cache]
set fd [open "[file join $HOME smileys cache ${filename}.png]" w]
fconfigure $fd -translation {binary binary}
puts -nonewline $fd $data
close $fd
set tw [::ChatWindow::GetOutText [::ChatWindow::For $user_login]]
set scrolling [::ChatWindow::getScrolling $tw]
catch {image create photo emoticonCustom_std_${filename} -file "[file join $HOME smileys cache ${filename}.png]" -format cximage}
if {[::config::getKey big_incoming_smileys 0] == 0} {
::smiley::resizeCustomSmiley emoticonCustom_std_${filename}
}
if {[::config::getKey big_incoming_smileys 0] == 0} {
::smiley::resizeCustomSmiley emoticonCustom_std_${filename}
}
if { $scrolling } { ::ChatWindow::Scroll $tw }
} elseif { $type == $::p2p::MSNObjectType::WINK } {
status_log "Incoming wink"
set fd [open "[file join $HOME winks cache ${filename}.cab]" w]
if {$fd != "" } {
fconfigure $fd -translation {binary binary}
puts -nonewline $fd $data
close $fd
set evPar(chatid) $user_login
set evPar(filename) [file join $HOME winks cache ${filename}.cab]
::plugins::PostEvent WinkReceived evPar
}
} elseif { $type == $::p2p::MSNObjectType::VOICE_CLIP } {
status_log "Incoming voice clip"
create_dir [file join $HOME voiceclips]
create_dir [file join $HOME voiceclips cache]
set fd [open "[file join $HOME voiceclips cache ${filename}.wav]" w]
fconfigure $fd -translation {binary binary}
puts -nonewline $fd $data
close $fd
set file [file join $HOME voiceclips cache ${filename}.wav]
::ChatWindow::ReceivedVoiceClip $user_login $file
}
}
proc InkSend { win_name filename {friendlyname ""}} {
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "VERY BAD ERROR in ::amsn::InkSend!!!\n" red
return 0
}
#Blank ink
if {$filename == ""} { return 0 }
if { $friendlyname != "" } {
set nick $friendlyname
set p4c 1
} elseif { [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] != ""} {
set friendlyname [::abook::parseCustomNick [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] [::abook::getPersonal MFN] [::abook::getPersonal login] "" [::abook::getpsmmedia] ]
set nick $friendlyname
set p4c 1
} elseif { [::config::getKey p4c_name] != ""} {
set nick [::config::getKey p4c_name]
set p4c 1
} else {
set nick [::abook::getPersonal MFN]
set p4c 0
}
#Postevent when we send a message
set evPar(nick) nick
set evPar(ink) filename
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent chat_ink_send evPar
#Draw our own message
#Does this image ever gets destroyed ? When destroying the chatwindow it's embeddeed in it should I guess ? This is not the leak I'm searching for though as I'm not sending inks...
# don't try to display it if the image is considered as invalid
if {[catch {set img [image create photo [TmpImgName] -file $filename]}]} {
status_log "(::amsn::InkSend) trying to display an invalid image, but keep sending it." red
} else {
SendMessageFIFO [list ::amsn::ShowInk $chatid [::abook::getPersonal login] $nick $img ink $p4c] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
::MSN::ChatQueue $chatid [list ::MSN::SendInk $chatid $filename]
::plugins::PostEvent chat_ink_sent evPar
}
proc InviteCallFromCW {win_name video} {
if {![winfo exists $win_name] } {
set win_name [::amsn::chatUser $win_name]
}
set chatid [::ChatWindow::Name $win_name]
status_log "chatid:=$chatid" red
set users [::MSN::usersInChat $chatid]
if {[llength $users] > 1} {
#TODO: add a new key?
::amsn::errorMsg [trans sipcallyouarebusy2]
} elseif {[llength $users] == 1} {
::amsn::SIPCallInviteUser $video [lindex $users 0]
} else {
::amsn::SIPCallInviteUser $video $chatid
}
}
proc FileTransferSend { win_name {filename ""} } {
if {![winfo exists $win_name] } {
set win_name [::amsn::chatUser $win_name]
}
global starting_dir
# set filename [ $w.top.fields.file get ]
if { $filename == "" } {
set filename [chooseFileDialog "" [trans sendfile] $win_name]
status_log $filename
}
if { $filename == "" } { return }
#Remember last directory
set starting_dir [file dirname $filename]
if {![file readable $filename]} {
msg_box "[trans invalidfile [trans filename] $filename]"
return
}
if { [::config::getKey autoftip] } {
set ipaddr [::config::getKey myip]
} else {
set ipaddr [::config::getKey manualip]
}
if { [catch {set filesize [file size $filename]} res]} {
::amsn::errorMsg "[trans filedoesnotexist]"
#::amsn::fileTransferProgress c $cookie -1 -1
return 1
}
set chatid [::ChatWindow::Name $win_name]
status_log "chatid:=$chatid" red
set users [::MSN::usersInChat $chatid]
foreach chatid $users {
chatUser $chatid
#Calculate a random cookie
set cookie [expr {([clock clicks]) % (65536 * 8)}]
set txt "[trans ftsendinvitation [::abook::getDisplayNick $chatid] $filename [::amsn::sizeconvert $filesize]]"
status_log "Random generated cookie: $cookie\n"
SendMessageFIFO [list ::amsn::WinWriteFTSend $chatid $txt $cookie] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
::MSN::ChatQueue $chatid [list ::MSNFT::sendFTInvitation $chatid $filename $filesize $ipaddr $cookie]
#::MSNFT::sendFTInvitation $chatid $filename $filesize $ipaddr $cookie
::log::ftlog $chatid $txt
# Postevent when we send a file transfer invitation
set evPar(chatid) $chatid
set evPar(filename) $filename
::plugins::PostEvent sent_ft_invite evPar
}
return 0
}
proc WinWriteFTSend { chatid txt cookie } {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid "$txt " green
WinWriteClickable $chatid "[trans cancel]" \
"::amsn::CancelFTInvitation $chatid $cookie" ftno$cookie
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
}
proc DisableCancelText { cookie chatid } {
set win_name [::ChatWindow::For $chatid]
if { [winfo exists $win_name] } {
[::ChatWindow::GetOutText ${win_name}] tag configure ftno$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftno$cookie <<Button1>> ""
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm
}
}
proc CancelFTInvitation { chatid cookie } {
#::MSNFT::acceptFT $chatid $cookie
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
::MSNFT::cancelFTInvitation $chatid $cookie
$::ft_handler cancel_by_cookie $cookie
DisableCancelText $cookie $chatid
set txt [trans invitationcancelled]
SendMessageFIFO [list ::amsn::WinWriteCancelFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteCancelFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
}
proc acceptedFT { chatid who filename } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set txt [trans ftacceptedby [::abook::getDisplayNick $chatid] $filename]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc rejectedFT { chatid who filename } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set txt [trans ftrejectedby [::abook::getDisplayNick $chatid] $filename]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid " \n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
#////////////////////////////////////////////////////////////////////////////////
# GotFileTransferRequest ( chatid dest branchuid cseq uid sid filename filesize)
# This procedure is called when we receive an MSN6 File Transfer Request
proc GotFileTransferRequest { chatid dest session} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set semic [string first ";" $dest]
if { $semic > 0 } {
set dest [string range $dest 0 [expr {$semic - 1}]]
}
set fromname [::abook::getDisplayNick $dest]
set filen [$session cget -filename]
set filesize [$session cget -size]
set txt [trans ftgotinvitation $fromname '$filen' [::amsn::sizeconvert $filesize] [::config::getKey receiveddir]]
set win_name [::ChatWindow::MakeFor $chatid $txt $dest]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid " \n" green
set sid [$session cget -id]
if { [::skin::loadPixmap "FT_preview_${sid}"] != "" } {
WinWriteIcon $chatid FT_preview_${sid} 5 5
WinWrite $chatid "\n" green
}
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid $txt green
WinWrite $chatid " - (" green
#WinWriteClickable $chatid "[trans accept]" [list ::amsn::AcceptFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]] ftyes$sid
WinWriteClickable $chatid "[trans accept]" [list $session accept] ftyes$sid
WinWrite $chatid " / " green
#WinWriteClickable $chatid "[trans saveas]" [list ::amsn::SaveAsFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]] ftsaveas$sid
WinWriteClickable $chatid "[trans saveas]" [list $session saveAs] ftsaveas$sid
WinWrite $chatid " / " green
#WinWriteClickable $chatid "[trans reject]" [list ::amsn::RejectFT $chatid -1 [list $sid $branchuid $uid]] ftno$sid
WinWriteClickable $chatid "[trans reject]" [list $session reject] ftno$sid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
::log::ftlog $dest $txt
if { ![file writable [::config::getKey receiveddir]]} {
WinWrite $chatid "\n[trans readonlywarn [::config::getKey receiveddir]]\n" red
WinWriteIcon $chatid greyline 3
}
if { [::config::getKey ftautoaccept] == 1 || [::abook::getContactData $dest autoacceptft] == 1 } {
WinWrite $chatid "\n[trans autoaccepted]" green
#::amsn::AcceptFT $chatid -1 [list $dest $branchuid $cseq $uid $sid $filename]
$session accept
}
}
#Message shown when receiving a file
proc fileTransferRecv {filename filesize cookie chatid fromlogin} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set semic [string first ";" $fromlogin]
if { $semic > 0 } {
set fromlogin [string range $fromlogin 0 [expr {$semic - 1}]]
}
set fromname [::abook::getDisplayNick $fromlogin]
set txt [trans ftgotinvitation $fromname '$filename' [::amsn::sizeconvert $filesize] [::config::getKey receiveddir]]
set win_name [::ChatWindow::MakeFor $chatid $txt $fromlogin]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid $txt green
WinWrite $chatid " - (" green
WinWriteClickable $chatid "[trans accept]" \
"::amsn::AcceptFT $chatid $cookie" ftyes$cookie
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans saveas]" \
"::amsn::SaveAsFT $chatid $cookie" ftsaveas$cookie
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans reject]" \
"::amsn::RejectFT $chatid $cookie" ftno$cookie
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
::log::ftlog $fromlogin $txt
if { ![file writable [::config::getKey receiveddir]]} {
WinWrite $chatid "\n[trans readonlywarn [::config::getKey receiveddir]]\n" red
WinWriteIcon $chatid greyline 3
}
if { [::config::getKey ftautoaccept] == 1 || [::abook::getContactData $fromlogin autoacceptft] == 1 } {
WinWrite $chatid "\n[trans autoaccepted]" green
::amsn::AcceptFT $chatid $cookie
}
}
proc AcceptFTOpenSB { chatid cookie {varlist ""} } {
#::amsn::RecvWin $cookie
if { $cookie != -1 } {
::MSNFT::acceptFT $chatid $cookie
} else {
::MSN6FT::AcceptFT $chatid [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2] [lindex $varlist 3] [lindex $varlist 4] [lindex $varlist 5]
set cookie [lindex $varlist 4]
}
}
proc AcceptFT { chatid cookie {varlist ""} } {
#foreach var $varlist {
# status_log "Var: $var\n" red
#}
set chatid [::MSN::chatTo $chatid]
#::MSN::ChatQueue $chatid [list ::amsn::AcceptFTOpenSB $chatid $cookie $varlist]
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
if { $cookie == -1 } {
set cookie [lindex $varlist 4]
}
[::ChatWindow::GetOutText ${win_name}] tag configure ftyes$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <<Button1>> ""
[::ChatWindow::GetOutText ${win_name}] tag configure ftsaveas$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <<Button1>> ""
DisableCancelText $cookie $chatid
set txt [trans ftaccepted]
SendMessageFIFO [list ::amsn::WinWriteAcceptFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteAcceptFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid fticon 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
}
proc SaveAsFT {chatid cookie {varlist ""} } {
global HOME
if {$cookie != -1} {
set initialfile [::MSNFT::getFilename $cookie]
} {
set initialfile [lindex $varlist 5]
}
if {[catch {set filename [tk_getSaveFile -initialfile $initialfile -initialdir [::config::getKey receiveddir]]} res]} {
status_log "Error in SaveAsFT: $res \n"
set filename [tk_getSaveFile -initialfile $initialfile -initialdir [set HOME]]
}
if {$filename != ""} {
AcceptFT $chatid $cookie [list [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2] [lindex $varlist 3] [lindex $varlist 4] "$filename"]
} {return}
}
proc RejectFT {chatid cookie {varlist ""} } {
if { $cookie != -1 && $cookie != -2 } {
::MSNFT::rejectFT $chatid $cookie
} elseif { $cookie == - 1 } {
#::MSN6FT::RejectFT $chatid [lindex $varlist 0] [lindex $varlist 1] [lindex $varlist 2]
#set cookie [lindex $varlist 0]
set cookie $varlist
} elseif { $cookie == -2 } {
set cookie [lindex $varlist 0]
set txt [trans filetransfercancelled]
}
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
[::ChatWindow::GetOutText ${win_name}] tag configure ftyes$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftyes$cookie <<Button1>> ""
[::ChatWindow::GetOutText ${win_name}] tag configure ftsaveas$cookie \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind ftsaveas$cookie <<Button1>> ""
DisableCancelText $cookie $chatid
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm
if { [info exists txt] == 0 } {
set txt [trans ftrejected]
}
SendMessageFIFO [list ::amsn::WinWriteRejectFT $chatid $txt] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
set email [::MSN::usersInChat $chatid]
::log::ftlog $email $txt
}
proc WinWriteRejectFT {chatid txt} {
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid ftreject 3 2
WinWrite $chatid "$txt\n" green
WinWriteIcon $chatid greyline 3
}
# TODO it would be best to make it "[$extratitle] - $file - [trans filetranser]"
proc setFTWinTitle { w cookie filename {extratitle ""} } {
variable ftwin_filename
if { ![info exists ftwin_filename($w,$cookie)] } {
set file ""
if { $filename != ""} {
set file [getfilename $filename]
set ftwin_filename($w,$cookie) $file
}
} else {
set file [set ftwin_filename($w,$cookie)]
}
set title "$extratitle"
if {$title != "" } {
append title " - "
}
append title "$file - [trans filetransfer]"
if { [string compare [wm title $w] "$title" ] } {
wm title $w "$title"
}
# if { [::MSNFT::getTransferType $cookie] == "received" } {
# wm title $w "$filename - [trans receivefile]"
# } else {
# wm title $w "$filename - [trans sendfile]"
# }
}
#PRIVATE: Opens Receiving Window
proc FTWin {cookie filename user session {chatid 0}} {
status_log "Creating receive progress window\n"
if { $chatid == 0 } { set chatid $user }
if { [string range $filename [expr {[string length $filename] - 11}] [string length $filename]] == ".incomplete" } {
set filename [filenoext $filename]
}
# Set appropriate Cancel command
#if { [::MSNP2P::SessionList get $cookie] == 0 } {
# set cancelcmd "::MSNFT::cancelFT $cookie"
#} else {
# set cancelcmd "::MSN6FT::CancelFT $chatid $cookie"
#}
if { [string first "FileTransferSession" "$session"] >= 0 } {
set cancelcmd [list $session cancel]
} else {
set cancelcmd "::MSNFT::cancelFT $cookie"
}
set w .ft$cookie
set lastfocus [focus]
toplevel $w
wm group $w .
#wm geometry $w 360x170
#frame $w.f -class amsnChatFrame -background [::skin::getKey chatwindowbg] -borderwidth 0 -relief flat
#set w $ww.f
label $w.user -text "[trans user]: $user" -font splainf
pack $w.user -side top -anchor w
label $w.file -text "[trans filename]: $filename" -font splainf
pack $w.file -side top -anchor w
pack [::dkfprogress::Progress $w.prbar] -fill x -expand 0 -padx 5 -pady 5 -side top
label $w.progress -text "" -font splainf
label $w.time -text "" -font splainf
pack $w.progress $w.time -side top
checkbutton $w.ftautoclose -text "[trans ftautoclose]" -onvalue 1 -offvalue 0 -variable [::config::getVar ftautoclose]
pack $w.ftautoclose -side top
#Specify the path to the file
set filepath $filename
set filedir [file dirname $filename]
#Open directory and Open picture button
button $w.close -text "[trans cancel]" -command $cancelcmd
button $w.open -text "[trans opendir]" -state normal -command [list launch_filemanager $filedir]
button $w.openfile -text "[trans openfile]" -state disable -command [list open_file $filepath]
pack $w.close $w.open $w.openfile -side right -pady 5 -padx 10
setFTWinTitle $w $cookie $filename
bind $w <<Escape>> $cancelcmd
wm protocol $w WM_DELETE_WINDOW $cancelcmd
moveinscreen $w 30
::dkfprogress::SetProgress $w.prbar 0
update idletasks
catch {focus $lastfocus}
}
#Updates filetransfer progress window/Bar
#fileTransferProgress mode cookie filename bytes filesize
# mode: a=Accepting invitation
# c=Connecting
# w=Waiting for connection
# e=Connect error
# i=Identifying/negotiating
# l=Connection lost
# ca=Cancel
# s=Sending
# r=Receiving
# fr=finish receiving
# fs=finish sending
# cookie: ID for the filetransfer
# bytes: bytes sent/received ( > filesize if finished / -1 if cancelling )
# filesize: total bytes in the file
# chatid: used for through server transfers
#####
proc FTProgress {mode session filename {bytes 0} {filesize 1000} {chatid 0}} {
variable firsttimes ;# Array. Times in ms when the FT started.
variable ratetimer
#set filename [$session cget -localpath]
set username [$session cget -peer]
if { $chatid == 0 } { set chatid $username }
set cookie [$session cget -id]
if { [info exists ratetimer($cookie)] } {
after cancel $ratetimer($cookie)
}
set w .ft$cookie
if { ([winfo exists $w] == 0) && ($mode != "ca")} {
#set filename2 [::MSNFT::getFilename $cookie]
#if { $filename == "" } {
# FTWin $cookie [::MSNFT::getFilename $cookie] [::MSNFT::getUsername $cookie] $chatid
# FTWin $cookie $filename $username $session $chatid
#} else {
FTWin $cookie $filename $username $session $chatid
#}
}
if {[winfo exists $w] == 0} {
return -1
}
switch $mode {
a {
$w.progress configure -text "[trans ftaccepting]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
c {
$w.progress configure -text "[trans ftconnecting $bytes $filesize]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
w {
$w.progress configure -text "[trans listeningon $bytes]..."
setFTWinTitle $w $cookie $filename
::dkfprogress::SetProgress $w.prbar 0 1000
}
e {
$w.progress configure -text "[trans ftconnecterror]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
setFTWinTitle $w $cookie $filename "[trans error]"
}
i {
# This means it's connected and it tries to authenticate the user...
#$w.progress configure -text "[trans ftconnecting]"
setFTWinTitle $w $cookie $filename
}
l {
$w.progress configure -text "[trans ftconnectionlost]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans error]"
}
r -
s {
#Calculate how many seconds has transmission lasted
if {![info exists firsttimes] || ![info exists firsttimes($cookie)]} {
set firsttimes($cookie) [clock seconds]
set difftime 0
} else {
set difftime [expr {[clock seconds] - $firsttimes($cookie)}]
}
if { $difftime == 0 || $bytes == 0} {
set rate "???"
set timeleft "-"
} else {
#Calculate rate and time
set rate [format "%.1f" [expr {(1.0*$bytes / $difftime) / 1024.0 } ]]
set secleft [expr {int(((1.0*($filesize - $bytes)) / $bytes) * $difftime)} ]
set t1 [expr {$secleft % 60 }] ;#Seconds
set secleft [expr {int($secleft / 60)}]
set t2 [expr {$secleft % 60 }] ;#Minutes
set secleft [expr {int($secleft / 60)}]
set t3 $secleft ;#Hours
set timeleft [format "%02i:%02i:%02i" $t3 $t2 $t1]
}
if {$mode == "r"} {
$w.progress configure -text \
"[trans receivedbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
} elseif {$mode == "s"} {
$w.progress configure -text \
"[trans sentbytes [::amsn::sizeconvert $bytes] [::amsn::sizeconvert $filesize]] ($rate KB/s)"
}
$w.time configure -text "[trans timeremaining] : $timeleft"
set percent [expr {int(double($bytes)/ (double($filesize)/100.0))}]
set ratetimer($cookie) [after 1000 [list ::amsn::FTProgress $mode $session $filename $bytes $filesize $chatid]]
setFTWinTitle $w $cookie $filename "${percent}%"
if { $filesize != 0 } {
::dkfprogress::SetProgress $w.prbar $bytes $filesize
}
}
ca {
$w.progress configure -text "[trans filetransfercancelled]"
$w.close configure -text "[trans close]" -command "destroy $w"
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans cancelled]"
}
fs -
fr {
::dkfprogress::SetProgress $w.prbar 100
$w.progress configure -text "[trans filetransfercomplete]"
$w.close configure -text "[trans close]" -command "destroy $w"
$w.openfile configure -state normal
wm protocol $w WM_DELETE_WINDOW "destroy $w"
bind $w <<Escape>> "destroy $w"
setFTWinTitle $w $cookie $filename "[trans done]"
::dkfprogress::SetProgress $w.prbar 1000 1000
}
}
switch $mode {
e -
l -
ca -
fs -
fr {
# Whenever a file transfer is terminated in a way or in another,
# remove the counters for this cookie.
if {[info exists firsttimes($cookie)]} { unset firsttimes($cookie) }
if {[info exists ratetimer($cookie)]} { unset ratetimer($cookie) }
variable ftwin_filename
if {[info exists ftwin_filename($w,$cookie)]} { unset ftwin_filename($w,$cookie) }
}
}
# Close the window if the filetransfer is finished
if {($mode == "fr" || $mode == "fs") && [::config::getKey ftautoclose]} {
destroy $w
}
}
#Converts filesize in KBytes or MBytes
proc sizeconvert {filesize} {
#Converts in KBytes
set filesizeK [expr {int($filesize/1024)}]
#Converts in MBytes
set filesizeM [expr {int($filesize/1048576)}]
#If the sizefile is bigger than 1Mo
if {$filesizeM != 0} {
set filesizeM2 [expr {int((($filesize/1048576.) - $filesizeM)*100)}]
if {$filesizeM2 < 10} {
set filesizeM2 "0$filesizeM2"
}
set filesizeM "$filesizeM,$filesizeM2"
return "${filesizeM}M"
#Elseif the filesize is bigger than 1Ko
} elseif {$filesizeK != 0} {
return "${filesizeK}K"
} else {
return "$filesize"
}
}
#////////////////////////////////////////////////////////////////////////////////
# SIP CALLING FUNCTION
#////////////////////////////////////////////////////////////////////////////////
variable sipchatids
set sipchatids [list]
proc AddSIPchatidToList {chatid} {
variable sipchatids
lappend sipchatids $chatid
}
proc DelSIPchatidFromList {chatid} {
variable sipchatids
set pos [lsearch $sipchatids $chatid]
if {$pos != -1} {
set sipchatids [lreplace $sipchatids $pos $pos]
}
}
proc SIPchatidExistsInList {chatid} {
variable sipchatids
if {[lsearch $sipchatids $chatid] != -1} {
return 1
} else {
return 0
}
}
proc SIPCallInviteUser { video email } {
status_log "CallInviteUser $email"
set clientid [::abook::getContactData $email clientid]
if { $clientid == "" } { set clientid 0 }
if {$video } {
if { ([::config::getKey protocol] >= 18 &&
[::MSN::hasCapability $clientid rtcvideo]) ||
([::config::getKey protocol] < 18 &&
[::MSN::hasCapability $clientid sip] &&
[::MSN::hasCapability $clientid msnc10]) } {
status_log "User $email supports SIP"
AddSIPchatidToList $email
::MSNSIP::InviteUser $email $video
} else {
status_log "User $email has no SIP flag"
SIPCallNoSIPFlag $video $email
}
} else {
if {[::MSN::hasCapability $clientid sip] ||
[::MSN::hasCapability $clientid tunnelsip] } {
status_log "User $email supports SIP"
AddSIPchatidToList $email
::MSNSIP::InviteUser $email $video
} else {
status_log "User $email has no SIP flag"
SIPCallNoSIPFlag $video $email
}
}
}
proc SIPPreparing {video email sip callid} {
set win_name [::ChatWindow::MakeFor $email]
$::farsight configure -video-preview-xid [winfo id [[::ChatWindow::GetInDisplayPictureFrame $win_name].pic.image getinnerframe]]
# -video-sink-xid [winfo id [::ChatWindow::GetOutDisplayPicturesFrame $win_name].dps.imgs.**something**]
::ChatWindow::AddVoipControls $email $video $sip $callid
if {$callid != "" } {
::ChatWindow::setCallButton $email "decline" $video $sip $callid
} else {
::ChatWindow::setCallButton $email "cancel" $video $sip $callid
}
}
proc DisableSIPButton { chatid tag } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
# Disable SIP Button button
[::ChatWindow::GetOutText ${win_name}] tag configure $tag \
-foreground #808080 -font bplainf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind $tag <Enter> ""
[::ChatWindow::GetOutText ${win_name}] tag bind $tag <Leave> ""
[::ChatWindow::GetOutText ${win_name}] tag bind $tag <<Button1>> ""
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm
}
proc SIPCallBack { video email} {
DisableSIPButton $email sipcallback$email
SIPCallInviteUser $video $email
}
proc SIPCallMessageCallBack { video chatid txt} {
::ChatWindow::MakeFor $chatid
DisableSIPButton $chatid sipcallback$chatid
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid sipicon 3 2
WinWrite $chatid " $txt\n" green
WinWrite $chatid " (" green
WinWriteClickable $chatid "[trans sipcallback]" [list ::amsn::SIPCallBack $video $chatid] sipcallback$chatid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
}
proc SIPCallMessage { chatid txt } {
::ChatWindow::MakeFor $chatid
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid sipicon 3 2
WinWrite $chatid " $txt\n" green
WinWriteIcon $chatid greyline 3
}
proc SIPCallNoVideoCodecs { chatid } {
status_log "SIP call is impossible.. no codecs found"
SIPCallMessage $chatid [trans novideocodecsavailable]
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" 1 ;# last arg is 1 because it will always be a videocall.
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCallReceived { video chatid sip callid} {
set fromname [::abook::getDisplayNick $chatid]
if {$video} {
set txt [trans sipvideogotinvitation $fromname]
} else {
set txt [trans sipgotinvitation $fromname]
}
set win_name [::ChatWindow::MakeFor $chatid $txt $chatid]
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid " \n" green
WinWriteIcon $chatid sipicon 3 2
WinWrite $chatid $txt green
WinWrite $chatid " - (" green
WinWriteClickable $chatid "[trans accept]" [list ::amsn::AcceptSIPCall $video $chatid $sip $callid] sipyes$callid
WinWrite $chatid " / " green
WinWriteClickable $chatid "[trans reject]" [list ::amsn::DeclineSIPCall $video $chatid $sip $callid] sipno$callid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
# The phone is ringing!!
play_sound ring.wav
}
proc AcceptSIPCall { video chatid sip callid } {
status_log "Accepting SIP call from $chatid"
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
DisableSIPButton $chatid sipyes$callid
DisableSIPButton $chatid sipno$callid
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid sipicon 3 2
if {$video} {
WinWrite $chatid " [trans sipvideocallaccepted]\n" green
} else {
WinWrite $chatid " [trans sipcallaccepted]\n" green
}
WinWrite $chatid " (" green
WinWriteClickable $chatid "[trans hangup]" [list ::amsn::HangupSIPCall $video $chatid $sip $callid] siphangup$callid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
AddSIPchatidToList $chatid
::ChatWindow::setCallButton $chatid "hangup" $video $sip $callid
::ChatWindow::UpdateVoipControls $chatid $video $sip $callid
::MSNSIP::AcceptInvite $sip $callid
}
proc DeclineSIPCall { video chatid sip callid } {
status_log "Rejecting SIP call from $chatid"
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
DisableSIPButton $chatid sipyes$callid
DisableSIPButton $chatid sipno$callid
if {$video} {
SIPCallMessage $chatid [trans sipvideocalldeclined]
} else {
SIPCallMessage $chatid [trans sipcalldeclined]
}
::MSNSIP::DeclineInvite $sip $callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc HangupSIPCall { video chatid sip callid } {
status_log "Hanging up SIP call"
SIPCallEnded [$::farsight IsVideo] $chatid $sip $callid
::MSNSIP::HangUp $sip $callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc CancelSIPCall { video chatid sip callid} {
status_log "Canceling SIP invite"
if {$callid != ""} {
DisableSIPButton $chatid siphangup$callid
::MSNSIP::CancelCall $sip $callid
}
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPInviteSent { video chatid sip callid } {
status_log "SIP invite sent"
WinWrite $chatid "\n" green
WinWriteIcon $chatid greyline 3
WinWrite $chatid "\n" green
WinWriteIcon $chatid sipicon 3 2
WinWrite $chatid " [trans sipcallsent [::abook::getDisplayNick $chatid]]\n" green
WinWrite $chatid " (" green
WinWriteClickable $chatid "[trans hangup]" [list ::amsn::CancelSIPCall $video $chatid $sip $callid] siphangup$callid
WinWrite $chatid ")\n" green
WinWriteIcon $chatid greyline 3
# Can be weird to ring the phone there, but i think it's useful
play_sound ring.wav
::ChatWindow::setCallButton $chatid "cancel" $video $sip $callid
::ChatWindow::UpdateVoipControls $chatid $video $sip $callid
}
proc SIPCallEnded { video chatid sip callid } {
status_log "SIP call ended"
if {$video} {
SIPCallMessage $chatid [trans sipvideocallended]
} else {
SIPCallMessage $chatid [trans sipcallended]
}
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeAccepted { video chatid sip callid } {
::ChatWindow::MakeFor $chatid
status_log "SIP callee accepted our call"
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
if {$video} {
SIPCallMessage $chatid [trans sipvideocalleeaccepted]
} else {
SIPCallMessage $chatid [trans sipcalleeaccepted]
}
# Modify Hangup button to hangup instead of cancel call
[::ChatWindow::GetOutText ${win_name}] tag bind siphangup$callid <<Button1>> [list ::amsn::HangupSIPCall $video $chatid $sip $callid]
::ChatWindow::setCallButton $chatid "hangup" $video $sip $callid
::ChatWindow::UpdateVoipControls $chatid $video $sip $callid
}
proc SIPCallConnected { video chatid sip callid } {
::ChatWindow::MakeFor $chatid
if {$video} {
::ChatWindow::Status [ ::ChatWindow::For $chatid ] [trans sipvideocallconnected]
} else {
::ChatWindow::Status [ ::ChatWindow::For $chatid ] [trans sipcallconnected]
}
::ChatWindow::UpdateVoipControls $chatid $video $sip $callid
}
proc SIPCalleeBusy { video chatid sip callid } {
status_log "SIP callee is busy"
SIPCallMessage $chatid [trans sipcalleebusy]
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeDeclined { video chatid sip callid } {
status_log "SIP callee declined our call"
if {$video} {
SIPCallMessage $chatid [trans sipvideocalleedeclined]
} else {
SIPCallMessage $chatid [trans sipcalleedeclined]
}
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeClosed { video chatid sip callid } {
status_log "SIP callee closed the call"
if {$video} {
SIPCallMessage $chatid [trans sipvideocalleeclosed]
} else {
SIPCallMessage $chatid [trans sipcalleeclosed]
}
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeNoAnswer { video chatid sip callid } {
status_log "SIP user did not answer our call"
SIPCallMessage $chatid [trans sipcalleenoanswer]
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeUnavailable { video chatid sip callid } {
status_log "SIP user is currently unavailable"
SIPCallMessage $chatid [trans sipcalleeunavailable]
DisableSIPButton $chatid siphangup$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCallImpossible { video chatid } {
status_log "SIP call is impossible.. no farsight utility found/working"
SIPCallMessage $chatid [trans sipcallimpossible2]
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCallNoSIPFlag { video chatid } {
status_log "User $chatid has no SIP flag in his clientid"
if {$video} {
SIPCallMessage $chatid [trans sipvideocallnosipflag]
} else {
SIPCallMessage $chatid [trans sipcallnosipflag]
}
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCallMissed { video chatid {callid ""} } {
status_log "We missed a SIP call from $chatid"
if {$video} {
SIPCallMessageCallBack $video $chatid [trans sipvideocallmissed [::abook::getDisplayNick $chatid]]
} else {
SIPCallMessageCallBack $video $chatid [trans sipcallmissed [::abook::getDisplayNick $chatid]]
}
if {$callid != "" } {
DisableSIPButton $chatid sipyes$callid
DisableSIPButton $chatid sipno$callid
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
}
proc SIPCallYouAreBusy { video chatid } {
status_log "Trying to make multiple SIP calls"
SIPCallMessage $chatid [trans sipcallyouarebusy2]
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
proc SIPCalleeCanceled { video chatid sip callid } {
status_log "SIP callee canceled his invite"
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
DisableSIPButton $chatid sipyes$callid
DisableSIPButton $chatid sipno$callid
if {$video} {
SIPCallMessage $chatid [trans sipvideocalleecanceled]
} else {
SIPCallMessage $chatid [trans sipcalleecanceled]
}
DelSIPchatidFromList $chatid
::ChatWindow::setCallButton $chatid "invite" $video
::ChatWindow::RemoveVoipControls $chatid
}
#///////////////////////////////////////////////////////////////////////////////
# PUBLIC messageFrom(chatid,user,msg,type,[fontformat])
# Called by the protocol layer when a message 'msg' arrives from the chat
# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
# the 'fontformat' parameter will be used as font format.
# The procedure will open a window if it does not exists, add a notifyWindow and
# play a sound if it's necessary
proc messageFrom { chatid user nick message type {p4c 0} } {
global remote_auth
set fonttype [$message getHeader X-MMS-IM-Format]
set begin [expr {[string first "FN=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontfamily "[urldecode [string range $fonttype $begin $end]]"
set begin [expr {[string first "EF=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontstyle "[urldecode [string range $fonttype $begin $end]]"
set begin [expr {[string first "CO=" $fonttype]+3}]
set end [expr {[string first ";" $fonttype $begin]-1}]
set fontcolor "000000[urldecode [string range $fonttype $begin $end]]"
set fontcolor "[string range $fontcolor end-1 end][string range $fontcolor end-3 end-2][string range $fontcolor end-5 end-4]"
set style [list]
if {[string first "B" $fontstyle] >= 0} {
lappend style "bold"
}
if {[string first "I" $fontstyle] >= 0} {
lappend style "italic"
}
if {[string first "U" $fontstyle] >= 0} {
lappend style "underline"
}
if {[string first "S" $fontstyle] >= 0} {
lappend style "overstrike"
}
if { [::config::getKey disableuserfonts] } {
# If user wants incoming and outgoing messages to have the same font
set fontfamily [lindex [::config::getKey mychatfont] 0]
set style [lindex [::config::getKey mychatfont] 1]
#set fontcolor [lindex [::config::getKey mychatfont] 2]
} elseif { [::config::getKey theirchatfont] != "" && $user != [::config::getKey login] } {
# If user wants to specify a font for incoming messages (to override that user's font)
foreach { fontfamily style fontcolor } [::config::getKey theirchatfont] {}
#set fontfamily [lindex 0]
#set style [lindex [::config::getKey theirchatfont] 1]
#set fontcolor [lindex [::config::getKey theirchatfont 2]
}
#if customfnick exists replace the nick with customfnick
set customfnick [::abook::getVolatileData $user parsed_customfnick]
if { [::abook::removeStyles $customfnick] eq "" } {
set customfnick [::abook::getVolatileData $user parsed_customnick] ;# it's different for the previous it was parsed_custom"F"nick, this one is parsed_customnick !
}
if { [::abook::removeStyles $customfnick] ne "" } {
set nick [::abook::getNick $user 1]
set customnick [::abook::getVolatileData $user parsed_customnick]
set nick [::abook::removeStyles [::abook::parseCustomNickStyled $customfnick $nick $user $customnick]]
}
set msg [$message getBody]
set maxw [expr {[::skin::getKey notifwidth]-20}]
incr maxw [expr {0-[font measure splainf -displayof . "[trans says [list]]:"]}]
set nickt [trunc $nick $maxw splainf]
#if { ([::config::getKey notifymsg] == 1) && ([string first ${win_name} [focus]] != 0)} {
# notifyAdd "[trans says $nickt]:\n$msg" "::amsn::chatUser $chatid"
#}
set fontformat [list $fontfamily $style $fontcolor]
set tmsg "[trans says $nickt]:\n$msg"
#Postevent for pre_msg_receive
set evPar(chatid) chatid
set evPar(user) user
set evPar(nick) nick
set evPar(msg) msg
set evPar(type) type
set evPar(fontformat) fontformat
set evPar(p4c) p4c
set evPar(tmsg) tmsg
::plugins::PostEvent pre_msg_receive evPar
if {$msg != "" || $tmsg != ""} {
set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]
if { $remote_auth == 1 } {
if { "$user" != "$chatid" } {
write_remote "To $chatid : $msg" msgsent
} else {
write_remote "From $chatid : $msg" msgrcv
}
}
PutMessage $chatid $user $nick $msg $type $fontformat $p4c
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# PUBLIC ShowInk(chatid,user,image,type,p4c)
# Called by the protocol layer when an ink 'image' arrives from the chat
# 'chatid'.'user' is the login of the message sender, and 'user' can be "msg" to
# send special messages not prefixed by "XXX says:". 'type' can be a style tag as
# defined in the ::ChatWindow::Open proc, or just "user". If the type is "user",
# the 'fontformat' parameter will be used as font format.
# The procedure will open a window if it does not exists, add a notifyWindow and
# play a sound if it's necessary
proc ShowInk { chatid user nick image type {p4c 0} } {
global remote_auth
#if customfnick exists replace the nick with customfnick
set customfnick [::abook::getVolatileData $user parsed_customfnick]
if { $customfnick != "" } {
set nick [::abook::getNick $user 1]
set customnick [::abook::getVolatileData $user parsed_customnick]
set nick [::abook::removeStyles [::abook::parseCustomNickStyled $customfnick $nick $user $customnick]]
}
set maxw [expr {[::skin::getKey notifwidth]-20}]
incr maxw [expr {0-[font measure splainf -displayof . "[trans says [list]]:"]}]
set nickt [trunc $nick $maxw splainf]
set tmsg "[trans gotink $user]"
set win_name [::ChatWindow::MakeFor $chatid $tmsg $user]
PutMessageWrapped $chatid $user $nickt "" $type "" $p4c
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
[::ChatWindow::GetOutText ${win_name}] image create end -image $image
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# enterCustomStyle ()
# Dialog window to edit the custom chat style
proc enterCustomStyle {} {
set w .change_custom_style
if {[winfo exists $w]} {
raise $w
return 0
}
toplevel $w
wm group $w .
wm title $w "[trans customstyle]"
frame $w.fn
label $w.fn.label -font sboldf -text "[trans customstyle]:"
entry $w.fn.ent -width 40 -bd 1 -font splainf
menubutton $w.fn.help -font sboldf -text "<-" -menu $w.fn.help.menu
menu $w.fn.help.menu -tearoff 0
$w.fn.help.menu add command -label [trans nick] -command "$w.fn.ent insert insert \\\$nick"
$w.fn.help.menu add command -label [trans timestamp] -command "$w.fn.ent insert insert \\\$tstamp"
$w.fn.help.menu add command -label [trans newline] -command "$w.fn.ent insert insert \\\$newline"
$w.fn.help.menu add separator
$w.fn.help.menu add command -label [trans delete] -command "$w.fn.ent delete 0 end"
$w.fn.ent insert end [::config::getKey customchatstyle]
frame $w.fb
button $w.fb.ok -text [trans ok] -command [list ::amsn::enterCustomStyleOk $w]
button $w.fb.cancel -text [trans cancel] -command "destroy $w"
pack $w.fn.label $w.fn.ent $w.fn.help -side left -fill x -expand true
pack $w.fb.ok $w.fb.cancel -side right -padx 5
pack $w.fn $w.fb -side top -fill x -expand true -padx 5
bind $w.fn.ent <Return> [list ::amsn::enterCustomStyleOk $w]
catch {
raise $w
focus -force $w.fn.ent
}
moveinscreen $w 30
}
proc enterCustomStyleOk {w} {
::config::setKey customchatstyle [$w.fn.ent get]
destroy $w
}
#///////////////////////////////////////////////////////////////////////////////
# userJoins (chatid, user_name)
# called from the protocol layer when a user JOINS a chat
# It should be called after a JOI in the switchboard.
# If a window exists, it will show "user joins conversation" in the status bar
# - 'chatid' is the chat name
# - 'usr_name' is the user that joins email
proc userJoins { chatid usr_name {create_win 1} } {
set win_name [::ChatWindow::For $chatid]
if { $create_win && $win_name == 0 && [::config::getKey newchatwinstate]!=2 } {
set win_name [::ChatWindow::MakeFor $chatid "" $usr_name]
# PostEvent 'new_conversation' to notify plugins that the window was created
set evPar(chatid) $chatid
set evPar(usr_name) $usr_name
::plugins::PostEvent new_conversation evPar
}
if { $win_name != 0 } {
set statusmsg "[timestamp] [trans joins [::abook::getDisplayNick $usr_name]]\n"
::ChatWindow::Status [ ::ChatWindow::For $chatid ] $statusmsg minijoins
::ChatWindow::TopUpdate $chatid
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name].dps] } {
::amsn::ShowOrHidePicture
::amsn::ShowOrHideTopPicture
::amsn::UpdatePictures $win_name
} else {
if { [::config::getKey showdisplaypic] && $usr_name != ""} {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $usr_name] [trans showuserpic $usr_name]
} else {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $usr_name] [trans showuserpic $usr_name] nopack
}
}
if { [::config::getKey leavejoinsinchat] == 1 } {
SendMessageFIFO [list ::amsn::WinWriteJoin $chatid $usr_name] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
}
if {[::abook::getKeepLogs $chatid]} {
::log::JoinsConf $chatid $usr_name
}
#Postevent when user joins a chat
set evPar(usr_name) usr_name
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent user_joins_chat evPar
}
proc WinWriteJoin {chatid usr_name} {
::amsn::WinWrite $chatid "\n" green "" 0
::amsn::WinWriteIcon $chatid minijoins 5 0
::amsn::WinWrite $chatid "[timestamp] [trans joins [::abook::getDisplayNick $usr_name]]" green "" 0
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# userLeaves (chatid, user_name)
# called from the protocol layer when a user LEAVES a chat.
# It will show the status message. No need to show it if the window is already
# closed, right?
# - 'chatid' is the chat name
# - 'usr_name' is the user email to show in the status message
proc userLeaves { chatid usr_name closed } {
global automsgsent
set win_name [::ChatWindow::For $chatid]
if { $win_name == 0} {
return 0
}
set username [::abook::getDisplayNick $usr_name]
if { $closed } {
set statusmsg "[timestamp] [trans leaves $username]\n"
set icon minileaves
if { [::config::getKey leavejoinsinchat] == 1 } {
SendMessageFIFO [list ::amsn::WinWriteLeave $chatid $username] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
} else {
set statusmsg "[timestamp] [trans closed $username]\n"
set icon minileaves
}
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name].dps] } {
::amsn::UpdatePictures $win_name
} else {
#Check if the image that is currently showing is
#from the user that left. Then, change it
set current_image ""
#Catch it, because the window might be closed
catch {set current_image [[::ChatWindow::GetInDisplayPictureFrame $win_name].pic.image cget -image]}
if { [string compare $current_image [::skin::getDisplayPicture $usr_name]]==0} {
set users_in_chat [::MSN::usersInChat $chatid]
set new_user [lindex $users_in_chat 0]
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $new_user] [trans showuserpic $new_user] nopack
}
}
::ChatWindow::Status $win_name $statusmsg $icon
::ChatWindow::TopUpdate $chatid
if {[::abook::getKeepLogs $chatid]} {
::log::LeavesConf $chatid $usr_name
}
# Unset automsg if he leaves so that it sends again on next msg
if { [info exists automsgsent($usr_name)] } {
unset automsgsent($usr_name)
}
#Postevent when user leaves a chat
set evPar(usr_name) usr_name
set evPar(chatid) chatid
set evPar(win_name) win_name
::plugins::PostEvent user_leaves_chat evPar
}
proc WinWriteLeave {chatid username} {
::amsn::WinWrite $chatid "\n" green "" 0
::amsn::WinWriteIcon $chatid minileaves 5 0
::amsn::WinWrite $chatid "[timestamp] [trans leaves $username]" green "" 0
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# updateTypers (chatid)
# Called from the protocol.
# Asks the protocol layer to get a list of typing users in the chat, and shows
# a message in the status bar.
# - 'chatid' is the name of the chat
proc updateTypers { chatid } {
if {[::ChatWindow::For $chatid] == 0} {
return 0
}
set typers_list [::MSN::typersInChat $chatid]
set typingusers ""
foreach login $typers_list {
set user_name [::abook::getDisplayNick $login]
set typingusers "${typingusers}${user_name}, "
}
set typingusers [string replace $typingusers end-1 end ""]
set statusmsg ""
set icon ""
if {[llength $typers_list] == 0} {
set lasttime [::MSN::lastMessageTime $chatid]
if { $lasttime != 0 } {
set statusmsg "[trans lastmsgtime $lasttime]"
}
} elseif {[llength $typers_list] == 1} {
set statusmsg " [trans istyping $typingusers]."
set icon typingimg
} else {
set statusmsg " [trans aretyping $typingusers]."
set icon typingimg
}
::ChatWindow::Status [::ChatWindow::For $chatid] $statusmsg $icon
}
#///////////////////////////////////////////////////////////////////////////////
if { $initialize_amsn == 1 } {
variable clipboard ""
}
proc ToggleShowPicture { } {
if { [::config::getKey showdisplaypic 0] == 1 } {
::config::setKey showdisplaypic 0
} else {
::config::setKey showdisplaypic 1
}
::amsn::ShowOrHidePicture
}
proc ShowTopPicMenu { win user x y } {
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
#Cursor at the top right hand corner (NE) of the popup.
incr x -123
incr y +2
}
set chatid [::ChatWindow::Name $win]
set pic [::skin::getDisplayPicture $user]
if { $pic != "displaypicture_std_none" && $user != ""} {
$win.picmenu add command -label "[trans changesize]" -command [list ::amsn::ShowTopPicMenu $win $user $x $y]
#4 possible size (someone can add something to let the user choose his size)
$win.picmenu add command -label " -> [trans small]" -command "::skin::ConvertDPSize $user 64 64; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans default2]" -command "::skin::ConvertDPSize $user 96 96; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans large]" -command "::skin::ConvertDPSize $user 128 128; ::amsn::UpdateAllPictures"
$win.picmenu add command -label " -> [trans huge]" -command "::skin::ConvertDPSize $user 192 192; ::amsn::UpdateAllPictures"
#Get back to original picture
$win.picmenu add command -label " -> [trans original]" -command "::MSNP2P::loadUserPic $chatid $user 1"
tk_popup $win.picmenu $x $y
}
}
proc ShowPicMenu { win x y } {
status_log "Show menu in window $win, position $x $y\n" blue
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
#Cursor in the bottom right hand corner (SE) of the popup.
incr x -212
incr y -25
}
#Load Change Display Picture window
$win.picmenu add command -label "[trans changedisplaypic]..." -command pictureBrowser
tk_popup $win.picmenu $x $y
}
proc ShowOldPicMenu { win x y } {
status_log "Show menu in window $win, position $x $y\n" blue
catch {menu $win.picmenu -tearoff 0}
$win.picmenu delete 0 end
#Make the picture menu appear on the conversation window instead of having it in the bottom of screen (and sometime lost it if the conversation window is in the bottom of the window)
if { [OnMac] } {
incr x -50
incr y -115
}
set chatid [::ChatWindow::Name $win]
set users [::MSN::usersInChat $chatid]
#Switch to "my picture" or "user picture"
$win.picmenu add command -label "[trans showmypic]" \
-command [list ::amsn::ChangePicture $win displaypicture_std_self [trans mypic]]
foreach user $users {
$win.picmenu add command -label "[trans showuserpic $user]" \
-command "::amsn::ChangePicture $win \[::skin::getDisplayPicture $user\] \[trans showuserpic $user\]"
}
set user [[::ChatWindow::GetInDisplayPictureFrame $win].pic.image cget -image]
if { $user != "[::skin::getNoDisplayPicture]" && $user != "displaypicture_std_self" } {
#made easy for if we would change the image names
set user [string range $user [string length "displaypicture_std_"] end]
$win.picmenu add separator
#Sub-menu to change size
$win.picmenu add cascade -label "[trans changesize]" -menu $win.picmenu.size
catch {menu $win.picmenu.size -tearoff 0 -type normal}
$win.picmenu.size delete 0 end
#4 possible size (someone can add something to let the user choose his size)
$win.picmenu.size add command -label "[trans small]" -command "::skin::ConvertDPSize $user 64 64; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans default2]" -command "::skin::ConvertDPSize $user 96 96; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans large]" -command "::skin::ConvertDPSize $user 128 128; ::amsn::UpdateAllPictures"
$win.picmenu.size add command -label "[trans huge]" -command "::skin::ConvertDPSize $user 192 192; ::amsn::UpdateAllPictures"
#Get back to original picture
$win.picmenu.size add command -label "[trans original]" -command "::MSNP2P::loadUserPic $chatid $user 1"
}
tk_popup $win.picmenu $x $y
}
proc ChangePicture {win picture balloontext {nopack ""}} {
#pack [::ChatWindow::GetInDisplayPictureFrame $win].image -side left -padx 2 -pady 2
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText $win]]
#Get the path to the image
set f [::ChatWindow::GetInDisplayPictureFrame $win]
set pictureinner [$f.pic.image getinnerframe]
if { $balloontext != "" } {
#TODO: Improve this!!! Use some kind of abstraction!
change_balloon $pictureinner $balloontext
#change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].image $balloontext
}
if { [catch {[::ChatWindow::GetInDisplayPictureFrame $win].pic.image configure -image $picture}] } {
status_log "Failed to set picture, using [::skin::getNoDisplayPicture]\n" red
[::ChatWindow::GetInDisplayPictureFrame $win].pic.image configure -image [::skin::getNoDisplayPicture]
#change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].image [trans nopic]
change_balloon $pictureinner [trans nopic]
} elseif { $nopack == "" } {
pack [::ChatWindow::GetInDisplayPictureFrame $win].pic.image -side left -padx 0 -pady 0 -anchor w
[::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic configure -image [::skin::loadPixmap imghide]
bind [::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic <Enter> "[::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic configure -image [::skin::loadPixmap imghide_hover]"
bind [::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic <Leave> "[::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic configure -image [::skin::loadPixmap imghide]"
change_balloon [::ChatWindow::GetInDisplayPictureFrame $win].pic.showpic [trans hidedisplaypic]
::config::setKey showdisplaypic 1
}
if { $scrolling } {
after idle [list ::ChatWindow::Scroll [::ChatWindow::GetOutText $win]]
}
}
proc UpdateAllPictures { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win].dps]} {
::amsn::UpdatePictures $win
}
}
}
proc UpdatePictures { win } {
set f [::ChatWindow::GetOutDisplayPicturesFrame $win]
set images $f.dps.imgs
set chatid [::ChatWindow::Name $win]
set users [::MSN::usersInChat $chatid]
foreach child [winfo children $images] {
destroy $child
}
# don't show user labels if there's only one user
set show_user_labels 0
if {[llength $users] > 1} {
set show_user_labels 1
}
# Calculate the max width of the DPs shown, so we can know how much pixels to truncate all the labels
set max_width 0
foreach user $users {
set new_width [image width [::skin::getDisplayPicture $user]]
if {$new_width > $max_width } {
set max_width $new_width
}
}
set idx 0
foreach user $users {
if {$show_user_labels == 1} {
set truncated [trunc [::abook::getDisplayNick $user] $images [expr {${max_width}-10}] sitalf 1]
label $images.user_name$idx \
-background [::skin::getKey chatwindowbg] \
-relief flat -font sitalf -text $truncated
pack $images.user_name$idx -side top -padx 0 -pady 0 -anchor n
}
framec $images.user_dp$idx -type label -relief solid -image [::skin::getDisplayPicture $user] \
-borderwidth [::skin::getKey chat_dp_border] \
-bordercolor [::skin::getKey chat_dp_border_color] \
-background [::skin::getKey chatwindowbg]\
-foreground [::skin::getKey statusbartext]; #TODO: add skin key
set pictureinner [$images.user_dp$idx getinnerframe]
bind $pictureinner <<Button1>> [list ::amsn::ShowTopPicMenu $win $user %X %Y]
bind $pictureinner <<Button3>> [list ::amsn::ShowTopPicMenu $win $user %X %Y]
#TODO: support changing cusom dp's in the drophandler
# ::dnd bindtarget $pictureinner Files <Drop> "fileDropHandler %D setdp $user"
pack $images.user_dp$idx -side top -padx 0 -pady 0 -anchor n
set_balloon $pictureinner [trans showuserpic $user]
incr idx
}
#compute the size of the frame
if {[::config::getKey ShowTopPicture 0] == 1 } {
if {[winfo exists $f.voip] && $max_width <100} {
set max_width 100
$f.voip configure -width 100
}
incr max_width [image width [::skin::loadPixmap imghide]]
} else {
set max_width 0
if {[winfo exists $f.voip] && $max_width <100} {
set max_width 100
$f.voip configure -width 100
}
incr max_width [image width [::skin::loadPixmap imgshow]]
}
set width [expr {$max_width + (2 * [::skin::getKey chat_dp_border])}]
[winfo parent $f] configure -width $width
}
proc HidePicture { win } {
set f [::ChatWindow::GetInDisplayPictureFrame $win]
set dpframe $f.pic
pack forget $dpframe.image
#grid [::ChatWindow::GetInDisplayPictureFrame $win].showpic -row 0 -column 1 -padx 0 -pady 0 -rowspan 2
#Change here to change the icon, instead of text
$dpframe.showpic configure -image [::skin::loadPixmap imgshow]
bind $dpframe.showpic <Enter> "$dpframe.showpic configure -image [::skin::loadPixmap imgshow_hover]"
bind $dpframe.showpic <Leave> "$dpframe.showpic configure -image [::skin::loadPixmap imgshow]"
change_balloon $dpframe.showpic [trans showdisplaypic]
}
proc ShowOrHidePicture { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { $win != 0 } {
if { [::config::getKey showdisplaypic 1] == 1} {
if {[winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win].dps] } {
::amsn::ChangePicture $win displaypicture_std_self [trans mypic]
} else {
::amsn::ChangePicture $win [[::ChatWindow::GetInDisplayPictureFrame $win].pic.image cget -image] ""
}
} else {
::amsn::HidePicture $win
}
}
}
}
proc ToggleShowTopPicture { } {
if {[::config::getKey ShowTopPicture 0] == 1 } {
::config::setKey ShowTopPicture 0
} else {
::config::setKey ShowTopPicture 1
}
ShowOrHideTopPicture
}
proc ShowOrHideTopPicture { } {
set chatids [::ChatWindow::getAllChatIds]
# Loop through the chats
foreach chat $chatids {
set win [::ChatWindow::For $chat]
if { $win != 0 } {
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win].dps] } {
if { [::config::getKey ShowTopPicture 1] == 1} {
ShowTopPicture $win
} else {
HideTopPicture $win
}
}
}
}
}
proc ShowTopPicture {win } {
set f [::ChatWindow::GetOutDisplayPicturesFrame $win]
set frame $f.dps
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText $win]]
pack $frame.imgs -side left -expand false -anchor ne
$frame.showpic configure -image [::skin::loadPixmap imghide]
bind $frame.showpic <Enter> [list $frame.showpic configure -image [::skin::loadPixmap imghide_hover]]
bind $frame.showpic <Leave> [list $frame.showpic configure -image [::skin::loadPixmap imghide]]
change_balloon $frame.showpic [trans hidedisplaypic]
#UGLY:
set width [expr {96 + (2 * [::skin::getKey chat_dp_border]+[image width [::skin::loadPixmap imghide]])}]
if {[winfo exists $f.voip] && $width <100} {
set width 100
$f.voip configure -width 100
}
[winfo parent $f] configure -width $width
if { $scrolling } {
after idle [list ::ChatWindow::Scroll [::ChatWindow::GetOutText $win]]
}
}
proc HideTopPicture { win } {
set f [::ChatWindow::GetOutDisplayPicturesFrame $win]
set frame $f.dps
pack forget $frame.imgs
#Change here to change the icon, instead of text
$frame.showpic configure -image [::skin::loadPixmap imgshow]
bind $frame.showpic <Enter> [list $frame.showpic configure -image [::skin::loadPixmap imgshow_hover]]
bind $frame.showpic <Leave> [list $frame.showpic configure -image [::skin::loadPixmap imgshow]]
change_balloon $frame.showpic [trans showdisplaypic]
set width [expr {2 * [::skin::getKey chat_dp_border]+[image width [::skin::loadPixmap imgshow]]}]
if {[winfo exists $f.voip] && $width <100} {
set width 100
$f.voip configure -width 100
}
[winfo parent $f] configure -width $width
}
#///////////////////////////////////////////////////////////////////////////////
proc ShowUserList {title command {show_offlines 0} {show_nonim 0}} {
#Replace for"::amsn::ChooseList \"[trans sendmsg]\" online ::amsn::chatUser 1 0"
set userlist [list]
foreach user_login [::MSN::sortedContactList] {
if {!$show_nonim} {
if { [lsearch [::abook::getContactData $user_login lists] "EL"] != -1 } {
continue
}
}
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { $user_state_code == "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
} elseif { $user_state_code != "FLN" || $show_offlines == 1 } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
}
}
::amsn::listChoose $title $userlist $command 1 1
}
proc ShowAddList {title win_name command} {
set userlist [list]
set chatusers [::MSN::usersInChat [::ChatWindow::Name $win_name]]
foreach user_login $chatusers {
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { [lsearch [::abook::getLists $user_login] FL] == -1 } {
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
}
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist $command 1 1
} else {
msg_box "[trans useralreadyonlist]"
}
}
proc ShowInviteList { title win_name } {
set userlist [list]
set chatid [::ChatWindow::Name $win_name]
set chatusers [::MSN::usersInChat $chatid]
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])" $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
}
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist "::amsn::queueinviteUser $chatid" 1 0
} else {
cmsn_draw_otherwindow $title "::amsn::queueinviteUser $chatid"
}
}
proc ShowInviteMenu { win_name x y } {
set menulength 0
set chatid [::ChatWindow::Name $win_name]
set chatusers [::MSN::usersInChat $chatid]
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
incr menulength 1
}
}
if { $menulength > 20 } {
::amsn::ShowInviteList "[trans invite]" $win_name
} elseif { $menulength == 0 } {
cmsn_draw_otherwindow [trans invite] "::amsn::queueinviteUser [::ChatWindow::Name $win_name]"
} else {
.menu_invite delete 0 end
foreach user_login [::MSN::sortedContactList] {
set user_state_code [::abook::getVolatileData $user_login state FLN]
set user_state_no [::MSN::stateToNumber $user_state_code]
if {($user_state_no < 7) && ([lsearch $chatusers $user_login] == -1)} {
if { $user_state_code != "NLN" } {
.menu_invite add command -label [trunc "[::abook::getDisplayNick $user_login] ([trans [::MSN::stateToDescription $user_state_code]])" "" 50] -command "::amsn::queueinviteUser $chatid $user_login"
} else {
.menu_invite add command -label [trunc "[::abook::getDisplayNick $user_login]" "" 50] -command "::amsn::queueinviteUser $chatid $user_login"
}
}
}
.menu_invite add separator
.menu_invite add command -label "[trans other]..." -command [list cmsn_draw_otherwindow [trans invite] "::amsn::queueinviteUser [::ChatWindow::Name $win_name]"]
tk_popup .menu_invite $x $y
}
}
proc queueinviteUser { chatid user } {
::MSN::ChatQueue $chatid [list ::MSN::inviteUser $chatid $user]
}
proc ShowChatList {title win_name command} {
set userlist [list]
set chatusers [::MSN::usersInChat [::ChatWindow::Name $win_name]]
if { [llength $chatusers] == 0 } {
#No SB yet. Check if chatid is a valid user
#example: opened chat while appearing offline
set chatid [::ChatWindow::Name $win_name]
if { [lsearch [::abook::getAllContacts] $chatid] != -1 } {
set chatusers $chatid
}
}
foreach user_login $chatusers {
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { $user_state_code != "NLN" } {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]]) " $user_login]
} else {
lappend userlist [list "[::abook::getDisplayNick $user_login] ($user_login)" $user_login]
}
}
if { [llength $userlist] > 0 } {
::amsn::listChoose $title $userlist $command 0 1
} else {
status_log "ShowChatList: No users\n"
}
}
proc scrollCanvas { canvas w d} {
if {[OnMac]} {
$w yview scroll [expr {- ($d)}] units
::guiContactList::moveBGimage $canvas
} elseif {[OnWin] } {
if {$d >= 0} {
::guiContactList::scrollCL $canvas up
} else {
::guiContactList::scrollCL $canvas down
}
}
}
proc listChoose {title itemlist command {other 0} {skip 1} {contacts 1}} {
variable itemlist_var
variable listChoose_contacts
variable original_itemlist
set itemcount [llength $itemlist]
#If just 1 user, and $skip flag set to one, just run command on that user
if { $itemcount == 1 && $skip == 1 && $other == 0} {
eval $command [lindex [lindex $itemlist 0] 1]
return 0
}
set w "._listchoose"
if { [catch {toplevel $w -borderwidth 0 -highlightthickness 0 } res ] } {
raise $w
focus $w
return 0
} else {
set wname $res
}
set itemlist_var $itemlist
set listChoose_contacts $contacts
catch {unset original_itemlist}
wm title $w $title
#No ugly blue frame on Mac OS X, system already use a border around window
if { [OnMac] } {
frame $w.blueframe -background [::skin::getKey topcontactlistbg]
} else {
frame $w.blueframe
}
wm geometry $w =350x400
set canv $w.canv
frame $canv -background white
canvas $canv.ca -width 100 -height 200 -bg white -yscrollcommand "$canv.ys set"
scrollbar $canv.ys -orient vertical -command "$canv.ca yview"
frame $w.searchbar -bg [::skin::getKey mainwindowbg] -borderwidth 2 -highlightthickness 0
entry $w.searchbar.entry -relief flat -bg white -font splainf -selectbackground #b7d1ff -fg grey \
-highlightcolor #aaaaaa -highlightthickness 2
pack $canv.ys -side right -fill y
pack $canv.ca -side left -fill both -expand true
pack $canv -side top -fill both -expand true
draw_listChoose $canv.ca $w $itemlist $command $contacts
frame $w.buttons
button $w.buttons.ok -text "[trans ok]" -command [list ::amsn::listChooseOk $w "" $command 1]
button $w.buttons.cancel -text "[trans cancel]" -command [list destroy $wname]
if { $other == 1 } {
button $w.buttons.other -text "[trans other]..." -command [list ::amsn::listChooseOther $w $title $command]
pack $w.buttons.ok -padx 5 -side right
pack $w.buttons.cancel -padx 5 -side right
pack $w.buttons.other -padx 5 -side left
} else {
pack $w.buttons.ok -padx 5 -side right
pack $w.buttons.cancel -padx 5 -side right
}
pack $w.buttons -side bottom -fill x -pady 3
pack $w.searchbar.entry -fill x -side bottom
pack $w.searchbar -fill x -side bottom
catch {
raise $w
focus $w.buttons.ok
}
bind $w.searchbar.entry <KeyRelease> \
"after cancel [list ::amsn::listChooseSearchBar $w $canv.ca [list $command]]; \
after 500 [list ::amsn::listChooseSearchBar $w $canv.ca [list $command]]"
bind $w <<Escape>> [list destroy $w]
bind $w <Return> [list ::amsn::listChooseOk $w "" $command 1]
if {[OnMac]} {
bind $canv.ca <MouseWheel> [list ::amsn::scrollCanvas $canv.ca %W %D]
} elseif {$::tcl_platform(platform) == "windows"} {
#TODO: test it with tcl8.5
if {$::tcl_version >= 8.5} {
bind $canv.ca <MouseWheel> [list ::amsn::scrollCanvas $canv.ca %W %D]
} else {
bind [winfo toplevel $canv.ca] <MouseWheel> [list ::amsn::scrollCanvas $canv.ca %W %D]
}
} else {
# We're on X11! (I suppose ;))
bind $canv.ca <ButtonPress-5> [list ::guiContactList::scrollCL $canv.ca down]
bind $canv.ca <ButtonPress-4> [list ::guiContactList::scrollCL $canv.ca up]
}
moveinscreen $w 30
}
proc draw_listChoose { w window itemlist command contacts} {
$w dchars list_choose 0 end
$w delete list_choose bg un ov bg_selection
foreach element $itemlist {
if {$contacts} {
set user_login [lindex $element 1]
set tag $user_login
set lst [list ]
lappend lst [list tag list_choose]
set lst [concat $lst [::abook::getDisplayNick $user_login 1]]
set user_state_code [::abook::getVolatileData $user_login state FLN]
if { $user_state_code != "NLN" } {
lappend lst [list text " ($user_login) - ([trans [::MSN::stateToDescription $user_state_code]])"]
} else {
lappend lst [list text " ($user_login)"]
}
lappend lst [list tag -list_choose]
} else {
set txt [lindex $element 0]
set tag [lindex $element 1]
set lst [list]
lappend lst [list tag list_choose]
lappend lst [list text $txt]
lappend lst [list tag -list_choose]
}
::guiContactList::renderContact $w $tag 1000 $lst 0
$w bind $tag <Button-1> [list ::amsn::listChooseSelect $w $tag]
$w bind $tag <Double-Button-1> [list ::amsn::listChooseOk $window $tag $command 0]
}
set y 0
foreach element $itemlist {
set tag [lindex $element 1]
set pos [$w bbox $tag]
$w move $tag 0 $y
incr y [expr {[lindex $pos 3] + 2}]
}
$w configure -scrollregion [list 0 0 0 $y]
pack $w
}
proc listChooseOk { wname user command fromlist} {
variable listchooseselect
if {$fromlist} {
if {[catch {set user $listchooseselect}]} {
return
}
}
catch {unset listchooseselect}
eval "$command $user"
destroy $wname
}
proc listChooseSelect {w tag} {
variable listchooseselect $tag
$w delete bg_selection
set color [::skin::getKey menuactivebackground]
set pos [$w bbox $tag]
$w create rect [lindex $pos 0] [lindex $pos 1] [lindex $pos 2] [lindex $pos 3] \
-fill $color -outline "" -tag bg_selection
$w lower bg_selection $tag
}
proc listChooseSearchBar {w wcanv command} {
variable itemlist_var
variable original_itemlist
variable listChoose_contacts
if {![info exists original_itemlist]} {
set original_itemlist $itemlist_var
} else {
set itemlist_var $original_itemlist
}
set key [string tolower [$w.searchbar.entry get]]
if {$key eq ""} {
set itemlist_var $original_itemlist
} else {
set itemlist_temp [list]
foreach item $itemlist_var {
if {[string first $key [string tolower [lindex $item 0]]] != -1} {
lappend itemlist_temp $item
}
}
set itemlist_var $itemlist_temp
}
draw_listChoose $wcanv $w $itemlist_var $command $listChoose_contacts
}
proc listChooseOther { wname title command } {
destroy $wname
cmsn_draw_otherwindow $title $command
variable itemlist_var
variable original_itemlist
unset itemlist_var
if { [info exists original_itemlist] } {
unset original_itemlist
}
}
#///////////////////////////////////////////////////////////////////////////////
# TypingNotification (win_name inputbox)
# Called by a window when the user types something into the text box. It tells
# the protocol layer to send a typing notification to the chat that the window
# 'win_name' is connected to
proc TypingNotification { win_name inputbox} {
global skipthistime
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "VERY BAD ERROR in ::amsn::TypingNotification!!!\n" red
return 0
}
if { $skipthistime } {
set skipthistime 0
} else {
if { [string length [$inputbox get 0.0 end-1c]] == 0 } {
CharsTyped $chatid ""
} else {
CharsTyped $chatid [string length [$inputbox get 0.0 end-1c]]
}
}
#Works for tcl/tk 8.4 only...
catch {
bind $inputbox <<Modified>> ""
$inputbox edit modified false
bind $inputbox <<Modified>> "::amsn::TypingNotification ${win_name} $inputbox"
}
if { [::MSNMobile::IsMobile $chatid] == 1} {
status_log "MOBILE CHAT\n" red
return 0
}
#no typing notification for OIM
#AIM: Try to send it, so status is rechecked
#TODO: Maybe should try to send it only for users
#not in contact list
#if {[::OIM_GUI::IsOIM $chatid] == 1 } {
# return 0
#}
#Don't queue unless chat is ready, but try to reconnect
if { [::MSN::chatReady $chatid] } {
if { [::config::getKey notifytyping] } {
sb_change $chatid
}
} else {
::MSN::chatTo $chatid
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DeleteKeyPressed (win_name inputbox)
# Called by a window when the user uses the delete key in a text box. It updates
# the number of characters typed to be correct
proc DeleteKeyPressed { win_name inputbox key} {
global skipthistime
set skipthistime 1
set totallength [string length [$inputbox get 0.0 end-1c]]
set x [$inputbox tag nextrange sel 0.0]
if { $x != "" } {
set y [string length [$inputbox get [lindex $x 0] [lindex $x 1]]]
} elseif { $key == "Delete" && [string length [$inputbox get 0.0 insert]] == $totallength \
|| $key == "BackSpace" && [string length [$inputbox get 0.0 insert]] == 0 } {
set y 0
set skipthistime 0
} else {
set y 1
}
set newlength [expr {$totallength - $y}]
set chatid [::ChatWindow::Name $win_name]
if { [string length [$inputbox get 0.0 end-1c]] == 0 } {
CharsTyped $chatid ""
} else {
CharsTyped $chatid $newlength
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# UpKeyPressed (inputbox)
# Called by a window when the user uses the up key in a text box. It returns
# the index of the character 1 line above the insertion cursor
proc UpKeyPressed { inputbox } {
$inputbox see insert
set bbox [$inputbox bbox insert]
set xpos [expr {[lindex $bbox 0]+[lindex $bbox 2]/2}]
set ypos [lindex $bbox 1]
set height [lindex $bbox 3]
if { $ypos > $height } {
return [$inputbox index "@$xpos,[expr {$ypos-$height}]"]
} else {
$inputbox yview scroll -1 units
update
set ypos [lindex [$inputbox bbox insert] 1]
set height [lindex [$inputbox bbox insert] 3]
if { $ypos > $height } {
return [$inputbox index "@$xpos,[expr {$ypos-$height}]"]
}
}
return [$inputbox index insert]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DownKeyPressed (inputbox)
# Called by a window when the user uses the down key in a text box. It returns
# the index of the character 1 line below the insertion cursor
proc DownKeyPressed { inputbox } {
$inputbox see insert
set bbox [$inputbox bbox insert]
set xpos [expr {[lindex $bbox 0]+[lindex $bbox 2]/2}]
set ypos [lindex $bbox 1]
set height [lindex $bbox 3]
set inputboxheight [lindex [$inputbox configure -height] end]
if { [expr {$ypos+$height}] < [expr {$inputboxheight*$height}] } {
return [$inputbox index "@$xpos,[expr {$ypos+$height}]"]
} else {
$inputbox yview scroll +1 units
update
set ypos [lindex [$inputbox bbox insert] 1]
set height [lindex [$inputbox bbox insert] 3]
set inputboxheight [lindex [$inputbox configure -height] end]
if { [expr {$ypos+$height}] < [expr {$inputboxheight*$height}] } {
return [$inputbox index "@$xpos,[expr {$ypos+$height}]"]
}
}
return [$inputbox index insert]
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# MessageSend (win_name,input)
# Called from a window the the user enters a message to send to the chat. It will
# just queue the message to send in the chat associated with 'win_name', and set
# a timeout for the message
proc MessageSend { win_name input {custom_msg ""} {friendlyname ""}} {
set chatid [::ChatWindow::Name $win_name]
if { $chatid == 0 } {
status_log "::amsn::MessageSend: TOO BAD!!! Got no chatid!\n" red
return 0
}
if { $custom_msg != "" } {
set msg $custom_msg
} else {
# Catch in case that $input is not a "text" control (ie: automessage).
if { [catch { set msg [$input get 0.0 end-1c] }] } {
set msg ""
}
}
#Blank message
if {[string length $msg] < 1} { return 0 }
if { $input != 0 } {
$input delete 0.0 end
focus ${input}
}
set fontfamily [lindex [::config::getKey mychatfont] 0]
set fontstyle [lindex [::config::getKey mychatfont] 1]
set fontcolor [lindex [::config::getKey mychatfont] 2]
if { $friendlyname != "" } {
set nick $friendlyname
set p4c 1
} elseif { [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] != ""} {
set friendlyname [::abook::parseCustomNick [::abook::getContactData [::ChatWindow::Name $win_name] cust_p4c_name] [::abook::getPersonal MFN] [::abook::getPersonal login] "" [::abook::getpsmmedia]]
set nick $friendlyname
set p4c 1
} elseif { [::config::getKey p4c_name] != ""} {
set nick [::config::getKey p4c_name]
set p4c 1
} else {
set nick [::abook::getPersonal MFN]
set p4c 0
}
#Postevent when we send a message
set evPar(nick) nick
set evPar(msg) msg
set evPar(chatid) chatid
set evPar(win_name) win_name
set evPar(fontfamily) fontfamily
set evPar(fontstyle) fontstyle
set evPar(fontcolor) fontcolor
::plugins::PostEvent chat_msg_send evPar
if {![string equal $msg ""]} {
set supports_actions 1
foreach user [::MSN::usersInChat $chatid] {
set clientid [::abook::getContactData $user clientid]
if { $clientid == "" } { set clientid 0 }
if { [::MSN::hasCapability $clientid msnc10] } {
set supports_actions 0
break
}
if { ![::MSN::hasCapability $clientid msnc6] &&
![::MSN::hasCapability $clientid msnc7] &&
![::MSN::hasCapability $clientid msnc8] } {
set supports_actions 0
break
}
}
if {$supports_actions &&
![::MSNMobile::IsMobile $chatid] &&
![::OIM_GUI::IsOIM $chatid] &&
[string first "/action " $msg] == 0 } {
set action "[string range $msg 8 end]"
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWriteIcon $chatid greyline 3
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWrite $chatid $action gray
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWriteIcon $chatid greyline 3
::amsn::WinWrite $chatid "\n" gray
set first 0
while { [expr {$first + 1480}] <= [string length $action] } {
set msgchunk [string range $action $first [expr {$first + 1479}]]
incr first 1480
::MSN::SendAction $chatid $msgchunk
}
set msgchunk [string range $action $first end]
if {$msgchunk != "" } {
::MSN::SendAction $chatid $msgchunk
}
CharsTyped $chatid ""
} elseif {$supports_actions &&
![::MSNMobile::IsMobile $chatid] &&
![::OIM_GUI::IsOIM $chatid] &&
[string first "/me " $msg] == 0 } {
set action "$nick [string range $msg 4 end]"
set font [lindex [::config::getGlobalKey basefont] 0]
if { $font == "" } { set font "Helvetica"}
set color 333333; #TODO: needs a skin key for this one
set customfont [list $font [list "italic"] $color]
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWriteIcon $chatid greyline 3
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWrite $chatid $action "custom" $customfont
::amsn::WinWrite $chatid "\n" gray
::amsn::WinWriteIcon $chatid greyline 3
::amsn::WinWrite $chatid "\n" gray
set first 0
while { [expr {$first + 1480}] <= [string length $action] } {
set msgchunk [string range $action $first [expr {$first + 1479}]]
incr first 1480
::MSN::SendAction $chatid $msgchunk
}
set msgchunk [string range $action $first end]
if {$msgchunk != "" } {
::MSN::SendAction $chatid $msgchunk
}
CharsTyped $chatid ""
} else {
set limit 1380
incr limit -[string length $friendlyname]
set first 0
while { [expr {$first + $limit}] <= [string length $msg] } {
set msgchunk [string range $msg $first [expr {$first + $limit - 1}]]
if {[::MSNMobile::IsMobile $chatid] == 0 && [::OIM_GUI::IsOIM $chatid] == 0} {
set ackid [after 60000 [list ::amsn::DeliveryFailed $chatid $msgchunk]]
} else {
set ackid 0
}
::MSN::messageTo $chatid "$msgchunk" $ackid $friendlyname
incr first $limit
}
set msgchunk [string range $msg $first end]
if {[::MSNMobile::IsMobile $chatid] == 0 && [::OIM_GUI::IsOIM $chatid] == 0} {
set ackid [after 60000 [list ::amsn::DeliveryFailed $chatid $msgchunk]]
} else {
set ackid 0
}
set message [Message create %AUTO%]
$message setBody $msg
#TODO: where is the best place to put this code?
set color "000000$fontcolor"
set color "[string range $color end-1 end][string range $color end-3 end-2][string range $color end-5 end-4]"
set style ""
if { [string first "bold" $fontstyle] >= 0 } { set style "${style}B" }
if { [string first "italic" $fontstyle] >= 0 } { set style "${style}I" }
if { [string first "overstrike" $fontstyle] >= 0 } { set style "${style}S" }
if { [string first "underline" $fontstyle] >= 0 } { set style "${style}U" }
set format ""
set format "{$format}FN=[urlencode $fontfamily]; "
set format "{$format}EF=$style; "
set format "{$format}CO=$color; "
set format "{$format}CS=0; "
set format "{$format}PF=22"
$message setHeader [list X-MMS-IM-Format "$format"]
#Draw our own message
messageFrom $chatid [::abook::getPersonal login] $nick $message user $p4c
#This object isn't used anymore: destroy it
$message destroy
::MSN::messageTo $chatid "$msgchunk" $ackid $friendlyname
CharsTyped $chatid ""
::plugins::PostEvent chat_msg_sent evPar
}
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# ackMessage (ackid)
# Called from the protocol layer when ACK for a message is received. It Cancels
# the timer for time outing the message 'ackid'.
proc ackMessage { ackid } {
after cancel $ackid
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# nackMessage (ackid)
# Called from the protocol layer when NACK for a message is received. It just
# writes the delivery error message without waiting for the message to timeout,
# and cancels the timer.
proc nackMessage { ackid } {
if {![catch {after info $ackid} command]} {
set command [lindex $command 0]
after cancel $ackid
eval $command
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# DeliveryFailed (chatid,msg)
# Writes the delivery error message along with the timeouted 'msg' into the
# window related to 'chatid'
proc DeliveryFailed { chatid msg } {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
chatUser $chatid
}
after idle [list SendMessageFIFO [list ::amsn::WinWriteFail $chatid $msg] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"]
}
proc WinWriteFail {chatid msg} {
WinWrite $chatid "\n[timestamp] [trans deliverfail]:\n" red
WinWrite $chatid "$msg" gray "" 1 [::config::getKey login]
if {[::abook::getKeepLogs $chatid]} {
::log::PutLog $chatid [trans deliverfail] $msg "" 1
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# PutMessage (chatid,user,msg,type,fontformat)
# Writes a message into the window related to 'chatid'
# - 'user' is the user login.
# - 'msg' is the message itself to be displayed.
# - 'type' can be red, gray... or any tag defined for the textbox when the window
# was created, or just "user" to use the fontformat parameter
# - 'fontformat' is a list containing font style and color
proc PutMessage { chatid user nick msg type fontformat {p4c 0}} {
#Run it in mutual exclusion
SendMessageFIFO [list ::amsn::PutMessageWrapped $chatid $user $nick $msg $type $fontformat $p4c] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
}
proc PutMessageWrapped { chatid user nick msg type fontformat {p4c 0 }} {
variable lastchatwith
set chatstyle [::config::getKey chatstyle]
if { [::config::getKey showtimestamps] } {
set tstamp [timestamp]
} else {
set tstamp ""
}
set lastchat 0
if {[info exists lastchatwith($chatid)]} {
if {$user eq $lastchatwith($chatid)} {
if {$chatstyle eq "compact"} {
set nick ""
set lastchat 1
}
} else {
array set lastchatwith [list $chatid $user]
}
} else {
array set lastchatwith [list $chatid $user]
}
switch $chatstyle {
msn {
::config::setKey customchatstyle "\$tstamp [trans says \$nick]: \$newline"
}
irc {
::config::setKey customchatstyle "\$tstamp <\$nick> "
}
compact {
::config::setKey customchatstyle "[trans says \$nick]: \$newline \$tstamp"
}
- {
}
}
#By default, quote backslashes and variables
set customchat [string map {"\\" "\\\\" "\$" "\\\$" "\(" "\\\(" } [::config::getKey customchatstyle]]
#Now, let's unquote the variables we want to replace
set customchat [string map { "\\\$nick" "\${nick}" "\\\$tstamp" "\${tstamp}" "\\\$newline" "\n" } $customchat]
if { [::abook::getContactData $user customcolor] != "" } {
set color [string trim [::abook::getContactData $user customcolor] "#"]
} else {
set color 404040
}
if { $p4c == 1 } {
if { $color == 404040 } { set color 000000 }
set style [list "bold" "italic"]
} else {
set style {}
}
set font [lindex [::config::getGlobalKey basefont] 0]
if { $font == "" } { set font "Helvetica"}
set customfont [list $font $style $color]
if {[::config::getKey truncatenicks]} {
set oldnick $nick
set nick ""
set says [subst -nocommands $customchat]
set measurefont [list $font [lindex [::config::getGlobalKey basefont] 1] $style]
set win_name [::ChatWindow::For $chatid]
set maxw [winfo width [::ChatWindow::GetOutText $win_name]]
#status_log "Custom font is $customfont\n" red
incr maxw [expr {-10-[font measure $measurefont -displayof $win_name "$says"]}]
set nick [trunc $oldnick $win_name $maxw splainf]
}
#Return the custom nick, replacing backslashses and variables
set customchat [subst -nocommands $customchat]
upvar #0 [string map {: _} ${chatid} ]_smileys emotions
if { [info exists emotions] } {
set emoticons_for_this_chatid [array get emotions]
unset emotions
}
if {[::config::getKey colored_text_in_cw] == 1} {
set original_nick [::smiley::parseMessageToList [list [ list "text" "$nick" ]]]
set evpar(variable) original_nick
set evpar(login) $user
::plugins::PostEvent parse_contact evpar
if {$chatstyle eq "msn"} {
set str [trans says __@__]
set pos [string first __@__ $str]
incr pos -1
set part1 [list text [string range $str 0 $pos]]
incr pos 6
set part2 [list text [string range $str $pos end]]
set parsing [list [list text "\n$tstamp "] $part1]
set parsing [concat $parsing $original_nick]
lappend parsing $part2 [list text ":\n"]
} elseif {$chatstyle eq "irc"} {
set parsing $original_nick
set parsing [linsert $parsing 0 [list text "\n$tstamp <"]]
lappend parsing [list text "> "]
} elseif {$chatstyle eq "compact" } {
if {!$lastchat} {
set str [trans says __@__]
set pos [string first __@__ $str]
incr pos -1
set part1 [list text "\n\n[string range $str 0 $pos]"]
incr pos 6
set part2 [list text [string range $str $pos end]]
set parsing [list $part1]
set parsing [concat $parsing $original_nick]
lappend parsing $part2 [list text ":\n$tstamp "]
} else {
set parsing [list [list text "\n$tstamp "]]
}
} elseif {$chatstyle eq "custom"} {
set customchatstyle__ [::config::getKey customchatstyle]
set style [string map { "\\" "\\\\" "\$nick" " \\\$nick " "\$tstamp" " \\\$tstamp " "\$newline" " \\\$newline " "\(" "\\\(" " " " \\__fr33s@p4ce-_ "} $customchatstyle__]
set parsing [list]
lappend parsing [list text "\n"]
foreach x $style {
if {$x eq "\$nick"} {
set parsing [concat $parsing $original_nick]
} elseif { $x eq "\$tstamp"} {
lappend parsing [list text $tstamp]
} elseif {$x eq "\$newline"} {
lappend parsing [list text "\n"]
} elseif {$x eq "\__fr33s@p4ce-_"} {
lappend parsing [list text " "]
} else {
lappend parsing [list text "$x"]
}
}
}
WinWrite $chatid "" "says" $customfont 1 "" $parsing
} else {
if {$chatstyle eq "compact"} {
if {$lastchat} {
if {$tstamp != ""} {
set customchat "$tstamp "
} else {
set customchat ""
}
} else {
if {$customchat ne ""} {
set pos [string first "\n" $customchat]
if {$pos > -1} {
incr pos
set customchat [string replace $customchat $pos $pos]
}
set customchat "\n$customchat "
}
}
}
WinWrite $chatid "\n$customchat" "says" $customfont
}
if { [info exists emoticons_for_this_chatid] } {
array set emotions $emoticons_for_this_chatid
unset emoticons_for_this_chatid
}
#Postevent for chat_msg_receive
set evPar(user) user
set evPar(msg) msg
set evPar(chatid) chatid
set evPar(fontformat) $fontformat
set message $msg
set evPar(message) message
::plugins::PostEvent chat_msg_receive evPar
if {![string equal $msg ""]} {
if {[::config::getKey colored_text_in_cw] == 1} {
set msg_parsing [list [list "text" $message]]
set evpar(variable) msg_parsing
set evpar(login) $user
::plugins::PostEvent parse_contact evpar
WinWrite $chatid "$message" $type $fontformat 1 $user $msg_parsing
} else {
WinWrite $chatid "$message" $type $fontformat 1 $user
}
if {[::abook::getKeepLogs $chatid]} {
::log::PutLog $chatid $nick $msg $fontformat
}
}
if { [info exists emotions] } {
unset emotions
}
::plugins::PostEvent chat_msg_received evPar
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# chatStatus (chatid,msg,[icon])
# Called by the protocol layer to show some information about the chat, that
# should be shown in the status bar. It parameter "ready" is different from "",
# then it will only show it if the chat is not
# ready, as most information is about connections/reconnections, and we don't
# mind in case we have a "chat ready to chat".
proc chatStatus {chatid msg {icon ""} {ready ""}} {
if { $chatid == 0} {
return 0
} elseif { [::ChatWindow::For $chatid] == 0} {
return 0
} elseif { "$ready" != "" && [::MSN::chatReady $chatid] != 0 } {
return 0
} else {
::ChatWindow::Status [::ChatWindow::For $chatid] $msg $icon
}
}
#///////////////////////////////////////////////////////////////////////////////
proc chatDisabled {chatid} {
chatStatus $chatid ""
}
#///////////////////////////////////////////////////////////////////////////////
# CharsTyped (chatid,msg)
# Writes the message 'msg' (number of characters typed) in the window 'win_name' status bar.
proc CharsTyped { chatid msg } {
if { $chatid == 0} {
return 0
} elseif { [::ChatWindow::For $chatid] == 0} {
return 0
} else {
set win_name [::ChatWindow::For $chatid]
set msg [string map {"\n" " "} $msg]
[::ChatWindow::GetStatusCharsTypedText ${win_name}] configure -state normal
[::ChatWindow::GetStatusCharsTypedText ${win_name}] delete 0.0 end
[::ChatWindow::GetStatusCharsTypedText ${win_name}] insert end $msg center
[::ChatWindow::GetStatusCharsTypedText ${win_name}] configure -state disabled
}
}
#///////////////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# chatUser (user, [oim])
# Opens a chat for user 'user'. If a window for that user already exists, it will
# use it and reconnect if necessary (will call to the protocol function chatUser),
# and raise and focus that window. If the window doesn't exist it will open a new
# one. 'user' is the mail address of the user to chat with.
# oim is 1 when we're opening this CW in order to put an OIM
#returns the name of the window
proc chatUser { user {oim 0}} {
# set lowuser [string tolower $user]
set lowuser $user
set win_name [::ChatWindow::For $lowuser]
set creating_window 0
if { $win_name == 0 } {
set creating_window 1
if { [::ChatWindow::UseContainer] == 0 } {
set win_name [::ChatWindow::Open]
::ChatWindow::SetFor $lowuser $win_name
} else {
set container [::ChatWindow::GetContainerFor $user]
set win_name [::ChatWindow::Open $container]
::ChatWindow::SetFor $lowuser $win_name
}
set ::ChatWindow::first_message($win_name) 0
#TODO: This check shouldn't be there
#Have a look at proc IsOIM (gui.tcl)
if {[::OIM_GUI::IsOIM $user] == 0 && $oim == 0} {
set chatid [::MSN::chatTo $lowuser]
} else {
#doing OIM
set chatid $lowuser
}
# PostEvent 'new_conversation' to notify plugins that the window was created
set evPar(chatid) $chatid
set evPar(usr_name) $user
::plugins::PostEvent new_conversation evPar
if { [winfo exists [::ChatWindow::GetOutDisplayPicturesFrame $win_name].dps] } {
::amsn::ShowOrHidePicture
::amsn::ShowOrHideTopPicture
::amsn::UpdatePictures $win_name
} else {
if { [::config::getKey showdisplaypic] && $user != ""} {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $user] [trans showuserpic $user]
} else {
::amsn::ChangePicture $win_name [::skin::getDisplayPicture $user] [trans showuserpic $user] nopack
}
}
}
#TODO: This check shouldn't be there
#Have a look at proc IsOIM (gui.tcl, ~2540)
if {[::OIM_GUI::IsOIM $user] == 0 && $oim == 0 } {
set chatid [::MSN::chatTo $lowuser]
} else {
#doing OIM
set chatid $lowuser
}
if { [::ChatWindow::UseContainer] != 0 && $creating_window == 1} {
::ChatWindow::NameTabButton $win_name $chatid
set_balloon $::ChatWindow::win2tab($win_name) "--command--::ChatWindow::SetNickText $chatid"
}
if { "$chatid" != "${lowuser}" } {
status_log "Error in ::amsn::chatUser, expected same chatid as user, but was different\n" red
return 0
}
set top_win [winfo toplevel $win_name]
if { [winfo exists .bossmode] } {
set ::BossMode(${top_win}) "normal"
wm state ${top_win} withdraw
} else {
if { [::config::getKey winmaximized 0] == 1 } {
wm state ${top_win} zoomed
} else {
wm state ${top_win} normal
}
}
wm deiconify ${top_win}
update idletasks
if { [OnMac] } { ::ChatWindow::MacPosition ${top_win} }
::ChatWindow::TopUpdate $chatid
#We have a window for that chatid, raise it
raise ${top_win}
set container [::ChatWindow::GetContainerFromWindow $win_name]
if { $container != "" } { ::ChatWindow::SwitchToTab $container $win_name }
# while receiving oims, with no tabbed chatting,
# since many windows could open at the same time, and each of them were asking for the focus
# here is an ugly workaround
if {!$oim } {
focus [::ChatWindow::GetInputText ${win_name}]
}
return $win_name
}
#///////////////////////////////////////////////////////////////////////////////
proc SelectUrl {textw urlname } {
if { [focus] != "${textw}.inner" || [llength [$textw tag ranges sel]] == 0} {
# If we were focusing on the text widget (user didn't explicitely just selected text with his mouse)
# We need to free up the selection to avoid having multiple ranges selected
if { [llength [$textw tag ranges sel]] > 0 } {
eval [list $textw] tag remove sel [$textw tag ranges sel]
}
# We force the focus on the inner frame, this way the selection will appear, otherwise, we won't see anything..
catch {focus -force ${textw}.inner}
eval [list $textw] tag add sel [$textw tag ranges $urlname]
}
}
#///////////////////////////////////////////////////////////////////////////////
# WinWrite (chatid,txt,tagid,[format])
# Writes 'txt' into the window related to 'chatid'
# It will use 'tagname' as style tag, unless 'tagname'=="user", where it will use
# 'fontname', 'fontstyle' and 'fontcolor' as from fontformat, or 'tagname'=="says"
# where it will use the same format as "user" but size 11.
# The parameter "user" is used for smiley substitution.
# If lst value is empty the txt value is considered and it will be converted in lst
proc WinWrite {chatid txt tagname {fontformat ""} {flicker 1} {user ""} {lst ""}} {
set win_name [::ChatWindow::For $chatid]
if { $win_name == 0} {
return 0
}
#Avoid problems if the windows was closed
if {![winfo exists $win_name]} {
return
}
set textw [::ChatWindow::GetOutText ${win_name}]
set scrolling [::ChatWindow::getScrolling $textw]
set fontname [lindex $fontformat 0]
set fontstyle [lindex $fontformat 1]
set fontcolor [lindex $fontformat 2]
set fontbg ""
$textw configure -font bplainf -foreground black
#Store position for later smiley and URL replacement
# use end-1c because text widgets always have \n at the end, and it's better than getting the
# previous line as we did before (creates bug when we use a custom chat style that fits in one line).
set text_start [$textw index end-1c]
#Ugly hack for elided search, but at least it works!...
if { [info tclversion] == 8.4 && $tagname == "user" } {
if { [$textw get end-2c]!= "\n" } {
set all_chars 0
$textw search -elide -regexp -count all_chars .* end-1l end-1c
#Remove line below and aMSN Plus causes bug report
set visible_chars $all_chars
$textw search -regexp -count visible_chars .* end-1l end-1c
set elided_chars [expr {$all_chars - $visible_chars + 1}]
set text_start $text_start-${elided_chars}c
}
}
#Check if this is first line in the text, then ignore the \n
#at the beginning of the line
if { [$textw get 1.0 2.0] == "\n" } {
if {$lst == ""} {
if {[string index $txt 0] == "\n"} {
set txt [string range $txt 1 end]
}
} else {
set txtelement [lindex [lindex $lst 0] 1]
if {[string index $txtelement 0] == "\n"} {
set txtelement [string range $txtelement 1 end]
set lst [lreplace $lst 0 0 [list text "$txtelement"]]
}
# Compact style has 2 newlines, no 1, so we need to remove both.
if {[string index $txtelement 0] == "\n"} {
set txtelement [string range $txtelement 1 end]
set lst [lreplace $lst 0 0 [list text "$txtelement"]]
}
}
}
set fontcolor_original $fontcolor
if {$lst == ""} {
set lst [list ]
lappend lst [list text "$txt"]
}
set evPar(tagname) tagname
set evPar(winname) {win_name}
set textw [::ChatWindow::GetOutText ${win_name}]
foreach unit $lst {
switch [lindex $unit 0] {
"text" { set txt "[lindex $unit 1]" }
"smiley" { set txt "[lindex $unit 2]" }
"colour" {
if {[lindex $unit 1] ne "reset"} {
set fontcolor [string range [lindex $unit 1] 1 end]
} else {
set fontcolor $fontcolor_original
}
continue
}
"bg" {
if {[lindex $unit 1] ne "reset"} {
set fontbg [lindex $unit 1]
} else {
set fontbg ""
}
continue
}
"newline" { set txt "\n" }
default { continue }
}
#By default tagid=tagname unless we generate a new one
set tagid $tagname
if { $tagid == "user" || $tagid == "yours" || $tagid == "says" || $tagid == "custom" } {
if { $tagid == "says" && [::config::getKey strictfonts] == 0 } {
set size [lindex [::config::getGlobalKey basefont] 1]
} else {
set size [expr {[lindex [::config::getGlobalKey basefont] 1]+[::config::getKey textsize]}]
}
# We'd rather avoid letting the system use 'fixed' whenever the font is not available, because it's THE ugliest...
# 7:44 <@azbridge> <Cameron> So, in the short term, you're rather stuck with [font families]. Maybe you can help make a better answer for a future release of Tk, though.
if { $tagid == "user" } {
set fontname [urldecode $fontname]
set font "bplainf"
foreach listed_font [string trim [split $fontname ","]] {
if { [info exists ::allfonts([string tolower $listed_font])] } {
#status_log "font $listed_font found!"
set font "\"$listed_font\" $size $fontstyle"
break
}
}
} else {
set font "\"$fontname\" $size $fontstyle"
}
set tagid [::md5::md5 "$font$fontcolor"]
if { ([string length $fontname] < 3 ) ||
([catch {$textw tag configure $tagid -foreground "#$fontcolor" -background $fontbg -font $font} res])} {
status_log "Font $font or color $fontcolor wrong. Using default\n" red
$textw tag configure $tagid -foreground black -font bplainf
}
}
set evPar(msg) txt
::plugins::PostEvent WinWrite evPar
$textw roinsert end "$txt" $tagid
if {$tagname ne "says"} {
variable urlcount
variable urlregexps
set text_data [$textw get $text_start end]
foreach match [urlParserString $text_data] {
set start [lindex $match 0]
set end [lindex $match 1]
set pos [$textw index ${text_start}+${start}c]
set endpos [$textw index ${text_start}+[expr {${end} +1}]c]
set urltext [$textw get $pos ${endpos}]
set urlcount "[expr {$urlcount+1}]"
set urlname "url_$urlcount"
$textw tag configure $urlname \
-foreground "#000080" -font splainf -underline true
$textw tag bind $urlname <Enter> \
"$textw tag conf $urlname -underline false; $textw conf -cursor hand2"
$textw tag bind $urlname <Leave> \
"$textw tag conf $urlname -underline true; $textw conf -cursor xterm"
$textw tag bind $urlname <<Button1>> \
"$textw conf -cursor watch; launch_browser [string map {% %%} [list $urltext]]"
$textw tag bind $urlname <<Button3>> [list ::amsn::SelectUrl $textw $urlname]
$textw rodelete $pos $endpos
$textw roinsert $pos "$urltext" $urlname
#Don't replace smileys in URLs
$textw tag add dont_replace_smileys ${urlname}.first ${urlname}.last
}
}
#Avoid problems if the windows was closed in the middle...
if {![winfo exists $win_name]} { return }
} ;#end of foreach
if {[::config::getKey chatsmileys]} {
if {($tagname ne "says") && ([::config::getKey customsmileys] && [::abook::getContactData $user showcustomsmileys] != 0) } {
custom_smile_subst $chatid $textw $text_start end
}
#Replace smileys... if you're sending custom ones, replace them too (last parameter)
if { $user == [string tolower [::config::getKey login]] } {
::smiley::substSmileys $textw $text_start end 0 1
#::smiley::substYourSmileys [::ChatWindow::GetOutText ${win_name}] $text_start end 0
} else {
::smiley::substSmileys $textw $text_start end 0 0
}
}
if { $scrolling } { ::ChatWindow::Scroll $textw }
if { $flicker } {
::ChatWindow::Flicker $chatid
}
after cancel [list set ::ChatWindow::recent_message($win_name) 0]
set ::ChatWindow::recent_message(${win_name}) 1
after 2000 [list set ::ChatWindow::recent_message($win_name) 0]
::plugins::PostEvent WinWritten evPar
}
#///////////////////////////////////////////////////////////////////////////////
proc WinWriteIcon { chatid imagename {padx 0} {pady 0}} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
[::ChatWindow::GetOutText ${win_name}] image create end -image [::skin::loadPixmap $imagename] -pady $pady -padx $pady
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
proc WinWriteClickable { chatid txt command {tagid ""}} {
set win_name [::ChatWindow::For $chatid]
if { [::ChatWindow::For $chatid] == 0} {
return 0
}
set scrolling [::ChatWindow::getScrolling [::ChatWindow::GetOutText ${win_name}]]
if { $tagid == "" } {
set tagid [getUniqueValue]
}
[::ChatWindow::GetOutText ${win_name}] tag configure $tagid \
-foreground #000080 -font bboldf -underline false
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <Enter> \
"[::ChatWindow::GetOutText ${win_name}] tag conf $tagid -underline true;\
[::ChatWindow::GetOutText ${win_name}] conf -cursor hand2"
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <Leave> \
"[::ChatWindow::GetOutText ${win_name}] tag conf $tagid -underline false;\
[::ChatWindow::GetOutText ${win_name}] conf -cursor xterm"
[::ChatWindow::GetOutText ${win_name}] tag bind $tagid <<Button1>> "$command"
[::ChatWindow::GetOutText ${win_name}] roinsert end "$txt" $tagid
if { $scrolling } { ::ChatWindow::Scroll [::ChatWindow::GetOutText ${win_name}] }
}
if { $initialize_amsn == 1 } {
variable NotifID 0
variable NotifPos [list]
}
###
### $closingdocks: 0 / unexistant = ask
### 1 = dock
### 2 = close
proc closeOrDock { closingdocks } {
global rememberdock
set rememberdock 0
if {$closingdocks == 1} {
closeOrDockDock
} elseif { $closingdocks == 2} {
exit
} else {
set w .closeordock
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w -bg [::skin::getKey extrastdwindowcolor]
wm title $w "[trans title]"
wm group $w .
wm resizable $w 0 0
#Create the 2 frames
frame $w.top
frame $w.buttons
#Create the picture of warning (at left)
label $w.top.bitmap -image [::skin::loadPixmap warning]
pack $w.top.bitmap -side left -pady 0 -padx [list 0 12 ]
label $w.top.question -text "[trans closeordock]" -wraplength 400 -justify left
pack $w.top.question -pady 0 -padx 0 -side top
checkbutton $w.top.remember -text [trans remembersetting] -variable rememberdock -anchor w
pack $w.top.remember -pady 5 -padx 10 -side bottom -fill x
#Create the buttons
button $w.buttons.quit -text "[trans quit]" -command "::amsn::closeOrDockClose"
button $w.buttons.dock -text "[trans minimize]" -command "::amsn::closeOrDockDock"
button $w.buttons.cancel -text "[trans cancel]" -command "destroy $w"
pack $w.buttons.quit -pady 0 -padx 0 -side right
pack $w.buttons.cancel -pady 0 -padx [list 0 6 ] -side right
pack $w.buttons.dock -pady 0 -padx 6 -side right
#Pack frames
pack $w.top -pady 12 -padx 12 -side top
pack $w.buttons -pady 12 -padx 12 -fill x
bind $w <<Escape>> "destroy $w"
moveinscreen $w 30
}
}
proc closeOrDockDock {} {
global systemtray_exist statusicon ishidden rememberdock
if {$rememberdock} {
::config::setKey closingdocks 1
}
wm iconify .
if { $systemtray_exist == 1 && $statusicon != 0 } {
status_log "Hiding\n" white
wm state . withdrawn
set ishidden 1
}
destroy .closeordock
unset rememberdock
}
proc closeOrDockClose {} {
global rememberdock
if {$rememberdock} {
::config::setKey closingdocks 2
}
destroy .closeordock
unset rememberdock
exit
}
#Adds a message to the notify, that executes "command" when clicked, and
#plays "sound"
proc notifyAdd { msg command {sound ""} {type other} {user ""} {lst 0}} {
#no notifications in bossmode or if disabled
if { [winfo exists .bossmode] || [::config::getKey shownotify] == 0} {
return
}
#if we gota sound, play it
if { $sound != ""} {
play_sound ${sound}.wav
}
global automessage
#Maybe we want to block the notification windows but not the sounds!
if { [info exists automessage] && $automessage != -1 && [lindex $automessage 7] == 1} { return }
# Check if we only want to play the sound notification
if { [::config::getKey notifyonlysound] == 0 } {
#have a unique name
variable NotifID
#the position, always incremented with height
variable NotifPos
#New name for the window
set w .notif$NotifID
incr NotifID
#the window will be stretched by the canvas anyways
toplevel $w -width 1 -height 1 -borderwidth 0; wm overrideredirect $w 1
wm group $w .
#no wm borders
wm state $w withdrawn
#To put the notify window in front of all
#Some verions of tk don't support this
catch { wm attributes $w -topmost 1 }
set xpos [::config::getKey notifyXoffset]
set ypos [::config::getKey notifyYoffset]
if { $xpos < 0 } { set xpos 0 }
if { $ypos < 0 } { set ypos 0 }
set height [::skin::getKey notifheight]
#Search for a free notify window position
while { [lsearch -exact $NotifPos $ypos] >=0 } {
incr ypos $height
}
lappend NotifPos $ypos
canvas $w.c -bg #EEEEFF -width [::skin::getKey notifwidth] -height [::skin::getKey notifheight] \
-relief ridge -borderwidth 0 -highlightthickness 0
pack $w.c
#set the background picture
switch $type {
online { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyonline] -tag bg }
offline { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyoffline] -tag bg }
state { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifystate] -tag bg }
plugins { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyplugins] -tag bg }
message { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifymsg] -tag bg }
email { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyemail] -tag bg }
default { $w.c create image 0 0 -anchor nw -image [::skin::loadPixmap notifyonline] -tag bg }
}
#----------convert msg in a list--------------;#
if {!$lst} { ;#
set msg [string map { "\n" " "} $msg] ;#
set msg [list $msg] ;#
set msg [list "text $msg"] ;#
} ;#
#---------------------------------------------;#
#If it's a notification about a user (user var given) and there is an image (the creation results 1) and we have the config set to show the image, show the display-picture
if {$user != "" && [getpicturefornotification $user] && [::config::getKey showpicnotify]} {
#Put the image on the canvas
$w.c create image [::skin::getKey x_notifydp] [::skin::getKey y_notifydp] -anchor nw\
-image displaypicture_not_$user -tag bg
set x [::skin::getKey x_notifytext]
set y [::skin::getKey y_notifytext]
set maxw [::skin::getKey width_notifytext]
#else, just show the text, using all the space
} else {
# set notify_id [$w.c create text [expr {[::skin::getKey notifwidth]/2}] [expr {[::skin::getKey notifheight]/2}] \
# -font [::skin::getKey notify_font] -justify left\
# -width [expr {[::skin::getKey notifwidth]-20}] -anchor center\
# -text "$msg" -tag bg -fill [::skin::getKey notifyfg]]
# set x [::skin::getKey notifwidth]
# set x [expr {[::skin::getKey notifwidth]/2}]
# set y [expr {[::skin::getKey notifheight]/2}]
set x [::skin::getKey x_notifydp]
set y [::skin::getKey y_notifytext]
set maxw [expr {[::skin::getKey notifwidth]-20}]
}
set default_x $x
set default_y $y
set default_maxw $maxw
set default_colour [::skin::getKey notifyfg]
set default_font [::skin::getKey notify_font]
# set lines 0 ;# not used
set colour $default_colour
set font_attr [font configure $default_font]
set incr_y [font metrics $font_attr -displayof $w.c -linespace]
set default_incr_y $incr_y
set bg_x ""
set bg_cl ""
foreach unit $msg {
switch [lindex $unit 0] {
"text" {
set textpart [lindex $unit 1]
set textwidth [font measure $font_attr $textpart]
if {$textwidth > $maxw} {
set l [string length $textpart]
for {set i 0} {$i < $l} {incr i} {
if { [ font measure $font_attr -displayof $w.c "[string range $textpart 0 $i]" ] > $maxw} {
set txt "[string range $textpart 0 [expr {$i-1}]]"
$w.c create text $x $y -text $txt \
-anchor nw -fill $colour -font $font_attr -tags {bg text2} -justify left
if {$bg_x ne ""} {
incr x [font measure $font_attr -displayof $w.c $txt]
$w.c create rect $bg_x $y $x [expr {$y + $incr_y}] -fill $bg_cl -outline "" -tag bgtext
foreach tag [list "text2" "img"] {
$w.c lower bgtext $tag
}
set bg_x $default_x
}
set textpart [string range $textpart $i end]
if {$textpart ne " "} {
set i 0
set l [string length $textpart]
set textwidth [font measure $font_attr $textpart]
} else {
set l 0
set textwidth 0
}
set x $default_x
set y [expr $y + $incr_y]
set maxw $default_maxw
set incr_y $default_incr_y
}
}
}
$w.c create text $x $y -text $textpart \
-anchor nw -fill $colour -font $font_attr -tags {bg text2} -justify left
incr x $textwidth
set maxw [expr {$maxw - $textwidth}]
}
"smiley" {
set img [lindex $unit 1]
set width [image width $img]
if {[image height $img] > $incr_y} {
set incr_y [image height $img]
}
if {$width > $maxw} {
set x $default_x
set y [expr $y + $incr_y]
set maxw $default_maxw
}
$w.c create image $x $y -image $img -anchor nw -state normal -tags {bg img}
set maxw [expr {$maxw - $width}]
incr x $width
}
"colour" {
if {[lindex $unit 1] eq "reset"} {
set colour $default_colour
} else {
set colour [lindex $unit 1]
}
}
"bg" {
if {$bg_x eq ""} {
if {[lindex $unit 1] ne "reset"} {
set bg_x $x
set bg_cl [lindex $unit 1]
}
} else {
$w.c create rect $bg_x $y $x [expr {$y + $incr_y}] -fill $bg_cl -outline "" -tag bgtext
foreach tag [list "text2" "img"] {
$w.c lower bgtext $tag
}
set bg_x $x
set bg_cl [lindex $unit 1]
if {$bg_cl eq "reset"} {
set bg_x ""
}
}
}
"font" {
if { [llength [lindex $unit 1]] == 1 } {
if { [lindex $unit 1] == "reset" } {
set font_attr [font configure $default_font]
} else {
set font_attr [font configure [lindex $unit 1]]
}
array set current_format $font_attr
} else {
array set current_format $font_attr
array set modifications [lindex $unit 1]
foreach key [array names modifications] {
set current_format($key) [set modifications($key)]
if { [set current_format($key)] == "reset" } {
set current_format($key) \
[font configure $default_font $key]
}
}
set font_attr [array get current_format]
}
}
"newline" {
if {$x != $default_x} {
set x $default_x
set y [expr $y + $incr_y]
set maxw $default_maxw
}
set incr_y $default_incr_y
}
}
}
#add the close button
$w.c create image [::skin::getKey x_notifyclose] [::skin::getKey y_notifyclose] -anchor nw -image [::skin::loadPixmap notifclose] -tag close
::amsn::leaveNotify $w $ypos $command
#wm overrideredirect $w 1
#now show it
wm state $w normal
if { [OnMac] } {
#Raise $w to correct a bug in "wm geometry" in AquaTK (Mac OS X)
lower $w
}
#Disable Grownotify for Mac OS X Aqua/tk users
if {![::config::getKey animatenotify] || [OnMac] } {
wm geometry $w -$xpos-$ypos
} else {
wm geometry $w -$xpos-[expr {$ypos-100}]
after 50 "::amsn::growNotify $w $xpos [expr {$ypos-100}] $ypos"
}
}
}
proc enterNotify { w after_id } {
$w.c configure -cursor hand2
after cancel $after_id
}
proc leaveNotify { w ypos command } {
$w.c configure -cursor left_ptr
set after_id [after [::config::getKey notifytimeout] [list ::amsn::KillNotify $w $ypos]]
$w.c bind bg <Enter> [list ::amsn::enterNotify $w $after_id]
$w.c bind bg <Leave> [list ::amsn::leaveNotify $w $ypos $command]
$w.c bind bg <ButtonRelease-1> "after cancel $after_id; [list ::amsn::KillNotify $w $ypos $command]"
$w.c bind bg <ButtonRelease-3> "after cancel $after_id; [list ::amsn::KillNotify $w $ypos]"
$w.c bind close <Enter> [list ::amsn::enterNotify $w $after_id]
$w.c bind close <Leave> [list ::amsn::leaveNotify $w $ypos $command]
$w.c bind close <ButtonRelease-1> "after cancel $after_id; ::amsn::KillNotify $w $ypos"
}
proc growNotify { w xpos currenty finaly } {
if { [winfo exists $w] == 0 } { return 0}
if { $currenty>$finaly} {
wm geometry $w -$xpos-$finaly
raise $w
return 0
}
wm geometry $w -$xpos-$currenty
after 75 "::amsn::growNotify $w $xpos [expr {$currenty+15}] $finaly"
}
proc KillNotify { w ypos {command ""}} {
variable NotifPos
if { $command != "" } {
catch {eval $command}
set timer 500
} else {
set timer 0
}
# We need to wait before making this disappear because we need the window to be created
# BEFORE the notify disappears, otherwise in windows, the focus is lost from amsn and returns to the
# previous application who had the focus, so we don't get the chat window focus.
after $timer [list destroy $w]
#remove this position from the list
set lpos [lsearch -exact $NotifPos $ypos]
set NotifPos [lreplace $NotifPos $lpos $lpos]
}
}
proc create_places_menu { wmenu } {
# Destroy if already existing
if {[winfo exists $wmenu]} {
destroy $wmenu
}
# User status menu
menu $wmenu -tearoff 0 -type normal
$wmenu add command -label [trans signouthere [::config::getKey epname aMSN]] -command "::MSN::logout"
foreach ep [::abook::getEndPoints] {
if {![string equal -nocase $ep [::config::getGlobalKey machineguid]] } {
$wmenu add command -label [trans signoutep [::abook::getEndPointName $ep]] -command [list ::MSN::logoutEP $ep]
}
}
$wmenu add command -label [trans signouteverywhere] -command "::MSN::logoutGtfo"
$wmenu add separator
$wmenu add command -label [trans renameep [::config::getKey epname aMSN]] -command "Preferences"
}
proc create_states_menu { wmenu } {
# Destroy if already existing
if {[winfo exists $wmenu]} {
destroy $wmenu
}
# User status menu
menu $wmenu -tearoff 0 -type normal
$wmenu add command -label [trans online] -command "ChCustomState NLN"
$wmenu add command -label [trans noactivity] -command "ChCustomState IDL"
$wmenu add command -label [trans busy] -command "ChCustomState BSY"
$wmenu add command -label [trans rightback] -command "ChCustomState BRB"
$wmenu add command -label [trans away] -command "ChCustomState AWY"
$wmenu add command -label [trans onphone] -command "ChCustomState PHN"
$wmenu add command -label [trans gonelunch] -command "ChCustomState LUN"
$wmenu add command -label [trans appearoff] -command "ChCustomState HDN"
$wmenu add command -label [trans logout] -command "::MSN::logout"
set modifier [GetPlatformModifier]
bind all <$modifier-Key-0> {catch {ChCustomState HDN}}
bind all <$modifier-Key-1> {catch {ChCustomState NLN}}
bind all <$modifier-Key-2> {catch {ChCustomState IDL}}
bind all <$modifier-Key-3> {catch {ChCustomState BSY}}
bind all <$modifier-Key-4> {catch {ChCustomState BRB}}
bind all <$modifier-Key-5> {catch {ChCustomState AWY}}
bind all <$modifier-Key-6> {catch {ChCustomState PHN}}
bind all <$modifier-Key-7> {catch {ChCustomState LUN}}
bind all <$modifier-Key-8> {catch {ChCustomState HDN}}
# Add the personal states to this menu
CreateStatesMenu $wmenu states_only
}
proc create_other_menus {umenu imenu} {
# Destroy if already existing
if {[winfo exists $umenu]} { destroy $umenu }
if {[winfo exists $imenu]} { destroy $imenu }
# User menu
menu $umenu -tearoff 0 -type normal
menu $umenu.move_group_menu -tearoff 0 -type normal
menu $umenu.copy_group_menu -tearoff 0 -type normal
menu $imenu -tearoff 0 -type normal
}
proc create_apple_menu { wmenu } {
set appmenu $wmenu.apple
$wmenu add cascade -label "aMSN" -menu $appmenu
menu $appmenu -tearoff 0 -type normal
$appmenu add command -label "[trans about] aMSN" \
-command ::amsn::aboutWindow
$appmenu add separator
$appmenu add command -label "[trans skinselector]" \
-command ::skinsGUI::SelectSkin -accelerator "Command-Shift-S"
$appmenu add command -label "[trans pluginselector]" \
-command ::plugins::PluginGui -accelerator "Command-Shift-P"
# Since Tk 8.4.14 the Preferences AppleMenu item is hardcoded by TkAqua.
# When the menu item is pressed, it calls ::tk::mac::ShowPreferences.
if { [version_vcompare [info patchlevel] 8.4.14] < 0 } {
$appmenu add separator
$appmenu add command -label "[trans preferences]..." \
-command Preferences -accelerator "Command-,"
}
$appmenu add separator
}
proc create_main_menu {wmenu} {
global password
# Destroy if already existing
if {[winfo exists .main_menu]} { destroy $wmenu }
#Main menu
if {[package provide pixmapmenu] != "" && \
[info commands pixmapmenu_isEnabled] != "" && [pixmapmenu_isEnabled]} {
pack [menubar .main_menu] -before .main -fill x -side top
} else {
menu .main_menu -tearoff 0 -type menubar -borderwidth 0 -activeborderwidth -0
}
######################################################
# Add the menus in the menubar #
######################################################
#For apple, the first menu is the "App menu"
if { [OnMac] } { create_apple_menu .main_menu }
.main_menu add cascade -label "[trans account]" -menu .main_menu.account
.main_menu add cascade -label "[trans view]" -menu .main_menu.view
.main_menu add cascade -label "[trans actions]" -menu .main_menu.actions
.main_menu add cascade -label "[trans contacts]" -menu .main_menu.contacts
if { [OnMac] } {
# Add a window menu as required by Apple's HIG.
package require windowlist
set window [windowlist::windowMenu {.main_menu}]
}
.main_menu add cascade -label "[trans help]" -menu .main_menu.helpmenu
###########################
#Account menu
###########################
set accnt .main_menu.account
#Temporary fix for (probably Mac-only) bug where states menu refuses to appear
if { [OnMac] } {
#I think this might create another bug, that's why I keep it Mac-only for now
#This way things stay good on other platforms, and on Mac we get a smaller bug.
#(menu does not update if new custom status is added, instead of not posting at all)
#TODO: Of course, this needs a real fix sometime.
menu $accnt -tearoff 0 -type normal
create_states_menu $accnt.my_menu
} else {
menu $accnt -tearoff 0 -type normal -postcommand "create_states_menu $accnt.my_menu"
}
#Note: One might think we should always have both entries (login and login_as)
#in the menu with "login" (with profile) greyed out if it's not available.
#Though, this makes us have 2 entries that are allmost the same, definitely
#in the translated string. As this menu doesn't swap all the time and only
#does so when once this option is set to have a profile, I don't think there's
#a problem of having this entry not be there when there is no profile.
#It's like, when you load a plugin for a new action it can add an item but that
#item wasn't there before and greyed out.
#Log in with default profile
if { [string length [::config::getKey login]] > 0 && $password != ""} {
#$accnt add command -label "[trans login] ([::config::getKey login])" -command ::MSN::connect -state normal
}
#log in with another profile
#$accnt add command -label "[trans loginas]..." -command cmsn_draw_login -state normal
#log out
$accnt add command -label "[trans logout]" -command [list preLogout ::MSN::logout] -state disabled
#-------------------
$accnt add separator
#change status submenu
$accnt add cascade -label "[trans changestatus]" -menu $accnt.my_menu -state disabled
#change nick
$accnt add command -label "[trans changenick]..." -command [list cmsn_change_name] -state disabled
#change psm
$accnt add command -label "[trans changepsm]..." -command [list cmsn_change_name 1] -state disabled
#change dp
$accnt add command -label "[trans changedisplaypic]..." -command [list dpBrowser] -state disabled
#-------------------
$accnt add separator
#go to inbox
$accnt add command -label "[trans gotoinbox]" -command [list ::hotmail::hotmail_login] -state disabled
#go to my profile
$accnt add command -label "[trans editmyprofile]" -command [list ::hotmail::hotmail_profile] -state disabled
#-------------------
$accnt add separator
#edit global alarm settings
$accnt add command -label "[trans cfgalarmall]..." -command [list ::alarms::configDialog all] -state disabled
#-------------------
$accnt add separator
#received files
$accnt add command -label "[trans openreceived]" -command [list launch_filemanager [::config::getKey receiveddir]]
#events history
$accnt add command -label "[trans eventhistory]" -command [list ::log::OpenLogWin eventlog] -state disabled
#On mac these are in the app menu instead of here, except for minimize, which doesn't exist on mac.
if {![OnMac]} {
#-------------------
$accnt add separator
# $accnt add checkbutton -label "[trans sound]" -onvalue 1 -offvalue 0 -variable [::config::getVar sound]u
$accnt add command -label "[trans skinselector]" -command [list ::skinsGUI::SelectSkin]
$accnt add command -label "[trans pluginselector]" -command [list ::plugins::PluginGui]
$accnt add command -label "[trans preferences]" -command Preferences -accelerator "Ctrl-P"
#-------------------
$accnt add separator
#Minimize to tray
$accnt add command -label "[trans minimize]" -command [list ::amsn::closeOrDock 1]
#Terminate aMSN
$accnt add command -label "[trans quit]" -command [list ::amsn::closeOrDock 2] -accelerator "Ctrl-Q"
}
###########################
#View menu
###########################
set view .main_menu.view
menu $view -tearoff 0 -type normal
#Add the "view by" radio buttons
$view add cascade -label "[trans sortcontactsby]" -menu $view.sortcontacts -state disabled
menu $view.sortcontacts -tearoff 0 -type normal
$view.sortcontacts add radio -label "[trans sortcontactstatus]" -value 0 \
-variable [::config::getVar orderbygroup] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add radio -label "[trans sortcontactgroup]" -value 1 \
-variable [::config::getVar orderbygroup] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add radio -label "[trans sortcontacthybrid]" -value 2 \
-variable [::config::getVar orderbygroup] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add separator
$view.sortcontacts add radio -label "[trans sortcontactsasc]" -value 1 \
-variable [::config::getVar orderusersincreasing] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add radio -label "[trans sortcontactsdesc]" -value 0 \
-variable [::config::getVar orderusersincreasing] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add separator
$view.sortcontacts add checkbutton -label "[trans sortcontactsbylogsize]" -onvalue 1 -offvalue 0 \
-variable [::config::getVar orderusersbylogsize] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add separator
$view.sortcontacts add checkbutton -label "[trans groupcontactsbystatus]" -onvalue 1 -offvalue 0 \
-variable [::config::getVar orderusersbystatus] -command [list ::Event::fireEvent changedSorting gui]
$view.sortcontacts add checkbutton -label "[trans groupnonim]" -onvalue 1 -offvalue 0 \
-variable [::config::getVar groupnonim] -command [list ::Event::fireEvent changedSorting gui]
#-------------------
$view add separator
$view add radio -label "[trans showcontactnick]" -value 0 \
-variable [::config::getVar emailsincontactlist] -command "::Event::fireEvent changedNickDisplay gui; ::Event::fireEvent changedSorting gui" -state disabled
$view add radio -label "[trans showcontactemail]" -value 1 \
-variable [::config::getVar emailsincontactlist] -command "::Event::fireEvent changedNickDisplay gui; ::Event::fireEvent changedSorting gui" -state disabled
#-------------------
$view add separator
$view add command -label "[trans changeglobnick]..." -command [list ::abookGui::SetGlobalNick]
#-------------------
$view add separator
$view add radio -label "[trans sortgroupsasc]" -value 1 \
-variable [::config::getVar ordergroupsbynormal] -command [list ::Event::fireEvent changedSorting gui] -state disabled
$view add radio -label "[trans sortgroupsdesc]" -value 0 \
-variable [::config::getVar ordergroupsbynormal] -command [list ::Event::fireEvent changedSorting gui] -state disabled
#-------------------
$view add separator
$view add checkbutton -label "[trans showdetailedview]" -onvalue 1 -offvalue 0 -state disabled \
-variable [::config::getVar show_detailed_view] -command [list ::guiContactList::DetailedView]
#-------------------
$view add separator
$view add checkbutton -label "[trans shownonim]" -onvalue 1 -offvalue 0 -state disabled \
-variable [::config::getVar shownonim] -command [list ::Event::fireEvent changedSorting gui]
#$view add checkbutton -label "[trans showspaces]" -onvalue 1 -offvalue 0 -state disabled \
# -variable [::config::getVar showspaces] -command [list ::Event::fireEvent changedSorting gui]
$view add checkbutton -label "[trans showofflinegroup]" -onvalue 1 -offvalue 0 -state disabled \
-variable [::config::getVar showOfflineGroup] -command [list ::Event::fireEvent changedSorting gui]
###########################
#Actions menu
###########################
set actions .main_menu.actions
menu $actions -tearoff 0 -type normal
#Send msg
$actions add command -label "[trans sendmsg]..." -command [list ::amsn::ShowUserList [trans sendmsg] ::amsn::chatUser 1] -state disabled
#Send SMS
$actions add command -label "[trans sendmobmsg]..." -command [list ::amsn::ShowUserList [trans sendmobmsg] ::MSNMobile::OpenMobileWindow] -state disabled
#Send e-mail
$actions add command -label "[trans sendmail]..." -command [list ::amsn::ShowUserList [trans sendmail] launch_mailer 1 1] -state disabled
#-------------------
$actions add separator
#Send File
$actions add command -label "[trans sendfile]..." -command [list ::amsn::ShowUserList [trans sendfile] ::amsn::FileTransferSend] -state disabled
#Send Webcam
$actions add command -label "[trans sendcam]..." -command "" -command [list ::amsn::ShowUserList [trans sendcam] ::MSNCAM::SendInviteQueue] -state disabled
#Ask Webcam
$actions add command -label "[trans askcam]..." -command "" -command [list ::amsn::ShowUserList [trans askcam] ::MSNCAM::AskWebcamQueue] -state disabled
#-------------------
$actions add separator
#Play game
$actions add cascade -label "[trans playgame]" -menu [::MSNGamesGUI::buildMenu $actions] -state disabled
###########################
#Contacts menu
###########################
set conts .main_menu.contacts
menu $conts -tearoff 0 -type normal
#add contact
$conts add command -label "[trans addacontact]..." -command cmsn_draw_addcontact -state disabled
#remove contact
$conts add command -label "[trans delete]..." -command [list ::amsn::ShowUserList [trans delete] ::amsn::deleteUser 1] -state disabled
#contact properties
$conts add command -label "[trans properties]..." -command [list ::amsn::ShowUserList [trans properties] ::abookGui::showUserProperties] -state disabled
#-------------------
$conts add separator
#Add group
$conts add command -label "[trans groupadd]..." -state disabled -command [list ::groups::dlgAddGroup]
#remove group
$conts add cascade -label "[trans groupdelete]" -state disabled -menu $conts.group_list_delete
#rename group
$conts add cascade -label "[trans grouprename]" -state disabled -menu $conts.group_list_rename
::groups::Init $conts
#-------------------
$conts add separator
#chat history
$conts add command -label "[trans history]" -command [list ::log::OpenLogWin] -state disabled
#webcam history
$conts add command -label "[trans webcamhistory]" -command [list ::log::OpenCamLogWin] -state disabled
#-------------------
$conts add separator
$conts add command -label "[trans savecontacts]" \
-command [list saveContacts] -state disabled
$conts add command -label "[trans loadcontacts]" \
-command [list ::abook::importContact] -state disabled
###########################
#Help menu
###########################
set help .main_menu.helpmenu
menu $help -tearoff 0 -type normal
if {[OnMac]} {
# The help menu on a mac should be given the Command-? accelerator.
$help add command -label "[trans onlinehelp]" \
-command [list launch_browser $::weburl/wiki/Main_Page] \
-accelerator "Command-?"
} else {
$help add command -label "[trans onlinehelp]" \
-command [list launch_browser $::weburl/wiki/Main_Page] \
}
set lang [::config::getGlobalKey language]
$help add command -label "[trans faq]" \
-command [list launch_browser "$::weburl/faq.php?lang=$lang"]
$help add separator
$help add command -label "[trans sendfeedback]" -command [list launch_browser "$::weburl/forums/index.php"]
# About is in the app menu on Mac
if {![OnMac]} {
$help add separator
$help add command -label "[trans about]" -command [list ::amsn::aboutWindow]
}
#add a postevent to modify the main menu
set evPar(menu) .main_menu
::plugins::PostEvent mainmenu evPar
# Show the menubar if config allows it (or we're on Mac)
if { [OnMac] || [::config::getKey showmainmenu -1] } { . conf -menu .main_menu }
}
proc preLogout {postCommand {force 0}} {
if {[::ChatWindow::CloseAllWindows $force] == 1} {
eval $postCommand
}
}
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_main {} {
global pgBuddy pgBuddyTop pgNews argv0 argv
create_states_menu .my_menu
create_other_menus .user_menu .menu_invite
create_main_menu .main_menu
wm title . "[trans title] - [trans offline]"
wm command . [concat $argv0 $argv]
wm group . .
if { [OnMac] } {
# Set the window style (brushed/aqua) for the CL.
::macWindowStyle::setBrushed .
frame .fake ;#Create the frame for play_Sound_Mac
}
#Put the color, size and style of the border around the contact list (from the skin)
frame .main -relief [::skin::getKey mainwindowrelief "flat"] \
-borderwidth [::skin::getKey mainwindowbd "1"] \
-background [::skin::getKey mainwindowbg "white"]
frame .main.f -relief flat -background [::skin::getKey mainwindowbg "white"] -borderwidth 0
pack .main -fill both -expand true
pack .main.f -expand true -fill both -padx [::skin::getKey buddylistpad] -pady [::skin::getKey buddylistpad] -side top
if {[::config::getKey withnotebook]} {
# Create the Notebook and initialize the page paths. These
# page paths must be used for adding new widgets to the
# notebook tabs. (This is disabled by default)
NoteBook .main.f.nb -background white
.main.f.nb insert end buddies -text "Buddies"
.main.f.nb insert end news -text "News"
set pgBuddy [.main.f.nb getframe buddies]
set pgNews [.main.f.nb getframe news]
.main.f.nb raise buddies
.main.f.nb compute_size
pack .main.f.nb -fill both -expand true -side top
} else {
# Set what's necessary to make it work without the notebook
set pgBuddy .main.f
set pgNews ""
}
# Set default pixmap names
::skin::SetPixmapNames
set pgBuddyTop $pgBuddy.top
frame $pgBuddyTop -background [::skin::getKey topcontactlistbg] -width 30 -height 30 -cursor left_ptr \
-borderwidth 0 -relief flat
$pgBuddyTop configure -padx 0 -pady 0
set pgBuddy [::guiContactList::createCLWindowEmbeded $pgBuddy]
pack $pgBuddy -expand true -fill both
# Initialize the event history
frame .main.eventmenu
combobox::combobox .main.eventmenu.list -editable false -highlightthickness 0 -width 22 -exportselection false
#Display the amsn banner if it is enabled
label .main.banner -borderwidth 0 -relief flat -background [::skin::getKey bannerbg]
pack .main.banner -side bottom -fill x
resetBanner
#delete F10 binding that crashes amsn
bind all <F10> ""
set modifier [GetPlatformModifier]
#Status log
bind . <$modifier-s> toggle_status
# Protocol log
bind . <$modifier-d> { degt_protocol_win_toggle }
#Console
bind . <$modifier-Shift-C> "load_console; console show"
#Quit
bind all <$modifier-q> "exit"
bind all <$modifier-Q> "exit"
#Set key bindings which are different on Mac.
if { [OnMac] } {
#Skin selector
bind all <$modifier-S> ::skinsGUI::SelectSkin
#Plugin selector
bind all <$modifier-P> ::plugins::PluginGui
#Preferences
bind all <$modifier-,> Preferences
#BossMode (Command Alt space is used as a global key combo since Mac OS X 10.4.)
bind . <$modifier-Shift-space> BossMode
#Plugins log
bind . <$modifier-p> ::pluginslog::toggle
#Online Help
bind all <$modifier-/> "launch_browser $::weburl/wiki/Main_Page"
bind all <$modifier-?> "launch_browser $::weburl/wiki/Main_Page"
bind all <$modifier-m> {catch {wm state [winfo toplevel %W] normal; carbon::processHICommand mini [winfo toplevel %W]}}
bind all <$modifier-M> {catch {wm state [winfo toplevel %W] normal; carbon::processHICommand mini [winfo toplevel %W]}}
# Webcam bindings
} else {
#Plugins log
bind . <Alt-p> ::pluginslog::toggle
#Preferences
bind . <$modifier-p> Preferences
#Boss mode
bind . <$modifier-Alt-space> BossMode
# Show/hide menu binding with toggle == 1
bind . <$modifier-m> "Showhidemenu 1"
bind . <$modifier-n> "::AVAssistant::AVAssistant"
}
#Set the wm close button action
if { [OnMac] } {
bind . <$modifier-w> { wm state . withdrawn }
# Default behaviour on OS X is to hide the main window, and open again when the dock icon is clicked.
proc ::tk::mac::ReopenApplication {} {
if {[::ChatWindow::MacRaiseWindows] == 0 } {
if { [wm state .] == "withdrawn"} {
wm state . normal
raise .
}
}
}
wm protocol . WM_DELETE_WINDOW { wm state . withdrawn }
} else {
wm protocol . WM_DELETE_WINDOW {::amsn::closeOrDock [::config::getKey closingdocks]}
}
#Draw main window contents
cmsn_draw_status
cmsn_draw_offline
#iconphoto is bugged under windows so only use it if we are > 8.4.16
# See Tk bug #1467997
if { [version_vcompare [info patchlevel] 8.4.16] >= 0 } {
set use_old_method 0
if { [catch {wm iconphoto . -default [::skin::loadPixmap amsnicon]}] } {
set use_old_method 1
}
} else {
set use_old_method 1
}
if { $use_old_method == 1 } {
# above doesn't exist on 8.4.7 and older, so we try the old way
if { [OnWin] } {
catch {wm iconbitmap . [::skin::GetSkinFile winicons msn.ico]}
catch {wm iconbitmap . -default [::skin::GetSkinFile winicons msn.ico]}
} else {
catch {wm iconbitmap . @[::skin::GetSkinFile pixmaps amsn.xbm]}
catch {wm iconmask . @[::skin::GetSkinFile pixmaps amsnmask.xbm]}
}
}
#allow for display updates so window size is correct
# This is allowed because this function is only called from the startup 'amsn' script
# so the 'update' is not called from an event handler, so it is safe to call it
update
#update idletasks
#Set the position on the screen and the size for the contact list, from config
#Check if the geometry is available :
set geometry [::config::getKey wingeometry]
set width 0
set height 0
set x 0
set y 0
set modified 0
regexp {=?(\d+)x(\d+)[+\-](-?\d+)[+\-](-?\d+)} $geometry -> width height x y
# Now make sure that the window will be onscreen. Checking each edge (top, right, bottom, left)
# The minimum values are in pixels from each edge.
set t_min 0
set r_min 0
set b_min 0
set l_min 0
if {[OnMac]} {
# There is a menu bar running accross the top of the screen that is 22px high..
set t_min 22
set r_min 2
}
# Check that the window isn't too small...
if {$width < 100} {
set modified 1
set width 300
}
if {$height < 200} {
set modified 1
set height 600
}
# Check the top.
if {[expr {$y}] < $t_min} {
set modified 1
set y $t_min
}
# Check the right.
if {[expr {$x + $width}] > [expr {[winfo screenwidth .] - $r_min}]} {
set modified 1
set x [expr {[winfo screenwidth .] - $width - $r_min - $l_min}]
}
# Check the bottom.
if {[expr {$y + $height}] > [expr {[winfo screenheight .] - $b_min}]} {
set modified 1
set y [expr {[winfo screenheight .] - $height - $b_min - $t_min}]
}
# Check the left.
if {[expr {$x}] < $l_min} {
set modified 1
set x $l_min
}
if {$modified == 1} {
set geometry ${width}x${height}+${x}+${y}
::config::setKey wingeometry $geometry
}
catch {wm geometry . $geometry}
# This is allowed because this function is only called from the startup 'amsn' script
# so the 'update' is not called from an event handler, so it is safe to call it
update
#Unhide main window now that it has finished being created
wm state . normal
}
#///////////////////////////////////////////////////////////////////////
proc loggedInGuiConf { event } {
################################################################
# Enable menu entries that are greyed out when not logged in
################################################################
proc enable { menu entry {state 1}} {
if { $state == 1 } {
$menu entryconfigure $entry -state normal
} else {
$menu entryconfigure $entry -state disabled
}
}
proc enableEntries {menu entrieslist {state 1}} {
foreach index $entrieslist {
enable $menu $index $state
}
}
set menu .main_menu.account
enable $menu 0 0
set lo 1
# Entries to enable in the Account menu
set logout_idx [$menu index "[trans logout]"]
set status_idx [$menu index "[trans changestatus]"]
set nick_idx [$menu index "[trans changenick]..."]
set psm_idx [$menu index "[trans changepsm]..."]
set dp_idx [$menu index "[trans changedisplaypic]..."]
set inbox_idx [$menu index "[trans gotoinbox]"]
set msn_profile_idx [$menu index "[trans editmyprofile]"]
set global_alarm_idx [$menu index "[trans cfgalarmall]..."]
set event_hist_idx [$menu index "[trans eventhistory]"]
enableEntries $menu [list $logout_idx $status_idx $nick_idx $psm_idx $dp_idx $inbox_idx $msn_profile_idx $global_alarm_idx $event_hist_idx]
# View menu
set menu .main_menu.view
set contact_sorting_idx [$menu index "[trans sortcontactsby]"]
set email_idx [$menu index "[trans showcontactemail]"]
set nick_idx [$menu index "[trans showcontactnick]"]
set asc_idx [$menu index "[trans sortgroupsasc]"]
set desc_idx [$menu index "[trans sortgroupsdesc]"]
set detview_idx [$menu index "[trans showdetailedview]"]
set nonim_idx [$menu index "[trans shownonim]"]
#set spaces_idx [$menu index "[trans showspaces]"]
set offline_idx [$menu index "[trans showofflinegroup]"]
enableEntries $menu [list $contact_sorting_idx $email_idx $nick_idx $asc_idx $desc_idx $detview_idx $nonim_idx $offline_idx]
# Actions menu
set menu .main_menu.actions
set msg_idx [$menu index "[trans sendmsg]..."]
set mobile_idx [$menu index "[trans sendmobmsg]..."]
set email_idx [$menu index "[trans sendmail]..."]
set file_idx [$menu index "[trans sendfile]..."]
set send_cam_idx [$menu index "[trans sendcam]..."]
set ask_cam_idx [$menu index "[trans askcam]..."]
set play_game_idx [$menu index "[trans playgame]"]
enableEntries $menu [list $msg_idx $mobile_idx $email_idx $file_idx $send_cam_idx $ask_cam_idx $play_game_idx]
# Contacts menu
set menu .main_menu.contacts
set add_idx [$menu index "[trans addacontact]..."]
set del_idx [$menu index "[trans delete]..."]
set prop_idx [$menu index "[trans properties]..."]
set grp_add_idx [$menu index "[trans groupadd]..."]
set grp_del_idx [$menu index "[trans grouprename]"]
set grp_ren_idx [$menu index "[trans groupdelete]"]
set hist_idx [$menu index "[trans history]"]
set cam_idx [$menu index "[trans webcamhistory]"]
set save_idx [$menu index "[trans savecontacts]"]
set load_idx [$menu index "[trans loadcontacts]"]
enableEntries $menu [list $add_idx $del_idx $prop_idx $grp_add_idx $grp_del_idx $grp_ren_idx $hist_idx $cam_idx $save_idx $load_idx]
################################################################
# Create the groups menus
################################################################
::groups::updateMenu menu .main_menu.contacts.group_list_delete ::groups::menuCmdDelete
::groups::updateMenu menu .main_menu.contacts.group_list_rename ::groups::menuCmdRename
}
proc loggedOutGuiConf { event } {
################################################################
# Enable menu entries that are greyed out when not logged in
################################################################
proc enable { menu entry {state 1} } {
if { $state == 1 } {
$menu entryconfigure $entry -state normal
} else {
$menu entryconfigure $entry -state disabled
}
}
proc enableEntries {menu entrieslist {state 1}} {
foreach index $entrieslist {
enable $menu $index $state
}
}
set menu .main_menu.account
enable $menu 0 1
set lo 1
# Entries to disable in the Account menu
set logout_idx [$menu index "[trans logout]"]
set status_idx [$menu index "[trans changestatus]"]
set nick_idx [$menu index "[trans changenick]..."]
set psm_idx [$menu index "[trans changepsm]..."]
set dp_idx [$menu index "[trans changedisplaypic]..."]
set inbox_idx [$menu index "[trans gotoinbox]"]
set msn_profile_idx [$menu index "[trans editmyprofile]"]
set global_alarm_idx [$menu index "[trans cfgalarmall]..."]
set event_hist_idx [$menu index "[trans eventhistory]"]
enableEntries $menu [list $logout_idx $status_idx $nick_idx $psm_idx $dp_idx $inbox_idx $msn_profile_idx $global_alarm_idx $event_hist_idx] 0
# View menu
set menu .main_menu.view
set contact_sorting_idx [$menu index "[trans sortcontactsby]"]
set email_idx [$menu index "[trans showcontactemail]"]
set nick_idx [$menu index "[trans showcontactnick]"]
set asc_idx [$menu index "[trans sortgroupsasc]"]
set desc_idx [$menu index "[trans sortgroupsdesc]"]
set detview_idx [$menu index "[trans showdetailedview]"]
set nonim_idx [$menu index "[trans shownonim]"]
#set spaces_idx [$menu index "[trans showspaces]"]
set offline_idx [$menu index "[trans showofflinegroup]"]
enableEntries $menu [list $contact_sorting_idx $email_idx $nick_idx $asc_idx $desc_idx $detview_idx $nonim_idx $offline_idx] 0
# Actions menu
set menu .main_menu.actions
set msg_idx [$menu index "[trans sendmsg]..."]
set mobile_idx [$menu index "[trans sendmobmsg]..."]
set email_idx [$menu index "[trans sendmail]..."]
set file_idx [$menu index "[trans sendfile]..."]
set send_cam_idx [$menu index "[trans sendcam]..."]
set ask_cam_idx [$menu index "[trans askcam]..."]
set play_game_idx [$menu index "[trans playgame]"]
enableEntries $menu [list $msg_idx $mobile_idx $email_idx $file_idx $send_cam_idx $ask_cam_idx $play_game_idx] 0
# Contacts menu
set menu .main_menu.contacts
set add_idx [$menu index "[trans addacontact]..."]
set del_idx [$menu index "[trans delete]..."]
set prop_idx [$menu index "[trans properties]..."]
set grp_add_idx [$menu index "[trans groupadd]..."]
set grp_del_idx [$menu index "[trans grouprename]"]
set grp_ren_idx [$menu index "[trans groupdelete]"]
set hist_idx [$menu index "[trans history]"]
set cam_idx [$menu index "[trans webcamhistory]"]
set save_idx [$menu index "[trans savecontacts]"]
set load_idx [$menu index "[trans loadcontacts]"]
enableEntries $menu [list $add_idx $del_idx $prop_idx $grp_add_idx $grp_del_idx $grp_ren_idx $hist_idx $cam_idx $save_idx $load_idx] 0
# hide event box
pack forget .main.eventmenu
}
proc ShowFirstTimeMenuHidingFeature { parent } {
#TODO : customMessageBox with askRememberAnswer
return [expr [::amsn::messageBox [trans hidemenumessage] yesno warning [trans hidemenu] $parent ] == yes]
}
proc Showhidemenu { {toggle 0} } {
if {$toggle} {
if { [::config::getKey showmainmenu -1] == -1 } {
if { [ShowFirstTimeMenuHidingFeature .] == 0 } {
return
}
}
::config::setKey showmainmenu [expr ![::config::getKey showmainmenu -1]]
}
if { [::config::getKey showmainmenu -1]} {
. configure -menu .main_menu
} else {
. configure -menu ""
}
}
proc resetBanner {} {
if {[::config::getKey enablebanner]} {
# This one is not a banner but a branding. When adverts are enabled
# they share this space with the branding image. The branding image
# is cycled in between adverts.
.main.banner configure -background [::skin::getKey bannerbg] -image [::skin::loadPixmap logolinmsn]
} else {
.main.banner configure -background [::skin::getKey mainwindowbg] -image [::skin::loadPixmap nullimage]
}
}
#///////////////////////////////////////////////////////////////////////
proc choose_font { parent title {initialfont ""} {initialcolor ""}} {
if { [winfo exists .fontsel] } {
raise .fontsel
return
}
set selected_font [SelectFont .fontsel -parent $parent -title $title -font $initialfont -initialcolor $initialcolor]
# If the color is 48 bits, then convert into 24 bit colors
set color [lindex $selected_font 1]
if {[string length $color] == 13} {
set r [string range $color 1 2]
set g [string range $color 5 6]
set b [string range $color 9 10]
set color "#${r}${g}${b}"
set selected_font [lreplace $selected_font 1 1 $color]
}
return $selected_font
}
#///////////////////////////////////////////////////////////////////////
# change_font
# Opens a font selector and changes the config key given by $key to the font selected
proc change_font {win_name key} {
#puts "change $key"
set basesize [lindex [::config::getGlobalKey basefont] 1]
#Get current font configuration
set fontname [lindex [::config::getKey $key] 0]
set fontsize [expr {$basesize + [::config::getKey textsize]}]
set fontstyle [lindex [::config::getKey $key] 1]
set fontcolor [lindex [::config::getKey $key] 2]
if { $fontname == "" } { set fontname helvetica }
if { $fontcolor == "" } { set fontcolor 000000 }
set selfont_and_color [choose_font .${win_name} [trans choosebasefont] [list $fontname $fontsize $fontstyle] "#$fontcolor"]
set selfont [lindex $selfont_and_color 0]
set selcolor [lindex $selfont_and_color 1]
if { $selfont == "" || $fontname == $selfont && $fontcolor == $selcolor } {
return
}
set sel_fontfamily [lindex $selfont 0]
set sel_fontsize [lindex $selfont 1]
set sel_fontstyle [lrange $selfont 2 end]
# Fix a weird bug occuring with 8.4.16 on mac.
if { ![info exists sel_fontstyle] } { set sel_fontstyle [list] }
if { $selcolor == "" } {
set selcolor $fontcolor
} else {
set selcolor [string range $selcolor 1 end]
}
::config::setKey $key [list $sel_fontfamily $sel_fontstyle $selcolor]
change_myfontsize [expr {$sel_fontsize - $basesize}]
}
#///////////////////////////////////////////////////////////////////////
proc change_myfontsize { size {windows ""}} {
set basesize [lindex [::config::getGlobalKey basefont] 1]
#Get current font configuration
set fontfamily [lindex [::config::getKey mychatfont] 0]
set fontsize [expr {$basesize + $size} ]
set fontstyle [lindex [::config::getKey mychatfont] 1]
set fontcolor [lindex [::config::getKey mychatfont] 2]
if { $fontcolor == "" } { set fontcolor "000000" }
if { $windows == "" } {
set windows $::ChatWindow::windows
}
foreach w $windows {
catch {
[::ChatWindow::GetOutText $w] tag configure yours -font [list $fontfamily $fontsize $fontstyle]
[::ChatWindow::GetInputText $w] configure -font [list $fontfamily $fontsize $fontstyle]
[::ChatWindow::GetInputText $w] configure -foreground "#$fontcolor"
}
#Get old user font and replace its size
catch {
set font [lreplace [[::ChatWindow::GetOutText $w] tag cget user -font] 1 1 $fontsize]
[::ChatWindow::GetOutText $w] tag configure user -font $font
} res
}
::config::setKey textsize $size
}
#///////////////////////////////////////////////////////////////////////
proc cmsn_msgwin_sendmail {name} {
upvar #0 [sb name $name users] users_list
set win_name "msg_[string tolower ${name}]"
if {[llength $users_list]} {
set recipient ""
foreach usrinfo $users_list {
if { $recipient != "" } {
set recipient "${recipient}, "
}
set user_login [lindex $usrinfo 0]
set recipient "${recipient}${user_login}"
}
} else {
set recipient "recipient@somewhere.com"
}
launch_mailer $recipient
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc show_encodingchoose {} {
set encodings [encoding names]
set encodings [lsort $encodings]
set enclist [list]
foreach enc $encodings {
if { $enc != "unicode" } {
lappend enclist [list $enc $enc]
}
}
set enclist [linsert $enclist 0 [list "Automatic" auto]]
::amsn::listChoose "[trans encoding]" $enclist set_encoding 0 1 0
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc set_encoding {enc} {
if {[catch {encoding system $enc} res]} {
if { $enc != "auto" } {
msg_box "Selected encoding not available, setting back to automatic"
} else {
catch {encoding system $::auto_encoding }
}
::config::setKey encoding auto
} else {
::config::setKey encoding $enc
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_status {} {
global followtext_status queued_status
set w .status
if { [winfo exists $w] } {return}
toplevel $w
wm group $w .
wm state $w withdrawn
wm title $w "Status Log - [trans title]"
set followtext_status 1
text $w.info -width 60 -height 30 -wrap word \
-yscrollcommand "$w.ys set" -font splainf
scrollbar $w.ys -command "$w.info yview"
entry $w.enter
checkbutton $w.follow -text "[trans followtext]" -onvalue 1 -offvalue 0 -variable followtext_status -font sboldf
frame $w.bot -relief sunken -borderwidth 1
button $w.bot.save -text [trans savetofile] -command status_save
button $w.bot.clear -text [trans clear] \
-command "$w.info delete 0.0 end"
button $w.bot.close -text [trans close] -command toggle_status
pack $w.bot.save $w.bot.close $w.bot.clear -side left
pack $w.bot $w.enter $w.follow -side bottom
pack $w.enter -fill x
pack $w.ys -side right -fill y
pack $w.info -expand true -fill both
$w.info tag configure green -foreground darkgreen
$w.info tag configure red -foreground red
$w.info tag configure white -foreground white -background black
$w.info tag configure white_highl -foreground white -background [$w.info tag cget sel -background]
$w.info tag configure blue -foreground blue
$w.info tag configure error -foreground white -background black
$w.info tag configure error_highl -foreground white -background [$w.info tag cget sel -background]
bind $w.info <<Selection>> "highlight_selected_tags %W \{white white_highl error error_highl\}"
bind $w.enter <Return> "window_history add %W; ns_enter"
bind $w.enter <Key-Up> "window_history previous %W"
bind $w.enter <Key-Down> "window_history next %W"
wm protocol $w WM_DELETE_WINDOW { toggle_status }
set modifier [GetPlatformModifier]
bind $w <$modifier-w> toggle_status
if { [info exists queued_status] && [llength $queued_status] > 0 } {
foreach item $queued_status {
status_log [lindex $item 0] [lindex $item 1]
}
unset queued_status
}
}
proc status_save { } {
set w .status_save
toplevel $w
wm title $w [trans savetofile]
label $w.msg -justify center -text [trans enterfilename]
pack $w.msg -side top
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m
button $w.buttons.dismiss -text [trans cancel] -command "destroy $w"
button $w.buttons.save -text [trans save] -command "status_save_file $w.filename.entry; destroy $w"
pack $w.buttons.save $w.buttons.dismiss -side left -expand 1
frame $w.filename -bd 2
entry $w.filename.entry -relief sunken -width 40
label $w.filename.label -text "[trans filename]:"
pack $w.filename.entry -side right
pack $w.filename.label -side left
pack $w.msg $w.filename -side top -fill x
focus $w.filename.entry
chooseFileDialog "status_log.txt" "" $w $w.filename.entry save
catch {grab $w}
}
proc status_save_file { filename } {
set fd [open [${filename} get] a+]
fconfigure $fd -encoding utf-8
puts $fd "[.status.info get 0.0 end]"
close $fd
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_offline {} {
::Event::fireEvent show_login_screen gui
}
#///////////////////////////////////////////////////////////////////////
proc ms_to_timer { ms } {
set ts [expr {$ms / 1000}]
set m [expr {$ts / 60}]
set s [expr {$ts % 60}]
if {$m < 10} {
set sm "0${m}"
} else {
set sm $m
}
if {$s < 10} {
set ss "0${s}"
} else {
set ss $s
}
return "${sm}:${ss}"
}
proc cmsn_update_reconnect_timer { } {
global reconnect_timer reconnect_timer_remaining
# Now we get a lock on the contact list
set clcanvas [set ::guiContactList::clcanvas]
if {$reconnect_timer > 0 &&
[$clcanvas type reconnect_timer] == "text"} {
$clcanvas itemconfigure reconnect_timer -text "[ms_to_timer $::reconnect_timer_remaining]"
incr reconnect_timer_remaining -1000
after 1000 cmsn_update_reconnect_timer
}
}
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_reconnect { error_msg } {
bind . <Configure> ""
global pgBuddyTop
# TODO : this is a hack to allow the login screen to get unpacked when we reconnect...
::Event::fireEvent reconnecting gui
# Now we get a lock on the contact list
set clcanvas [::guiContactList::lockContactList]
if { $clcanvas == "" } { return }
pack forget $pgBuddyTop
#pack forget .main.loginscreen
#pack .main.f -expand true -fill both
set loganim [::skin::loadPixmap loganim]
$clcanvas create image 0 90 -image $loganim -anchor n -tags [list loganim centerx]
$clcanvas create text 0 [expr 120 + [image height $loganim]] -text "$error_msg" -font splainf \
-fill [::skin::getKey loginfg] -justify center -tags [list errormsg centerx]
$clcanvas create text 0 [expr 190 + [image height $loganim]] -text "[trans reconnecting]..." -font sboldf \
-fill [::skin::getKey loginfg] -tags [list signin centerx]
$clcanvas create text 0 [expr 220 + [image height $loganim]] -text "" -font sboldf \
-fill [::skin::getKey loginfg] -tags [list reconnect_timer centerx]
$clcanvas create text 0 [expr 260 + [image height $loganim]] -text "[trans reconnectnow]" -font splainf \
-fill [::skin::getKey loginurlfg] -tags [list reconnect_now centerx]
$clcanvas create text 0 [expr 320 + [image height $loganim]] -text "[trans cancel]" -font splainf \
-fill [::skin::getKey loginurlfg] -tags [list cancel_reconnect centerx]
$clcanvas bind cancel_reconnect <Enter> \
"$clcanvas itemconfigure cancel_reconnect -fill [::skin::getKey loginurlfghover] -font sunderf;\
$clcanvas configure -cursor hand2"
$clcanvas bind cancel_reconnect <Leave> \
"$clcanvas itemconfigure cancel_reconnect -fill [::skin::getKey loginurlfg] -font splainf;\
$clcanvas configure -cursor left_ptr"
$clcanvas bind cancel_reconnect <<Button1>> \
"preLogout \"::MSN::cancelReconnect\""
$clcanvas bind reconnect_now <Enter> \
"$clcanvas itemconfigure reconnect_now -fill [::skin::getKey loginurlfghover] -font sunderf;\
$clcanvas configure -cursor hand2"
$clcanvas bind reconnect_now <Leave> \
"$clcanvas itemconfigure reconnect_now -fill [::skin::getKey loginurlfg] -font splainf;\
$clcanvas configure -cursor left_ptr"
$clcanvas bind reconnect_now <<Button1>> {
after cancel ::MSN::connect
::MSN::connect
}
::guiContactList::centerItems $clcanvas
set bbox [$clcanvas bbox cancel_reconnect signin errormsg loganim]
$clcanvas configure -scrollregion [list 0 0 [lindex $bbox 2] [lindex $bbox 3]]
::guiContactList::semiUnlockContactList
cmsn_update_reconnect_timer
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_signin {} {
bind . <Configure> ""
global pgBuddyTop eventdisconnected
set eventdisconnected 1
wm title . "[trans title] - [::config::getKey login]"
# Now we get a lock on the contact list
set clcanvas [::guiContactList::lockContactList]
if { $clcanvas == "" } { return }
pack forget $pgBuddyTop
#pack forget .main.loginscreen
#pack .main.f -expand true -fill both
set loganim [::skin::loadPixmap loganim]
$clcanvas create image 0 90 -image $loganim -anchor n -tags [list loganim centerx]
$clcanvas create text 0 [expr 120 + [image height $loganim]] -text "[trans loggingin]..." -font sboldf \
-fill [::skin::getKey loginfg] -tags [list signin centerx]
$clcanvas create text 0 [expr 190 + [image height $loganim]] -text "[trans cancel]" -font splainf \
-fill [::skin::getKey loginurlfg] -tags [list cancel_reconnect centerx]
$clcanvas bind cancel_reconnect <Enter> \
"$clcanvas itemconfigure cancel_reconnect -fill [::skin::getKey loginurlfghover] -font sunderf;\
$clcanvas configure -cursor hand2"
$clcanvas bind cancel_reconnect <Leave> \
"$clcanvas itemconfigure cancel_reconnect -fill [::skin::getKey loginurlfg] -font splainf;\
$clcanvas configure -cursor left_ptr"
$clcanvas bind cancel_reconnect <<Button1>> \
"preLogout \"::MSN::cancelReconnect\""
::guiContactList::centerItems $clcanvas
set bbox [$clcanvas bbox cancel_reconnect signin loganim]
$clcanvas configure -scrollregion [list 0 0 [lindex $bbox 2] [lindex $bbox 3]]
::guiContactList::semiUnlockContactList
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc login_ok {} {
global password loginmode
if { $loginmode == 0 } {
::config::setKey login [string tolower [.login.main.loginentry get]]
set password [.login.main.passentry get]
} else {
if { $password != [.login.main.passentry2 get] } {
set password [.login.main.passentry2 get]
}
}
catch {grab release .login}
destroy .login
if { $password != "" && [::config::getKey login] != "" } {
::MSN::connect $password
} else {
cmsn_draw_login
}
}
#///////////////////////////////////////////////////////////////////////
proc SSLToggled {} {
if {[::config::getKey nossl] == 1 } {
::amsn::infoMsg "[trans sslwarning]"
}
}
#///////////////////////////////////////////////////////////////////////
# Main login window, separated profiled or default logins
# cmsn_draw_login {}
#
proc cmsn_draw_login {} {
global password loginmode HOME HOME2
if {[winfo exists .login]} {
raise .login
return 0
}
LoadLoginList 1
toplevel .login
wm group .login .
wm title .login "[trans login] - [trans title]"
ShowTransient .login
set mainframe [labelframe .login.main -text [trans login] -font splainf]
radiobutton $mainframe.button -text [trans defaultloginradio] -value 0 -variable loginmode -command "RefreshLogin $mainframe"
label $mainframe.loginlabel -text "[trans user]: " -font sboldf
entry $mainframe.loginentry -width 25
if { [::config::getGlobalKey disableprofiles]!=1} {
grid $mainframe.button -row 1 -column 1 -columnspan 2 -sticky w -padx 10
}
grid $mainframe.loginlabel -row 2 -column 1 -sticky e -padx 10
grid $mainframe.loginentry -row 2 -column 2 -sticky w -padx 10
radiobutton $mainframe.button2 -text [trans profileloginradio] -value 1 -variable loginmode -command "RefreshLogin $mainframe"
combobox::combobox $mainframe.box -editable false -width 25 -command ConfigChange
if { [::config::getGlobalKey disableprofiles]!=1} {
grid $mainframe.button2 -row 1 -column 3 -sticky w
grid $mainframe.box -row 2 -column 3 -sticky w
}
label $mainframe.passlabel -text "[trans pass]: " -font sboldf
entry $mainframe.passentry -width 25 -show "*" -vcmd {expr {[string length %P]<=16} } -validate key
entry $mainframe.passentry2 -width 25 -show "*" -vcmd {expr {[string length %P]<=16} } -validate key
checkbutton $mainframe.remember -variable [::config::getVar save_password] \
-text "[trans rememberpass]" -pady 5 -padx 10
#Combobox to choose our state on connect
label $mainframe.statetext -text "[trans signinstatus]" -font splainf
combobox::combobox $mainframe.statelist -editable false -width 15 -command remember_state_list \
-bg [::skin::getKey extrastdbgcolor]
$mainframe.statelist list delete 0 end
set i 0
while {$i < 8} {
set statecode "[::MSN::numberToState $i]"
set description "[trans [::MSN::stateToDescription $statecode]]"
$mainframe.statelist list insert end $description
incr i
}
# Add custom states to list
AddStatesToList $mainframe.statelist
$mainframe.statelist select [get_state_list_idx [::config::getKey connectas]]
label $mainframe.example -text "[trans examples] :\ncopypastel@hotmail.com\nelbarney@msn.com\nexample@passport.com" -font examplef -padx 10
set buttonframe [frame .login.buttons]
button $buttonframe.cancel -text [trans cancel] -command "ButtonCancelLogin .login"
button $buttonframe.ok -text [trans ok] -command login_ok -default active
button $buttonframe.addprofile -text [trans addprofile] -command AddProfileWin
if { [::config::getGlobalKey disableprofiles]!=1} {
pack $buttonframe.ok $buttonframe.cancel $buttonframe.addprofile -side right -padx 10
} else {
pack $buttonframe.ok $buttonframe.cancel -side right -padx 10
}
grid $mainframe.passlabel -row 3 -column 1 -sticky e -padx 10
grid $mainframe.passentry -row 3 -column 2 -sticky w -padx 10
if { [::config::getGlobalKey disableprofiles]!=1} {
grid $mainframe.passentry2 -row 3 -column 3 -sticky w
}
grid $mainframe.remember -row 5 -column 2 -sticky wn
grid $mainframe.statetext -row 6 -column 1 -sticky wn
grid $mainframe.statelist -row 6 -column 2 -sticky wn
grid $mainframe.example -row 1 -column 4 -rowspan 4
pack .login.main .login.buttons -side top -anchor n -expand true -fill both -padx 10 -pady 10
# Lets fill our combobox
#$mainframe.box insert 0 [::config::getKey login]
set idx 0
set tmp_list ""
while { [LoginList get $idx] != 0 } {
lappend tmp_list [LoginList get $idx]
incr idx
}
eval $mainframe.box list insert end $tmp_list
unset idx
unset tmp_list
# Select appropriate radio button
if { $HOME == $HOME2 } {
set loginmode 0
} else {
set loginmode 1
}
if { [::config::getGlobalKey disableprofiles]==1} {
set loginmode 0
}
RefreshLogin $mainframe
bind .login <Return> "login_ok"
bind .login <KP_Enter> "login_ok"
bind .login <<Escape>> "ButtonCancelLogin .login"
#tkwait visibility .login
catch {grab .login}
moveinscreen .login 30
}
proc remember_state_list {w value} {
set idx [get_state_list_idx $value]
if {$idx >= 8} {
::config::setKey connectas $value
} else {
::config::setKey connectas [::MSN::numberToState $idx]
}
}
proc get_state_list_idx { value } {
set i 0
while {$i < 8} {
set statecode "[::MSN::numberToState $i]"
set description "[trans [::MSN::stateToDescription $statecode]]"
if {$description == $value || $statecode == $value} {
return $i
}
incr i
}
for {set idx 0} {$idx < [StateList size] } { incr idx } {
if {"** [lindex [StateList get $idx] 0] **" == $value} {
return [expr {8 + $idx}]
}
}
status_log "Variable connectas is not valid $value\n" red
return 0
}
proc is_connectas_custom_state { value } {
return [expr [get_state_list_idx $value] >= 8]
}
proc get_custom_state_idx { value } {
for {set idx 0} {$idx < [StateList size] } { incr idx } {
if { "** [lindex [StateList get $idx] 0] **" == $value} {
return $idx
}
}
}
#///////////////////////////////////////////////////////////////////////
# proc RefreshLogin { mainframe }
# Called after pressing a radio button in the Login screen to enable/disable
# the appropriate entries
proc RefreshLogin { mainframe {extra 0} } {
global loginmode
if { $extra == 0 } {
SwitchProfileMode $loginmode
}
if { $loginmode == 0 } {
$mainframe.box configure -state disabled
$mainframe.passentry2 configure -state disabled
$mainframe.loginentry configure -state normal
$mainframe.passentry configure -state normal
$mainframe.remember configure -state disabled
focus $mainframe.loginentry
bind $mainframe.loginentry <Tab> "focus $mainframe.passentry; break"
} elseif { $loginmode == 1 } {
$mainframe.box configure -state normal
$mainframe.passentry2 configure -state normal
$mainframe.loginentry configure -state disabled
$mainframe.passentry configure -state disabled
$mainframe.remember configure -state normal
focus $mainframe.passentry2
}
}
#///////////////////////////////////////////////////////////////////////////////
# ButtonCancelLogin ()
# Function thats releases grab on .login and destroys it
proc ButtonCancelLogin { window {email ""} } {
catch {grab release $window}
destroy $window
cmsn_draw_offline
}
#////////////////////////////////////////////////////////////////////// /////////
# AddProfileWin ()
# Small dialog window with entry to create new profile
proc AddProfileWin {} {
if {[winfo exists .add_profile]} {
raise .add_profile
return 0
}
toplevel .add_profile
wm group .add_profile .login
wm title .add_profile "[trans addprofile]"
ShowTransient .add_profile .login
set mainframe [labelframe .add_profile.main -text [trans addprofile] -font splainf]
label $mainframe.desc -text "[trans addprofiledesc]" -font splainf -justify left
entry $mainframe.login -bd 1 -font splainf -highlightthickness 0 -width 35
label $mainframe.example -text "[trans examples] :\ncopypastel@hotmail.com\nelbarney@msn.com\nexample@passport.com" -font examplef -padx 10
grid $mainframe.desc -row 1 -column 1 -sticky w -columnspan 2 -padx 5 -pady 5
grid $mainframe.login -row 2 -column 1 -padx 5 -pady 5
grid $mainframe.example -row 2 -column 2 -sticky e
set buttonframe [frame .add_profile.buttons]
button $buttonframe.cancel -text [trans cancel] -command "grab release .add_profile; destroy .add_profile"
button $buttonframe.ok -text [trans ok] -command "AddProfileOk $mainframe"
AddProfileOk $mainframe
pack $buttonframe.cancel $buttonframe.ok -side right -padx 10
bind .add_profile <Return> "AddProfileOk $mainframe"
#Virtual binding for destroying the window
bind .add_profile <<Escape>> "grab release .add_profile; destroy .add_profile"
pack .add_profile.main .add_profile.buttons -side top -anchor n -expand true -fill both -padx 10 -pady 10
catch {grab .add_profile}
focus $mainframe.login
}
#////////////////////////////////////////////////////////////////////// /////////
# AddProfileOk (mainframe)
#
proc AddProfileOk {mainframe} {
#In case someone destroy .login
catch {wm group .add_profile .login}
set login [string tolower [$mainframe.login get]]
if { $login == "" } {
return
}
if { [CreateProfile $login] != -1 } {
catch {grab release .add_profile}
destroy .add_profile
}
}
#///////////////////////////////////////////////////////////////////////
proc toggleGroup {tw name image id {padx 0} {pady 0}} {
set imgIdx [$tw image create end -image [::skin::loadPixmap $image] -padx $padx -pady $pady]
$tw tag add $name $imgIdx
$tw tag bind $name <Enter> "$tw image configure $imgIdx -image [::skin::loadPixmap ${image}_hover]; $tw conf -cursor hand2"
$tw tag bind $name <Leave> "$tw image configure $imgIdx -image [::skin::loadPixmap $image]; $tw conf -cursor left_ptr"
$tw tag bind $name <<Button1>> "status_log \"$id\"; ::groups::ToggleStatus $id"
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc clickableImage {tw name image command {padx 0} {pady 0}} {
set imgIdx [$tw image create end -image [::skin::loadPixmap $image] -padx $padx -pady $pady -align center]
$tw tag add $tw.$name $imgIdx
$tw tag bind $tw.$name <<Button1>> $command
$tw tag bind $tw.$name <Enter> "$tw configure -cursor hand2"
$tw tag bind $tw.$name <Leave> "$tw configure -cursor left_ptr"
}
#Clickable display picture in the contact list
proc clickableDisplayPicture {tw type name command {padx 0} {pady 0}} {
#Create the clickable display picture
canvas $tw.$name -width [image width [::skin::loadPixmap mystatus_bg]] \
-height [image height [::skin::loadPixmap mystatus_bg]] \
-bg [::skin::getKey topcontactlistbg] -highlightthickness 0 \
-cursor hand2 -borderwidth 0
$tw.$name create image [::skin::getKey x_dp_top] [::skin::getKey y_dp_top] -anchor nw -image displaypicture_not_self
$tw.$name create image 0 0 -anchor nw -image [::skin::loadPixmap mystatus_bg] -tag mystatus_bg
if {[::skin::getKey mydp_hoverimage 0] == 1} {
$tw.$name bind mystatus_bg <Enter> [list $tw.$name itemconfigure mystatus_bg -image [::skin::loadPixmap mystatus_bg_hover]]
$tw.$name bind mystatus_bg <Leave> [list $tw.$name itemconfigure mystatus_bg -image [::skin::loadPixmap mystatus_bg]]
}
bind $tw.$name <<Button1>> $command
# Drag and Drop setting DP
#status_log "@@@@@@@@@@@@@@ DRAG AND DROP"
if {[catch {tkdnd::drop_target register $tw.$name *} res]} {
#status_log "dnd error: $res"
} else {
#status_log "DP DND registered"
bind $tw.$name <<Drop>> "::fileDropHandler %D setdp"
}
return $tw.$name
}
proc fileDropHandler { data action {target "self"}} {
status_log "Raw data: $data"
set data [string map {\r "" \n "" \x00 ""} $data]
set data [urldecode $data]
status_log "File drop handler: $action for string: $data"
#this is for windows
if { [string index $data 0] == "{" && [string index $data end] == "}" } {
set data [string range $data 1 end-1]
}
if { $action != "pasteText" } {
#TODO #(VFS pseudo-)protocol: if we can't acces the file, display an error
foreach type [list smb http https ftp sftp floppy cdrom dvd] {
if {[string first $type $data] == 0} {
status_log "file can't be accessed: $data"
return refuse_drop
}
}
#If the data begins with "file://", strip this off
if { [string range $data 0 6] == "file://" } {
set data [string range $data 7 [string length $data]]
}
}
status_log "File/text dropped: $data"
switch $action {
setdp {
# if { $target != "self" } {
# global customdp_$target
# set customdp_$target [::abook::getContactData $target customdp ""]
# }
after 0 dpBrowser $target
setDPFromFile $target $data
# if { $target != "self" } {
# tkwait window .dpbrowser
# catch {image delete customdp_img_$target}
# image create photo customdp_img_$target -file [set customdp_$target]
# ::skin::getDisplayPicture $target 1
# ::skin::getLittleDisplayPicture $target 1
# catch {image delete customdp_img_$target}
#
#
# }
return copy
}
sendfile {
if {$target == "self"} {
status_log "This ain't right ... should I send a file to window 'self'?"
return refuse_drop
} else {
::amsn::FileTransferSend $target $data
return copy
}
}
pasteText {
if { [catch {[::ChatWindow::GetInputText $target] insert end $data} res] } {
status_log "Unable to drop text \"$data\" to $target: $res"
}
return copy
}
default {
status_log "Dunnow what to do with the file ... what's $action ?"
return refuse_drop
}
}
}
# The same as the previous one, but this proc works on a list.
proc trunc_list {str {window ""} {maxw 0 } {font ""}} {
if { $window == "" || $font == "" } {
return $str
}
set buffer [list ]
foreach elt $str {
switch [lindex $elt 0] {
text {
set txt [lindex $elt 1]
set slen [string length $txt]
for {set idx 0} { $idx <= $slen} {incr idx} {
if { [font measure $font -displayof $window "[string range $txt 0 $idx]..."] > $maxw } {
set txt "[string range $txt 0 [expr {$idx-1}]]"
lappend buffer [list text $txt] [list colour reset] [list bg reset] [list font reset] [list text "..."]
return $buffer
}
}
set maxw [expr {$maxw - [font measure $font -displayof $window $txt]}]
lappend buffer $elt
}
smiley {
set maxw [expr {$maxw - [image width [lindex $elt 1]]}]
if {$maxw <= 0 } {
lappend buffer [list colour reset] [list bg reset] [list font reset] [list text "..."]
return $buffer
}
lappend buffer $elt
}
#what should we do in that case ???
newline {}
default {
lappend buffer $elt
}
}
}
return $str
}
proc getpicturefornotification {email} {
#we'll only create it if it's not yet there
if { ![ImageExists displaypicture_not_$email] } {
#create the blank image
image create photo displaypicture_not_$email -format cximage
#Verify that we can copy user_pic, if there's an error it means user_pic doesn't exist
if {![catch {displaypicture_not_$email copy [::skin::getDisplayPicture $email]} ] } {
if {[image width displaypicture_not_$email] > 50 && [image height displaypicture_not_$email] > 50} {
::picture::ResizeWithRatio displaypicture_not_$email 50 50
}
return 1
} else {
image delete displaypicture_not_$email
#we have no small version, report as error
return 0
}
} else {
#we already have an image
return 1
}
}
#///////////////////////////////////////////////////////////////////////
#TODO: This really shouldn't be here
if { $initialize_amsn == 1 } {
init_ticket draw_online
}
#///////////////////////////////////////////////////////////////////////
# TODO: move into ::amsn namespace, and maybe improve it
# topbottom: 1 = top only, 2 = bottom only, 3 = top and bottom
proc cmsn_draw_online { {delay 0} {topbottom 3} } {
#Delay not forced redrawing (to avoid too many redraws)
if { $delay } {
if { $topbottom & 1 } {
after cancel "cmsn_draw_online 0 1"
after 500 "cmsn_draw_online 0 1"
}
if { $topbottom & 2 } {
after cancel "cmsn_draw_online 0 2"
after 500 "cmsn_draw_online 0 2"
}
return
}
#Run this procedure in mutual exclusion, to avoid procedure
#calls due to events while still drawing. This fixes some bugs
if { $topbottom & 1 } { run_exclusive cmsn_draw_buildtop_wrapped draw_online }
if { $topbottom & 2 } { run_exclusive cmsn_draw_online_wrapped draw_online }
}
proc cmsn_draw_buildtop_wrapped {} {
global login password pgBuddy pgBuddyTop automessage emailBList
set my_image_type [::MSN::stateToBigImage [::MSN::myStatusIs]]
set my_mobilegroup [::config::getKey showMobileGroup]
#Clear the children of top to avoid memory leaks:
foreach child [winfo children $pgBuddyTop] {
destroy $child
}
pack $pgBuddyTop -expand false -fill x -before $pgBuddy
# Display MSN logo with user's handle. Make it clickable so
# that the user can change his/her status that way
# Verify if the skinner wants to replace the status picture for the display picture
$pgBuddyTop configure -background [::skin::getKey topcontactlistbg]
if { ![::skin::getKey showdisplaycontactlist] } {
label $pgBuddyTop.bigstate -background [::skin::getKey topcontactlistbg] -border 0 -cursor hand2 -borderwidth 0 \
-image [::skin::loadPixmap $my_image_type] \
-width [image width [::skin::loadPixmap $my_image_type]] \
-height [image height [::skin::loadPixmap $my_image_type]]
bind $pgBuddyTop.bigstate <<Button1>> {kill_balloon; tk_popup .my_menu %X %Y}
set disppic $pgBuddyTop.bigstate
} else {
set disppic [clickableDisplayPicture $pgBuddyTop mystatus bigstate {kill_balloon; tk_popup .my_menu %X %Y} [::skin::getKey bigstate_xpad] [::skin::getKey bigstate_ypad]]
}
set pic_name displaypicture_std_self
bind $pgBuddyTop.bigstate <<Button3>> {kill_balloon; tk_popup .my_menu %X %Y}
pack $disppic -side left -padx [::skin::getKey bigstate_xpad] -pady [::skin::getKey bigstate_ypad]
canvas $pgBuddyTop.mystatus -background [::skin::getKey topcontactlistbg] -borderwidth 0 \
-cursor left_ptr -relief flat
pack $pgBuddyTop.mystatus -expand true -fill both -side left -padx 10 -pady 10
drawNick
set balloon_message [list "[string map {"%" "%%"} [::abook::removeStyles [::abook::getVolatileData myself parsed_MFN]]]" \
"[string map {"%" "%%"} [::abook::getpsmmedia]]" \
"[::config::getKey login]" "[trans status]: [trans [::MSN::stateToDescription [::MSN::myStatusIs]]]"]
set fonts [list "sboldf" "sitalf" "splainf" "splainf"]
bind $pgBuddyTop.bigstate <Enter> +[list balloon_enter %W %X %Y $balloon_message $pic_name $fonts complex]
bind $pgBuddyTop.bigstate <Leave> "+set Bulle(first) 0; kill_balloon;"
bind $pgBuddyTop.bigstate <Motion> +[list balloon_motion %W %X %Y $balloon_message $pic_name $fonts complex]
set colorbar $pgBuddyTop.colorbar
label $colorbar -image [::skin::getColorBar] -background [::skin::getKey topcontactlistbg] -borderwidth 0
pack $colorbar -before $disppic -side bottom
set evpar(colorbar) $colorbar
set evpar(text) $pgBuddyTop
::plugins::PostEvent ContactListColourBarDrawn evpar
if { [::config::getKey checkemail] } {
# Show Mail Notification status
text $pgBuddyTop.mail -height 1 -background [::skin::getKey topcontactlistbg] -borderwidth 0 -wrap none -cursor left_ptr \
-relief flat -highlightthickness 0 -selectbackground [::skin::getKey topcontactlistbg] -selectborderwidth 0 \
-exportselection 0 -relief flat -highlightthickness 0 -borderwidth 0 -padx 0 -pady 0
if {[::skin::getKey emailabovecolorbar]} {
pack $pgBuddyTop.mail -expand true -fill x -after $colorbar -side bottom -padx 0 -pady 0
} else {
pack $pgBuddyTop.mail -expand true -fill x -before $colorbar -side bottom -padx 0 -pady 0
}
$pgBuddyTop.mail configure -state normal
#Set up TAGS for mail notification
$pgBuddyTop.mail tag conf mail -fore [::skin::getKey emailfg] -underline false -font splainf
$pgBuddyTop.mail tag bind mail <<Button1>> "$pgBuddyTop.mail conf -cursor watch; ::hotmail::hotmail_login"
$pgBuddyTop.mail tag bind mail <Enter> "$pgBuddyTop.mail tag conf mail -under true -fore [::skin::getKey emailhover] -background [::skin::getKey emailhoverbg];$pgBuddyTop.mail conf -cursor hand2"
$pgBuddyTop.mail tag bind mail <Leave> "$pgBuddyTop.mail tag conf mail -under false -fore [::skin::getKey emailfg] -background [::skin::getKey topcontactlistbg];$pgBuddyTop.mail conf -cursor left_ptr"
set unread [::hotmail::unreadMessages]
set froms [::hotmail::getFroms]
set fromsText ""
foreach {from frommail} $froms {
append fromsText "\n[trans newmailfrom $from $frommail]"
}
if {$unread == 0} {
set mailmsg "[trans nonewmail]"
set balloon_message "[trans nonewmail]"
set mail_img mailbox
} elseif {$unread == 1} {
set mailmsg "[trans onenewmail]"
set balloon_message "[trans onenewmail]\n$fromsText"
set mail_img mailbox_new
} elseif {$unread == 2} {
set mailmsg "[trans twonewmail 2]"
set balloon_message "[trans twonewmail 2]\n$fromsText"
set mail_img mailbox_new
} else {
set mailmsg "[trans newmail $unread]"
set balloon_message "[trans newmail $unread]\n$fromsText"
set mail_img mailbox_new
}
clickableImage $pgBuddyTop.mail mailbox $mail_img "::hotmail::hotmail_login" [::skin::getKey mailbox_xpad] [::skin::getKey mailbox_ypad]
set mailheight [expr {[image height [::skin::loadPixmap mailbox]]+(2*[::skin::getKey mailbox_ypad])}]
#in windows need an extra -2 is to include the extra 1 pixel above and below in a font
if { [OnWin] || [OnMac] } {
incr mailheight -2
}
set textheight [font metrics splainf -linespace]
if { $mailheight < $textheight } {
set mailheight $textheight
}
$pgBuddyTop.mail configure -font "{} -$mailheight"
$pgBuddyTop.mail tag bind mail <Enter> +[list balloon_enter %W %X %Y $balloon_message]
$pgBuddyTop.mail tag bind mail <Leave> "+set ::Bulle(first) 0; kill_balloon;"
$pgBuddyTop.mail tag bind mail <Motion> +[list balloon_motion %W %X %Y $balloon_message]
set evpar(text) pgBuddyTop.mail
set evpar(msg) mailmsg
::plugins::PostEvent ContactListEmailsDraw evpar
set maxw [expr {[winfo width [winfo parent $pgBuddyTop]]-[image width [::skin::loadPixmap $mail_img]]-(2*[::skin::getKey mailbox_xpad])}]
set short_mailmsg [trunc $mailmsg $pgBuddyTop.mail $maxw splainf]
$pgBuddyTop.mail insert end "$short_mailmsg" {mail dont_replace_smileys}
set evpar(text) pgBuddyTop.mail
::plugins::PostEvent ContactListEmailsDrawn evpar
$pgBuddyTop.mail configure -state disabled
}
#This lets the top part finish redrawing before the bottom part starts
#otherwise, the top part stays disappeared until the bottom part
#finishes redrawing... and we end up with pgBuddyTop disappearing
#for 1 second with like 90 contacts
# TODO: try not to use update here...
update idletasks
}
#Called when $pgBuddyTop.mystatus is resized
proc RedrawNick {} {
after cancel "drawNick"
after 200 "drawNick"
}
proc drawNick { } {
global pgBuddy pgBuddyTop automessage
$pgBuddyTop.mystatus delete all
set maxw [expr {[winfo width [winfo parent $pgBuddyTop]]-[$pgBuddyTop.bigstate cget -width]-(2*[::skin::getKey bigstate_xpad])}]
set pic_name displaypicture_std_self
set stylestring [list ]
lappend stylestring [list "tag" "mystatuslabel"]
lappend stylestring [list "colour" [::skin::getKey mystatus]]
lappend stylestring [list "font" [::skin::getFont "mystatuslabel" "splainf"]]
lappend stylestring [list "text" "[trans mystatus]: "]
lappend stylestring [list "tag" "-mystatuslabel"]
#$pgBuddyTop.mystatus insert end "[trans mystatus]: " mystatuslabel
if { [info exists automessage] && $automessage != -1} {
lappend stylestring [list "tag" "mystatuslabel2"]
lappend stylestring [list "font" [::skin::getFont "mystatuslabel2" "bboldf"]]
lappend stylestring [list "text" "[lindex $automessage 0]"]
lappend stylestring [list "tag" "-mystatuslabel2"]
}
if {[::config::getKey emailVerified 1] == 0} {
lappend stylestring [list "newline" "\n"]
lappend stylestring [list "tag" "myemailwarning"]
lappend stylestring [list "colour" [::skin::getKey myemailwarning]]
lappend stylestring [list "font" [::skin::getFont "mystatus" "bboldf"]]
lappend stylestring [list "text" [trans emailnotverified]]
lappend stylestring [list "tag" "-myemailwarning"]
}
lappend stylestring [list "newline" "\n"]
lappend stylestring [list "underline" "ul"]
lappend stylestring [list "trunc" 1 "..."]
#get the new
set my_state_desc [trans [::MSN::stateToDescription [::MSN::myStatusIs]]]
set my_name [::abook::getVolatileData myself parsed_mfn]
set my_colour [::MSN::stateToColor [::MSN::myStatusIs] "contact"]
set my_colour_state [::MSN::stateToColor [::MSN::myStatusIs] "contact"]
lappend stylestring [list "tag" "mystatus"]
lappend stylestring [list "default" $my_colour [::skin::getFont "mystatus" "bboldf"]]
lappend stylestring [list "colour" "reset"]
lappend stylestring [list "font" "reset"]
set stylestring [concat $stylestring $my_name]
lappend stylestring [list "default" $my_colour_state [::skin::getFont "mystatus" "bboldf"]]
lappend stylestring [list "colour" "reset"]
lappend stylestring [list "font" "reset"]
lappend stylestring [list "text" " ($my_state_desc)"]
lappend stylestring [list "tag" "-mystatus"]
set psmmedia ""
if {[::config::getKey protocol] >= 11} {
set psmmedia [::abook::getpsmmedia "" 1]
lappend stylestring [list "newline" "\n"]
lappend stylestring [list "tag" "mypsmmedia"]
lappend stylestring [list "default" $my_colour [::skin::getFont "psmfont" "sbolditalf"]]
lappend stylestring [list "colour" "reset"]
lappend stylestring [list "font" "reset"]
set stylestring [concat $stylestring $psmmedia]
lappend stylestring [list "tag" "-mypsmmedia"]
}
lappend stylestring [list "underline" "reset"]
if {[llength [::abook::getEndPoints]] > 1} {
lappend stylestring [list "newline" "\n"]
lappend stylestring [list "tag" "myplaceslabel"]
lappend stylestring [list "colour" [::skin::getKey mystatus]]
lappend stylestring [list "font" [::skin::getFont "mystatuslabel" "splainf"]]
lappend stylestring [list "text" "[trans connectedat]"]
lappend stylestring [list "tag" "-myplaceslabel"]
lappend stylestring [list "tag" "myplaces"]
lappend stylestring [list "default" $my_colour_state [::skin::getFont "mystatus" "bboldf"]]
lappend stylestring [list "colour" "reset"]
lappend stylestring [list "font" "reset"]
lappend stylestring [list "underline" "pl"]
lappend stylestring [list "text" "[trans xplaces [llength [::abook::getEndPoints]]]"]
lappend stylestring [list "tag" "-myplaces"]
}
::guiContactList::trimInfo stylestring
set renderInfo [::guiContactList::renderContact $pgBuddyTop.mystatus "all" $maxw $stylestring 0]
array set underlinst $renderInfo
set balloon_message [list "[string map {"%" "%%"} [::abook::removeStyles $my_name]]" \
"[string map {"%" "%%"} [::abook::removeStyles $psmmedia]]" \
"[::config::getKey login]" "[trans status]: $my_state_desc"]
set fonts [list "sboldf" "sitalf" "splainf" "splainf"]
$pgBuddyTop.mystatus bind mystatus <<Button3>> "kill_balloon; tk_popup .my_menu %X %Y"
$pgBuddyTop.mystatus bind mystatus <Enter> \
[list ::guiContactList::underlineList $pgBuddyTop.mystatus [set underlinst(ul)] "all"]
$pgBuddyTop.mystatus bind mystatus <Leave> [list $pgBuddyTop.mystatus delete "uline_all"]
$pgBuddyTop.mystatus bind mystatus <Enter> \
+[list $pgBuddyTop.mystatus configure -cursor hand2]
$pgBuddyTop.mystatus bind mystatus <Leave> +[list $pgBuddyTop.mystatus configure -cursor left_ptr]
$pgBuddyTop.mystatus bind mystatus <<Button1>> "kill_balloon; tk_popup .my_menu %X %Y"
$pgBuddyTop.mystatus bind mystatus <Enter> \
+[list balloon_enter %W %X %Y $balloon_message $pic_name $fonts complex]
$pgBuddyTop.mystatus bind mystatus <Leave> "+set Bulle(first) 0; kill_balloon"
$pgBuddyTop.mystatus bind mystatus <Motion> \
+[list balloon_motion %W %X %Y $balloon_message $pic_name $fonts complex]
$pgBuddyTop.mystatus bind mypsmmedia <<Button3>> "kill_balloon; tk_popup .my_menu %X %Y"
$pgBuddyTop.mystatus bind mypsmmedia <Enter> \
[list ::guiContactList::underlineList $pgBuddyTop.mystatus [set underlinst(ul)] "all"]
$pgBuddyTop.mystatus bind mypsmmedia <Leave> [list $pgBuddyTop.mystatus delete "uline_all"]
$pgBuddyTop.mystatus bind mypsmmedia <Enter> \
+[list $pgBuddyTop.mystatus configure -cursor hand2]
$pgBuddyTop.mystatus bind mypsmmedia <Leave> +[list $pgBuddyTop.mystatus configure -cursor left_ptr]
$pgBuddyTop.mystatus bind mypsmmedia <<Button1>> "kill_balloon; tk_popup .my_menu %X %Y"
$pgBuddyTop.mystatus bind mypsmmedia <Enter> \
+[list balloon_enter %W %X %Y $balloon_message $pic_name $fonts complex]
$pgBuddyTop.mystatus bind mypsmmedia <Leave> "+set Bulle(first) 0; kill_balloon"
$pgBuddyTop.mystatus bind mypsmmedia <Motion> \
+[list balloon_motion %W %X %Y $balloon_message $pic_name $fonts complex]
if {[llength [::abook::getEndPoints]] > 1} {
create_places_menu .my_places_menu
$pgBuddyTop.mystatus bind myplaces <<Button3>> "kill_balloon; tk_popup .my_places_menu %X %Y"
set ep_balloon ""
foreach ep [::abook::getEndPoints] {
append ep_balloon "[::abook::getEndPointName $ep]\n"
}
$pgBuddyTop.mystatus bind myplaces <Enter> \
[list ::guiContactList::underlineList $pgBuddyTop.mystatus [set underlinst(pl)] "all"]
$pgBuddyTop.mystatus bind myplaces <Leave> [list $pgBuddyTop.mystatus delete "uline_all"]
$pgBuddyTop.mystatus bind myplaces <Enter> \
+[list $pgBuddyTop.mystatus configure -cursor hand2]
$pgBuddyTop.mystatus bind myplaces <Leave> +[list $pgBuddyTop.mystatus configure -cursor left_ptr]
$pgBuddyTop.mystatus bind myplaces <<Button1>> "kill_balloon; tk_popup .my_places_menu %X %Y"
$pgBuddyTop.mystatus bind myplaces <Enter> \
+[list balloon_enter %W %X %Y $ep_balloon "" $fonts simple]
$pgBuddyTop.mystatus bind myplaces <Leave> "+set Bulle(first) 0; kill_balloon"
$pgBuddyTop.mystatus bind myplaces <Motion> \
+[list balloon_motion %W %X %Y $ep_balloon "" $fonts simple]
}
#Called when the window is resized
# -> Refreshes the colorbar depending on the width of the window, and redraw the nickname, truncating as necessary
bind $pgBuddyTop.mystatus <Configure> "::skin::getColorBar ; RedrawNick"
set bbox [$pgBuddyTop.mystatus bbox all]
#make sure we didn't get an empty string (because the status isn't visible anymore)
if {[llength $bbox] == 4} {
# We say +2 to let underline visible
$pgBuddyTop.mystatus configure -width [lindex $bbox 2] -height [expr {[lindex $bbox 3]+2}]
}
}
proc cmsn_draw_online_wrapped {} {
variable lastLogin
::guiContactList::unlockContactList
#Pack what is necessary for event menu
if { [::log::checkeventdisplay] } {
pack configure .main.eventmenu.list -fill x -ipadx 10
pack configure .main.eventmenu -side bottom -fill x
pack configure .main.eventmenu -padx [list [::skin::getKey eventmenuleftpad "0"] [::skin::getKey eventmenurightpad "0"]]
# clear events if login is a different account
if {[info exists lastLogin] && $lastLogin!=[::config::getKey login]} {
.main.eventmenu.list list delete 0 end
}
set lastLogin [::config::getKey login]
::log::eventlogin
.main.eventmenu.list select 0
} else {
pack forget .main.eventmenu
}
}
#///////////////////////////////////////////////////////////////////////
proc configured_main_win {{w ""}} {
global wingeom
set w [winfo width .]
set h [winfo height .]
if { [lindex $wingeom 0] != $w || [lindex $wingeom 1] != $h} {
set wingeom [list $w $h]
cmsn_draw_online 1 1
}
}
proc getUniqueValue {} {
global uniqueValue
if {![info exists uniqueValue]} {
set uniqueValue 0
}
incr uniqueValue
return $uniqueValue
}
#///////////////////////////////////////////////////////////////////////
proc balloon_enter {window x y msg {pic ""} {fonts ""} {mode "simple"}} {
global Bulle
set Bulle(set) 0
set Bulle(first) 1
set Bulle(id) [after 1000 [list balloon ${window} ${msg} ${pic} $x $y ${fonts} ${mode}]]
}
proc balloon_motion {window x y msg {pic ""} {fonts ""} {mode "simple"}} {
global Bulle
if {[set Bulle(set)] == 0} {
after cancel [set Bulle(id)]
set Bulle(id) [after 1000 [list balloon ${window} ${msg} ${pic} $x $y ${fonts} ${mode}]]
}
}
# trunc (str {window ""} {maxw 0 } {font ""})
#
# Truncates a string to at most nchars characters and places an ellipsis "..."
# at the end of it. nchars should include the three characters of the ellipsis.
# If the string is too short or nchars is too small, the ellipsis is not
# appended to the truncated string.
#
proc trunc {str {window ""} {maxw 0 } {font ""} {force 0}} {
if { $window == "" || $font == "" || ([::config::getKey truncatenames]!=1 && !$force) } {
return $str
}
#first check if whole message fits (increase speed)
if { [font measure $font -displayof $window $str] < $maxw } {
return $str
}
set slen [string length $str]
for {set idx 0} { $idx <= $slen} {incr idx} {
if { [font measure $font -displayof $window "[string range $str 0 $idx]..."] > $maxw } {
if { [string index $str end] == "\n" } {
return "[string range $str 0 [expr {$idx-1}]]...\n"
} else {
return "[string range $str 0 [expr {$idx-1}]]..."
}
}
}
return $str
}
# trunc_with_smileys (str {window ""} {maxw 0 } {font ""})
#
# The same as the previous one, but also take care of smileys
#
proc trunc_with_smileys {str {window ""} {maxw 0 } {font ""}} {
if { $window == "" || $font == "" || [::config::getKey truncatenames]!=1} {
return $str
}
#first check if whole message fits (increase speed)
set str_list [::smiley::parseMessageToList [list [list "text" "$str"]] 1 0]
if { [string equal [lindex [lindex $str_list 0 ] 1] $str ] &&\
[font measure $font -displayof $window $str] < $maxw } {
return $str
}
set indice 0
foreach elt $str_list {
switch [lindex $elt 0] {
text {
set txt [lindex $elt 1]
set slen [string length $txt]
for {set idx 0} { $idx <= $slen} {incr idx} {
if { [font measure $font -displayof $window "[string range $txt 0 $idx]..."] > $maxw } {
return "[string range $str 0 [expr {$indice+$idx-1}]]..."
}
}
incr indice $slen
set maxw [expr {$maxw - [font measure $font -displayof $window $txt]}]
}
smiley {
set maxw [expr {$maxw - [image width [lindex $elt 1]]}]
if {$maxw <= 0 } {
return "[string range $str 0 [expr {$indice-1}]]..."
}
incr indice [string length [lindex $elt 2]]
}
#what should we do in that case ???
newline {}
}
}
return $str
}
#returns text string to bind to a on mouse over event to trigger mouse pointer change
proc onMouseEnterHand { w } {
if { ![info exists ::MouseLeave($w)] } {
set ::MouseLeave($w) ""
}
return "+after cancel \$::MouseLeave($w); if \{\[$w cget -cursor\] != \"hand2\" \} \{$w conf -cursor hand2\}"
}
#returns text string to bind to a on mouse leave event to trigger mouse pointer change
proc onMouseLeaveHand { w } {
if { ![info exists ::MouseLeave($w)] } {
set ::MouseLeave($w) ""
}
return "+after cancel \$::MouseLeave($w); set ::MouseLeave($w) \[after 50 \"$w conf -cursor left_ptr\"\]"
}
proc tk_textCopy { w } {
copy 0 $w
}
proc tk_textCut { w } {
copy 1 $w
}
proc tk_textPaste { w } {
paste $w
}
#///////////////////////////////////////////////////////////////////////
proc copy { cut w } {
#Try this (for chat windows)
if { [ catch {set window [::ChatWindow::GetInputText $w]} ]} { set window $w }
set index [$window tag ranges sel]
if { $index == "" } {
set window [::ChatWindow::GetOutText $w]
catch {set index [$window tag ranges sel]}
if { $index == "" } { return }
}
clipboard clear
set dump [$window dump -text [lindex $index 0] [lindex $index 1]]
#if { [OnLinux] } {
# foreach { text output index } $dump { clipboard append -type UTF8_STRING "$output" }
#} else {
foreach { text output index } $dump { clipboard append "$output" }
#}
if { $cut == "1" } { catch { $window delete sel.first sel.last } }
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc paste { window {middle 0} } {
set contents ""
if { [catch {selection get} res] != 0 } {
catch {
if { [OnLinux] } {
set contents [ selection get -type UTF8_STRING -selection CLIPBOARD ]
} else {
set contents [ selection get -selection CLIPBOARD ]
}
}
} else {
if { $middle == 0} {
catch {
if { [OnLinux] } {
set contents [ selection get -type UTF8_STRING -selection CLIPBOARD ]
} else {
set contents [ selection get -selection CLIPBOARD ]
}
}
}
}
set evPar(contents) contents
set evPar(window) window
set evpar(middle) middle
::plugins::PostEvent pre_paste evPar
if {$contents != "" } {
catch {[::ChatWindow::GetInputText $window] insert insert $contents}
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_addcontact {} {
global lang pcc
if {[winfo exists .addcontact]} {
catch {
raise .addcontact
focus .addcontact.email
}
set pcc 0
return 0
}
toplevel .addcontact
wm group .addcontact .
wm title .addcontact "[trans addacontact] - [trans title]"
label .addcontact.l -font sboldf -text "[trans entercontactemail]:"
entry .addcontact.email -width 50 -font splainf
label .addcontact.example -font examplef -justify left \
-text "[trans examples]:\ncopypastel@hotmail.com\nelbarney@msn.com\nexample@passport.com"
frame .addcontact.group
combobox::combobox .addcontact.group.list -editable false -highlightthickness 0 -width 22 -font splainf -exportselection false
set groups [::groups::GetSortedList]
foreach gid $groups {
.addcontact.group.list list insert end "[::groups::GetName $gid]"
}
.addcontact.group.list select 0
label .addcontact.group.l -font sboldf -text "[trans group] : "
pack .addcontact.group.l -side left
pack .addcontact.group.list -side left
frame .addcontact.b
button .addcontact.b.next -text "[trans next]->" -command addcontact_next
button .addcontact.b.cancel -text [trans cancel] \
-command "set pcc 0; destroy .addcontact"
bind .addcontact <<Escape>> "set pcc 0; destroy .addcontact"
pack .addcontact.b.next .addcontact.b.cancel -side right -padx 5
pack .addcontact.l -side top -anchor sw -padx 10 -pady 3
pack .addcontact.email -side top -fill x -padx 10 -pady 3
pack .addcontact.example -side top -anchor nw -padx 10 -pady 3
pack .addcontact.group -side top -fill x -padx 10 -pady 3
pack .addcontact.b -side top -pady 3 -expand true -fill x -anchor se
bind .addcontact.email <Return> "addcontact_next"
catch {
raise .addcontact
focus .addcontact.email
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
# Check if the "add contact" window is open and then re-make the group list
proc cmsn_draw_grouplist {} {
set groupsel [.addcontact.group.list get]
set selection 0
.addcontact.group.list list delete 0 end
set groups [::groups::GetSortedList]
foreach gid $groups {
if { $groupsel == [::groups::GetName $gid] } {
set selection [.addcontact.group.list list index end]
}
.addcontact.group.list list insert end "[::groups::GetName $gid]"
}
catch {.addcontact.group.list select $selection }
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc addcontact_next {} {
set tmp_email [.addcontact.email get]
if { $tmp_email != ""} {
set group [.addcontact.group.list curselection]
set gid [lindex [::groups::GetSortedList] $group]
::MSN::addUser "$tmp_email" "" $gid
catch {grab release .addcontact}
destroy .addcontact
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc cmsn_draw_otherwindow { title command } {
if {[winfo exists .otherwindow] } { destroy .otherwindow }
toplevel .otherwindow
wm group .otherwindow .
wm title .otherwindow "$title"
label .otherwindow.l -font sboldf -text "[trans entercontactemail]:"
entry .otherwindow.email -width 50 -bd 1 \
-font splainf
frame .otherwindow.b
button .otherwindow.b.ok -text "[trans ok]" \
-command "run_command_otherwindow \"$command\""
button .otherwindow.b.cancel -text [trans cancel] \
-command "grab release .otherwindow;destroy .otherwindow"
pack .otherwindow.b.ok .otherwindow.b.cancel -side right -padx 5
pack .otherwindow.l -side top -anchor sw -padx 10 -pady 3
pack .otherwindow.email -side top -expand true -fill x -padx 10 -pady 3
pack .otherwindow.b -side top -pady 3 -expand true -anchor se
bind .otherwindow.email <Return> "run_command_otherwindow \"$command\""
focus .otherwindow.email
tkwait visibility .otherwindow
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc newcontact {new_login new_name} {
set login [split $new_login "@ ."]
set login [join $login "_"]
set wname ".newc_$login"
if { [catch {toplevel ${wname} } ] } {
return 0
}
if { [winfo exists .bossmode] } {
set ::BossMode(${wname}) "normal"
wm state ${wname} withdraw
}
wm group ${wname} .
wm geometry ${wname} -0+100
wm title ${wname} "$new_name - [trans title]"
global newc_add_to_list_${wname}
if {[lsearch [::abook::getLists $new_login] FL] != -1} {
set add_stat "disabled"
set newc_add_to_list_${wname} 0
} else {
set add_stat "normal"
set newc_add_to_list_${wname} 1
}
global newc_allow_block_${wname}
set newc_allow_block_${wname} 1
label ${wname}.l1 -font splainf -justify left -wraplength 300 \
-text "[trans addedyou $new_name $new_login]"
label ${wname}.l2 -font splainf -text "[trans youwant]:"
radiobutton ${wname}.allow -value "1" -variable newc_allow_block_${wname} \
-text [trans allowseen] \
-highlightthickness 0 \
-activeforeground #FFFFFF -selectcolor #FFFFFF -font sboldf
radiobutton ${wname}.block -value "0" -variable newc_allow_block_${wname} \
-text [trans avoidseen] \
-highlightthickness 0 \
-activeforeground #FFFFFF -selectcolor #FFFFFF -font sboldf
checkbutton ${wname}.add -var newc_add_to_list_${wname} -state $add_stat \
-text [trans addtoo] -font sboldf \
-highlightthickness 0 -activeforeground #FFFFFF -selectcolor #FFFFFF
frame ${wname}.b
button ${wname}.b.ok -text [trans ok] \
-command [list newcontact_ok ${wname} $new_login $new_name]
button ${wname}.b.cancel -text [trans cancel]\
-command [list destroy ${wname}]
pack ${wname}.b.ok ${wname}.b.cancel -side right -padx 5
pack ${wname}.l1 -side top -pady 3 -padx 5 -anchor nw
pack ${wname}.l2 -side top -pady 3 -padx 5 -anchor w
pack ${wname}.allow -side top -pady 0 -padx 15 -anchor w
pack ${wname}.block -side top -pady 0 -padx 15 -anchor w
pack ${wname}.add -side top -pady 3 -padx 5 -anchor w
pack ${wname}.b -side top -pady 3 -anchor se -expand true -fill x
moveinscreen ${wname} 30
}
#///////////////////////////////////////////////////////////////////////
proc newcontact_ok { w x0 x1 } {
global newc_allow_block_$w newc_add_to_list_$w
set newc_allow_block [set newc_allow_block_$w]
set newc_add_to_list [set newc_add_to_list_$w]
if {[::config::getKey protocol] >= 13 } {
if { [lsearch [::abook::getLists $x0] PL] != -1 } {
::MSN::removeUserFromList $x0 PL
::MSN::addUserToList $x0 RL
}
if {$newc_allow_block == "1"} {
::MSN::unblockUser $x0
} else {
::MSN::blockUser $x0
}
} elseif { [::config::getKey protocol] == 11 } {
if {$newc_allow_block == "1"} {
::MSN::WriteSB ns "ADC" "AL N=$x0"
} else {
::MSN::WriteSB ns "ADC" "BL N=$x0"
}
if { [lsearch [::abook::getLists $x0] PL] != -1 } {
#It is in the PL : move it to RL
::MSN::WriteSB ns "ADC" "RL N=$x0"
::MSN::WriteSB ns "REM" "PL $x0"
}
} else {
if {$newc_allow_block == "1"} {
::MSN::WriteSB ns "ADD" "AL $x0 [urlencode $x1]"
} else {
::MSN::WriteSB ns "ADD" "BL $x0 [urlencode $x1]"
}
}
if {$newc_add_to_list} {
::MSN::addUser $x0 [urlencode $x1]
}
destroy $w
}
#///////////////////////////////////////////////////////////////////////
proc cmsn_change_name {{changepsm 0}} {
set w .change_name
if {[winfo exists $w]} {
raise $w
return 0
}
toplevel $w
wm group $w .
wm title $w "[trans changenick] - [trans title]"
frame $w.f
label $w.f.nick_label -font sboldf -text "[trans enternick]:"
entry $w.f.nick_entry -width 40 -font splainf
label $w.f.nick_smiley -image [::skin::loadPixmap butsmile] -relief flat -padx 3 -highlightthickness 0
label $w.f.nick_newline -image [::skin::loadPixmap butnewline] -relief flat -padx 3
label $w.f.nick_textcounter -font sboldf
label $w.f.psm_label -font sboldf -text "[trans enterpsm]:"
entry $w.f.psm_entry -width 40 -font splainf
label $w.f.psm_smiley -image [::skin::loadPixmap butsmile] -relief flat -padx 3 -highlightthickness 0
label $w.f.psm_newline -image [::skin::loadPixmap butnewline] -relief flat -padx 3
label $w.f.psm_textcounter -font sboldf
label $w.f.p4c_label -font sboldf -text "[trans friendlyname]:"
entry $w.f.p4c_entry -width 40 -font splainf
label $w.f.p4c_smiley -image [::skin::loadPixmap butsmile] -relief flat -padx 3 -highlightthickness 0
label $w.f.p4c_newline -image [::skin::loadPixmap butnewline] -relief flat -padx 3
grid $w.f.nick_label -row 0 -column 0 -sticky w
grid $w.f.nick_entry -row 0 -column 1 -sticky we
grid $w.f.nick_smiley -row 0 -column 2
grid $w.f.nick_newline -row 0 -column 3
grid $w.f.nick_textcounter -row 0 -column 4
if { [::config::getKey protocol] >= 11} {
grid $w.f.psm_label -row 1 -column 0 -sticky w
grid $w.f.psm_entry -row 1 -column 1 -sticky we
grid $w.f.psm_smiley -row 1 -column 2
grid $w.f.psm_newline -row 1 -column 3
grid $w.f.psm_textcounter -row 1 -column 4
}
grid $w.f.p4c_label -row 2 -column 0 -sticky w
grid $w.f.p4c_entry -row 2 -column 1 -sticky we
grid $w.f.p4c_smiley -row 2 -column 2
grid $w.f.p4c_newline -row 2 -column 3
grid columnconfigure $w.f 1 -weight 1
frame $w.fb
button $w.fb.ok -text [trans ok] -command change_name_ok
button $w.fb.cancel -text [trans cancel] -command [list destroy $w]
pack $w.fb.cancel -side right -padx [list 5 0 ]
pack $w.fb.ok -side right
pack $w.f $w.fb -side top -fill x -expand true -padx 5
bind $w <<Escape>> "destroy $w"
bind $w.f.psm_entry <Return> "change_name_ok"
bind $w.f.p4c_entry <Return> "change_name_ok"
bind $w.f.psm_smiley <<Button1>> "focus $w.f.psm_entry; ::smiley::smileyMenu %X %Y $w.f.psm_entry"
bind $w.f.p4c_smiley <<Button1>> "focus $w.f.p4c_entry; ::smiley::smileyMenu %X %Y $w.f.p4c_entry"
bind $w.f.psm_newline <<Button1>> "$w.f.psm_entry insert end \"\n\""
bind $w.f.p4c_newline <<Button1>> "$w.f.p4c_entry insert end \"\n\""
bind $w.f.psm_entry <Tab> "focus $w.f.p4c_entry; break"
bind $w.f.p4c_entry <Tab> "focus $w.f.nick_entry; break"
bind $w.f.psm_entry <KeyRelease> "ChangeNameBarEdited $w psm"
bind $w.f.psm_entry <<Button2>> "after 200 [list ::::ChangeNameBarEdited $w psm]"
if {[::config::getKey emailVerified 1] == 1} {
bind $w.f.nick_entry <Return> "change_name_ok"
bind $w.f.nick_smiley <<Button1>> "focus $w.f.nick_entry; ::smiley::smileyMenu %X %Y $w.f.nick_entry"
bind $w.f.nick_newline <<Button1>> "$w.f.nick_entry insert end \"\n\""
bind $w.f.nick_entry <Tab> "focus $w.f.psm_entry; break"
bind $w.f.nick_entry <KeyRelease> "ChangeNameBarEdited $w nick"
bind $w.f.nick_entry <<Button2>> "after 200 [list ::::ChangeNameBarEdited $w nick]"
}
# Make sure the smiley selector disappears with the window
bind $w <Destroy> { if {[winfo exists .smile_selector] } { wm state .smile_selector withdrawn }}
set nick [::abook::getPersonal MFN]
if {[::config::getKey emailVerified 1] == 0} {
set nick "$nick [trans emailnotverified]"
}
set psm [::abook::getPersonal PSM]
$w.f.nick_entry insert 0 $nick
$w.f.psm_entry insert 0 $psm
$w.f.p4c_entry insert 0 [::config::getKey p4c_name]
$w.f.nick_textcounter configure -text "[string length $nick]/130" -justify left
$w.f.psm_textcounter configure -text "[string length $psm]/130" -justify left
if {[::config::getKey emailVerified 1] == 0} {
#disable nick change (email not yet verified)
$w.f.nick_entry configure -state disabled
$w.f.nick_smiley configure -state disabled
$w.f.nick_newline configure -state disabled
}
catch {
raise $w
if {$changepsm} {
focus -force $w.f.psm_entry
} else {
focus -force $w.f.nick_entry
}
}
moveinscreen $w 30
if {[::config::getKey emailVerified 1] == 0 && $changepsm == 0} {
#remind user of verification
msg_box [trans passportnotverified]
}
}
#///////////////////////////////////////////////////////////////////////
proc ChangeNameBarEdited {w what} {
if {$what == "nick"} {
catch {$w.f.nick_textcounter configure -text "[string length [$w.f.nick_entry get]]/130"}
} else {
catch {$w.f.psm_textcounter configure -text "[string length [$w.f.psm_entry get]]/130"}
}
}
#///////////////////////////////////////////////////////////////////////
proc change_name_ok {} {
set nick_changed 0
set psm_changed 0
if {![winfo exists .change_name]} {return}
set new_name [.change_name.f.nick_entry get]
set friendly [.change_name.f.p4c_entry get]
if { [::config::getKey protocol] >= 11} {
set new_psm [.change_name.f.psm_entry get]
}
destroy .change_name
if {$new_name != "" && [::abook::getContactData myself MFN] != $new_name} {
if { [string length $new_name] > 130} {
set answer [::amsn::messageBox [trans longnick] yesno question [trans confirm]]
if { $answer == "no" } {
return
}
}
set nick_changed 1
}
if { [::config::getKey protocol] >= 11} {
#TODO: how many chars in a Personal Message?
if { [string length $new_psm] > 130} {
set answer [::amsn::messageBox [trans longpsm] yesno question [trans confirm]]
if { $answer == "no" } {
return
}
}
set psm_changed 1
}
if {$psm_changed } {
::MSN::changePSM $new_psm [expr {!$nick_changed}]
}
if {$nick_changed && [::config::getKey emailVerified 1] == 1} {
::MSN::changeName $new_name
}
if { [string length $friendly] > 130} {
set answer [::amsn::messageBox [trans longp4c [string range $friendly 0 129]] yesno question [trans confirm]]
if { $answer == "no" } {
return
}
}
::config::setKey p4c_name $friendly
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc Fill_users_list { path path2} {
global emailBList
if {![winfo exists $path] || ![winfo exists $path2]} {
return
}
# clearing the list boxes from there content
$path.allowlist.box delete 0 end
$path.blocklist.box delete 0 end
$path2.contactlist.box delete 0 end
$path2.reverselist.box delete 0 end
foreach user [lsort [::MSN::getList AL]] {
if {[lsearch [::abook::getLists $user] BL] == -1} {
$path.allowlist.box insert end $user
if {([lsearch [::abook::getLists $user] RL] == -1) && ([lsearch [::abook::getLists $user] FL] == -1)} {
set colour [::skin::getKey extraprivacy_old_bg]
set foreground [::skin::getKey extraprivacy_old_fg]
} elseif {[lsearch [::abook::getLists $user] RL] == -1} {
set colour [::skin::getKey extraprivacy_notrl_bg]
set foreground [::skin::getKey extraprivacy_notrl_fg]
} elseif {[lsearch [::abook::getLists $user] FL] == -1} {
set colour [::skin::getKey extraprivacy_notfl_bg]
set foreground [::skin::getKey extraprivacy_notfl_fg]
} else {
set colour [::skin::getKey extrastdbgcolor]
set foreground [::skin::getKey extrastdtxtcolor]
}
$path.allowlist.box itemconfigure end -background $colour -foreground $foreground
}
}
foreach user [lsort [::MSN::getList BL]] {
$path.blocklist.box insert end $user
if {([lsearch [::abook::getLists $user] RL] == -1) && ([lsearch [::abook::getLists $user] FL] == -1)} {
set colour [::skin::getKey extraprivacy_old_bg]
set foreground [::skin::getKey extraprivacy_old_fg]
} elseif {[lsearch [::abook::getLists $user] RL] == -1} {
set colour [::skin::getKey extraprivacy_notrl_bg]
set foreground [::skin::getKey extraprivacy_notrl_fg]
} elseif {[lsearch [::abook::getLists $user] FL] == -1} {
set colour [::skin::getKey extraprivacy_notfl_bg]
set foreground [::skin::getKey extraprivacy_notfl_fg]
} else {
set colour [::skin::getKey extrastdbgcolor]
set foreground [::skin::getKey extrastdtxtcolor]
}
$path.blocklist.box itemconfigure end -background $colour -foreground $foreground
}
foreach user [lsort [::MSN::getList FL]] {
$path2.contactlist.box insert end $user
set foreground [::skin::getKey extrastdtxtcolor]
if {[lsearch [::MSN::getList AL] $user] != -1} {
set foreground [::skin::getKey extraprivacy_intoal_fg]
} elseif {[lsearch [::MSN::getList BL] $user] != -1} {
set foreground [::skin::getKey extraprivacy_intobl_fg]
}
if {[lsearch [::MSN::getList RL] $user] == -1} {
set colour [::skin::getKey extraprivacy_notrl_bg]
} else {
set colour [::skin::getKey extrastdbgcolor]
}
$path2.contactlist.box itemconfigure end -background $colour -foreground $foreground
}
foreach user [lsort [::MSN::getList RL]] {
$path2.reverselist.box insert end $user
set foreground [::skin::getKey extrastdtxtcolor]
if {[lsearch [::MSN::getList AL] $user] != -1} {
set foreground [::skin::getKey extraprivacy_intoal_fg]
} elseif {[lsearch [::MSN::getList BL] $user] != -1} {
set foreground [::skin::getKey extraprivacy_intobl_fg]
}
if {[lsearch [::MSN::getList FL] $user] == -1} {
set colour [::skin::getKey extraprivacy_notfl_bg]
} else {
set colour [::skin::getKey extrastdbgcolor]
}
$path2.reverselist.box itemconfigure end -background $colour -foreground $foreground
}
}
proc create_users_list_popup { path list x y} {
if { [$path.${list}list.box curselection] == "" } {
$path.status configure -text "[trans choosecontact]"
} else {
$path.status configure -text ""
set user [$path.${list}list.box get active]
set add "normal"
set remove "normal"
if { "$list" == "contact" } {
set add "disabled"
} elseif { "$list" == "reverse" } {
set remove "disabled"
} elseif { "$list" == "allow" } {
# Other config to add ???
} elseif { "$list" == "block" } {
# Other config to add ???
}
if { [winfo exists $path.${list}popup] } {
destroy $path.${list}popup
}
menu $path.${list}popup -tearoff 0 -type normal
$path.${list}popup add command -label "$user" -command "clipboard clear;clipboard append $user"
$path.${list}popup add separator
$path.${list}popup add command -label "[trans addtocontacts]" -command "AddToContactList \"$user\" $path" -state $add
$path.${list}popup add command -label "[trans removefromlist]" -command "Remove_from_list $list $user" -state $remove
$path.${list}popup add command -label "[trans properties]" -command "::abookGui::showUserProperties $user"
tk_popup $path.${list}popup $x $y
}
}
proc AddToContactList { user path } {
if { [NotInContactList "$user"] } {
if {[::config::getKey protocol] >= 13 } {
::MSN::addUser $user
} elseif { [::config::getKey protocol] == 11 } {
::MSN::WriteSB ns "ADC" "FL N=$user F=$user"
} else {
::MSN::WriteSB ns "ADD" "FL $user $user 0"
}
} else {
$path.status configure -text "[trans useralreadyonlist]"
}
}
proc Remove_from_list { list user } {
if { "$list" == "contact" && [lsearch [::abook::getLists $user] FL] != -1 } {
if {[::config::getKey protocol] >= 13 } {
::MSN::deleteUser $user
} else {
set guid [::abook::getContactData $user contactguid]
if { $guid != "" } {
::MSN::WriteSB ns "REM" "FL $guid"
}
}
} elseif { "$list" == "allow" && [lsearch [::abook::getLists $user] AL] != -1} {
if {[::config::getKey protocol] >= 13 } {
::MSN::removeUserFromList $user "AL"
} else {
::MSN::WriteSB ns "REM" "AL $user"
}
} elseif { "$list" == "block" && [lsearch [::abook::getLists $user] BL] != -1} {
if {[::config::getKey protocol] >= 13 } {
::MSN::removeUserFromList $user "BL"
} else {
::MSN::WriteSB ns "REM" "BL $user"
}
}
}
proc Add_To_List { path list } {
set username [$path.adding.enter get]
if { [string match "*@*" $username] == 0 } {
set username [split $username "@"]
set username "[lindex $username 0]@hotmail.com"
}
if { $list == "FL" } {
AddToContactList "$username" "$path"
} else {
if { [::config::getKey protocol] >= 13 } {
::MSN::addUserToList $username $list
} elseif { [::config::getKey protocol] == 11 } {
::MSN::WriteSB ns "ADC" "$list N=$username"
} else {
::MSN::WriteSB ns "ADD" "$list $username $username"
}
}
}
proc Reverse_to_Contact { path } {
if { [VerifySelect $path "reverse"] } {
$path.status configure -text ""
set user [$path.reverselist.box get active]
AddToContactList "$user" "$path"
}
}
proc Remove_Contact { path } {
if { [$path.contactlist.box curselection] == "" } {
$path.status configure -text "[trans choosecontact]"
} else {
$path.status configure -text ""
set user [$path.contactlist.box get active]
Remove_from_list "contact" $user
}
}
proc Allow_to_Block { path } {
if { [VerifySelect $path "allow"] } {
$path.status configure -text ""
set user [$path.allowlist.box get active]
::MSN::blockUser "$user"
}
}
proc Block_to_Allow { path } {
if { [VerifySelect $path "block"] } {
$path.status configure -text ""
set user [$path.blocklist.box get active]
::MSN::unblockUser "$user"
}
}
proc AllowAllUsers { state } {
global list_BLP
set list_BLP $state
updateAllowAllUsers
}
proc updateAllowAllUsers { } {
global list_BLP
if { $list_BLP == 1 } {
::MSN::WriteSB ns "BLP" "AL"
} elseif { $list_BLP == 0} {
::MSN::WriteSB ns "BLP" "BL"
} else {
return
}
}
proc VerifySelect { path list } {
if { [$path.${list}list.box curselection] == "" } {
$path.status configure -text "[trans choosecontact]"
return 0
} else {
return 1
}
}
proc NotInContactList { user } {
if {[lsearch [::MSN::getList FL] $user] == -1} {
return 1
} else {
return 0
}
}
#saves the contactlist to a file
proc saveContacts { } {
set w ".savecontacts"
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w
wm title $w "[trans options]"
frame $w.format
radiobutton $w.format.ctt -text "[trans formatctt]" -value "ctt" -variable format
radiobutton $w.format.csv -text "[trans formatcsv]" -value "csv" -variable format
$w.format.ctt select
pack configure $w.format.ctt -side top -fill x -expand true
pack configure $w.format.csv -side top -fill x -expand true
frame $w.button
button $w.button.save -text "[trans save]" -command "saveContacts2"
button $w.button.cancel -text "[trans cancel]" -command "destroy $w"
pack configure $w.button.save -side right -padx 3 -pady 3
pack configure $w.button.cancel -side right -padx 3 -pady 3
pack configure $w.format -side top -fill both -expand true
pack configure $w.button -side top -fill x -expand true
}
proc saveContacts2 { } {
upvar 1 format format
if { $format == "ctt" } {
set types [list { {Messenger Contacts} {.ctt} }]
} elseif { $format == "csv" } {
set types [list { {Comma Seperated Values} {.csv} }]
}
set filename [tk_getSaveFile -filetypes $types -defaultextension ".$format" -initialfile "amsncontactlist.$format"]
if {$filename != ""} {
if { [string match "$filename" "*.$format"] == 0 } {
set filename "$filename.$format"
::abook::saveToDisk $filename $format
}
}
destroy .savecontacts
}
###TODO: Replace all this msg_box calls with ::amsn::infoMsg
proc msg_box {msg} { ::amsn::infoMsg "$msg" }
############################################################
### Extra procedures that go nowhere else
############################################################
#///////////////////////////////////////////////////////////////////////
# launch_browser(url)
# Launches the configured browser
proc launch_browser { url {local 0}} {
if { $local != 1 &&
![regexp ^\[\[:alnum:\]\]+:// $url] &&
![regexp ^spotify: $url]} {
set url "http://$url"
}
if { [OnWin] && [string tolower [string range $url 0 6]] == "file://" } {
set url [string range $url 7 end]
regsub -all "/" $url "\\\\" url
}
status_log "url is $url\n"
#status_log "Launching browser for url: $url\n"
if { [OnWin] } {
catch {package require WinUtils }
if { [catch { WinLoadFile $url }] } {
regsub -all -nocase {htm} $url {ht%6D} url
regsub -all -nocase {&} $url {^&} url
catch { exec rundll32 url.dll,FileProtocolHandler $url & } res
}
} else {
if { [string first "\$url" [::config::getKey browser]] == -1 } {
::config::setKey browser "[::config::getKey browser] \$url"
}
#if { [catch {eval exec [::config::getKey browser] [list $url] &} res ] } {}
#status_log "Launching [::config::getKey browser]\n"
if { [catch {eval exec [::config::getKey browser] &} res ] } {
::amsn::errorMsg "[trans cantexec [::config::getKey browser]]"
}
}
}
#///////////////////////////////////////////////////////////////////////
# open_file(file)
# open the file with the environnment's default
proc open_file {file} {
#use WinLoadFile for windows
if { [OnWin] } {
#replace all / with \
regsub -all {/} $file {\\} file
package require WinUtils
WinLoadFile $file
} elseif { [string length [::config::getKey openfilecommand]] < 1 } {
msg_box "[trans checkopenfilecommand $file]"
} else {
if {[catch {eval exec [::config::getKey openfilecommand] &} res]} {
status_log "[::config::getKey openfilecommand]"
status_log $res
::amsn::errorMsg "[trans cantexec [::config::getKey openfilecommand]]"
}
}
}
#///////////////////////////////////////////////////////////////////////
# launch_filemanager(directory)
# Launches the configured file manager
proc launch_filemanager {location} {
if { [string length [::config::getKey filemanager]] < 1 } {
msg_box "[trans checkfilman $location]"
} else {
#replace all / with \ for windows
if { [OnWin] } {
regsub -all {/} $location {\\} location
}
if { [string first "\$location" [::config::getKey filemanager]] == -1 } {
::config::setKey filemanager "[::config::getKey filemanager] \$location"
}
if {[catch {eval exec [::config::getKey filemanager] &} res]} {
::amsn::errorMsg "[trans cantexec [::config::getKey filemanager]]"
}
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
# launch_mailer(directory)
# Launches the configured mailer program
proc launch_mailer {recipient} {
global password
if {[string length [::config::getKey mailcommand]]==0} {
::hotmail::composeMail $recipient
return 0
}
if { [string first "\$recipient" [::config::getKey mailcommand]] == -1 } {
::config::setKey mailcommand "[::config::getKey mailcommand] \$recipient"
}
if { [catch {eval exec [::config::getKey mailcommand] &} res]} {
::amsn::errorMsg "[trans cantexec [::config::getKey mailcommand]]"
}
return 0
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
# toggle_status()
# Enabled/disables status window (for debugging purposes)
proc toggle_status {} {
set w .status
if {"[wm state $w]" == "normal"} {
wm state $w withdrawn
set status_show 0
} else {
wm state $w normal
set status_show 1
raise $w
focus $w.enter
}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
# timestamp()
# Returns a timestamp like [HH:MM:SS]
proc timestamp {} {
set stamp [clock format [clock seconds] -format %H:%M:%S]
return "[::config::getKey leftdelimiter]$stamp[::config::getKey rightdelimiter]"
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////////////
# status_log (text,[color])
# Logs the given text with a timestamp using the given color
# to the status window
proc status_log {txt {colour ""}} {
global followtext_status queued_status
# return
#ensure txt ends in a newline
if { [string index $txt end] != "\n" } {
set txt "$txt\n"
}
if { [catch {
#puts -nonewline "[timestamp] $txt"
.status.info insert end "[timestamp] $txt" $colour
.status.info delete 0.0 end-1000lines
if { $followtext_status == 1 } {
catch {.status.info yview end}
}
}]} {
lappend queued_status [list $txt $colour]
}
}
#///////////////////////////////////////////////////////////////////////////////
if { [info command ::tk::exit] == "" && [info command exit] == "exit" } {
rename exit ::tk::exit
}
#///////////////////////////////////////////////////////////////////////
# close_cleanup()
# Makes some cleanup and config save before closing
proc exit {} {
global HOME lockSock
catch { ::MSN::logout}
# if there is a container
if { [info exists ::ChatWindow::containers] } {
foreach { key value } [array get ::ChatWindow::containers] {
::ChatWindow::CloseAll $value
}
}
if { [info exists ::ChatWindow::windows] } {
foreach { value } [array get ::ChatWindow::windows] {
#cycle in every window and destroy it
#force the destroy
set ::ChatWindow::recent_message($value) 0
::ChatWindow::Close $value
}
}
::config::setKey wingeometry [wm geometry .]
save_config
::config::saveGlobal
#before quitting, unload plugins, so that they run their DeInit proc
#we unload plugins at that moment and not before, since save_config
#would have saved wrong plugins config because no plugin would have been
#loaded at that moment
::plugins::UnLoadPlugins
LoadLoginList 1
# Unlock current profile
LoginList changelock 0 [::config::getKey login] 0
if { [info exists lockSock] } {
if { $lockSock != 0 } {
catch {close $lockSock} res
}
}
SaveLoginList
SaveStateList
close_dock ;# Close down the dock socket
catch {file delete [file join $HOME hotlog.htm]} res
$::farsight Close
# As suggested by Joe English, letting the idler do the exit is better since it lets the C stack unwind
# into a safer state.. would resolve possible segfaults on exit..
# other alternative is to use 'destroy .' instead of 'exit'.. especially when it's called from a -command option of a menu entry
# ok.. more info.. we shouldn't rename 'exit' at all.. argh :s and we should never call exit,
# we should call 'destroy .' whenever we want to exit the program...
# and we should bind this cleanup procedure to the <Destroy> even of the '.' window...
# for now, I'll leave it like that..
after idle ::tk::exit
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
# idleCheck()
# Check idle every five seconds and reset idle if the mouse has moved
proc idleCheck {} {
global idletime oldmousepos trigger autostatuschange
set mousepos [winfo pointerxy .]
if { $mousepos != $oldmousepos } {
set oldmousepos $mousepos
set idletime 0
}
# Check for empty fields and use 5min by default
if {[::config::getKey awaytime] == ""} { ::config::setKey awaytime 10 }
if {[::config::getKey idletime] == ""} { ::config::setKey idletime 5 }
if { [string is digit [::config::getKey awaytime]] && [string is digit [::config::getKey idletime]] } {
#Avoid running this if the settings are not digits, which can happen while changing preferences
set second [expr {[::config::getKey awaytime] * 60}]
set first [expr {[::config::getKey idletime] * 60}]
set changed 0
if { $idletime >= $second && [::config::getKey autoaway] == 1 && \
(([::MSN::myStatusIs] == "IDL" && $autostatuschange == 1) || \
([::MSN::myStatusIs] == "NLN"))} {
#We change to Away if time has passed, and if IDL was set automatically
::MSN::changeStatus AWY
set autostatuschange 1
set changed "AWY"
} elseif {$idletime >= $first && [::MSN::myStatusIs] == "NLN" && [::config::getKey autoidle] == 1} {
#We change to idle if time has passed and we're online
::MSN::changeStatus IDL
set autostatuschange 1
set changed "IDL"
} elseif { $idletime == 0 && $autostatuschange == 1} {
#We change to only if mouse movement, and status change was automatic
::MSN::changeStatus NLN
#Status change always resets automatic change to 0
set changed "NLN"
}
if { $changed != "0" } {
#PostEvent 'ChangeMyState' when the user changes his/her state
set evPar(automessage) $::automessage
set evPar(idx) $changed
::plugins::PostEvent ChangeMyState evPar
}
}
set idletime [expr {$idletime + 5}]
after 5000 idleCheck
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc choose_theme { } {
setColor . . background {-background -highlightbackground}
}
#///////////////////////////////////////////////////////////////////////
#///////////////////////////////////////////////////////////////////////
proc setColor {w button name options} {
catch {grab $w}
set initialColor [$button cget -$name]
set color [tk_chooseColor -title "[trans choosebgcolor]" -parent $w \
-initialcolor $initialColor]
if { $color != "" } {
::config::setKey backgroundcolor $color
::themes::ApplyDeep $w $options $color
}
catch {grab release $w}
}
#///////////////////////////////////////////////////////////////////////
# Given a string, this proc returns a list where each element is a list containing
# the positions (first and end) of any URL in this string.
proc urlParserString { str } {
set matches [list]
foreach url $::amsn::urlregexps {
foreach match [regexp -line -nocase -indices -all -inline -- $url $str] {
set start [lindex $match 0]
set end [lindex $match 1]
set duplicate 0
# Make sure not to match the same url twice if it matches 2 regexps
foreach m $matches {
set s [lindex $m 0]
set e [lindex $m 1]
if {$s <= $start && $e >= $end} {
set duplicate 1
break
}
}
if {!$duplicate} {
lappend matches [list $start $end]
}
}
}
return $matches
}
#///////////////////////////////////////////////////////////////////////
proc show_umenu {user_login grId x y} {
set blocked [::MSN::userIsBlocked $user_login]
#clear the menu
.user_menu delete 0 end
set statecode [::abook::getVolatileData $user_login state FLN]
set mobile [expr {[::abook::getContactData $user_login MOB] == "Y"}]
#Add the first item, depending on what's possible
if {[::MSN::userIsNotIM ${user_login}]} {
.user_menu add command -label "[trans sendmail] ($user_login)" \
-command "launch_mailer ${user_login}"
set first "[trans sendmail] ($user_login)"
} elseif {$statecode != "FLN"} {
.user_menu add command -label "[trans sendmsg] ($user_login)" \
-command "::amsn::chatUser ${user_login}"
set first "[trans sendmsg] ($user_login)"
} elseif { $mobile == 1 } {
.user_menu add command -label "[trans sendmobmsg] ($user_login)" \
-command "::MSNMobile::OpenMobileWindow ${user_login}"
set first "[trans sendmobmsg] ($user_login)"
.user_menu add command -label "[trans sendoim] ($user_login)" \
-command "::amsn::chatUser $user_login; set ::OIM_GUI::oim_asksend_[string map {: _} ${user_login} ] 0"
} else {
.user_menu add command -label "[trans sendoim] ($user_login)" \
-command "::amsn::chatUser $user_login; set ::OIM_GUI::oim_asksend_[string map {: _} ${user_login} ] 0"
.user_menu add command -label "[trans sendmail] ($user_login)" \
-command "launch_mailer $user_login"
set first "[trans sendoim] ($user_login)"
}
#here comes the actions submenu if more then 3 extra actions are defined. We add all the core actions here, plugins can add actions later, and after plugins are done we chack how much actions there are. If more then 3, the submenu is added, esle, all acitons are copied in the root menu over here.
set actions .user_menu.actionssubmenu
if {[winfo exists $actions]} { destroy $actions }
menu $actions -tearoff 0 -type normal
if {[::MSN::userIsNotIM ${user_login}] } {
$actions add command -label "[trans addtocontacts]" \
-command "::MSN::addUser ${user_login}"
} else {
#add mobile if it's not already the default action
# mobile is default when offline and a mobile account is set up
if {$mobile == 1 && $statecode != "FLN"} {
$actions add command -label "[trans sendmobmsg]" \
-command "::MSNMobile::OpenMobileWindow ${user_login}"
}
#add e-mail if it's not already the default action
# e-mail is default when offline and no mobile account set up
if { !($mobile != 1 && $statecode == "FLN")} {
$actions add command -label "[trans sendmail]" \
-command "launch_mailer $user_login"
}
}
#view profile action
.user_menu add command -label "[trans viewprofile]" \
-command "::hotmail::viewProfile [list ${user_login}]"
#-----------------------
.user_menu add separator
#The url-actions
set the_nick [::abook::getNick ${user_login}]
set the_psm [::abook::getpsmmedia $user_login]
#parse nick and PSM in the same time.
set nickpsm "${the_nick} ${the_psm}"
set url_indices [urlParserString "$nickpsm"]
foreach match $url_indices {
set pos_start [lindex $match 0]
set pos [lindex $match 1 ]
set urltext [string range $nickpsm $pos_start $pos]
.user_menu add command -label "[trans goto ${urltext} ] " \
-command "launch_browser [list $urltext]"
.user_menu add command -label "[trans copytoclipboard \"${urltext}\"]" \
-command "clipboard clear;clipboard append \"${urltext}\""
#end with a separator:
#-----------------------
.user_menu add separator
}
#chat history
.user_menu add command -label "[trans history]" \
-command "::log::OpenLogWin ${user_login}"
#webcam history
.user_menu add command -label "[trans webcamhistory]" \
-command "::log::OpenCamLogWin ${user_login}"
#-----------------------
.user_menu add separator
if {![::MSN::userIsNotIM ${user_login}] } {
#block/unblock
if {$blocked == 0} {
.user_menu add command -label "[trans block]" -command "::amsn::blockUser ${user_login}"
} else {
.user_menu add command -label "[trans unblock]" \
-command "::amsn::unblockUser ${user_login}"
}
}
#move/copy
::groups::updateMenu menu .user_menu.move_group_menu ::groups::menuCmdMove [list $grId $user_login]
::groups::updateMenu menu .user_menu.copy_group_menu ::groups::menuCmdCopy $user_login
#check if user is in a virtual group
set grIdV 1
foreach group [::guiContactList::getGroupList 1] {
if { [lindex $group 0] == $grId } {
set grIdV 0
break
}
}
if {$grIdV} {
.user_menu add cascade -label "[trans movetogroup]" -state disabled
.user_menu add cascade -label "[trans copytogroup]" -state disabled
.user_menu add command -label "[trans removefromgroup]" -state disabled
} else {
.user_menu add cascade -label "[trans movetogroup]" -menu .user_menu.move_group_menu
#you may not copy a contact from "no group" to a normal group
if { $grId == 0 } {
.user_menu add cascade -label "[trans copytogroup]" -state disabled
.user_menu add command -label "[trans removefromgroup]" -state disabled
} else {
.user_menu add cascade -label "[trans copytogroup]" -menu .user_menu.copy_group_menu
.user_menu add command -label "[trans removefromgroup]" -command [list ::amsn::removeUserFromGroup $user_login $grId]
}
}
#delete, if in a normal group, only from current group, otherwise from all groups and FL
.user_menu add command -label "[trans delete]" -command [list ::amsn::deleteUser $user_login]
#-----------------------
.user_menu add separator
.user_menu add command -label "[trans cfgalarm]" -command "::abookGui::showUserProperties $user_login; .user_[::md5::md5 $user_login]_prop.nb raise alarms"
.user_menu add command -label "[trans properties]" \
-command "::abookGui::showUserProperties $user_login"
# PostEvent 'right_menu'
set evPar(menu_name) .user_menu
set evPar(user_login) ${user_login}
::plugins::PostEvent right_menu evPar
#check if the actions-submenu contains 3 or more items. If not, add those items to the root menu.
set nrofactions [$actions index end]
#index starts counting at 0, this means "less then 3 items"
set start [expr [.user_menu index $first] + 1]
if {$nrofactions < 2 } {
for {set i 0} {$i <= $nrofactions} {incr i} {
eval .user_menu insert $start [$actions type $i]
foreach option [$actions entryconfigure $i] {
#FIXME #why is the value the last item in this list ?
.user_menu entryconfigure $start [lindex $option 0] [lindex $option end]
}
incr start
}
} elseif { $nrofactions == "none"} {
#menu is empty
} else {
#3 or more actions are defines, add the submenu
.user_menu insert $start cascade -label "[trans moreactions]" -menu $actions
}
kill_balloon
tk_popup .user_menu $x $y
}
#///////////////////////////////////////////////////////////////////////
proc run_command_otherwindow { command } {
set tmp [.otherwindow.email get]
if { $tmp != "" } {
eval $command [list $tmp]
destroy .otherwindow
}
}
#///////////////////////////////////////////////////////////////////////
proc BossMode { } {
global bossMode BossMode
if { [info exists bossMode] == 0 } {
set bossMode 0
}
if { $bossMode == 0 } {
set children [winfo children .]
if { [catch { toplevel .bossmode } ] } {
set bossMode 0
set children ""
} else {
wm title .bossmode "[trans pass]"
label .bossmode.passl -text "[trans pass]"
entry .bossmode.pass -show "*" -validate key -vcmd {expr {[string length %P]<=16} }
pack .bossmode.passl .bossmode.pass -side left
#updatebossmodetime
bind .bossmode.pass <Return> "BossMode"
if { [WinDock] } {
wm state .bossmode withdraw
wm protocol .bossmode WM_DELETE_WINDOW "wm state .bossmode withdraw"
catch {wm iconbitmap .bossmode [::skin::GetSkinFile winicons bossmode.ico]}
} else {
wm protocol .bossmode WM_DELETE_WINDOW "BossMode"
}
statusicon_proc "BOSS"
}
foreach child $children {
if { "$child" == ".bossmode" } {continue}
if { [catch { wm state "$child" } res ] } {
status_log "$res\n"
continue
}
if { [wm overrideredirect "$child"] == 0 } {
set BossMode($child) [wm state "$child"]
wm state "$child" normal
wm state "$child" withdraw
}
}
if { "$children" != "" } {
set BossMode(.) [wm state .]
wm state . normal
wm state . withdraw
set bossMode 1
}
} elseif { $bossMode == 1 && [winfo exists .bossmode]} {
if { [.bossmode.pass get] != [set ::password] } {
return
}
set children [winfo children .]
foreach child $children {
if { [catch { wm state "$child" } res ] } {
status_log "$res\n"
continue
}
if { "$child" == ".bossmode" } {continue}
if { [wm overrideredirect "$child"] == 0 } {
wm state "$child" normal
if { [info exists BossMode($child)] } {
wm state "$child" "$BossMode($child)"
}
}
}
wm state . normal
if { [info exists BossMode(.)] } {
wm state . $BossMode(.)
}
set bossMode 0
destroy .bossmode
statusicon_proc [::MSN::myStatusIs]
}
}
proc updatebossmodetime { } {
.bossmode.time configure -text "[string map { \" "" } [clock format [clock seconds] -format \"%T\"]]"
#" Just to fix some editors syntax hilighting
after 1000 updatebossmodetime
}
proc window_history { command w } {
global win_history
set HISTMAX 100
set new [info exists win_history(${w}_count)]
catch {
if { [winfo class $w] == "Text" } {
set zero 0.0
} else {
set zero 0
}
}
switch $command {
add {
if { [winfo class $w] == "Text" } {
set msg "[$w get 0.0 end-1c]"
} else {
set msg "[$w get]"
}
if { $msg != "" } {
if { $new } {
set idx $win_history(${w}_count)
} else {
set idx 0
}
if { $idx == $HISTMAX } {
set win_history(${w}) [lrange $win_history(${w}) 1 end]
lappend win_history(${w}) "$msg"
set win_history(${w}_index) $HISTMAX
return
}
set win_history(${w}_count) [expr {$idx + 1}]
set win_history(${w}_index) [expr {$idx + 1}]
# set win_history(${w}_${idx}) "$msg"
lappend win_history(${w}) "$msg"
}
}
clear {
if {! $new } { return -1}
# foreach histories [array names win_history] {
# if { [string match "${w}*" $histories] } {
# unset win_history($histories)
# }
# }
catch {
unset win_history(${w}_count)
unset win_history(${w}_index)
unset win_history(${w})
unset win_history(${w}_temp)
}
}
previous {
if {! $new } { return -1}
set idx $win_history(${w}_index)
if { $idx == 0 } { return -1}
if { $idx == $win_history(${w}_count) } {
if { [winfo class $w] == "Text" } {
set msg "[$w get 0.0 end-1c]"
} else {
set msg "[$w get]"
}
set win_history(${w}_temp) "$msg"
}
incr idx -1
set win_history(${w}_index) $idx
$w delete $zero end
# $w insert $zero "$win_history(${w}_${idx})"
$w insert $zero "[lindex $win_history(${w}) $idx]"
}
next {
if {! $new } { return -1}
set idx $win_history(${w}_index)
if { $idx == $win_history(${w}_count) } { return -1}
incr idx
set win_history(${w}_index) $idx
$w delete $zero end
# if {! [info exists win_history(${w}_${idx})] } { }
if { $idx == $win_history(${w}_count) } {
$w insert $zero "$win_history(${w}_temp)"
} else {
# $w insert $zero "$win_history(${w}_${idx})"
$w insert $zero "[lindex $win_history(${w}) $idx]"
}
}
}
}
########################################################################
#### ALL ABOUT CONVERTING AND CHOOSING DISPLAY PICTURES
########################################################################
# Converts the given $filename to the given size, and leaves
# xx.png and xxx.gif in the given destination directory
proc convert_image { filename destdir size } {
set filetail [file tail $filename]
set filetail_noext [filenoext $filetail]
set tempfile [file join $destdir $filetail]
set destfile [file join $destdir $filetail_noext]
if { ![file exists $filename] } {
status_log "Tring to convert file $filename that does not exist\n" error
return ""
}
if { [catch {::picture::IsAnimated $filename} res] } {
#The image is surely bad so don't try to load it maybe a bad FT
#I don't think we should warn the user : annoying when it's due to bad DP of a contact
status_log $res
return
}
if { $res } {
#We are animated so we just convert it
status_log "converting animation $filename to $tempfile\n"
if {[catch {::picture::Convert $filename ${destfile}.png} res]} {
msg_box $res
return
}
} else {
status_log "converting $filename to $tempfile with size $size\n"
#Separe the size X and Y in 2 variables
set sizexy [split $size "x" ]
if { [lindex $sizexy 1] == "" } {
set sizex [lindex $sizexy 0]
set sizey [lindex $sizexy 0]
} else {
set sizex [lindex $sizexy 0]
set sizey [lindex $sizexy 1]
}
#Create img from the file
if {[catch {set img [image create photo [TmpImgName] -file $filename -format cximage]} res]} {
#If there's an error, it means the filename is corrupted, remove it
catch { file delete $filename }
catch { file delete [filenoext $filename].dat }
#As the image couldn't ne loaded we can't destroy it :)
return
}
#Resize with ratio
if {[catch {::picture::ResizeWithRatio $img $sizex $sizey} res]} {
image delete $img
msg_box $res
return
}
#Save in PNG
if {[catch {::picture::Save $img ${destfile}.png cxpng} res]} {
image delete $img
msg_box $res
return
}
image delete $img
}
return ${destfile}.png
}
proc convert_image_plus { filename type size } {
global HOME
catch { create_dir [file join $HOME $type]}
return [convert_image $filename [file join $HOME $type] $size]
}
proc load_my_pic { } {
global pgBuddyTop
if { [::config::getKey displaypic] == "" } {
::config::setKey displaypic nopic.gif
}
set dpfilename [PathRelToAbs [::config::getKey displaypic]]
status_log "load_my_pic: Trying to set display picture $dpfilename\n" blue
if {[file readable [::skin::GetSkinFile displaypic $dpfilename]]} {
if { ![catch {image create photo displaypicture_std_self -file "[::skin::GetSkinFile displaypic $dpfilename]" -format cximage}] } {
load_my_smaller_pic
} else {
# Image corrupted on disk
catch {image delete $dpfilename}
::config::setKey displaypic nopic.gif
}
} else {
status_log "load_my_pic: Picture not found!!\n" red
clear_disp
}
}
#Create a smaller display picture from the bigger one
proc load_my_smaller_pic {} {
if { [ImageExists displaypicture_not_self]} {
displaypicture_not_self blank
}
image create photo displaypicture_not_self -format cximage
if { [catch {displaypicture_not_self copy displaypicture_std_self}] } {
displaypicture_not_self copy [::skin::getNoDisplayPicture]
}
::picture::ResizeWithRatio displaypicture_not_self 50 50
}
proc clear_disp { } {
global pgBuddyTop
::config::setKey displaypic nopic.gif
if { [catch {image create photo displaypicture_std_self -file "[::skin::GetSkinFile displaypic nopic.gif]" -format cximage}] } {
image create photo displaypicture_std_self
}
load_my_smaller_pic
}
proc pictureBrowser {} {
dpBrowser
}
proc dpBrowser { {target_user "self" } } {
global HOME
package require dpbrowser
set w .dpbrowser
#if it already exists, create the window, otherwise, raise it
if { [winfo exists $w] } {
raise $w
return
}
toplevel $w
wm minsize $w 480 10
wm title $w "[trans picbrowser]"
#Get all the contacts
set contact_list [list]
foreach contact [::abook::getAllContacts] {
#Selects the contacts who are in our list and adds them to the contact_list
if {[string last "FL" [::abook::getContactData $contact lists]] != -1} {
lappend contact_list $contact
}
}
#Sorts contacts
set contactlist [lsort -dictionary $contact_list]
# Select current DP (custom or not) for target user
if { $target_user != "self" } {
if { [::abook::getContactData $target_user customdp ""] != "" } {
set image_name [::abook::getContactData $target_user customdp ""]
} else {
set image_name [::abook::getContactData $target_user displaypicfile ""]
}
if {$image_name != ""} {
set selected_path [file join $HOME displaypic cache $target_user [filenoext $image_name].png]
} else {
set selected_path ""
}
} else {
set selected_path [displaypicture_std_self cget -file]
}
################
# First column #
################
frame $w.leftpane
frame $w.leftpane.mydpstitle -bd 0
label $w.leftpane.mydpstitle.text -text "[trans mypics]:" -font bboldf
#clear cache button ?
pack $w.leftpane.mydpstitle.text -side left
frame $w.leftpane.moredpstitle -bd 0
label $w.leftpane.moredpstitle.text -text "[trans cachedpicsfor]:" -font bboldf
#combobox to choose user which configures the widget with -user $user
set combo $w.leftpane.moredpstitle.combo
combobox::combobox $combo -highlightthickness 0 -width 22 -font splainf -exportselection true -command "configureDpBrowser $target_user" -editable false
$combo list delete 0 end
$combo list insert end "[trans selectcontact]"
set i 1
foreach contact $contactlist {
#put the name of the device in the widget
$combo list insert end $contact
if {$contact == $target_user} {
set selection $i
}
incr i
}
$combo list insert end "[trans otherdps]"
# If we are choosing a custom DP for a contact, show his cache in the lower pane
if {$target_user == "self"} {
catch {$combo select 0}
set selected_user ""
} else {
catch {$combo select $selection}
set selected_user $target_user
}
pack $w.leftpane.moredpstitle.text -side left
pack $w.leftpane.moredpstitle.combo -side right
::dpbrowser $w.leftpane.mydps -width 3 -mode "both" -invertmatch 0 -firstselect $selected_path \
-command [list updateDpBrowserSelection $w.leftpane.mydps $target_user] -user self
::dpbrowser $w.leftpane.moredps -width 3 -mode "both" -invertmatch 0 -firstselect $selected_path \
-command [list updateDpBrowserSelection $w.leftpane.moredps $target_user] -user $selected_user
#################
# second column #
#################
frame $w.rightpane
#preview
label $w.rightpane.dppreviewtxt -text "[trans preview]:"
if { $selected_path == "" || [catch {image create photo displaypicture_pre_$target_user -file $selected_path -format cximage}] } {
image create photo displaypicture_pre_$target_user -file [[::skin::getNoDisplayPicture] cget -file] -format cximage
}
label $w.rightpane.dppreview -image displaypicture_pre_$target_user
#browse button
button $w.rightpane.browsebutton -command "pictureChooseFile $target_user" -text "[trans browse]..."
#under this button is space for more buttons we'll make a frame for so plugins can pack stuff in this frame
frame $w.rightpane.pluginsframe -bd 0
set evPar(target) $target_user
set evPar(win) $w.rightpane.pluginsframe
::plugins::PostEvent xtra_choosepic_buttons evPar
#################
# lower pane #
#################
frame $w.lowerpane -bd 0
button $w.lowerpane.ok -text "[trans ok]" -command "applyDP $target_user;destroy $w"
button $w.lowerpane.cancel -text "[trans cancel]" -command "destroy .dpbrowser"
#################
# packing #
#################
pack $w.lowerpane.ok $w.lowerpane.cancel -side right -padx 5
pack $w.lowerpane -side bottom -fill x
pack $w.rightpane.dppreviewtxt $w.rightpane.dppreview $w.rightpane.browsebutton $w.rightpane.pluginsframe -fill x
pack $w.rightpane -side right -fill y
pack $w.leftpane.mydpstitle -fill x
pack $w.leftpane.mydps -expand true -fill both
pack $w.leftpane.moredpstitle -fill x
pack $w.leftpane.moredps -expand true -fill both
pack $w.leftpane -side left -fill both -expand true
bind $w.rightpane.dppreview <Destroy> "catch { image delete displaypicture_pre_$target_user }"
}
proc configureDpBrowser {target combowidget selection} {
set invert_match 0
if {$selection == "[trans selectcontact]"} {
set selection ""
}
if {$selection == "[trans otherdps]"} {
#Get all the contacts
set contact_list [list]
foreach contact [::abook::getAllContacts] {
#Selects the contacts who are in our list and adds them to the contact_list
if {[string last "FL" [::abook::getContactData $contact lists]] != -1} {
lappend contact_list $contact
}
}
set invert_match 1
set selection $contact_list
}
[winfo toplevel $combowidget].leftpane.moredps configure -invertmatch $invert_match -user $selection
}
# This procedure is called back from the dpbrowser pane when a picture is selected
proc updateDpBrowserSelection { browser target } {
set w [winfo toplevel $browser]
set file [lindex [$browser getSelected] 1]
set old_image [$w.rightpane.dppreview cget -image]
$w.rightpane.dppreview configure -image ""
catch {image delete $old_image}
if {$file == ""} {
set file [[::skin::getNoDisplayPicture] cget -file]
}
$w.rightpane.dppreview configure -image [image create photo displaypicture_pre_$target -file $file -format cximage]
if {"$browser" == "$w.leftpane.mydps"} {
$w.leftpane.moredps deSelect
} else {
$w.leftpane.mydps deSelect
}
}
#proc chooseFileDialog {basename {initialfile ""} {types {{"All files" *}} }} {}
proc chooseFileDialog { {initialfile ""} {title ""} {parent ""} {entry ""} {operation "open"} {types {{ "All Files" {*} }} }} {
if { $parent == "" || ![winfo exists $parent] } {
catch {set parent [focus]}
if { $parent == "" } {
set parent "."
}
}
global starting_dir
if { ![file isdirectory $starting_dir] } {
set starting_dir [pwd]
}
if { $operation == "open" } {
if {![file exists $initialfile]} {
set initialfile ""
}
set selfile [tk_getOpenFile -filetypes $types -parent $parent -initialdir $starting_dir -initialfile $initialfile -title $title]
} else {
set selfile [tk_getSaveFile -filetypes $types -parent $parent -initialdir $starting_dir -initialfile $initialfile -title $title]
}
if { $selfile != "" } {
#Remember last directory
set starting_dir [file dirname $selfile]
if { $entry != "" } {
$entry delete 0 end
$entry insert 0 $selfile
# Next line has caused some problems with an old Tile version
catch { $entry xview end }
}
}
return $selfile
}
proc pictureChooseFile { target } {
set file [chooseFileDialog "" "" "" "" open [list [list [trans imagefiles] [list *.gif *.GIF *.jpg *.JPG *.jpeg *.JPEG *.bmp *.BMP *.png *.PNG]] [list [trans allfiles] *]]]
setDPFromFile $target $file
}
proc setDPFromFile { target file } {
global HOME
if { $file != "" } {
set convertsize "96x96"
if { [catch {::picture::GetPictureSize $file} cursize] } {
status_log "Error opening $file: $cursize\n"
msg_box $cursize
return ""
}
if { $cursize != "96x96" && ![::picture::IsAnimated $file] } {
set convertsize [AskDPSize $cursize]
}
if { ![catch {convert_image_plus $file displaypic $convertsize} res]} {
if {![winfo exists .dpbrowser]} {
dpBrowser
}
image create photo displaypicture_pre_$target -file [::skin::GetSkinFile "displaypic" "[filenoext [file tail $file]].png"] -format cximage
.dpbrowser.rightpane.dppreview configure -image displaypicture_pre_$target
set desc_file "[filenoext [file tail $file]].dat"
set fd [open [file join $HOME displaypic $desc_file] w]
status_log "Writing description to $desc_file\n"
# puts $fd "[clock format [clock seconds] -format %x]\n[filenoext [file tail $file]].png"
puts $fd "[clock seconds]\n[filenoext [file tail $file]].png"
close $fd
# Redraw dpBrowser's upper pane
.dpbrowser.leftpane.mydps configure -user self
return "[filenoext [file tail $file]].png"
} else {
status_log "Error converting $file: $res\n"
}
}
return ""
}
#Window created to choose if we should use another size (other than 96x96) for display picture
proc AskDPSize { cursize } {
global done dpsize
if {[winfo exists .askdpsize]} {
return "96x96"
}
toplevel .askdpsize
set dpsize "96x96"
set done 0
label .askdpsize.lwhatsize -text [trans whatsize] -font splainf
frame .askdpsize.rb
radiobutton .askdpsize.rb.retain -text [trans original] -value $cursize -variable dpsize
radiobutton .askdpsize.rb.huge -text [trans huge] -value "192x192" -variable dpsize
radiobutton .askdpsize.rb.large -text [trans large] -value "128x128" -variable dpsize
radiobutton .askdpsize.rb.default -text [trans default2] -value "96x96" -variable dpsize
radiobutton .askdpsize.rb.small -text [trans small] -value "64x64" -variable dpsize
button .askdpsize.okb -text [trans ok] -command "set done 1" -default active
button .askdpsize.cancelb -text [trans cancel] -command "destroy .askdpsize" -default normal
pack .askdpsize.lwhatsize -side top -anchor w -pady 10 -padx 10
pack .askdpsize.rb.retain -side top -anchor w
pack .askdpsize.rb.huge -side top -anchor w
pack .askdpsize.rb.large -side top -anchor w
pack .askdpsize.rb.default -side top -anchor w
pack .askdpsize.rb.small -side top -anchor w
pack .askdpsize.rb -side top -padx 10 -pady 10
pack .askdpsize.okb .askdpsize.cancelb -side right -padx 10
wm title .askdpsize [trans displaypic]
moveinscreen .askdpsize 30
vwait done
destroy .askdpsize
status_log "User requested pic size $dpsize\n"
return $dpsize
}
proc applyDP { { email "self" } } {
set file ""
catch {set file [displaypicture_pre_$email cget -file]}
if { $file == [[::skin::getNoDisplayPicture] cget -file] } {
# Some skin add a dat file for nopic.gif too, so it's selectable
# Check this is not the case
if {[lindex [.dpbrowser.leftpane.mydps getSelected] 1] == ""} {
set file ""
}
}
set_displaypic $file $email
}
proc set_displaypic { file { email "self" } } {
if { $email == "self" } {
if { $file != "" } {
::config::setKey displaypic $file
status_log "set_displaypic: File set to $file\n" blue
load_my_pic
::MSN::changeStatus [set ::MSN::myStatus]
save_config
} else {
status_log "set_displaypic: Setting displaypic to [::skin::getNoDisplayPicture]\n" blue
clear_disp
::MSN::changeStatus [set ::MSN::myStatus]
}
::MSN::updateDP
} else {
global customdp_$email
set customdp_$email $file
}
}
proc saveFile {filename} {
set name [file tail $filename]
set newfilename [chooseFileDialog "$name" "[trans save]" "" "" save]
catch {file copy $filename $newfilename}
}
###################### Protocol Debugging ###########################
if { $initialize_amsn == 1 } {
global degt_protocol_window_visible degt_command_window_visible
set degt_protocol_window_visible 0
set degt_command_window_visible 0
}
proc hexify_all { str } {
set out ""
for {set i 0} { $i < [string length $str] } { incr i} {
set c [string range $str $i $i]
binary scan $c H* h
append out "\[$h\]"
}
set out
}
proc hexify { str } {
set out ""
for {set i 0} { $i < [string length $str] } { incr i} {
set c [string range $str $i $i]
if {[string is ascii $c] && (![string is control $c] || $c == "\r" || $c == "\n") } {
append out $c
} else {
binary scan $c H* h
append out "\[$h\]"
}
}
set out
}
proc hexify_c { str } {
set out "{"
for {set i 0} { $i < [string length $str] } { incr i} {
set c [string range $str $i $i]
binary scan $c H* h
append out "0x$h"
if {[expr {$i+1}] < [string length $str] } {
append out ","
if {[expr {$i % 4}] == 3} {
append out "\n"
} else {
append out " "
}
}
}
append out "}"
set out
}
proc unhexify { str } {
set out ""
for { set i 0 } { $i < [string length $str] } { incr i } {
if {[string range $str $i $i] == "\[" &&
[string length $str] > [expr {$i + 3}] &&
[string range $str [expr {$i + 3}] [expr {$i + 3}]] == "\]" } {
set d1 [string range $str [expr {$i + 1}] [expr {$i + 1}]]
set d2 [string range $str [expr {$i + 2}] [expr {$i + 2 }]]
if {([string is digit $d1] || $d1 == "a" || $d1 == "b" ||
$d1 == "c" || $d1 == "d" || $d1 == "e" || $d1 == "f") ||
([string is digit $d2] || $d2 == "a" || $d2 == "b" ||
$d2 == "c" || $d2 == "d" || $d2 == "e" || $d2 == "f")} {
append out [binary format H* "${d1}${d2}"]
incr i 3
} else {
append out "\[${d1}${d2}\]"
}
} else {
append out [string range $str $i $i]
}
}
return $out
}
proc degt_protocol { str {colour ""}} {
global followtext_degt
# return
.degt.mid.txt insert end "[timestamp] [hexify $str]\n" $colour
.degt.mid.txt delete 0.0 end-1000lines
if { $followtext_degt == 1} {
.degt.mid.txt yview end
}
}
proc degt_protocol_win_toggle {} {
global degt_protocol_window_visible
if { $degt_protocol_window_visible } {
wm state .degt withdraw
set degt_protocol_window_visible 0
} else {
wm state .degt normal
set degt_protocol_window_visible 1
raise .degt
}
}
proc degt_protocol_win { } {
global followtext_degt
set followtext_degt 1
toplevel .degt
wm title .degt "MSN Protocol Debug"
wm iconname .degt "MSNProt"
wm state .degt withdraw
frame .degt.top -class Degt
label .degt.top.name -text "Protocol" -justify left -font sboldf
pack .degt.top.name -side left -anchor w
#font create debug -family Verdana -size 24 -weight bold
frame .degt.mid -class Degt
text .degt.mid.txt -height 20 -width 85 -font splainf \
-wrap none -background white -foreground black \
-yscrollcommand ".degt.mid.sy set" \
-xscrollcommand ".degt.mid.sx set"
scrollbar .degt.mid.sy -command ".degt.mid.txt yview"
scrollbar .degt.mid.sx -orient horizontal -command ".degt.mid.txt xview"
.degt.mid.txt tag configure error -foreground #ff0000
.degt.mid.txt tag configure nssend -foreground #888888
.degt.mid.txt tag configure nsrecv -foreground #000000
.degt.mid.txt tag configure sbsend -foreground #006666
.degt.mid.txt tag configure sbrecv -foreground #000088
.degt.mid.txt tag configure msgcontents -foreground #004400
.degt.mid.txt tag configure red -foreground red
.degt.mid.txt tag configure white -foreground white -background black
.degt.mid.txt tag configure blue -foreground blue
pack .degt.mid.sy -side right -fill y
pack .degt.mid.sx -side bottom -fill x
pack .degt.mid.txt -anchor nw -expand true -fill both
pack .degt.mid -expand true -fill both
checkbutton .degt.follow -text "[trans followtext]" -onvalue 1 -offvalue 0 -variable followtext_degt -font sboldf
frame .degt.bot -relief sunken -borderwidth 1 -class Degt
button .degt.bot.save -text [trans savetofile] -command degt_protocol_save
button .degt.bot.clear -text [trans clear] \
-command ".degt.mid.txt delete 0.0 end"
button .degt.bot.close -text [trans close] -command degt_protocol_win_toggle
pack .degt.bot.save .degt.bot.close .degt.bot.clear -side left
pack .degt.top .degt.mid .degt.follow .degt.bot -side top
wm protocol .degt WM_DELETE_WINDOW { degt_protocol_win_toggle }
}
proc degt_ns_command_win_toggle {} {
global degt_command_window_visible
if { $degt_command_window_visible } {
wm state .nscmd withdraw
set degt_command_window_visible 0
} else {
wm state .nscmd normal
set degt_command_window_visible 1
}
}
proc degt_protocol_save { } {
set w .protocol_save
toplevel $w
wm title $w [trans savetofile]
label $w.msg -justify center -text [trans enterfilename]
pack $w.msg -side top
frame $w.buttons -class Degt
pack $w.buttons -side bottom -fill x -pady 2m
button $w.buttons.dismiss -text [trans cancel] -command "destroy $w"
button $w.buttons.save -text [trans save] -command "degt_protocol_save_file $w.filename.entry; destroy $w"
pack $w.buttons.save $w.buttons.dismiss -side left -expand 1
frame $w.filename -bd 2 -class Degt
entry $w.filename.entry -relief sunken -width 40
label $w.filename.label -text "[trans filename]:"
pack $w.filename.entry -side right
pack $w.filename.label -side left
pack $w.msg $w.filename -side top -fill x
focus $w.filename.entry
chooseFileDialog "protocol_log.txt" "" $w $w.filename.entry save
catch {grab $w}
}
proc degt_protocol_save_file { filename } {
set fd [open [${filename} get] a+]
fconfigure $fd -encoding utf-8
puts $fd "[.degt.mid.txt get 0.0 end]"
close $fd
}
# Ctrl-M to toggle raise/hide. This window is for developers only
# to issue commands manually to the Notification Server
proc degt_ns_command_win {} {
if {[winfo exists .nscmd]} {
return
}
toplevel .nscmd
wm title .nscmd "MSN Command"
wm iconname .nscmd "MSNCmd"
wm state .nscmd withdraw
frame .nscmd.f -class Degt
label .nscmd.f.l -text "NS Command:" -font bboldf
entry .nscmd.f.e -width 20
pack .nscmd.f.l .nscmd.f.e -side left
pack .nscmd.f
bind .nscmd.f.e <Return> {
set cmd [string trim [.nscmd.f.e get]]
if { [string length $cmd] > 0 } {
# There is actually a command typed. If %T found in
# the string replace it by a transaction ID
set nsclst [split $cmd]
set nscmd [lindex $nsclst 0]
set nspar [lreplace $nsclst 0 0]
# Send command to the Notification Server
::MSN::WriteSB ns $nscmd $nspar
}
}
wm protocol .nscmd WM_DELETE_WINDOW { degt_ns_command_win_toggle }
}
namespace eval ::OIM_GUI {
#Most of this code is from the MSNMobile namespace from protocol.tcl
#TODO:
# * fix all pending bugs !
namespace export IsOIM MessageSend MessagesReceived OpenOIMWindow
#TODO:when we write a message to a CW, it should do the same as WLM, try to open an SB, if the CAL answer is 207 (user is offline, cannot join chat), then send the OIM
#use a list of such users ......
#Have a look at proc chatUser (gui.tcl, ~2540)
proc IsOIM {user} {
if {[::abook::getVolatileData $user state] == "FLN" && ![::MSN::chatReady [GetChatId $user]] } {
return 1
} else {
return 0
}
}
proc MessageSendCallback { chatid error } {
if {![string match *success* $error]} {
::amsn::WinWriteFail $chatid "([trans $error])"
}
}
proc MessageSend { chatid txt } {
set email $chatid
status_log "sending OIM to $chatid" green
if { ![info exists ::OIM_GUI::oim_asksend_[string map {: _} ${chatid} ] ] } {
set ::OIM_GUI::oim_asksend_[string map {: _} ${chatid} ] 1
}
# should fix issue with automessages from alarms since the window is
# not yet created and the user has just gone offline
# in that case, should we send the message ? ask to send the message ?
# for the moment we send it without asking
set window [::ChatWindow::For $chatid]
if {[config::getKey no_oim_confirmation 0] == 0 &&
[set ::OIM_GUI::oim_asksend_[string map {: _} ${chatid} ]] &&
$window != 0} {
set answer [::amsn::messageBox [trans asksendoim] yesno question "" $window]
} else {
set answer "yes"
}
if { $answer == "yes"} {
set ::OIM_GUI::oim_asksend_[string map {: _} ${chatid} ] 0
::MSNOIM::sendOIMMessage [list ::OIM_GUI::MessageSendCallback $chatid] $email $txt
}
return $answer
}
proc deleteOIMCallback {oim_messages success} {
if { $success == 0 } {
status_log "\[OIM\]Unable to delete messages for OIMs : $oim_messages" white
} else {
status_log "\[OIM\]Successfully deleted OIMs : $oim_messages" green
}
}
proc MessagesReceivedCallback { oim_messages email nick MsgId oimlist oim_message } {
if { $oim_message == "" } {
status_log "\[OIM\]Unable to fetch message from $nick <$email>; MsgId is $MsgId"
} else {
lappend oimlist $oim_message
}
if { [llength $oim_messages] > 0} {
foreach {email nick MsgId} [lindex $oim_messages 0] break
::MSNOIM::getOIMMessage [list ::OIM_GUI::MessagesReceivedCallback [lrange $oim_messages 1 end] $email $nick $MsgId $oimlist] $MsgId
} else {
#No more messages to grab
#oldest are first
set sorted_oims [lsort -command SortOIMs $oimlist]
set to_delete [list]
foreach oim_message $sorted_oims {
if { [DisplayOIM $oim_message] } {
lappend to_delete [lindex $oim_message 4]
}
}
if {[llength $to_delete] > 0 } {
::MSNOIM::deleteOIMMessage [list ::OIM_GUI::deleteOIMCallback $to_delete] $to_delete
}
}
}
proc MessagesReceived { oim_messages } {
if { [llength $oim_messages] > 0} {
foreach {email nick MsgId} [lindex $oim_messages 0] break
::MSNOIM::getOIMMessage [list ::OIM_GUI::MessagesReceivedCallback [lrange $oim_messages 1 end] $email $nick $MsgId [list]] $MsgId
}
}
#oldest are first
proc SortOIMs { oim1 oim2 } {
#an oim is [list $sequence $email $nick $body $mid $runId]
set seq1 [lindex $oim1 0]
set seq2 [lindex $oim2 0]
if {$seq1 > $seq2 } {
return 1
} elseif {$seq1 < $seq2 } {
return -1
} else {
#should never happen
return 0
}
}
proc DisplayOIM {oim_message} {
#an oim_message is [list $sequence $email $nick $body $mid $runId]
set user [lindex $oim_message 1]
set nick [lindex $oim_message 2]
set msg [lindex $oim_message 3]
set MsgId [lindex $oim_message 4]
set arrivalTime [lindex $oim_message 6]
set unixtimestamp 0
#convert the arrival time
set pos [string first . $arrivalTime]
incr pos -1
set arrivalTime [string range $arrivalTime 0 $pos]
set unixtimestamp [clock scan $arrivalTime -gmt 1]
set dateformat [string tolower [::config::getKey dateformat]]
set part1 [string index $dateformat 0 ]
set part2 [string index $dateformat 1 ]
set part3 [string index $dateformat 2 ]
if { [catch { set str "[ clock format $unixtimestamp -format "%$part1/%$part2/%$part3 %T"]"} ] } {
#the timestamp is maybe corrupted, don't display it
status_log "\[DisplayOIM\] timestamp = $timestamp seems corrupted, or ::config::getKey dateformat = [::config::getKey dateformat] is corrupted" white
set unixtimestamp 0
set tstamp ""
} else {
set tstamp [::config::getKey leftdelimiter]
append tstamp $str
append tstamp [::config::getKey rightdelimiter]
}
set chatid [GetChatId $user]
if { $chatid == 0 } {
if {$user == "" } {
return 0
}
# 1 means we want to display an OIM
::amsn::chatUser $user 1
#TODO: use the normal way to get the chatid
set chatid [GetChatId $user]
}
status_log "Writing offline msg \"$msg\" on : $chatid\n" red
set customchatstyle [::config::getKey customchatstyle]
switch [::config::getKey chatstyle] {
msn {
if {$unixtimestamp} {
set customchatstyle "\$tstamp [trans says \$nick]: \$newline"
} else {
set customchatstyle "[trans says \$nick]: \$newline"
}
}
irc {
if {$unixtimestamp} {
set customchatstyle "\$tstamp <\$nick> "
} else {
#timestamp is wrong
set customchatstyle "<\$nick> "
}
}
- {}
}
#By default, quote backslashes and variables
set customchatstyle [string map {"\\" "\\\\" "\$" "\\\$" "\(" "\\\(" } $customchatstyle]
#Now, let's unquote the variables we want to replace
set customchatstyle [string map { "\\\$nick" "\${nick}" "\\\$tstamp" "\${tstamp}" "\\\$newline" "\n" } $customchatstyle]
#Return the custom nick, replacing backslashses and variables
set customchatstyle [subst -nocommands $customchatstyle]
set custommsg "\n${customchatstyle}${msg}"
if { [::config::getKey disableuserfonts] } {
# If user wants incoming and outgoing messages to have the same font
set fontformat [::config::getKey mychatfont]
} elseif { [::config::getKey theirchatfont] != "" } {
# If user wants to specify a font for incoming messages (to override that user's font)
set fontformat [::config::getKey theirchatfont]
} else {
set fontformat ""
}
SendMessageFIFO [list ::amsn::WinWrite $chatid "$custommsg" user $fontformat] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
#We should add an event for sending message
#loging
if {[::abook::getKeepLogs $chatid]} {
::log::PutLog $chatid $nick $msg "" 0 $tstamp
}
return 1
}
proc OpenOIMWindow { user } {
set chatid [GetChatId $user]
status_log "opening chat window for offline messaging : $chatid\n" red
if { $chatid == 0 } {
set win [::ChatWindow::Open]
set chatid "$user"
::ChatWindow::SetFor $chatid $win
if { [winfo exists .bossmode] } {
set ::BossMode(${win_name}) "normal"
wm state $win withdraw
} else {
wm state $win normal
}
wm deiconify $win
} else {
set win [::ChatWindow::For $chatid]
if { [winfo exists .bossmode] } {
set ::BossMode(${win_name}) "normal"
wm state $win withdraw
} else {
wm state $win normal
}
wm deiconify $win
focus $win
}
}
proc GetChatId { user } {
set chatid $user
set win [::ChatWindow::For $chatid]
if {$win != 0 && [winfo exists $win] } {
return $chatid
} else {
return 0
}
}
}
#///////////////////////////////////////////////////////////////////////////////
# if a button has a -image, -relief flat but not -overrelief, it will actually be created as a label
# this is a workaround for platforms like macos and tileqt which have a problem with buttons (like
# not honouring "-relief flat" (tileqt) or not supporting alpha transparancy(macos))
# TODO: add a bind that works as -command on a button (mousebutton press, move away, release does not trigger)
# apply buttons2labels on Mac, because there seem to be problems with buttons there
# TODO: as soon as it is fixed in tk on mac, make it version-conditional
snit::widgetadaptor buttonlabel {
option -command -default ""
option -overrelief -default ""
option -repeatdelay -default ""
option -repeatinterval -default ""
option -default -default ""
delegate option * to hull
constructor {args} {
installhull using label
$self configurelist $args
bind $self <<Button1>> [list $self _LabelClicked]
}
method _LabelClicked { } {
return [$self invoke]
}
method invoke { } {
if {[$self cget -state] != "disabled" } {
eval $options(-command)
} else {
return ""
}
}
method flash { } {
}
}
proc buttons2labels { } {
if { [info commands ::tk::button2] == "" } {
rename button ::tk::button2
}
proc button { pathName args } {
array set options $args
if { [info exists options(-image)] &&
[info exists options(-relief)] && $options(-relief) == "flat" } {
eval buttonlabel [list $pathName] [array get options]
} else {
eval ::tk::button2 [list $pathName] $args
}
}
}
if { $initialize_amsn == 1 } {
if {[OnMac] } {
buttons2labels
}
}
|