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
|
{
Copyright 1998-2018 PasDoc developers.
This file is part of "PasDoc".
"PasDoc" is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
"PasDoc" is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with "PasDoc"; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
----------------------------------------------------------------------------
}
{ @abstract(defines all items that can appear within a Pascal unit's interface)
@created(11 Mar 1999)
@author(Johannes Berg <johannes@sipsolutions.de>)
@author(Ralf Junker (delphi@zeitungsjunge.de))
@author(Marco Schmidt (marcoschmidt@geocities.com))
@author(Michalis Kamburelis)
@author(Richard B. Winston <rbwinst@usgs.gov>)
@author(Damien Honeyford)
@author(Arno Garrels <first name.name@nospamgmx.de>)
For each item (type, variable, class etc.) that may appear in a Pascal
source code file and can thus be taken into the documentation, this unit
provides an object type which will store name, unit, description and more
on this item. }
unit PasDoc_Items;
{$I PasDoc_Defines.inc}
interface
uses
SysUtils,
PasDoc_Types,
PasDoc_StringVector,
PasDoc_ObjectVector,
PasDoc_Hashes,
Classes,
PasDoc_TagManager,
PasDoc_Serialize,
PasDoc_SortSettings,
PasDoc_StringPairVector,
PasDoc_Tokenizer;
type
{ Visibility of a field/method. }
TVisibility = (
{ indicates field or method is published }
viPublished,
{ indicates field or method is public }
viPublic,
{ indicates field or method is protected }
viProtected,
{ indicates field or method is strict protected }
viStrictProtected,
{ indicates field or method is private }
viPrivate,
{ indicates field or method is strict private }
viStrictPrivate,
{ indicates field or method is automated }
viAutomated,
{ implicit visibility, marks the implicit members if user
used @--implicit-visibility=implicit command-line option. }
viImplicit
);
TVisibilities = set of TVisibility;
const
VisibilityStr: array[TVisibility] of string[16] =
(
'published',
'public',
'protected',
'strict protected',
'private',
'strict private',
'automated',
'implicit'
);
AllVisibilities: TVisibilities = [Low(TVisibility) .. High(TVisibility)];
DefaultVisibilities: TVisibilities =
[viProtected, viPublic, viPublished, viAutomated];
type
{ Type of merging intf section and impl section metadata of an item }
TInfoMergeType = (
{ impl section is not scanned - default behavior }
imtNone,
{ data is taken from intf, if it's empty - from impl }
imtPreferIntf,
{ data is concatenated }
imtJoin,
{ data is taken from impl, if it's empty - from intf }
imtPreferImpl
);
const
InfoMergeTypeStr: array[TInfoMergeType] of string = (
'none',
'prefer-interface',
'join',
'prefer-implementation'
);
type
TPasCio = class;
TPasMethod = class;
TPasProperty = class;
TPasUnit = class;
TAnchorItem = class;
TBaseItems = class;
TPasItems = class;
TPasMethods = class;
TPasProperties = class;
TPasNestedCios = class;
TPasTypes = class;
TPasEnum = class;
{ Raw description, in other words: the contents of comment before
given item. Besides the content, this also
specifies filename, begin and end positions of given comment. }
TRawDescriptionInfo = record
{ This is the actual content the comment. }
Content: string;
// @name is the name of the TStream from which this comment was read.
// Will be '' if no comment was found. It will be ' ' if
// the comment was somehow read from more than one stream.
StreamName: string;
// @name is the position in the stream of the start of the comment.
BeginPosition: Int64;
// @name is the position in the stream of the character immediately
// after the end of the comment describing the item.
EndPosition: Int64;
end;
PRawDescriptionInfo = ^TRawDescriptionInfo;
{ This is a basic item class, that is linkable,
and has some @link(RawDescription). }
TBaseItem = class(TSerializable)
private
FDetailedDescription: string;
FFullLink: string;
FLastMod: string;
FName: string;
FAuthors: TStringVector;
FCreated: string;
FAutoLinkHereAllowed: boolean;
FRawDescriptionInfo: TRawDescriptionInfo;
procedure SetAuthors(const Value: TStringVector);
function GetRawDescription: string;
procedure WriteRawDescription(const Value: string);
procedure StoreAuthorTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure StoreCreatedTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure StoreLastModTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure StoreCVSTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure PreHandleNoAutoLinkTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure HandleNoAutoLinkTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
protected
{ Serialization of TPasItem need to store in stream only data
that is generated by parser. That's because current approach
treats "loading from cache" as equivalent to parsing a unit
and stores to cache right after parsing a unit.
So what is generated by parser must be written to cache.
That said,
@orderedList(
@item(
It will not break anything if you will accidentally store
in cache something that is not generated by parser.
That's because saving to cache will be done anyway right
after doing parsing, so properties not initialized by parser
will have their initial values anyway.
You're just wasting memory for cache, and some cache
saving/loading time.)
@item(
For now, in implementation of serialize/deserialize we try
to add even things not generated by parser in a commented out
code. This way if approach to cache will change some day,
we will be able to use this code.)
) }
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
public
constructor Create; override;
destructor Destroy; override;
{ It registers @link(TTag)s that init @link(Authors),
@link(Created), @link(LastMod) and remove relevant tags from description.
You can override it to add more handlers. }
procedure RegisterTags(TagManager: TTagManager); virtual;
{ Search for an item called ItemName @italic(inside this Pascal item).
For units, it searches for items declared
@italic(inside this unit) (like a procedure, or a class in this unit).
For classes it searches for items declared @italic(within this class)
(like a method or a property).
For an enumerated type, it searches for members of this enumerated type.
All normal rules of ObjectPascal scope apply, which means that
e.g. if this item is a unit, @name searches for a class named
ItemName but it @italic(doesn't) search for a method named ItemName
inside some class of this unit. Just like in ObjectPascal
the scope of identifiers declared within the class always
stays within the class. Of course, in ObjectPascal you can
qualify a method name with a class name, and you can also
do such qualified links in pasdoc, but this is not handled
by this routine (see @link(FindName) instead).
Returns nil if not found.
Note that it never compares ItemName with Self.Name.
You may want to check this yourself if you want.
Note that for TPasItem descendants, it always returns
also some TPasItem descendant (so if you use this method
with some TPasItem instance, you can safely cast result
of this method to TPasItem).
Implementation in this class always returns nil.
Override as necessary. }
function FindItem(const ItemName: string): TBaseItem; virtual;
{ This is just like @link(FindItem), but in case of classes
or such it should also search within ancestors.
In this class, the default implementation just calls FindItem. }
function FindItemMaybeInAncestors(const ItemName: string):
TBaseItem; virtual;
{ Do all you can to find link specified by NameParts.
While searching this tries to mimic ObjectPascal identifier scope
as much as it can. It seaches within this item,
but also within class enclosing this item,
within ancestors of this class,
within unit enclosing this item, then within units used by unit
of this item. }
function FindName(const NameParts: TNameParts): TBaseItem; virtual;
{ Detailed description of this item.
In case of TPasItem, this is something more elaborate
than @link(TPasItem.AbstractDescription).
This is already in the form suitable for final output,
ready to be put inside final documentation. }
property DetailedDescription: string
read FDetailedDescription write FDetailedDescription;
{ This stores unexpanded version (as specified
in user's comment in source code of parsed units)
of description of this item.
Actually, this is just a shortcut to
@code(@link(RawDescriptionInfo).Content) }
property RawDescription: string
read GetRawDescription write WriteRawDescription;
{ Full info about @link(RawDescription) of this item,
including it's filename and position.
This is intended to be initialized by parser.
This returns @link(PRawDescriptionInfo) instead of just
@link(TRawDescriptionInfo) to allow natural setting of
properties of this record
(otherwise @longCode(# Item.RawDescriptionInfo.StreamName := 'foo'; #)
would not work as expected) . }
function RawDescriptionInfo: PRawDescriptionInfo;
{ a full link that should be enough to link this item from anywhere else }
property FullLink: string read FFullLink write FFullLink;
{ Contains '' or string with date of last modification.
This string is already in the form suitable for final output
format (i.e. already processed by TDocGenerator.ConvertString). }
property LastMod: string read FLastMod write FLastMod;
{ name of the item }
property Name: string read FName write FName;
{ Returns the qualified name of the item.
This is intended to return a concise and not ambigous name.
E.g. in case of TPasItem it is overridden to return Name qualified
by class name and unit name.
In this class this simply returns Name. }
function QualifiedName: String; virtual;
{ list of strings, each representing one author of this item }
property Authors: TStringVector read FAuthors write SetAuthors;
{ Contains '' or string with date of creation.
This string is already in the form suitable for final output
format (i.e. already processed by TDocGenerator.ConvertString). }
property Created: string read FCreated;
{ Is auto-link mechanism allowed to create link to this item ?
This may be set to @false by @@noAutoLinkHere tag in item's description. }
property AutoLinkHereAllowed: boolean
read FAutoLinkHereAllowed write FAutoLinkHereAllowed default true;
{ The full (absolute) path used to resolve filenames in this item's descriptions.
Must always end with PathDelim.
In this class, this simply returns GetCurrentDir (with PathDelim added if needed). }
function BasePath: string; virtual;
end;
THintDirective = (hdDeprecated, hdPlatform, hdLibrary, hdExperimental);
THintDirectives = set of THintDirective;
{ This is a @link(TBaseItem) descendant that is always declared inside
some Pascal source file.
Parser creates only items of this class
(e.g. never some basic @link(TBaseItem) instance).
This class introduces properties and methods pointing
to parent unit (@link(MyUnit)) and parent class/interface/object/record
(@link(MyObject)). Also many other things not needed at @link(TBaseItem)
level are introduced here: things related to handling @@abstract tag,
@@seealso tag, used to sorting items inside (@link(Sort)) and some more. }
TPasItem = class(TBaseItem)
private
FAbstractDescription: string;
FAbstractDescriptionWasAutomatic: boolean;
FVisibility: TVisibility;
FMyEnum: TPasEnum;
FMyObject: TPasCio;
FMyUnit: TPasUnit;
FHintDirectives: THintDirectives;
FDeprecatedNote: string;
FFullDeclaration: string;
FSeeAlso: TStringPairVector;
FCachedUnitRelativeQualifiedName: string; //< do not serialize
FAttributes: TStringPairVector;
FParams: TStringPairVector;
FRaises: TStringPairVector;
procedure StoreAbstractTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure HandleDeprecatedTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure HandleSeeAlsoTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure StoreRaisesTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure StoreParamTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
function MyUnitName: String;
protected
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
{ This does the same thing as @link(FindName) but it @italic(doesn't)
scan other units. If this item is a unit, it searches only
inside this unit, else it searches only inside @link(MyUnit)
unit.
Actually @link(FindName) uses this function. }
function FindNameWithinUnit(const NameParts: TNameParts): TBaseItem; virtual;
public
constructor Create; override;
destructor Destroy; override;
function FindName(const NameParts: TNameParts): TBaseItem; override;
procedure RegisterTags(TagManager: TTagManager); override;
{ Abstract description of this item.
This is intended to be short (e.g. one sentence) description of
this object.
This will be inited from @@abstract tag in RawDescription,
or cutted out from first sentence in RawDescription
if @--auto-abstract was used.
Note that this is already in the form suitable for final output,
with tags expanded, chars converted etc. }
property AbstractDescription: string
read FAbstractDescription write FAbstractDescription;
(*
TDocGenerator.ExpandDescriptions sets this property to
true if AutoAbstract was used and AbstractDescription of this
item was automatically deduced from the 1st sentence of
RawDescription.
Otherwise (if @@abstract was specified explicitly, or there
was no @@abstract and AutoAbstract was false) this is set to false.
This is a useful hint for generators: it tells them that when they
are printing @italic(both) AbstractDescription and DetailedDescription of the item
in one place (e.g. TTexDocGenerator.WriteItemLongDescription
and TGenericHTMLDocGenerator.WriteItemLongDescription both do this)
then they should @italic(not) put any additional space between
AbstractDescription and DetailedDescription.
This way when user will specify description like
@longcode(#
{ First sentence. Second sentence. }
procedure Foo;
#)
and @--auto-abstract was on, then "First sentence." is the
AbstractDescription, " Second sentence." is DetailedDescription,
AbstractDescriptionWasAutomatic is true and
and TGenericHTMLDocGenerator.WriteItemLongDescription
can print them as "First sentence. Second sentence."
Without this property, TGenericHTMLDocGenerator.WriteItemLongDescription
would not be able to say that this abstract was deduced automatically
and would print additional paragraph break that was not present
in desscription, i.e. "First sentence.<p> Second sentence."
*)
property AbstractDescriptionWasAutomatic: boolean
read FAbstractDescriptionWasAutomatic
write FAbstractDescriptionWasAutomatic;
{ Returns true if there is a DetailedDescription or AbstractDescription
available. }
function HasDescription: Boolean;
function QualifiedName: String; override;
function UnitRelativeQualifiedName: string; virtual;
{ Unit of this item. }
property MyUnit: TPasUnit read FMyUnit write FMyUnit;
{ If this item is part of a class (or record, object., interface...),
the corresponding class is stored here. @nil otherwise. }
property MyObject: TPasCio read FMyObject write FMyObject;
{ If this item is a member of an enumerated type,
then the enclosing enumerated type is stored here. @nil otherwise. }
property MyEnum: TPasEnum read FMyEnum write FMyEnum;
property Visibility: TVisibility read FVisibility write FVisibility;
{ Hint directives specify is this item deprecated, platform-specific,
library-specific, or experimental. }
property HintDirectives: THintDirectives read FHintDirectives write FHintDirectives;
{ Deprecation note, specified as a string after "deprecated" directive.
Empty if none, always empty if @link(HintDirectives) does not
contain hdDeprecated. }
property DeprecatedNote: string
read FDeprecatedNote write FDeprecatedNote;
{ This recursively sorts all items inside this item,
and all items inside these items, etc.
E.g. in case of TPasUnit, this method sorts all variables,
consts, CIOs etc. inside (honouring SortSettings),
and also recursively calls Sort(SortSettings) for every CIO.
Note that this does not guarantee that absolutely everything
inside will be really sorted. Some items may be deliberately
left unsorted, e.g. Members of TPasEnum are never sorted
(their declared order always matters,
so we shouldn't sort them when displaying their documentation
--- reader of such documentation would be seriously misleaded).
Sorting of other things depends on SortSettings ---
e.g. without ssMethods, CIOs methods will not be sorted.
So actually this method @italic(makes sure that all things that should
be sorted are really sorted). }
procedure Sort(const SortSettings: TSortSettings); virtual;
{ Full declaration of the item.
This is full parsed declaration of the given item.
Note that that this is not used for some descendants.
Right now it's used only with
@unorderedList(
@item TPasConstant
@item TPasFieldVariable (includes type, default values, etc.)
@item TPasType
@item TPasMethod (includes parameter list, procedural directives, etc.)
@item TPasProperty (includes read/write and storage specifiers, etc.)
@item(TPasEnum
But in this special case, '...' is used instead of listing individual
members, e.g. 'TEnumName = (...)'. You can get list of Members using
TPasEnum.Members. Eventual specifics of each member should be also
specified somewhere inside Members items, e.g.
@longcode# TMyEnum = (meOne, meTwo = 3); #
and
@longcode# TMyEnum = (meOne, meTwo); #
will both result in TPasEnum with equal FullDeclaration
(just @code('TMyEnum = (...)')) but this @code('= 3') should be
marked somewhere inside Members[1] properties.)
@item TPasItem when it's a CIO's field.
)
The intention is that in the future all TPasItem descendants
will always have approprtate FullDeclaration set.
It all requires adjusting appropriate places in PasDoc_Parser to
generate appropriate FullDeclaration. }
property FullDeclaration: string read FFullDeclaration write FFullDeclaration;
{ Items here are collected from @@seealso tags.
Name of each item is the 1st part of @@seealso parameter.
Value is the 2nd part of @@seealso parameter. }
property SeeAlso: TStringPairVector read FSeeAlso;
{ List of attributes defined for this item }
property Attributes: TStringPairVector read FAttributes;
procedure SetAttributes(var Value: TStringPairVector);
function BasePath: string; override;
{ Parameters of method or property.
Name of each item is the name of parameter (without any surrounding
whitespace), Value of each item is users description for this item
(in already-expanded form).
This is already in the form processed by
@link(TTagManager.Execute), i.e. with links resolved,
html characters escaped etc. So @italic(don't) convert them (e.g. before
writing to the final docs) once again (by some ExpandDescription or
ConvertString or anything like that). }
property Params: TStringPairVector read FParams;
{ Exceptions raised by the method, or by property getter/setter.
Name of each item is the name of exception class (without any surrounding
whitespace), Value of each item is users description for this item
(in already-expanded form).
This is already in the form processed by
@link(TTagManager.Execute), i.e. with links resolved,
html characters escaped etc. So @italic(don't) convert them (e.g. before
writing to the final docs) once again (by some ExpandDescription or
ConvertString or anything like that). }
property Raises: TStringPairVector read FRaises;
{ Is optional information (that may be empty for
after parsing unit and expanding tags) specified.
Currently this checks @link(Params) and @link(Raises) and
@link(TPasMethod.Returns). }
function HasOptionalInfo: boolean; virtual;
end;
{ @abstract(Pascal constant.)
Precise definition of "constant" for pasdoc purposes is
"a name associated with a value".
Optionally, constant type may also be specified in declararion.
Well, Pascal constant always has some type, but pasdoc is too weak
to determine the implicit type of a constant, i.e. to unserstand that
constand @code(const A = 1) is of type Integer. }
TPasConstant = class(TPasItem)
end;
{ @abstract(Pascal global variable or field or nested constant of CIO.)
Precise definition is "a name with some type". And Optionally with some
initial value, for global variables. It also holds a nested constant of
extended classes and records.
In the future we may introduce here some property like Type: TPasType. }
TPasFieldVariable = class(TPasItem)
private
FIsConstant: Boolean;
protected
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
public
{ @abstract(Set if this is a nested constant field) }
property IsConstant: Boolean read FIsConstant write FIsConstant;
end;
{ @abstract(Pascal type (but not a procedural type --- these are expressed
as @link(TPasMethod).)) }
TPasType = class(TPasItem)
end;
{ @abstract(Enumerated type.) }
TPasEnum = class(TPasType)
protected
FMembers: TPasItems;
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
procedure StoreValueTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
public
procedure RegisterTags(TagManager: TTagManager); override;
{ Searches for a member of this enumerated type. }
function FindItem(const ItemName: string): TBaseItem; override;
destructor Destroy; override;
constructor Create; override;
property Members: TPasItems read FMembers;
end;
{ Methodtype for @link(TPasMethod) }
TMethodType = (METHOD_CONSTRUCTOR, METHOD_DESTRUCTOR,
METHOD_FUNCTION, METHOD_PROCEDURE, METHOD_OPERATOR);
{ This represents:
@orderedList(
@item global function/procedure,
@item method (function/procedure of a class/interface/object),
@item pointer type to one of the above (in this case Name is the type name).
) }
TPasMethod = class(TPasItem)
protected
FReturns: string;
FWhat: TMethodType;
FDirectives: TStandardDirectives;
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
procedure StoreReturnsTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
public
constructor Create; override;
destructor Destroy; override;
{ In addition to inherited, this also registers @link(TTag)
that inits @link(Returns). }
procedure RegisterTags(TagManager: TTagManager); override;
{ }
property What: TMethodType read FWhat write FWhat;
{ What does the method return.
This is already in the form processed by
@link(TTagManager.Execute), i.e. with links resolved,
html characters escaped etc. So @italic(don't) convert them (e.g. before
writing to the final docs) once again (by some ExpandDescription or
ConvertString or anything like that). }
property Returns: string read FReturns;
{ Set of method directive flags }
property Directives: TStandardDirectives read FDirectives write FDirectives;
function HasOptionalInfo: boolean; override;
end;
TPasProperty = class(TPasItem)
protected
FDefault: Boolean;
FNoDefault: Boolean;
FIndexDecl: string;
FStoredID: string;
FDefaultID: string;
FWriter: string;
FPropType: string;
FReader: string;
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
public
{ contains the optional index declaration, including brackets }
property IndexDecl: string read FIndexDecl write FIndexDecl;
{ contains the type of the property }
property Proptype: string read FPropType write FPropType;
{ read specifier }
property Reader: string read FReader write FReader;
{ write specifier }
property Writer: string read FWriter write FWriter;
{ true if the property is the default property }
property Default: Boolean read FDefault write FDefault;
{ keeps default value specifier }
property DefaultID: string read FDefaultID write FDefaultID;
{ true if Nodefault property }
property NoDefault: Boolean read FNoDefault write FNoDefault;
{ keeps Stored specifier }
property StoredId: string read FStoredID write FStoredID;
end;
{ enumeration type to determine type of @link(TPasCio) item }
TCIOType = (CIO_CLASS, CIO_PACKEDCLASS,
CIO_DISPINTERFACE, CIO_INTERFACE,
CIO_OBJECT, CIO_PACKEDOBJECT,
CIO_RECORD, CIO_PACKEDRECORD );
TClassDirective = (CT_NONE, CT_ABSTRACT, CT_SEALED, CT_HELPER);
{ @abstract(Extends @link(TPasItem) to store all items in
a class / an object, e.g. fields.) }
TPasCio = class(TPasType)
protected
FClassDirective: TClassDirective;
FFields: TPasItems;
FMethods: TPasMethods;
FProperties: TPasProperties;
FAncestors: TStringPairVector;
FOutputFileName: string;
FMyType: TCIOType;
FHelperTypeIdentifier: string;
FCios: TPasNestedCios;
FTypes: TPasTypes;
FNameWithGeneric: string;
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
protected
procedure StoreMemberTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
public
constructor Create; override;
destructor Destroy; override;
{ If this class (or interface or object) contains a field, method or
property with the name of ItemName, the corresponding item pointer is
returned. }
function FindItem(const ItemName: string): TBaseItem; override;
function FindItemMaybeInAncestors(const ItemName: string):
TBaseItem; override;
{ This searches for item (field, method or property) defined
in ancestor of this cio. I.e. searches within the FirstAncestor,
then within FirstAncestor.FirstAncestor, and so on.
Returns nil if not found. }
function FindItemInAncestors(const ItemName: string): TPasItem;
procedure Sort(const SortSettings: TSortSettings); override;
procedure RegisterTags(TagManager: TTagManager); override;
public
{ Name of the ancestor (class, object, interface).
Each item is a TStringPair, with
@unorderedList(
@item @code(Name) is the name (single Pascal identifier) of this ancestor,
@item(@code(Value) is the full declaration of this ancestor.
For example, in addition to Name, this may include "specialize"
directive (for FPC generic specialization) at the beginning.
And "<foo,bar>" section at the end (for FPC or Delphi
generic specialization).)
@item(@code(Data) is a TPasItem reference to this ancestor,
or @nil if not found. This is assigned only in TDocGenerator.BuildLinks.)
)
Note that each ancestor is a TPasItem, @italic(not necessarily) TPasCio.
Consider e.g. the case
@longcode(#
TMyStringList = Classes.TStringList;
TMyExtendedStringList = class(TMyStringList)
...
end;
#)
At least for now, such declaration will result in TPasType
(not TPasCio!) with Name = 'TMyStringList', which means that
ancestor of TMyExtendedStringList will be a TPasType instance.
Note that the PasDoc_Parser already takes care of correctly
setting Ancestors when user didn't specify any ancestor name
at cio declaration. E.g. if this cio is a class,
and user didn't specify ancestor name at class declaration,
and this class name is not 'TObject' (in case pasdoc parses the RTL),
the Ancestors[0] will be set to 'TObject'. }
property Ancestors: TStringPairVector read FAncestors;
{ Nested classes (and records, interfaces...). }
property Cios: TPasNestedCios read FCios;
{@name is used to indicate whether a class is sealed or abstract.}
property ClassDirective: TClassDirective read FClassDirective
write FClassDirective;
{ This returns Ancestors[0].Data, i.e. instance of the first
ancestor of this Cio (or nil if it couldn't be found),
or nil if Ancestors.Count = 0. }
function FirstAncestor: TPasItem;
{ This returns the name of first ancestor of this Cio.
If Ancestor.Count > 0 then it simply returns Ancestors[0],
i.e. the name of the first ancestor as was specified at class declaration,
else it returns ''.
So this method is @italic(roughly) something like
@code(FirstAncestor.Name), but with a few notable differences:
@unorderedList(
@item(
FirstAncestor is nil if the ancestor was not found in items parsed
by pasdoc.
But this method will still return in this case name of ancestor.)
@item(@code(FirstAncestor.Name) is the name of ancestor as specified
at declaration of an ancestor.
But this method is the name of ancestor as specified at declaration
of this cio --- with the same letter case, with optional unit specifier.)
)
If this function returns '', then you can be sure that
FirstAncestor returns nil. The other way around is not necessarily true
--- FirstAncestor may be nil, but still this function may return something
<> ''. }
function FirstAncestorName: string;
{ list of all fields }
property Fields: TPasItems read FFields;
{ Class or record helper type identifier }
property HelperTypeIdentifier: string read FHelperTypeIdentifier
write FHelperTypeIdentifier;
{ list of all methods }
property Methods: TPasMethods read FMethods;
{ list of properties }
property Properties: TPasProperties read FProperties;
{ determines if this is a class, an interface or an object }
property MyType: TCIOType read FMyType write FMyType;
{ name of documentation output file (if each class / object gets
its own file, that's the case for HTML, but not for TeX) }
property OutputFileName: string read FOutputFileName write FOutputFileName;
//function QualifiedName: String; override;
{ Is Visibility of items (Fields, Methods, Properties) important ? }
function ShowVisibility: boolean;
{ Simple nested types (that don't fall into @link(Cios)). }
property Types: TPasTypes read FTypes;
{ Name, with optional "generic" directive before (for FPC generics)
and generic type identifiers list "<foo,bar>" after (for FPC and Delphi generics). }
property NameWithGeneric: string read FNameWithGeneric write FNameWithGeneric;
end;
EAnchorAlreadyExists = class(Exception);
{ @name extends @link(TBaseItem) to store extra information about a project.
@name is used to hold an introduction and conclusion to the project. }
TExternalItem = class(TBaseItem)
private
FSourceFilename: string;
FTitle: string;
FShortTitle: string;
FOutputFileName: string;
// See @link(Anchors).
FAnchors: TBaseItems;
procedure SetOutputFileName(const Value: string);
protected
procedure HandleTitleTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
procedure HandleShortTitleTag(ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
public
Constructor Create; override;
destructor Destroy; override;
procedure RegisterTags(TagManager: TTagManager); override;
{ name of documentation output file }
property OutputFileName: string read FOutputFileName write SetOutputFileName;
property ShortTitle: string read FShortTitle write FShortTitle;
property SourceFileName: string read FSourceFilename write FSourceFilename;
property Title: string read FTitle write FTitle;
function FindItem(const ItemName: string): TBaseItem; override;
procedure AddAnchor(const AnchorItem: TAnchorItem); overload;
{ If item with Name (case ignored) already exists, this raises
exception EAnchorAlreadyExists. Otherwise it adds TAnchorItem
with given name to Anchors. It also returns created TAnchorItem. }
function AddAnchor(const AnchorName: string): TAnchorItem; overload;
// @name holds a list of @link(TAnchorItem)s that represent anchors and
// sections within the @classname. The @link(TAnchorItem)s have no content
// so, they should not be indexed separately.
property Anchors: TBaseItems read FAnchors;
function BasePath: string; override;
end;
{ @name extends @link(TObjectVector) to store non-nil instances of @link(TExternalItem)}
TExternalItemList = class(TObjectVector)
public
function Get(Index: Integer): TExternalItem;
end;
TAnchorItem = class(TBaseItem)
private
FExternalItem: TExternalItem;
FSectionLevel: Integer;
FSectionCaption: string;
public
property ExternalItem: TExternalItem read FExternalItem write FExternalItem;
{ If this is an anchor for a section, this tells section level
(as was specified in the @@section tag).
Otherwise this is 0. }
property SectionLevel: Integer
read FSectionLevel write FSectionLevel default 0;
{ If this is an anchor for a section, this tells section caption
(as was specified in the @@section tag). }
property SectionCaption: string
read FSectionCaption write FSectionCaption;
end;
{ extends @link(TPasItem) to store anything about a unit, its constants,
types etc.; also provides methods for parsing a complete unit.
Note: Remember to always set @link(CacheDateTime) after
deserializing this unit. }
TPasUnit = class(TPasItem)
protected
FTypes: TPasTypes;
FVariables: TPasItems;
FCIOs: TPasItems;
FConstants: TPasItems;
FFuncsProcs: TPasMethods;
FUsesUnits: TStringVector;
FSourceFilename: string;
FOutputFileName: string;
FCacheDateTime: TDateTime;
FSourceFileDateTime: TDateTime;
FIsUnit: boolean;
FIsProgram: boolean;
procedure Serialize(const ADestination: TStream); override;
procedure Deserialize(const ASource: TStream); override;
public
constructor Create; override;
destructor Destroy; override;
procedure AddCIO(const i: TPasCio);
procedure AddConstant(const i: TPasItem);
procedure AddType(const i: TPasItem);
procedure AddVariable(const i: TPasItem);
function FindInsideSomeClass(const AClassName, ItemInsideClass: string): TPasItem;
function FindInsideSomeEnum(const EnumName, EnumMember: string): TPasItem;
function FindItem(const ItemName: string): TBaseItem; override;
procedure Sort(const SortSettings: TSortSettings); override;
public
{ list of classes, interfaces, objects, and records defined in this unit }
property CIOs: TPasItems read FCIOs;
{ list of constants defined in this unit }
property Constants: TPasItems read FConstants;
{ list of functions and procedures defined in this unit }
property FuncsProcs: TPasMethods read FFuncsProcs;
{ The names of all units mentioned in a uses clause in the interface
section of this unit.
This is never nil.
After @link(TDocGenerator.BuildLinks), for every i:
UsesUnits.Objects[i] will point to TPasUnit object with
Name = UsesUnits[i] (or nil, if pasdoc's didn't parse such unit).
In other words, you will be able to use UsesUnits.Objects[i] to
obtain given unit's instance, as parsed by pasdoc. }
property UsesUnits: TStringVector read FUsesUnits;
{ list of types defined in this unit }
property Types: TPasTypes read FTypes;
{ list of variables defined in this unit }
property Variables: TPasItems read FVariables;
{ name of documentation output file
THIS SHOULD NOT BE HERE! }
property OutputFileName: string read FOutputFileName write FOutputFileName;
property SourceFileName: string read FSourceFilename write FSourceFilename;
property SourceFileDateTime: TDateTime
read FSourceFileDateTime write FSourceFileDateTime;
{ If WasDeserialized then this specifies the datetime
of a cache data of this unit, i.e. when cache data was generated.
If cache was obtained from a file then this is just the cache file
modification date/time.
If not WasDeserialized then this property has undefined value --
don't use it. }
property CacheDateTime: TDateTime
read FCacheDateTime write FCacheDateTime;
{ If @false, then this is a program or library file, not a regular unit
(though it's treated by pasdoc almost like a unit, so we use TPasUnit
class for this). }
property IsUnit: boolean read FIsUnit write FIsUnit;
property IsProgram: boolean read FIsProgram write FIsProgram;
{ Returns if unit WasDeserialized, and file FileName exists,
and file FileName is newer than CacheDateTime.
So if FileName contains some info generated from information
of this unit, then we can somehow assume that FileName still
contains valid information and we don't have to write
it once again.
Sure, we're not really 100% sure that FileName still
contains valid information, but that's how current approach
to cache works. }
function FileNewerThanCache(const FileName: string): boolean;
function BasePath: string; override;
end;
{ Container class to store a list of @link(TBaseItem)s. }
TBaseItems = class(TObjectVector)
private
FHash: TObjectHash;
procedure Serialize(const ADestination: TStream);
procedure Deserialize(const ASource: TStream);
public
constructor Create(const AOwnsObject: Boolean); override;
destructor Destroy; override;
{ Find a given item name on a list.
In the base class (TBaseItems), this simply searches the items
(not recursively).
In some cases, it may look within the items (recursively),
when the identifiers inside the item are in same namespace as the items
themselves. Example: it will look also inside enumerated types
members, because (when "scoped enums" are off) the enumerated members
are in the same namespace as the enumerated type name.
Returns @nil if nothing can be found. }
function FindListItem(const AName: string): TBaseItem;
{ Inserts all items of C into this collection.
Disposes C and sets it to nil. }
procedure InsertItems(const c: TBaseItems);
{ During Add, AObject is associated with AObject.Name using hash table,
so remember to set AObject.Name @italic(before) calling Add(AObject). }
procedure Add(const AObject: TBaseItem);
{ This is a shortcut for doing @link(Clear) and then
@link(Add Add(AObject)). Useful when you want the list
to contain exactly the one given AObject. }
procedure ClearAndAdd(const AObject: TBaseItem);
procedure Delete(const AIndex: Integer);
procedure Clear; override;
end;
{ Container class to store a list of @link(TPasItem)s. }
TPasItems = class(TBaseItems)
private
function GetPasItemAt(const AIndex: Integer): TPasItem;
procedure SetPasItemAt(const AIndex: Integer; const Value: TPasItem);
public
{ A comfortable routine that just calls inherited and
casts result to TPasItem, since every item on this list must
be always TPasItem. }
function FindListItem(const AName: string): TPasItem;
{ Copies all Items from c to this object, not changing c at all. }
procedure CopyItems(const c: TPasItems);
{ Counts classes, interfaces and objects within this collection. }
procedure CountCIO(var c, i, o: Integer);
{ Checks each element's Visibility field and removes all elements with a value
of viPrivate. }
procedure RemovePrivateItems;
property PasItemAt[const AIndex: Integer]: TPasItem read GetPasItemAt
write SetPasItemAt;
{ This sorts all items on this list by their name,
and also calls @link(TPasItem.Sort Sort(SortSettings))
for each of these items.
This way it sorts recursively everything in this list.
This is equivalent to doing both
@link(SortShallow) and @link(SortOnlyInsideItems). }
procedure SortDeep(const SortSettings: TSortSettings);
{ This calls @link(TPasItem.Sort Sort(SortSettings))
for each of items on the list.
It does @italic(not) sort the items on this list. }
procedure SortOnlyInsideItems(const SortSettings: TSortSettings);
{ This sorts all items on this list by their name.
Unlike @link(SortDeep), it does @italic(not) call @link(TPasItem.Sort Sort)
for each of these items.
So "items inside items" (e.g. class methods, if this list contains
TPasCio objects) remain unsorted. }
procedure SortShallow;
{ Sets FullDeclaration of every item to
@orderedList(
@item Name of this item (only if PrefixName)
@item + Suffix.
)
Very useful if you have a couple of items that share a common
declaration in source file, e.g. variables or fields declared like
@longcode(#
A, B: Integer;
#) }
procedure SetFullDeclaration(PrefixName: boolean; const Suffix: string);
end;
{ Collection of methods. }
TPasMethods = class(TPasItems)
{ Find an Index-th item with given name on a list. Index is 0-based.
There could be multiple items sharing the same name (overloads) while
method of base class returns only the one most recently added item.
Returns @nil if nothing can be found. }
function FindListItem(const AName: string; Index: Integer): TPasMethod; overload;
end;
{ Collection of properties. }
TPasProperties = class(TPasItems)
end;
{ Collection of classes / records / interfaces. }
TPasNestedCios = class(TPasItems)
public
constructor Create; reintroduce;
end;
{ Collection of types. }
TPasTypes = class(TPasItems)
function FindListItem(const AName: string): TPasItem;
end;
{ Collection of units. }
TPasUnits = class(TPasItems)
private
function GetUnitAt(const AIndex: Integer): TPasUnit;
procedure SetUnitAt(const AIndex: Integer; const Value: TPasUnit);
public
property UnitAt[const AIndex: Integer]: TPasUnit
read GetUnitAt
write SetUnitAt;
function ExistsUnit(const AUnit: TPasUnit): Boolean;
end;
const
CIORecordType = [CIO_RECORD, CIO_PACKEDRECORD];
CIONonHierarchy = CIORecordType;
EmptyRawDescriptionInfo: TRawDescriptionInfo =
( Content: ''; StreamName: ''; BeginPosition: -1; EndPosition: -1; );
{ Returns lowercased keyword associated with given method type. }
function MethodTypeToString(const MethodType: TMethodType): string;
{ Returns VisibilityStr for each value in Visibilities,
delimited by commas. }
function VisibilitiesToStr(const Visibilities: TVisibilities): string;
function VisToStr(const Vis: TVisibility): string;
implementation
uses StrUtils,
PasDoc_Utils;
function ComparePasItemsByName(PItem1, PItem2: Pointer): Integer;
var
P1, P2: TPasItem;
begin
P1 := TPasItem(PItem1);
P2 := TPasItem(PItem2);
Result := CompareText(
P1.UnitRelativeQualifiedName,
P2.UnitRelativeQualifiedName);
// Sort duplicate names by unit name if available.
if Result = 0 then
Result := CompareText(
P1.MyUnitName,
P2.MyUnitName);
{ If both name and unit are equal (so it's an overloaded routine),
sort by description. The goal is to make output of AllIdentifiers.html
and similar lists "stable", guaranteed regardless of sorting algorithm
used by a particular compiler version, OS etc.
In case descriptions are equal, the order is still undefined,
but it will not matter (since everything generated for AllIdentifiers.html
will be equal). }
if Result = 0 then
Result := CompareText(
P1.DetailedDescription,
P2.DetailedDescription);
end;
function ComparePasMethods(PItem1, PItem2: Pointer): Integer;
var
P1: TPasMethod;
P2: TPasMethod;
begin
P1 := TPasMethod(PItem1);
P2 := TPasMethod(PItem2);
{ compare 'method type', order is constructor > destructor > visibility > function, procedure }
if P1.What = P2.What then begin
{ if 'method type' is equal, compare names }
if P1.Visibility = P2.Visibility then begin
Result := CompareText(P1.Name, P2.Name)
end else begin
if P1.Visibility < P2.Visibility then begin
Result := -1
end else begin
Result := 1;
end;
end;
end else begin
if P1.What < P2.What then begin
Result := -1
end else begin
Result := 1;
end;
end;
end;
{ TBaseItem ------------------------------------------------------------------- }
constructor TBaseItem.Create;
begin
inherited Create;
FAuthors := TStringVector.Create;
AutoLinkHereAllowed := true;
end;
destructor TBaseItem.Destroy;
begin
Authors.Free;
inherited;
end;
function TBaseItem.FindItem(const ItemName: string): TBaseItem;
begin
Result := nil;
end;
function TBaseItem.FindItemMaybeInAncestors(const ItemName: string):
TBaseItem;
begin
Result := FindItem(ItemName);
end;
function TBaseItem.FindName(const NameParts: TNameParts): TBaseItem;
begin
Result := nil;
end;
procedure TBaseItem.StoreAuthorTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if TagParameter = '' then exit;
if Authors = nil then
FAuthors := NewStringVector;
Authors.Add(TagParameter);
ReplaceStr := '';
end;
procedure TBaseItem.StoreCreatedTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if TagParameter = '' then exit;
FCreated := TagParameter;
ReplaceStr := '';
end;
procedure TBaseItem.StoreLastModTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if TagParameter = '' then exit;
FLastMod := TagParameter;
ReplaceStr := '';
end;
procedure TBaseItem.StoreCVSTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
function IsVersionControlTag(const S: string;
const VersionControlTag: string; out TagValue: string): boolean;
var
Prefix: string;
begin
Prefix := '$' + VersionControlTag + ' ';
Result := IsPrefix(Prefix, TagParameter);
if Result then
begin
{ cut off -1 to cut off final '$' }
TagValue := Trim(Copy(S, Length(Prefix) + 1, Length(S) - Length(Prefix) - 1));
end;
end;
{$IFNDEF FPC}
function TrimRightSet(const AText: string; const ACharS: TSysCharSet): string;
var
Length1: Integer;
begin
Result := AText;
Length1 := Length(Result);
while (Length1 > 0) and (CharInSet(Result[Length1], ACharS)) do begin
Dec(Length1);
end;
SetLength(Result, Length1);
end;
{$ENDIF FPC}
var
TagValue: string;
begin
if IsVersionControlTag(TagParameter, 'Date:', TagValue) then
begin
LastMod := TagValue;
ReplaceStr := '';
end else
if IsVersionControlTag(TagParameter, 'Date::', TagValue) then
begin
LastMod := TrimRightSet(TagValue, ['#']);
ReplaceStr := '';
end else
{ See http://svnbook.red-bean.com/en/1.7/svn.advanced.props.special.keywords.html
about fixed date format in SVN. }
if IsVersionControlTag(TagParameter, 'Author:', TagValue) then
begin
if Length(TagValue) > 0 then
begin
if not Assigned(Authors) then
FAuthors := NewStringVector;
Authors.AddNotExisting(TagValue);
ReplaceStr := '';
end;
end;
end;
procedure TBaseItem.PreHandleNoAutoLinkTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
ReplaceStr := '';
{ We set AutoLinkHereAllowed in the 1st pass of expanding descriptions
(i.e. in PreHandleNoAutoLinkTag, not in HandleNoAutoLinkTag)
because all information about AutoLinkHereAllowed must be collected
before auto-linking happens in the 2nd pass of expanding descriptions. }
AutoLinkHereAllowed := false;
end;
procedure TBaseItem.HandleNoAutoLinkTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
ReplaceStr := '';
end;
procedure TBaseItem.RegisterTags(TagManager: TTagManager);
begin
inherited;
TTag.Create(TagManager, 'author', nil, {$IFDEF FPC}@{$ENDIF} StoreAuthorTag,
[toParameterRequired]);
TTag.Create(TagManager, 'created', nil, {$IFDEF FPC}@{$ENDIF} StoreCreatedTag,
[toParameterRequired, toRecursiveTags, toAllowNormalTextInside]);
TTag.Create(TagManager, 'lastmod', nil, {$IFDEF FPC}@{$ENDIF} StoreLastModTag,
[toParameterRequired, toRecursiveTags, toAllowNormalTextInside]);
TTag.Create(TagManager, 'cvs', nil, {$IFDEF FPC}@{$ENDIF} StoreCVSTag,
[toParameterRequired]);
TTopLevelTag.Create(TagManager, 'noautolinkhere',
{$IFDEF FPC}@{$ENDIF} PreHandleNoAutoLinkTag,
{$IFDEF FPC}@{$ENDIF} HandleNoAutoLinkTag, []);
end;
procedure TBaseItem.SetAuthors(const Value: TStringVector);
begin
FAuthors.Assign(Value);
end;
function TBaseItem.QualifiedName: String;
begin
Result := Name;
end;
procedure TBaseItem.Deserialize(const ASource: TStream);
begin
inherited;
Name := LoadStringFromStream(ASource);
RawDescription := LoadStringFromStream(ASource);
{ No need to serialize, because it's not generated by parser:
DetailedDescription := LoadStringFromStream(ASource);
FullLink := LoadStringFromStream(ASource);
LastMod := LoadStringFromStream(ASource);
Authors.LoadFromBinaryStream(ASource);
FCreated := LoadStringFromStream(ASource);
AutoLinkHereAllowed }
end;
procedure TBaseItem.Serialize(const ADestination: TStream);
begin
inherited;
SaveStringToStream(Name, ADestination);
SaveStringToStream(RawDescription, ADestination);
{ No need to serialize, because it's not generated by parser:
SaveStringToStream(DetailedDescription, ADestination);
SaveStringToStream(FullLink, ADestination);
SaveStringToStream(LastMod, ADestination);
Authors.SaveToBinaryStream(ADestination);
SaveStringToStream(Created, ADestination);
AutoLinkHereAllowed }
end;
function TBaseItem.RawDescriptionInfo: PRawDescriptionInfo;
begin
Result := @FRawDescriptionInfo;
end;
function TBaseItem.GetRawDescription: string;
begin
Result := FRawDescriptionInfo.Content;
end;
procedure TBaseItem.WriteRawDescription(const Value: string);
begin
FRawDescriptionInfo.Content := Value;
end;
function TBaseItem.BasePath: string;
begin
Result := IncludeTrailingPathDelimiter(GetCurrentDir);
end;
{ TPasItem ------------------------------------------------------------------- }
constructor TPasItem.Create;
begin
inherited;
FSeeAlso := TStringPairVector.Create(true);
FAttributes := TStringPairVector.Create(true);
FParams := TStringPairVector.Create(true);
FRaises := TStringPairVector.Create(true);
end;
destructor TPasItem.Destroy;
begin
FreeAndNil(FParams);
FreeAndNil(FRaises);
FreeAndNil(FSeeAlso);
FreeAndNil(FAttributes);
inherited;
end;
function TPasItem.MyUnitName: String;
begin
if MyUnit <> nil then
Result := MyUnit.Name
else
Result := '';
end;
function TPasItem.FindNameWithinUnit(const NameParts: TNameParts): TBaseItem;
var
p: TBaseItem;
LNameParts0: string;
begin
Result := nil;
LNameParts0 := LowerCase(NameParts[0]);
case Length(NameParts) of
1: begin
Result := FindItemMaybeInAncestors(NameParts[0]);
if Result <> nil then Exit;
if Assigned(MyObject) then begin { this item is a method or field }
p := MyObject.FindItemMaybeInAncestors(NameParts[0]);
if Assigned(p) then begin
Result := p;
Exit;
end;
end;
if Assigned(MyUnit) then begin
p := MyUnit.FindItem(NameParts[0]);
if Assigned(p) then begin
Result := p;
Exit;
end;
end;
if Assigned(MyUnit) and (LNameParts0 = LowerCase(MyUnit.Name)) then begin
Result := MyUnit;
Exit;
end;
end;
2: begin
if Assigned(MyObject) then begin
if LowerCase(MyObject.Name) = LNameParts0 then begin
p := MyObject.FindItem(NameParts[1]);
if Assigned(p) then begin
Result := p;
Exit;
end;
end;
end;
if Assigned(MyUnit) then
begin
// To find links inside classes
p := MyUnit.FindInsideSomeClass(NameParts[0], NameParts[1]);
if Assigned(p) then begin
Result := p;
Exit;
end;
// To find links inside enums
p := MyUnit.FindInsideSomeEnum(NameParts[0], NameParts[1]);
if Assigned(p) then begin
Result := p;
Exit;
end;
end;
end;
end;
end;
function TPasItem.FindName(const NameParts: TNameParts): TBaseItem;
procedure SearchUsedUnits(UsesUnits: TStringVector);
var
U: TPasUnit;
i: Integer;
begin
for i := 0 to UsesUnits.Count - 1 do
begin
U := TPasUnit(UsesUnits.Objects[i]);
if U <> nil then
begin
Result := U.FindNameWithinUnit(NameParts);
if Result <> nil then Exit;
end;
end;
Result := nil;
end;
begin
Result := FindNameWithinUnit(NameParts);
if Result = nil then
begin
{ Dirty code: checking for "Self is some class".
This could be organized better by virtual methods. }
if Self is TPasUnit then
SearchUsedUnits(TPasUnit(Self).UsesUnits) else
if MyUnit <> nil then
SearchUsedUnits(MyUnit.UsesUnits);
end;
end;
procedure TPasItem.StoreAbstractTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if AbstractDescription <> '' then
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@abstract tag was already specified for this item. ' +
'It was specified as "%s"', [AbstractDescription]);
AbstractDescription := TagParameter;
ReplaceStr := '';
end;
procedure TPasItem.HandleDeprecatedTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
HintDirectives := HintDirectives + [hdDeprecated];
ReplaceStr := '';
end;
procedure TPasItem.HandleSeeAlsoTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
var
Pair: TStringPair;
begin
Pair := TStringPair.CreateExtractFirstWord(TagParameter);
if Pair.Name = '' then
begin
FreeAndNil(Pair);
ThisTag.TagManager.DoMessage(2, pmtWarning,
'@seealso tag doesn''t specify any name to link to, skipped', []);
end else
begin
SeeAlso.Add(Pair);
end;
ReplaceStr := '';
end;
{ TODO for StoreRaisesTag and StoreParamTag:
splitting TagParameter using ExtractFirstWord should be done
inside TTagManager.Execute, working with raw text, instead
of here, where the TagParameter is already expanded and converted.
Actually, current approach works for now perfectly,
but only because neighter html generator nor LaTeX generator
change text in such way that first word of the text
(assuming it's a normal valid Pascal identifier) is changed.
E.g. '@raises(EFoo with some link @link(Blah))'
is expanded to 'EFoo with some link <a href="...">Blah</a>'
so the 1st word ('EFoo') is preserved.
But this is obviously unclean approach. }
procedure TPasItem.StoreRaisesTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
var
Pair: TStringPair;
begin
Pair := TStringPair.CreateExtractFirstWord(TagParameter);
if Pair.Name = '' then
begin
FreeAndNil(Pair);
ThisTag.TagManager.DoMessage(2, pmtWarning,
'@raises tag doesn''t specify exception name, skipped', []);
end else
begin
FRaises.Add(Pair);
end;
ReplaceStr := '';
end;
procedure TPasItem.StoreParamTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
var
Pair: TStringPair;
begin
Pair := TStringPair.CreateExtractFirstWord(TagParameter);
if Name = '' then
begin
FreeAndNil(Pair);
ThisTag.TagManager.DoMessage(2, pmtWarning,
'@param tag doesn''t specify parameter name, skipped', []);
end else
begin
FParams.Add(Pair);
end;
ReplaceStr := '';
end;
procedure TPasItem.RegisterTags(TagManager: TTagManager);
begin
inherited;
TTopLevelTag.Create(TagManager, 'abstract',
nil, {$IFDEF FPC}@{$ENDIF} StoreAbstractTag,
[toParameterRequired, toRecursiveTags, toAllowOtherTagsInsideByDefault,
toAllowNormalTextInside]);
TTag.Create(TagManager, 'deprecated',
nil, {$ifdef FPC}@{$endif} HandleDeprecatedTag, []);
TTopLevelTag.Create(TagManager, 'seealso',
nil, {$ifdef FPC}@{$endif} HandleSeeAlsoTag,
[toParameterRequired, toFirstWordVerbatim]);
TTopLevelTag.Create(TagManager, 'raises',
nil, {$IFDEF FPC}@{$ENDIF} StoreRaisesTag,
[toParameterRequired, toRecursiveTags, toAllowOtherTagsInsideByDefault,
toAllowNormalTextInside, toFirstWordVerbatim]);
TTopLevelTag.Create(TagManager, 'param',
nil, {$IFDEF FPC}@{$ENDIF} StoreParamTag,
[toParameterRequired, toRecursiveTags, toAllowOtherTagsInsideByDefault,
toAllowNormalTextInside, toFirstWordVerbatim]);
end;
function TPasItem.HasDescription: Boolean;
begin
HasDescription := (AbstractDescription <> '') or (DetailedDescription <> '');
end;
function TPasItem.HasOptionalInfo: boolean;
begin
Result :=
(not ObjectVectorIsNilOrEmpty(Params)) or
(not ObjectVectorIsNilOrEmpty(Raises));
end;
procedure TPasItem.Sort(const SortSettings: TSortSettings);
begin
{ Nothing to sort in TPasItem }
end;
function TPasItem.QualifiedName: String;
begin
Result := UnitRelativeQualifiedName;
if MyUnit <> nil then
Result := MyUnit.Name + '.' + Result;
end;
function TPasItem.UnitRelativeQualifiedName: String;
var
LItem: TPasItem;
begin
if FCachedUnitRelativeQualifiedName <> '' then
Result := FCachedUnitRelativeQualifiedName
else begin
Result := FName;
LItem := Self;
while LItem.MyObject <> nil do
begin
Result := LItem.MyObject.Name + '.' + Result;
LItem := LItem.MyObject;
end;
FCachedUnitRelativeQualifiedName := Result;
end;
end;
procedure TPasItem.Deserialize(const ASource: TStream);
begin
inherited;
ASource.Read(FVisibility, SizeOf(Visibility));
ASource.Read(FHintDirectives, SizeOf(FHintDirectives));
DeprecatedNote := LoadStringFromStream(ASource);
FullDeclaration := LoadStringFromStream(ASource);
Attributes.LoadFromBinaryStream(ASource);
{ No need to serialize, because it's not generated by parser:
AbstractDescription := LoadStringFromStream(ASource);
ASource.Read(FAbstractDescriptionWasAutomatic,
SizeOf(FAbstractDescriptionWasAutomatic));
SeeAlso
Params.LoadFromBinaryStream(ASource);
FRaises.LoadFromBinaryStream(ASource);
}
end;
procedure TPasItem.Serialize(const ADestination: TStream);
begin
inherited;
ADestination.Write(FVisibility, SizeOf(Visibility));
ADestination.Write(FHintDirectives, SizeOf(FHintDirectives));
SaveStringToStream(DeprecatedNote, ADestination);
SaveStringToStream(FullDeclaration, ADestination);
FAttributes.SaveToBinaryStream(ADestination);
{ No need to serialize, because it's not generated by parser:
SaveStringToStream(AbstractDescription, ADestination);
ADestination.Write(FAbstractDescriptionWasAutomatic,
SizeOf(FAbstractDescriptionWasAutomatic));
SeeAlso
Params.SaveToBinaryStream(ADestination);
FRaises.SaveToBinaryStream(ADestination);
}
end;
procedure TPasItem.SetAttributes(var Value: TStringPairVector);
begin
if Value.Count > 0 then begin
FreeAndNil(FAttributes);
FAttributes := Value;
Value := TStringPairVector.Create(true);
end;
end;
function TPasItem.BasePath: string;
begin
if MyUnit <> nil then
Result := MyUnit.BasePath
else
Result := inherited BasePath; //required by D7
end;
{ TPasEnum ------------------------------------------------------------------- }
constructor TPasEnum.Create;
begin
inherited Create;
FMembers := TPasItems.Create(True);
end;
procedure TPasEnum.Deserialize(const ASource: TStream);
begin
inherited;
Members.Deserialize(ASource);
end;
destructor TPasEnum.Destroy;
begin
FMembers.Free;
inherited;
end;
procedure TPasEnum.RegisterTags(TagManager: TTagManager);
begin
inherited;
{ Note that @value tag does not have toRecursiveTags,
and it shouldn't: parameters of this tag will be copied
verbatim to appropriate member's RawDescription,
and they will be expanded when this member will be expanded
by TDocGenerator.ExpandDescriptions.
This way they will be expanded exactly once, as they should be. }
TTag.Create(TagManager, 'value',
nil, {$IFDEF FPC}@{$ENDIF} StoreValueTag,
[toParameterRequired]);
end;
procedure TPasEnum.Serialize(const ADestination: TStream);
begin
inherited;
Members.Serialize(ADestination);
end;
procedure TPasEnum.StoreValueTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
var
ValueName: String;
ValueDesc: String;
Value: TPasItem;
begin
ReplaceStr := '';
ValueDesc := TagParameter;
ValueName := ExtractFirstWord(ValueDesc);
Value := Members.FindListItem(ValueName);
if Assigned(Value) then
begin
if Value.RawDescription = '' then
Value.RawDescription := ValueDesc else
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@value tag specifies description for a value "%s" that already' +
' has one description.', [ValueName]);
end else
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@value tag specifies unknown value "%s"', [ValueName]);
end;
function TPasEnum.FindItem(const ItemName: string): TBaseItem;
begin
Result := FMembers.FindListItem(ItemName);
end;
{ TPasFieldVariable ---------------------------------------------------------- }
procedure TPasFieldVariable.Deserialize(const ASource: TStream);
begin
inherited;
ASource.Read(FIsConstant, SizeOf(FIsConstant));
end;
procedure TPasFieldVariable.Serialize(const ADestination: TStream);
begin
inherited;
ADestination.Write(FIsConstant, SizeOf(FIsConstant));
end;
{ TBaseItems ----------------------------------------------------------------- }
constructor TBaseItems.Create(const AOwnsObject: Boolean);
begin
inherited;
FHash := TObjectHash.Create;
end;
destructor TBaseItems.Destroy;
begin
FHash.Free;
FHash := nil;
inherited;
end;
procedure TBaseItems.Delete(const AIndex: Integer);
var
LObj: TBaseItem;
begin
LObj := TBaseItem(Items[AIndex]);
FHash.Delete(LowerCase(LObj.Name));
inherited Delete(AIndex);
end;
function TBaseItems.FindListItem(const AName: string): TBaseItem;
begin
Result := nil;
if Length(AName) > 0 then begin
result := TPasItem(FHash.Items[LowerCase(AName)]);
end;
end;
procedure TBaseItems.Add(const AObject: TBaseItem);
begin
inherited Add(AObject);
FHash.Items[LowerCase(AObject.Name)] := AObject;
end;
procedure TBaseItems.InsertItems(const c: TBaseItems);
var
i: Integer;
begin
if ObjectVectorIsNilOrEmpty(c) then Exit;
for i := 0 to c.Count - 1 do
Add(TBaseItem(c.Items[i]));
end;
procedure TBaseItems.Clear;
begin
if Assigned(FHash) then begin
// not assigned if destroying
FHash.Free;
FHash := TObjectHash.Create;
end;
inherited;
end;
procedure TBaseItems.Deserialize(const ASource: TStream);
var
LCount, i: Integer;
begin
Clear;
ASource.Read(LCount, SizeOf(LCount));
for i := 0 to LCount - 1 do
Add(TBaseItem(TSerializable.DeserializeObject(ASource)));
end;
procedure TBaseItems.Serialize(const ADestination: TStream);
var
LCount, i: Integer;
begin
LCount := Count;
ADestination.Write(LCount, SizeOf(LCount));
{ Remember to always serialize and deserialize items in the
same order -- this is e.g. checked by ../../tests/scripts/check_cache.sh }
for i := 0 to Count - 1 do
TSerializable.SerializeObject(TBaseItem(Items[i]), ADestination);
end;
procedure TBaseItems.ClearAndAdd(const AObject: TBaseItem);
begin
Clear;
Add(AObject);
end;
{ TPasItems ------------------------------------------------------------------ }
function TPasItems.FindListItem(const AName: string): TPasItem;
begin
Result := TPasItem(inherited FindListItem(AName));
end;
procedure TPasItems.CopyItems(const c: TPasItems);
var
i: Integer;
begin
if ObjectVectorIsNilOrEmpty(c) then Exit;
for i := 0 to c.Count - 1 do
Add(TPasItem(c.GetPasItemAt(i)));
end;
procedure TPasItems.CountCIO(var c, i, o: Integer);
var
j: Integer;
begin
c := 0;
i := 0;
o := 0;
for j := 0 to Count - 1 do
case TPasCio(GetPasItemAt(j)).MyType of
CIO_CLASS, CIO_PACKEDCLASS:
Inc(c);
CIO_INTERFACE:
Inc(i);
CIO_OBJECT, CIO_PACKEDOBJECT:
Inc(o);
end;
end;
function TPasItems.GetPasItemAt(const AIndex: Integer): TPasItem;
begin
Result := TPasItem(Items[AIndex]);
end;
procedure TPasItems.RemovePrivateItems;
var
i: Integer;
Item: TPasItem;
begin
i := 0;
while (i < Count) do begin
Item := PasItemAt[i];
if Assigned(Item) and (Item.Visibility = viPrivate) then
Delete(i)
else
Inc(i);
end;
end;
procedure TPasItems.SetPasItemAt(const AIndex: Integer; const Value:
TPasItem);
begin
Items[AIndex] := Value;
end;
procedure TPasItems.SortShallow;
begin
Sort( {$IFDEF FPC}@{$ENDIF} ComparePasItemsByName);
end;
procedure TPasItems.SortOnlyInsideItems(const SortSettings: TSortSettings);
var i: Integer;
begin
for i := 0 to Count - 1 do
PasItemAt[i].Sort(SortSettings);
end;
procedure TPasItems.SortDeep(const SortSettings: TSortSettings);
begin
SortShallow;
SortOnlyInsideItems(SortSettings);
end;
procedure TPasItems.SetFullDeclaration(PrefixName: boolean; const Suffix: string);
var i: Integer;
begin
if PrefixName then
begin
for i := 0 to Count - 1 do
PasItemAt[i].FullDeclaration := PasItemAt[i].Name + Suffix;
end else
begin
for i := 0 to Count - 1 do
PasItemAt[i].FullDeclaration := Suffix;
end;
end;
{ TPasMethods ----------------------------------------------------------------- }
function TPasMethods.FindListItem(const AName: string; Index: Integer): TPasMethod;
var i, Counter: Integer;
begin
Counter := -1;
for i := 0 to Count - 1 do
if AnsiSameText(PasItemAt[i].Name, AName) then
begin
Inc(Counter);
if Counter = Index then
begin
Result := PasItemAt[i] as TPasMethod;
Exit;
end;
end;
Result := nil;
end;
{ TPasNestedCios ------------------------------------------------------------- }
constructor TPasNestedCios.Create;
begin
inherited Create(True);
end;
{ TPasCio -------------------------------------------------------------------- }
constructor TPasCio.Create;
begin
inherited;
FClassDirective := CT_NONE;
FFields := TPasItems.Create(True);
FMethods := TPasMethods.Create(True);
FProperties := TPasProperties.Create(True);
FAncestors := TStringPairVector.Create(True);
FCios := TPasNestedCios.Create;
FTypes := TPasTypes.Create(True);
end;
destructor TPasCio.Destroy;
begin
Ancestors.Free;
Fields.Free;
Methods.Free;
Properties.Free;
FCios.Free;
FTypes.Free;
inherited;
end;
procedure TPasCio.Deserialize(const ASource: TStream);
begin
inherited;
FFields.Deserialize(ASource);
FMethods.Deserialize(ASource);
FProperties.Deserialize(ASource);
Ancestors.LoadFromBinaryStream(ASource);
ASource.Read(FMyType, SizeOf(FMyType));
ASource.Read(FClassDirective, SizeOf(FClassDirective));
FHelperTypeIdentifier := LoadStringFromStream(ASource);
FTypes.Deserialize(ASource);
FCios.Deserialize(ASource);
FNameWithGeneric := LoadStringFromStream(ASource);
{ No need to serialize, because it's not generated by parser:
FOutputFileName := LoadStringFromStream(ASource); }
end;
procedure TPasCio.Serialize(const ADestination: TStream);
begin
inherited;
FFields.Serialize(ADestination);
FMethods.Serialize(ADestination);
FProperties.Serialize(ADestination);
Ancestors.SaveToBinaryStream(ADestination);
ADestination.Write(FMyType, SizeOf(FMyType));
ADestination.Write(FClassDirective, SizeOf(FClassDirective));
SaveStringToStream(HelperTypeIdentifier, ADestination);
FTypes.Serialize(ADestination);
FCios.Serialize(ADestination);
SaveStringToStream(NameWithGeneric, ADestination);
{ No need to serialize, because it's not generated by parser:
SaveStringToStream(FOutputFileName, ADestination); }
end;
function TPasCio.FindItem(const ItemName: string): TBaseItem;
begin
if Fields <> nil then begin
Result := Fields.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if Methods <> nil then begin
Result := Methods.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if Properties <> nil then begin
Result := Properties.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if FTypes <> nil then begin
Result := FTypes.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if FCios <> nil then begin
Result := FCios.FindListItem(ItemName);
if Result <> nil then Exit;
end;
Result := inherited FindItem(ItemName);
end;
function TPasCio.FindItemMaybeInAncestors(const ItemName: string):
TBaseItem;
begin
Result := inherited FindItemMaybeInAncestors(ItemName);
if Result = nil then
Result := FindItemInAncestors(ItemName);
end;
procedure TPasCio.Sort(const SortSettings: TSortSettings);
begin
inherited;
if Fields <> nil then
begin
if MyType in CIORecordType then
begin
if ssRecordFields in SortSettings then
Fields.SortShallow;
end else
begin
if ssNonRecordFields in SortSettings then
Fields.SortShallow;
end;
end;
if (Methods <> nil) and (ssMethods in SortSettings) then
Methods.Sort( {$IFDEF FPC}@{$ENDIF} ComparePasMethods);
if (Properties <> nil) and (ssProperties in SortSettings) then
Properties.SortShallow;
if (FCios <> nil) then
FCios.SortDeep(SortSettings);
if (FTypes <> nil) then
FTypes.SortDeep(SortSettings);
end;
procedure TPasCio.RegisterTags(TagManager: TTagManager);
begin
inherited;
{ Note that @member tag does not have toRecursiveTags,
and it shouldn't: parameters of this tag will be copied
verbatim to appropriate member's RawDescription,
and they will be expanded when this member will be expanded
by TDocGenerator.ExpandDescriptions.
This way they will be expanded exactly once, as they should be.
Moreover, this allows you to correctly use tags like @param
and @raises inside @member for a method. }
TTag.Create(TagManager, 'member',
nil, {$IFDEF FPC}@{$ENDIF} StoreMemberTag,
[toParameterRequired]);
end;
procedure TPasCio.StoreMemberTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
var
MemberName: String;
MemberDesc: String;
Member: TBaseItem;
begin
ReplaceStr := '';
MemberDesc := TagParameter;
MemberName := ExtractFirstWord(MemberDesc);
Member := FindItem(MemberName);
if Assigned(Member) then
begin
{ Only replace the description if one wasn't specified for it
already }
if Member.RawDescription = '' then
Member.RawDescription := MemberDesc else
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@member tag specifies description for member "%s" that already' +
' has one description.', [MemberName]);
end else
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@member tag specifies unknown member "%s".', [MemberName]);
end;
function TPasCio.ShowVisibility: boolean;
begin
// Result := not (MyType in CIORecordType);
{ This is always true now, because with "advanced records",
records have meaningful visibility sections too.
In the future, maybe we should auto-detect this smarter,
so that for records (CIORecordType) we only show visibility
if something is not public.
(But maybe not, maybe for consistency visibility should be always shown?)
}
Result := true;
end;
function TPasCio.FirstAncestor: TPasItem;
begin
if Ancestors.Count <> 0 then
Result := TObject(Ancestors[0].Data) as TPasItem else
Result := nil;
end;
function TPasCio.FirstAncestorName: string;
begin
if Ancestors.Count <> 0 then
Result := Ancestors[0].Name else
Result := '';
end;
function TPasCio.FindItemInAncestors(const ItemName: string): TPasItem;
var Ancestor: TBaseItem;
begin
Ancestor := FirstAncestor;
Result := nil;
while (Result = nil) and (Ancestor <> nil) and (Ancestor is TPasCio) do
begin
{ TPasCio.FindItem always returns some TPasItem, so the cast below
of Ancestor.FindItem to TPasItem should always be OK. }
Result := Ancestor.FindItem(ItemName) as TPasItem;
Ancestor := TPasCio(Ancestor).FirstAncestor;
end;
end;
{ TPasUnit ------------------------------------------------------------------- }
constructor TPasUnit.Create;
begin
inherited Create;
FTypes := TPasTypes.Create(True);
FVariables := TPasItems.Create(True);
FCIOs := TPasItems.Create(True);
FConstants := TPasItems.Create(True);
FFuncsProcs := TPasMethods.Create(True);
FUsesUnits := TStringVector.Create;
end;
destructor TPasUnit.Destroy;
begin
FCIOs.Free;
FConstants.Free;
FFuncsProcs.Free;
FTypes.Free;
FUsesUnits.Free;
FVariables.Free;
inherited;
end;
procedure TPasUnit.AddCIO(const i: TPasCio);
begin
CIOs.Add(i);
end;
procedure TPasUnit.AddConstant(const i: TPasItem);
begin
Constants.Add(i);
end;
procedure TPasUnit.AddType(const i: TPasItem);
begin
Types.Add(i);
end;
procedure TPasUnit.AddVariable(const i: TPasItem);
begin
Variables.Add(i);
end;
function TPasUnit.FindInsideSomeClass(const AClassName, ItemInsideClass: string): TPasItem;
var
po: TPasCio;
begin
Result := nil;
if CIOs = nil then Exit;
po := TPasCio(CIOs.FindListItem(AClassName));
if Assigned(po) then
Result := TPasItem(po.FindItem(ItemInsideClass));
end;
function TPasUnit.FindInsideSomeEnum(const EnumName, EnumMember: string): TPasItem;
var
TypeItem: TPasItem;
begin
Result := nil;
if Types = nil then Exit;
TypeItem := Types.FindListItem(EnumName);
if Assigned(TypeItem) and (TypeItem is TPasEnum) then
Result := TPasItem(TPasEnum(TypeItem).FindItem(EnumMember));
end;
function TPasUnit.FindItem(const ItemName: string): TBaseItem;
begin
if Constants <> nil then begin
Result := Constants.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if Types <> nil then begin
Result := Types.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if Variables <> nil then begin
Result := Variables.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if FuncsProcs <> nil then begin
Result := FuncsProcs.FindListItem(ItemName);
if Result <> nil then Exit;
end;
if CIOs <> nil then begin
Result := CIOs.FindListItem(ItemName);
if Result <> nil then Exit;
end;
Result := inherited FindItem(ItemName);
end;
function TPasUnit.FileNewerThanCache(const FileName: string): boolean;
begin
{$IFDEF COMPILER_10_UP}
Result := WasDeserialized and FileExists(FileName) and
(CacheDateTime < CheckGetFileDate(FileName));
{$ELSE}
Result := WasDeserialized and FileExists(FileName) and
(CacheDateTime < FileDateToDateTime(FileAge(FileName)));
{$ENDIF}
end;
procedure TPasUnit.Sort(const SortSettings: TSortSettings);
begin
inherited;
if CIOs <> nil then
begin
if ssCIOs in SortSettings then
CIOs.SortShallow;
CIOs.SortOnlyInsideItems(SortSettings);
end;
if (Constants <> nil) and (ssConstants in SortSettings) then
Constants.SortShallow;
if (FuncsProcs <> nil) and (ssFuncsProcs in SortSettings) then
FuncsProcs.SortShallow;
if (Types <> nil) and (ssTypes in SortSettings) then
Types.SortShallow;
if (Variables <> nil) and (ssVariables in SortSettings) then
Variables.SortShallow;
if (UsesUnits <> nil) and (ssUsesClauses in SortSettings) then
UsesUnits.Sort;
end;
procedure TPasUnit.Deserialize(const ASource: TStream);
begin
inherited;
FTypes.Deserialize(ASource);
FVariables.Deserialize(ASource);
FCIOs.Deserialize(ASource);
FConstants.Deserialize(ASource);
FFuncsProcs.Deserialize(ASource);
FUsesUnits.LoadFromBinaryStream(ASource);
ASource.Read(FIsUnit, SizeOf(FIsUnit));
ASource.Read(FIsProgram, SizeOf(FIsProgram));
{ No need to serialize, because it's not generated by parser:
FOutputFileName := LoadStringFromStream(ASource);
FSourceFilename := LoadStringFromStream(ASource);
SourceFileDateTime := LoadDoubleFromStream(ASource);}
end;
procedure TPasUnit.Serialize(const ADestination: TStream);
begin
inherited;
FTypes.Serialize(ADestination);
FVariables.Serialize(ADestination);
FCIOs.Serialize(ADestination);
FConstants.Serialize(ADestination);
FFuncsProcs.Serialize(ADestination);
FUsesUnits.SaveToBinaryStream(ADestination);
ADestination.Write(FIsUnit, SizeOf(FIsUnit));
ADestination.Write(FIsProgram, SizeOf(FIsProgram));
{ No need to serialize, because it's not generated by parser:
SaveStringToStream(FOutputFileName, ADestination);
SaveStringToStream(FSourceFilename, ADestination);
SaveDoubleToStream(SourceFileDateTime, ADestination); }
end;
function TPasUnit.BasePath: string;
begin
Result := ExtractFilePath(ExpandFileName(SourceFileName));
end;
{ TPasTypes ------------------------------------------------------------------ }
function TPasTypes.FindListItem(const AName: string): TPasItem;
var
I: Integer;
begin
Result := inherited;
if Result = nil then
begin
for I := 0 to Count - 1 do
if PasItemAt[I] is TPasEnum then
begin
Result := TPasEnum(PasItemAt[I]).FindItem(AName) as TPasItem;
if Result <> nil then
Exit;
end;
end;
end;
{ TPasUnits ------------------------------------------------------------------ }
function TPasUnits.ExistsUnit(const AUnit: TPasUnit): Boolean;
begin
Result := FindListItem(AUnit.Name) <> nil;
end;
function TPasUnits.GetUnitAt(const AIndex: Integer): TPasUnit;
begin
Result := TPasUnit(Items[AIndex]);
end;
procedure TPasUnits.SetUnitAt(const AIndex: Integer; const Value: TPasUnit);
begin
Items[AIndex] := Value;
end;
{ TPasMethod ----------------------------------------------------------------- }
constructor TPasMethod.Create;
begin
inherited;
end;
destructor TPasMethod.Destroy;
begin
inherited Destroy;
end;
procedure TPasMethod.StoreReturnsTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if TagParameter = '' then exit;
FReturns := TagParameter;
ReplaceStr := '';
end;
function TPasMethod.HasOptionalInfo: boolean;
begin
Result :=
(inherited HasOptionalInfo) or
(Returns <> '');
end;
procedure TPasMethod.Deserialize(const ASource: TStream);
begin
inherited;
ASource.Read(FWhat, SizeOf(FWhat));
{ No need to serialize, because it's not generated by parser:
FReturns := LoadStringFromStream(ASource);
}
end;
procedure TPasMethod.Serialize(const ADestination: TStream);
begin
inherited;
ADestination.Write(FWhat, SizeOf(FWhat));
{ No need to serialize, because it's not generated by parser:
SaveStringToStream(FReturns, ADestination);
}
end;
procedure TPasMethod.RegisterTags(TagManager: TTagManager);
begin
inherited;
TTopLevelTag.Create(TagManager, 'returns',
nil, {$IFDEF FPC}@{$ENDIF} StoreReturnsTag,
[toParameterRequired, toRecursiveTags, toAllowOtherTagsInsideByDefault,
toAllowNormalTextInside]);
TTopLevelTag.Create(TagManager, 'return',
nil, {$IFDEF FPC}@{$ENDIF} StoreReturnsTag,
[toParameterRequired, toRecursiveTags, toAllowOtherTagsInsideByDefault,
toAllowNormalTextInside]);
end;
{ TPasProperty --------------------------------------------------------------- }
procedure TPasProperty.Deserialize(const ASource: TStream);
begin
inherited;
ASource.Read(FDefault, SizeOf(FDefault));
ASource.Read(FNoDefault, SizeOf(FNoDefault));
FIndexDecl := LoadStringFromStream(ASource);
FStoredID := LoadStringFromStream(ASource);
FDefaultID := LoadStringFromStream(ASource);
FWriter := LoadStringFromStream(ASource);
FPropType := LoadStringFromStream(ASource);
FReader := LoadStringFromStream(ASource);
end;
procedure TPasProperty.Serialize(const ADestination: TStream);
begin
inherited;
ADestination.Write(FDefault, SizeOf(FDefault));
ADestination.Write(FNoDefault, SizeOf(FNoDefault));
SaveStringToStream(FIndexDecl, ADestination);
SaveStringToStream(FStoredID, ADestination);
SaveStringToStream(FDefaultID, ADestination);
SaveStringToStream(FWriter, ADestination);
SaveStringToStream(FPropType, ADestination);
SaveStringToStream(FReader, ADestination);
end;
{ TExternalItem ---------------------------------------------------------- }
procedure TExternalItem.AddAnchor(const AnchorItem: TAnchorItem);
begin
FAnchors.Add(AnchorItem);
end;
function TExternalItem.AddAnchor(const AnchorName: string): TAnchorItem;
begin
if FindItem(AnchorName) = nil then
begin
Result := TAnchorItem.Create;
Result.Name := AnchorName;
Result.ExternalItem := Self;
AddAnchor(Result);
end else
raise EAnchorAlreadyExists.CreateFmt(
'Within "%s" there already exists anchor "%s"',
[Name, AnchorName]);
end;
constructor TExternalItem.Create;
begin
inherited;
FAnchors := TBaseItems.Create(true);
end;
destructor TExternalItem.Destroy;
begin
FAnchors.Free;
inherited;
end;
function TExternalItem.FindItem(const ItemName: string): TBaseItem;
begin
result := nil;
if FAnchors <> nil then begin
Result := FAnchors.FindListItem(ItemName);
if Result <> nil then Exit;
end;
end;
procedure TExternalItem.HandleShortTitleTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if ShortTitle <> '' then
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@shorttitle tag was already specified for this item. ' +
'It was specified as "%s"', [ShortTitle]);
ShortTitle := TagParameter;
ReplaceStr := '';
end;
procedure TExternalItem.HandleTitleTag(
ThisTag: TTag; var ThisTagData: TObject;
EnclosingTag: TTag; var EnclosingTagData: TObject;
const TagParameter: string; var ReplaceStr: string);
begin
if Title <> '' then
ThisTag.TagManager.DoMessage(1, pmtWarning,
'@title tag was already specified for this item. ' +
'It was specified as "%s"', [Title]);
Title := TagParameter;
ReplaceStr := '';
end;
procedure TExternalItem.RegisterTags(TagManager: TTagManager);
begin
inherited;
TTopLevelTag.Create(TagManager, 'title',
nil, {$IFDEF FPC}@{$ENDIF} HandleTitleTag,
[toParameterRequired]);
TTopLevelTag.Create(TagManager, 'shorttitle',
nil, {$IFDEF FPC}@{$ENDIF} HandleShortTitleTag,
[toParameterRequired]);
end;
procedure TExternalItem.SetOutputFileName(const Value: string);
begin
FOutputFileName := Value;
end;
function TExternalItem.BasePath: string;
begin
Result := ExtractFilePath(ExpandFileName(SourceFileName));
end;
{ TExternalItemList ---------------------------------------------------------- }
function TExternalItemList.Get(Index: Integer): TExternalItem;
begin
Result := inherited Items[Index] as TExternalItem;
end;
{ global things ------------------------------------------------------------ }
function MethodTypeToString(const MethodType: TMethodType): string;
const
{ Maps @link(TMethodType) value to @link(TKeyWord) value.
When given TMethodType value doesn't correspond to any keyword,
it maps it to KEY_INVALIDKEYWORD. }
MethodTypeToKeyWord: array[TMethodType] of TKeyWord =
( KEY_CONSTRUCTOR,
KEY_DESTRUCTOR,
KEY_FUNCTION,
KEY_PROCEDURE,
KEY_INVALIDKEYWORD );
begin
if MethodType = METHOD_OPERATOR then
Result := StandardDirectiveArray[SD_OPERATOR] else
Result := KeyWordArray[MethodTypeToKeyWord[MethodType]];
Result := LowerCase(Result);
end;
function VisToStr(const Vis: TVisibility): string;
begin
result := StringReplace(string(VisibilityStr[Vis]), ' ', '', [rfReplaceAll]);
end;
function VisibilitiesToStr(const Visibilities: TVisibilities): string;
var Vis: TVisibility;
begin
Result := '';
for Vis := Low(Vis) to High(Vis) do
if Vis in Visibilities then
begin
if Result <> '' then Result := Result + ',';
Result := Result + VisToStr(Vis);
end;
end;
initialization
TSerializable.Register(TPasItem);
TSerializable.Register(TPasConstant);
TSerializable.Register(TPasFieldVariable);
TSerializable.Register(TPasType);
TSerializable.Register(TPasEnum);
TSerializable.Register(TPasMethod);
TSerializable.Register(TPasProperty);
TSerializable.Register(TPasCio);
TSerializable.Register(TPasUnit);
end.
|