1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 5154 5155 5156 5157 5158 5159 5160 5161 5162 5163 5164 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 5234 5235 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 5271 5272 5273 5274 5275 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 5291 5292 5293 5294 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 5465 5466 5467 5468 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 5619 5620 5621 5622 5623 5624 5625 5626 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 5681 5682 5683 5684 5685 5686 5687 5688 5689 5690 5691 5692 5693 5694 5695 5696 5697 5698 5699 5700 5701 5702 5703 5704 5705 5706 5707 5708 5709 5710 5711 5712 5713 5714 5715 5716 5717 5718 5719 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 5903 5904 5905 5906 5907 5908 5909 5910 5911 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 5969 5970 5971 5972 5973 5974 5975 5976 5977 5978 5979 5980 5981 5982 5983 5984 5985 5986 5987 5988 5989 5990 5991 5992 5993 5994 5995 5996 5997 5998 5999 6000 6001 6002 6003 6004 6005 6006 6007 6008 6009 6010 6011 6012 6013 6014 6015 6016 6017 6018 6019 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 6087 6088 6089 6090 6091 6092 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 6123 6124 6125 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 6141 6142 6143 6144 6145 6146 6147 6148 6149 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 6165 6166 6167 6168 6169 6170 6171 6172 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 6188 6189 6190 6191 6192 6193 6194 6195 6196 6197 6198 6199 6200 6201 6202 6203 6204 6205 6206 6207 6208 6209 6210 6211 6212 6213 6214 6215 6216 6217 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 6249 6250 6251 6252 6253 6254 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 6298 6299 6300 6301 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 6317 6318 6319 6320 6321 6322 6323 6324 6325 6326 6327 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 6345 6346 6347 6348 6349 6350 6351 6352 6353 6354 6355 6356 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 6375 6376 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 6446 6447 6448 6449 6450 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 6471 6472 6473 6474 6475 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 6499 6500 6501 6502 6503 6504 6505 6506 6507 6508 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 6572 6573 6574 6575 6576 6577 6578 6579 6580 6581 6582 6583 6584 6585 6586 6587 6588 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 6612 6613 6614 6615 6616 6617 6618 6619 6620 6621 6622 6623 6624 6625 6626 6627 6628 6629 6630 6631 6632 6633 6634 6635 6636 6637 6638 6639 6640 6641 6642 6643 6644 6645 6646 6647 6648 6649 6650 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 6666 6667 6668 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 6684 6685 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 6704 6705 6706 6707 6708 6709 6710 6711 6712 6713 6714 6715 6716 6717 6718 6719 6720 6721 6722 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 6784 6785 6786 6787 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 6821 6822 6823 6824 6825 6826 6827 6828 6829 6830 6831 6832 6833 6834 6835 6836 6837 6838 6839 6840 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 6856 6857 6858 6859 6860 6861 6862 6863 6864 6865 6866 6867 6868 6869 6870 6871 6872 6873 6874 6875 6876 6877 6878 6879 6880 6881 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 6939 6940 6941 6942 6943 6944 6945 6946 6947 6948 6949 6950 6951 6952 6953 6954 6955 6956 6957 6958 6959 6960 6961 6962 6963 6964 6965 6966 6967 6968 6969 6970 6971 6972 6973 6974 6975 6976 6977 6978 6979 6980 6981 6982 6983 6984 6985 6986 6987 6988 6989 6990 6991 6992 6993 6994 6995 6996 6997 6998 6999 7000 7001 7002 7003 7004 7005 7006 7007 7008 7009 7010 7011 7012 7013 7014 7015 7016 7017 7018 7019 7020 7021 7022 7023 7024 7025 7026 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 7063 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080 7081 7082 7083 7084 7085 7086 7087 7088 7089 7090 7091 7092 7093 7094 7095 7096 7097 7098 7099 7100 7101 7102 7103 7104 7105 7106 7107 7108 7109 7110 7111 7112 7113 7114 7115 7116 7117 7118 7119 7120 7121 7122 7123 7124 7125 7126 7127 7128 7129 7130 7131 7132 7133 7134 7135 7136 7137 7138 7139 7140 7141 7142 7143 7144 7145 7146 7147 7148 7149 7150 7151 7152 7153 7154 7155 7156 7157 7158 7159 7160 7161 7162 7163 7164 7165 7166 7167 7168 7169 7170 7171 7172 7173 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 7261 7262 7263 7264 7265 7266 7267 7268 7269 7270 7271 7272 7273 7274 7275 7276 7277 7278 7279 7280 7281 7282 7283 7284 7285 7286 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 7302 7303 7304 7305 7306 7307 7308 7309 7310 7311 7312 7313 7314 7315 7316 7317 7318 7319 7320 7321 7322 7323 7324 7325 7326 7327 7328 7329 7330 7331 7332 7333 7334 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 7372 7373 7374 7375 7376 7377 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 7440 7441 7442 7443 7444 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 7460 7461 7462 7463 7464 7465 7466 7467 7468 7469 7470 7471 7472 7473 7474 7475 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 7495 7496 7497 7498 7499 7500 7501 7502 7503 7504 7505 7506 7507 7508 7509 7510 7511 7512 7513 7514 7515 7516 7517 7518 7519 7520 7521 7522 7523 7524 7525 7526 7527 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 7552 7553 7554 7555 7556 7557 7558 7559 7560 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 7576 7577 7578 7579 7580 7581 7582 7583 7584 7585 7586 7587 7588 7589 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 7623 7624 7625 7626 7627 7628 7629 7630 7631 7632 7633 7634 7635 7636 7637 7638 7639 7640 7641 7642 7643 7644 7645 7646 7647 7648 7649 7650 7651 7652 7653 7654 7655 7656 7657 7658 7659 7660 7661 7662 7663 7664 7665 7666 7667 7668 7669 7670 7671 7672 7673 7674 7675 7676 7677 7678 7679 7680 7681 7682 7683 7684 7685 7686 7687 7688 7689 7690 7691 7692 7693 7694 7695 7696 7697 7698 7699 7700 7701 7702 7703 7704 7705 7706 7707 7708 7709 7710 7711 7712 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722 7723 7724 7725 7726 7727 7728 7729 7730 7731 7732 7733 7734 7735 7736 7737 7738 7739 7740 7741 7742 7743 7744 7745 7746 7747 7748 7749 7750 7751 7752 7753 7754 7755 7756 7757 7758 7759 7760 7761 7762 7763 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 7779 7780 7781 7782 7783 7784 7785 7786 7787 7788 7789 7790 7791 7792 7793 7794 7795 7796 7797 7798 7799 7800 7801 7802 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 7821 7822 7823 7824 7825 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 7857 7858 7859 7860 7861 7862 7863 7864 7865 7866 7867 7868 7869 7870 7871 7872 7873 7874 7875 7876 7877 7878 7879 7880 7881 7882 7883 7884 7885 7886 7887 7888 7889 7890 7891 7892 7893 7894 7895 7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 7944 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 7966 7967 7968 7969 7970 7971 7972 7973 7974 7975 7976 7977 7978 7979 7980 7981 7982 7983 7984 7985 7986 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 8002 8003 8004 8005 8006 8007 8008 8009 8010 8011 8012 8013 8014 8015 8016 8017 8018 8019 8020 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 8036 8037 8038 8039 8040 8041 8042 8043 8044 8045 8046 8047 8048 8049 8050 8051 8052 8053 8054 8055 8056 8057 8058 8059 8060 8061 8062 8063 8064 8065 8066 8067 8068 8069 8070 8071 8072 8073 8074 8075 8076 8077 8078 8079 8080 8081 8082 8083 8084 8085 8086 8087 8088 8089 8090 8091 8092 8093 8094 8095 8096 8097 8098 8099 8100 8101 8102 8103 8104 8105 8106 8107 8108 8109 8110 8111 8112 8113 8114 8115 8116 8117 8118 8119 8120 8121 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 8138 8139 8140 8141 8142 8143 8144 8145 8146 8147 8148 8149 8150 8151 8152 8153 8154 8155 8156 8157 8158 8159 8160 8161 8162 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 8190 8191 8192 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 8253 8254 8255 8256 8257 8258 8259 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 8298 8299 8300 8301 8302 8303 8304 8305 8306 8307 8308 8309 8310 8311 8312 8313 8314 8315 8316 8317 8318 8319 8320 8321 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 8337 8338 8339 8340 8341 8342 8343 8344 8345 8346 8347 8348 8349 8350 8351 8352 8353 8354 8355 8356 8357 8358 8359 8360 8361 8362 8363 8364 8365 8366 8367 8368 8369 8370 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 8386 8387 8388 8389 8390 8391 8392 8393 8394 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 8421 8422 8423 8424 8425 8426 8427 8428 8429 8430 8431 8432 8433 8434 8435 8436 8437 8438 8439 8440 8441 8442 8443 8444 8445 8446 8447 8448 8449 8450 8451 8452 8453 8454 8455 8456 8457 8458 8459 8460 8461 8462 8463 8464 8465 8466 8467 8468 8469 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 8485 8486 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 8519 8520 8521 8522 8523 8524 8525 8526 8527 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 8573 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 8693 8694 8695 8696 8697 8698 8699 8700 8701 8702 8703 8704 8705 8706 8707 8708 8709 8710 8711 8712 8713 8714 8715 8716 8717 8718 8719 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 8742 8743 8744 8745 8746 8747 8748 8749 8750 8751 8752 8753 8754 8755 8756 8757 8758 8759 8760 8761 8762 8763 8764 8765 8766 8767 8768 8769 8770 8771 8772 8773 8774 8775 8776 8777 8778 8779 8780 8781 8782 8783 8784 8785 8786 8787 8788 8789 8790 8791 8792 8793 8794 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 8817 8818 8819 8820 8821 8822 8823 8824 8825 8826 8827 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 8911 8912 8913 8914 8915 8916 8917 8918 8919 8920 8921 8922 8923 8924 8925 8926 8927 8928 8929 8930 8931 8932 8933 8934 8935 8936 8937 8938 8939 8940 8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 9058 9059 9060 9061 9062 9063 9064 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 9080 9081 9082 9083 9084 9085 9086 9087 9088 9089 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 9120 9121 9122 9123 9124 9125 9126 9127 9128 9129 9130 9131 9132 9133 9134 9135 9136 9137 9138 9139 9140 9141 9142 9143 9144 9145 9146 9147 9148 9149 9150 9151 9152 9153 9154 9155 9156 9157 9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 9186 9187 9188 9189 9190 9191 9192 9193 9194 9195 9196 9197 9198 9199 9200 9201 9202 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226
|
;;; files.el --- file input and output commands -*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 1992-2025 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Defines Emacs's basic file- and directory-handling functions,
;; including file visiting, backup file generation and versioning,
;; link handling, load- and write-hook handling, and the like.
;;; Code:
(eval-when-compile
(require 'pcase)
(require 'easy-mmode)) ; For `define-minor-mode'.
(defvar font-lock-keywords)
(defgroup backup nil
"Backups of edited data files."
:group 'files)
(defgroup find-file nil
"Finding files."
:group 'files)
(defcustom directory-abbrev-alist
nil
"Alist of abbreviations for file directories.
A list of elements of the form (FROM . TO), each meaning to replace
a match for FROM with TO when a directory name matches FROM. This
replacement is done when setting up the default directory of a
newly visited file buffer.
FROM is a regexp that is matched against directory names anchored at
the first character, so it should start with a \"\\\\\\=`\", or, if
directory names cannot have embedded newlines, with a \"^\".
FROM and TO should be equivalent names, which refer to the
same directory. TO should be an absolute directory name.
Do not use `~' in the TO strings.
Use this feature when you have directories that you normally refer to
via absolute symbolic links. Make TO the name of the link, and FROM
a regexp matching the name it is linked to."
:type '(repeat (cons :format "%v"
:value ("\\`" . "")
(regexp :tag "From")
(string :tag "To")))
:group 'abbrev
:group 'find-file)
(defun directory-abbrev-make-regexp (directory)
"Create a regexp to match DIRECTORY for `directory-abbrev-alist'."
(let ((regexp
;; We include a slash at the end, to avoid spurious
;; matches such as `/usr/foobar' when the home dir is
;; `/usr/foo'.
(concat "\\`" (regexp-quote directory) "\\(/\\|\\'\\)")))
;; The value of regexp could be multibyte or unibyte. In the
;; latter case, we need to decode it.
(if (multibyte-string-p regexp)
regexp
(decode-coding-string regexp
(if (eq system-type 'windows-nt)
'utf-8
locale-coding-system)))))
(defun directory-abbrev-apply (filename)
"Apply the abbreviations in `directory-abbrev-alist' to FILENAME.
Note that when calling this, you should set `case-fold-search' as
appropriate for the filesystem used for FILENAME."
(dolist (dir-abbrev directory-abbrev-alist filename)
(when (string-match (car dir-abbrev) filename)
(setq filename (concat (cdr dir-abbrev)
(substring filename (match-end 0)))))))
(defcustom make-backup-files t
"Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.
Renaming means that Emacs renames the existing file so that it is a
backup file, then writes the buffer into a new file. Any other names
that the old file had will now refer to the backup file. The new file
is owned by you and its group is defaulted.
Copying means that Emacs copies the existing file into the backup
file, then writes the buffer on top of the existing file. Any other
names that the old file had will now refer to the new (edited) file.
The file's owner and group are unchanged.
The choice of renaming or copying is controlled by the variables
`backup-by-copying', `backup-by-copying-when-linked',
`backup-by-copying-when-mismatch' and
`backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
:type 'boolean
:group 'backup)
;; Do this so that local variables based on the file name
;; are not overridden by the major mode.
(defvar backup-inhibited nil
"If non-nil, backups will be inhibited.
This variable is intended for use by making it local to a buffer,
but it is not an automatically buffer-local variable.")
(put 'backup-inhibited 'permanent-local t)
(defcustom backup-by-copying nil
"Non-nil means always use copying to create backup files.
See documentation of variable `make-backup-files'."
:type 'boolean
:group 'backup)
(defcustom backup-by-copying-when-linked nil
"Non-nil means use copying to create backups for files with multiple names.
This causes the alternate names to refer to the latest version as edited.
This variable is relevant only if `backup-by-copying' is nil."
:type 'boolean
:group 'backup)
(defcustom backup-by-copying-when-mismatch t
"Non-nil means create backups by copying if this preserves owner or group.
Renaming may still be used (subject to control of other variables)
when it would not result in changing the owner or group of the file;
that is, for files that are owned by you and whose group matches
the default for a new file created there by you.
This variable is relevant only if `backup-by-copying' is nil."
:version "24.1"
:type 'boolean
:group 'backup)
(put 'backup-by-copying-when-mismatch 'permanent-local t)
(defcustom backup-by-copying-when-privileged-mismatch 200
"Non-nil means create backups by copying to preserve a privileged owner.
Renaming may still be used (subject to control of other variables)
when it would not result in changing the owner of the file or if the
user id and group id of the file are both greater than the value of
this variable. This is useful when low-numbered uid's and gid's are
used for special system users (such as root) that must maintain
ownership of certain files.
This variable is relevant only if `backup-by-copying' and
`backup-by-copying-when-mismatch' are nil."
:type '(choice (const nil) integer)
:group 'backup)
(defvar backup-enable-predicate 'normal-backup-enable-predicate
"Predicate that looks at a file name and decides whether to make backups.
Called with an absolute file name as argument, it returns t to enable backup.")
(defcustom buffer-offer-save nil
"Non-nil in a buffer means always offer to save buffer on exiting Emacs.
Do so even if the buffer is not visiting a file.
Automatically local in all buffers.
Set to the symbol `always' to offer to save buffer whenever
`save-some-buffers' is called.
Note that this option has no effect on `kill-buffer';
if you want to control what happens when a buffer is killed,
use `kill-buffer-query-functions'."
:type '(choice (const :tag "Never" nil)
(const :tag "On Emacs exit" t)
(const :tag "Whenever save-some-buffers is called" always))
:group 'backup)
(make-variable-buffer-local 'buffer-offer-save)
(put 'buffer-offer-save 'permanent-local t)
(defcustom find-file-existing-other-name t
"Non-nil means find a file under alternative names, in existing buffers.
This means if any existing buffer is visiting the file you want
under another name, you get the existing buffer instead of a new buffer."
:type 'boolean
:group 'find-file)
(defcustom find-file-visit-truename nil
"Non-nil means visiting a file uses its truename as the visited-file name.
That is, the buffer visiting the file has the truename as the
value of `buffer-file-name'. The truename of a file is found by
chasing all links both at the file level and at the levels of the
containing directories."
:type 'boolean
:group 'find-file)
(defcustom revert-without-query nil
"Specify which files should be reverted without query.
The value is a list of regular expressions.
If the file name matches one of these regular expressions,
then `revert-buffer' reverts the file without querying
if the file has changed on disk and you have not edited the buffer."
:type '(repeat regexp)
:group 'find-file)
(defvar-local buffer-file-number nil
"The inode number and the device of the file visited in the current buffer.
The value is a list of the form (INODENUM DEVICE), where DEVICE can be
either a single number or a cons cell of two numbers.
This tuple of numbers uniquely identifies the file.
If the buffer is visiting a new file, the value is nil.")
(put 'buffer-file-number 'permanent-local t)
(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
"Non-nil means that `buffer-file-number' uniquely identifies files.")
(defvar-local buffer-file-read-only nil
"Non-nil if visited file was read-only when visited.")
(defcustom small-temporary-file-directory
(if (eq system-type 'ms-dos) (getenv "TMPDIR"))
"The directory for writing small temporary files.
If non-nil, this directory is used instead of `temporary-file-directory'
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
:initialize #'custom-initialize-delay
:type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device (purecopy "/dev/null") "The system null device.")
(declare-function msdos-long-file-names "msdos.c")
(declare-function w32-long-file-name "w32proc.c")
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(declare-function dired-unmark "dired" (arg &optional interactive))
(declare-function dired-do-flagged-delete "dired" (&optional nomessage))
(declare-function dos-8+3-filename "dos-fns" (filename))
(declare-function dosified-file-name "dos-fns" (file-name))
(defvar file-name-invalid-regexp
(cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
(purecopy
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
"[\000-\037]\\|" ; control characters
"\\(/\\.\\.?[^/]\\)\\|" ; leading dots
"\\(/[^/.]+\\.[^/.]*\\.\\)"))) ; more than a single dot
((memq system-type '(ms-dos windows-nt cygwin))
(purecopy
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[|<>\"?*\000-\037]"))) ; invalid characters
(t (purecopy "[\000]")))
"Regexp recognizing file names that aren't allowed by the filesystem.")
(defcustom file-precious-flag nil
"Non-nil means protect against I/O errors while saving files.
Some modes set this non-nil in particular buffers.
This feature works by writing the new contents into a temporary file
and then renaming the temporary file to replace the original.
In this way, any I/O error in writing leaves the original untouched,
and there is never any instant where the file is nonexistent.
Note that this feature forces backups to be made by copying.
Yet, at the same time, saving a precious file
breaks any hard links between it and other files.
This feature is advisory: for example, if the directory in which the
file is being saved is not writable, Emacs may ignore a non-nil value
of `file-precious-flag' and write directly into the file.
See also: `break-hardlink-on-save' and `file-preserve-symlinks-on-save'."
:type 'boolean
:group 'backup)
(defcustom break-hardlink-on-save nil
"Whether to allow breaking hardlinks when saving files.
If non-nil, then when saving a file that exists under several
names \(i.e., has multiple hardlinks), break the hardlink
associated with `buffer-file-name' and write to a new file, so
that the other instances of the file are not affected by the
save.
If `buffer-file-name' refers to a symlink, do not break the symlink.
Unlike `file-precious-flag', `break-hardlink-on-save' is not advisory.
For example, if the directory in which a file is being saved is not
itself writable, then error instead of saving in some
hardlink-nonbreaking way.
See also `backup-by-copying' and `backup-by-copying-when-linked'."
:type 'boolean
:group 'files
:version "23.1")
(defcustom version-control nil
"Control use of version-numbered backup files.
When t, make numbered backup files unconditionally.
When nil, make them for files that already have numbered backups.
The value `never' means never make numbered backups."
:type '(choice (const :tag "Never" never)
(const :tag "If numbered backups exist" nil)
(other :tag "Always" t))
:safe #'version-control-safe-local-p
:group 'backup)
(defun version-control-safe-local-p (x)
"Return whether X is safe as local value for `version-control'."
(or (booleanp x) (equal x 'never)))
(defcustom dired-kept-versions 2
"When cleaning directory, number of versions of numbered backups to keep.
See `version-control', `kept-old-versions' and `kept-new-versions' for
more about keeping and deleting old versioned (a.k.a. \"numbered\")
backup files."
:type 'natnum
:group 'backup
:group 'dired)
(defcustom delete-old-versions nil
"If t, delete excess numbered backup files silently.
If nil, ask confirmation. Any other value prevents any trimming.
See `version-control', `kept-old-versions', `kept-new-versions'
and `dired-kept-versions' for more about keeping and deleting old
versioned (a.k.a. \"numbered\") backup files."
:type '(choice (const :tag "Delete" t)
(const :tag "Ask" nil)
(other :tag "Leave" other))
:group 'backup)
(defcustom kept-old-versions 2
"Number of oldest versions to keep when a new numbered backup is made.
See `version-control' for how Emacs decides when to make numbered backups."
:type 'natnum
:safe #'natnump
:group 'backup)
(defcustom kept-new-versions 2
"Number of newest versions to keep when a new numbered backup is made.
Includes the new backup. Must be greater than 0.
See `version-control' for how Emacs decides when to make numbered backups."
:type 'natnum
:safe #'natnump
:group 'backup)
(defcustom require-final-newline nil
"Whether to add a newline automatically at the end of the file.
A value of t means do this only when the file is about to be saved.
A value of `visit' means do this right after the file is visited.
A value of `visit-save' means do it at both of those times.
Any other non-nil value means ask user whether to add a newline, when saving.
A value of nil means don't add newlines.
Certain major modes set this locally to the value obtained
from `mode-require-final-newline'.
This variable is heeded only when visiting files (or saving
buffers into files they visit). Writing data to the file system
with `write-region' and the like is not influenced by this variable."
:safe #'symbolp
:type '(choice (const :tag "When visiting" visit)
(const :tag "When saving" t)
(const :tag "When visiting or saving" visit-save)
(const :tag "Don't add newlines" nil)
(other :tag "Ask each time" ask))
:group 'editing-basics)
(defcustom mode-require-final-newline t
"Whether to add a newline at end of file, in certain major modes.
Those modes set `require-final-newline' to this value when you enable them.
They do so because they are often used for files that are supposed
to end in newlines, and the question is how to arrange that.
A value of t means do this only when the file is about to be saved.
A value of `visit' means do this right after the file is visited.
A value of `visit-save' means do it at both of those times.
Any other non-nil value means ask user whether to add a newline, when saving.
A value of nil means do not add newlines. That is a risky choice in this
variable since this value is used for modes for files that ought to have
final newlines. So if you set this to nil, you must explicitly check and
add a final newline, whenever you save a file that really needs one."
:type '(choice (const :tag "When visiting" visit)
(const :tag "When saving" t)
(const :tag "When visiting or saving" visit-save)
(const :tag "Don't add newlines" nil)
(other :tag "Ask each time" ask))
:group 'editing-basics
:version "22.1")
(defcustom auto-save-default t
"Non-nil says by default do auto-saving of every file-visiting buffer."
:type 'boolean
:group 'auto-save)
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
;; Don't put "\\2" inside expand-file-name, since it will be
;; transformed to "/2" on DOS/Windows.
,(concat temporary-file-directory "\\2") t))
"Transforms to apply to buffer file name before making auto-save file name.
Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
REGEXP is a regular expression to match against the file name.
If it matches, `replace-match' is used to replace the
matching part with REPLACEMENT.
If the optional element UNIQUIFY is nil, Emacs does not check for
file name clashes, so using that is not recommended. If UNIQUIFY
is one of the members of `secure-hash-algorithms', Emacs
constructs the nondirectory part of the auto-save file name by
applying that `secure-hash' to the buffer file name. This avoids
any risk of excessively long file names. Finally, if UNIQUIFY is
any other value the auto-save file name is constructed by taking
the directory part of the replaced file-name, concatenated with
the buffer file name with all directory separators changed to `!'
to prevent clashes. This will not work correctly if your
filesystem truncates the resulting name.
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
no further transforms are tried.
The default value is set up to put the auto-save file into the
temporary directory (see the variable `temporary-file-directory') for
editing a remote file.
On MS-DOS filesystems without long names this variable is always
ignored."
:group 'auto-save
:type `(repeat (list (regexp :tag "Regexp")
(string :tag "Replacement")
(choice
(const :tag "Uniquify" t)
,@(mapcar (lambda (algo)
(list 'const algo))
(secure-hash-algorithms)))))
:initialize #'custom-initialize-delay
:version "21.1")
(defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
(defcustom auto-save-visited-interval 5
"Interval in seconds for `auto-save-visited-mode'.
If `auto-save-visited-mode' is enabled, Emacs will save all
buffers visiting a file to the visited file after it has been
idle for `auto-save-visited-interval' seconds."
:group 'auto-save
:type 'number
:version "26.1"
:set (lambda (symbol value)
(set-default symbol value)
(when auto-save--timer
(timer-set-idle-time auto-save--timer value :repeat))))
(defcustom auto-save-visited-predicate nil
"Predicate function for `auto-save-visited-mode'.
If non-nil, the value should be a function of no arguments; it
will be called once in each file-visiting buffer when the time
comes to auto-save. A buffer will be saved only if the predicate
function returns a non-nil value.
For example, you could add this to your Init file to only save
files that are both in Org mode and in a particular directory:
(setq auto-save-visited-predicate
(lambda () (and (eq major-mode \\='org-mode)
(string-match \"^/home/skangas/org/\"
buffer-file-name))))
If the value of this variable is not a function, it is ignored.
This is the same as having a predicate that always returns
non-nil."
:group 'auto-save
:type '(choice :tag "Function:"
(const :tag "No extra predicate" :value nil)
(function :tag "Predicate function" :value always))
:risky t
:version "29.1")
(defcustom remote-file-name-inhibit-auto-save-visited nil
"When nil, `auto-save-visited-mode' will auto-save remote files.
Any other value means that it will not."
:group 'auto-save
:group 'tramp
:type 'boolean
:version "29.1")
(define-minor-mode auto-save-visited-mode
"Toggle automatic saving of file-visiting buffers to their files.
When this mode is enabled, file-visiting buffers are automatically
saved to their files. This is in contrast to `auto-save-mode', which
auto-saves those buffers to a separate file, leaving the original
file intact. See Info node `Saving' for details of the save process.
The user option `auto-save-visited-interval' controls how often to
auto-save a buffer into its visited file.
You can use `auto-save-visited-predicate' to control which
buffers are saved.
You can also set the buffer-local value of the variable
`auto-save-visited-mode' to nil. A buffer where the buffer-local
value of this variable is nil is ignored for the purpose of
`auto-save-visited-mode', even if `auto-save-visited-mode' is
enabled.
For more details, see Info node `(emacs) Auto Save Files'."
:group 'auto-save
:global t
(when auto-save--timer (cancel-timer auto-save--timer))
(setq auto-save--timer
(when auto-save-visited-mode
(run-with-idle-timer
auto-save-visited-interval :repeat
#'save-some-buffers :no-prompt
(lambda ()
(and buffer-file-name
auto-save-visited-mode
(not (and buffer-auto-save-file-name
auto-save-visited-file-name))
(or (not (file-remote-p buffer-file-name))
(not remote-file-name-inhibit-auto-save-visited))
(or (not (functionp auto-save-visited-predicate))
(funcall auto-save-visited-predicate))))))))
;; The 'set' part is so we don't get a warning for using this variable
;; above, while still catching code that _sets_ the variable to get
;; the same effect as the new auto-save-visited-mode.
(make-obsolete-variable 'auto-save-visited-file-name 'auto-save-visited-mode
"Emacs 26.1" 'set)
(defcustom save-abbrevs t
"Non-nil means save word abbrevs too when files are saved.
If `silently', don't ask the user before saving."
:type '(choice (const t) (const nil) (const silently))
:group 'abbrev)
(defcustom lock-file-name-transforms nil
"Transforms to apply to buffer file name before making a lock file name.
This has the same syntax as `auto-save-file-name-transforms',
but applies to lock file names instead of auto-save file names.
By default, Emacs puts each lock file into the same directory as the
file it locks, prepending \".#\" to the base file name.
Note that changing this could break lock file functionality, e.g.:
if different users access the same file, using different lock file settings;
if accessing files on a shared file system from different hosts,
using a transform that puts the lock files on a local file system."
:group 'files
:type '(repeat (list (regexp :tag "Regexp")
(string :tag "Replacement")
(boolean :tag "Uniquify")))
:version "28.1")
(defcustom remote-file-name-inhibit-locks nil
"Whether to create file locks for remote files."
:group 'files
:group 'tramp
:version "28.1"
:type 'boolean)
(define-minor-mode lock-file-mode
"Toggle file locking in the current buffer (Lock File mode)."
:version "28.1"
(setq-local create-lockfiles (and lock-file-mode t)))
(defcustom find-file-run-dired t
"Non-nil means allow `find-file' to visit directories.
To visit the directory, `find-file' runs `find-directory-functions'."
:type 'boolean
:group 'find-file)
(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
"List of functions to try in sequence to visit a directory.
Each function is called with the directory name as the sole argument
and should return either a buffer or nil."
:type '(hook :options (cvs-dired-noselect dired-noselect))
:group 'find-file)
;; FIXME: also add a hook for `(thing-at-point 'filename)'
(defcustom file-name-at-point-functions '(ffap-guess-file-name-at-point)
"List of functions to try in sequence to get a file name at point.
Each function should return either nil or a file name found at the
location of point in the current buffer."
:type '(hook :options (ffap-guess-file-name-at-point))
:group 'find-file)
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-functions 'permanent-local t)
(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hook 'permanent-local t)
;; I found some external files still using the obsolete form in 2018.
(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
(defcustom find-file-hook nil
"List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
functions are called. This includes directory-local variables, if any,
for the file's directory."
:group 'find-file
:type 'hook
:options '(auto-insert)
:version "22.1")
;; I found some external files still using the obsolete form in 2018.
(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar write-file-functions nil
"List of functions to be called before saving a buffer to a file.
Used only by `save-buffer'.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the visited file.
So any buffer-local binding of this variable is discarded if you change
the visited file name with \\[set-visited-file-name], but not when you
change the major mode.
This hook is not run if any of the functions in
`write-contents-functions' returns non-nil. Both hooks pertain
to how to save a buffer to file, for instance, choosing a suitable
coding system and setting mode bits. (See Info
node `(elisp)Saving Buffers'.) To perform various checks or
updates before the buffer is saved, use `before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
;; I found some files still using the obsolete form in 2018.
(defvar-local local-write-file-hooks nil)
(put 'local-write-file-hooks 'permanent-local t)
(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
;; I found some files still using the obsolete form in 2018.
(define-obsolete-variable-alias 'write-contents-hooks
'write-contents-functions "22.1")
(defvar-local write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
Used only by `save-buffer'. If one of them returns non-nil, the
file is considered already written and the rest are not called
and neither are the functions in `write-file-functions'. This
hook can thus be used to create save behavior for buffers that
are not visiting a file at all.
This variable is meant to be used for hooks that pertain to the
buffer's contents, not to the particular visited file; thus,
`set-visited-file-name' does not clear this variable; but changing the
major mode does clear it.
For hooks that _do_ pertain to the particular visited file, use
`write-file-functions'. Both this variable and
`write-file-functions' relate to how a buffer is saved to file.
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
The value can be t, nil, :safe, :all, or something else.
A value of t means file local variables specifications are obeyed
if all the specified variable values are safe; if any values are
not safe, Emacs queries you, once, whether to set them all.
\(When you say yes to certain values, they are remembered as safe.)
:safe means set the safe variables, and ignore the rest.
:all means set all variables, whether safe or not.
(Don't set it permanently to :all.)
A value of nil means always ignore the file local variables.
Any other value means always query you once whether to set them all.
\(When you say yes to certain values, they are remembered as safe, but
this has no effect when `enable-local-variables' is \"something else\".)
This variable also controls use of major modes specified in
a -*- line.
The command \\[normal-mode], when used interactively,
always obeys file local variable specifications and the -*- line,
and ignores this variable.
Also see the `permanently-enabled-local-variables' and
`safe-local-variable-directories' variables."
:risky t
:type '(choice (const :tag "Query Unsafe" t)
(const :tag "Safe Only" :safe)
(const :tag "Do all" :all)
(const :tag "Ignore" nil)
(other :tag "Query" other))
:group 'find-file)
(defvar enable-dir-local-variables t
"Non-nil means enable use of directory-local variables.
Some modes may wish to set this to nil to prevent directory-local
settings being applied, but still respect file-local ones.")
(defvar-local untrusted-content nil
"Non-nil means that current buffer originated from an untrusted source.
Email clients and some other modes may set this non-nil to mark the
buffer contents as untrusted.
This variable might be subject to change without notice.")
(put 'untrusted-content 'permanent-local t)
(defcustom trusted-content nil
"List of files and directories whose content we trust.
Be extra careful here since trusting means that Emacs might execute the
code contained within those files and directories without an explicit
request by the user.
One important case when this might happen is when `flymake-mode' is
enabled (for example, when it is added to a mode hook).
Each element of the list should be a string:
- If it ends in \"/\", it is considered as a directory name and means that
Emacs should trust all the files whose name has this directory as a prefix.
- Otherwise, it is considered a file name.
Use abbreviated file names. For example, an entry \"~/mycode/\" means
that Emacs will trust all the files in your directory \"mycode\".
This variable can also be set to `:all', in which case Emacs will trust
all files, which opens a gaping security hole. Emacs Lisp authors
should note that this value must never be set by a major or minor mode."
:type '(choice (repeat :tag "List" file)
(const :tag "Trust everything (DANGEROUS!)" :all))
:version "30.1")
(put 'trusted-content 'risky-local-variable t)
(defun trusted-content-p ()
"Return non-nil if we trust the contents of the current buffer.
Here, \"trust\" means that we are willing to run code found inside of it.
See also `trusted-content'."
;; We compare with `buffer-file-truename' i.s.o `buffer-file-name'
;; to try and avoid marking as trusted a file that's merely accessed
;; via a symlink that happens to be inside a trusted dir.
(and (not untrusted-content)
(or
(eq trusted-content :all)
(and
buffer-file-truename
(with-demoted-errors "trusted-content-p: %S"
(let ((exists (file-exists-p buffer-file-truename)))
(or
;; We can't avoid trusting the user's init file.
(if (and exists user-init-file)
(file-equal-p buffer-file-truename user-init-file)
(equal buffer-file-truename user-init-file))
(let ((file (abbreviate-file-name buffer-file-truename))
(trusted nil))
(dolist (tf trusted-content)
(when (or (if exists (file-equal-p tf file) (equal tf file))
;; We don't use `file-in-directory-p' here, because
;; we want to err on the conservative side: "guilty
;; until proven innocent".
(and (string-suffix-p "/" tf)
(string-prefix-p tf file)))
(setq trusted t)))
trusted))))))))
;; This is an odd variable IMO.
;; You might wonder why it is needed, when we could just do:
;; (setq-local enable-local-variables nil)
;; These two are not precisely the same.
;; Setting this variable does not cause -*- mode settings to be
;; ignored, whereas setting enable-local-variables does.
;; Only three places in Emacs use this variable: tar and arc modes,
;; and rmail. The first two don't need it. They already use
;; inhibit-local-variables-regexps, which is probably enough, and
;; could also just set enable-local-variables locally to nil.
;; Them setting it has the side-effect that dir-locals cannot apply to
;; eg tar files (?). FIXME Is this appropriate?
;; AFAICS, rmail is the only thing that needs this, and the only
;; reason it uses it is for BABYL files (which are obsolete).
;; These contain "-*- rmail -*-" in the first line, which rmail wants
;; to respect, so that find-file on a BABYL file will switch to
;; rmail-mode automatically (this is nice, but hardly essential,
;; since most people are used to explicitly running a command to
;; access their mail; M-x gnus etc). Rmail files may happen to
;; contain Local Variables sections in messages, which Rmail wants to
;; ignore. So AFAICS the only reason this variable exists is for a
;; minor convenience feature for handling of an obsolete Rmail file format.
(defvar local-enable-local-variables t
"Like `enable-local-variables', except for major mode in a -*- line.
The meaningful values are nil and non-nil. The default is non-nil.
It should be set in a buffer-local fashion.
Setting this to nil has the same effect as setting `enable-local-variables'
to nil, except that it does not ignore any mode: setting in a -*- line.
Unless this difference matters to you, you should set `enable-local-variables'
instead of this variable.")
(defcustom enable-local-eval 'maybe
"Control processing of the \"variable\" `eval' in a file's local variables.
The value can be t, nil or something else.
A value of t means obey `eval' variables.
A value of nil means ignore them; anything else means query."
:risky t
:type '(choice (const :tag "Obey" t)
(const :tag "Ignore" nil)
(other :tag "Query" other))
:group 'find-file)
(defcustom view-read-only nil
"Non-nil means buffers visiting files read-only do so in view mode.
In fact, this means that all read-only buffers normally have
View mode enabled, including buffers that are read-only because
you visit a file you cannot alter, and buffers you make read-only
using \\[read-only-mode]."
:type 'boolean
:group 'view)
(defvar file-name-history nil
"History list of file names entered in the minibuffer.
Maximum length of the history list is determined by the value
of `history-length', which see.")
(defvar save-silently nil
"If non-nil, avoid messages when saving files.
Error-related messages will still be printed, but all other
messages will not.")
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
"Provides support for ange-ftp host name completion.
Runs the usual ange-ftp hook, but only for completion operations."
;; Having this here avoids the need to load ange-ftp when it's not
;; really in use.
(if (memq op '(file-name-completion file-name-all-completions))
(apply 'ange-ftp-hook-function op args)
(let ((inhibit-file-name-handlers
(cons 'ange-ftp-completion-hook-function
(and (eq inhibit-file-name-operation op)
inhibit-file-name-handlers)))
(inhibit-file-name-operation op))
(apply op args))))
(declare-function dos-convert-standard-filename "dos-fns.el" (filename))
(declare-function w32-convert-standard-filename "w32-fns.el" (filename))
(defun convert-standard-filename (filename)
"Convert a standard file's name to something suitable for the OS.
This means to guarantee valid names and perhaps to canonicalize
certain patterns.
FILENAME should be an absolute file name since the conversion rules
sometimes vary depending on the position in the file name. E.g. c:/foo
is a valid DOS file name, but c:/bar/c:/foo is not.
This function's standard definition is trivial; it just returns
the argument. However, on Windows and DOS, replace invalid
characters. On DOS, make sure to obey the 8.3 limitations.
In the native Windows build, turn Cygwin names into native names.
See Info node `(elisp)Standard File Names' for more details."
(cond
((eq system-type 'cygwin)
(let ((name (copy-sequence filename))
(start 0))
;; Replace invalid filename characters with !
(while (string-match "[?*:<>|\"\000-\037]" name start)
(aset name (match-beginning 0) ?!)
(setq start (match-end 0)))
name))
((eq system-type 'windows-nt)
(w32-convert-standard-filename filename))
((eq system-type 'ms-dos)
(dos-convert-standard-filename filename))
(t filename)))
(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
"Read directory name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
Default name to DEFAULT-DIRNAME if user exits with the same
non-empty string that was inserted by this function.
(If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
or just DIR if INITIAL is nil.)
If the user exits with an empty minibuffer, this function returns
an empty string. (This can happen only if the user erased the
pre-inserted contents or if `insert-default-directory' is nil.)
Fourth arg MUSTMATCH non-nil means require existing directory's name.
Non-nil and non-t means also require confirmation after completion.
Fifth arg INITIAL specifies text to start with.
DIR should be an absolute directory name. It defaults to
the value of `default-directory'."
(unless dir
(setq dir default-directory))
(read-file-name prompt dir (or default-dirname
(if initial (expand-file-name initial dir)
dir))
mustmatch initial
'file-directory-p))
(defun pwd (&optional insert)
"Show the current default directory.
With prefix argument INSERT, insert the current default directory
at point instead."
(interactive "P")
(if insert
(insert default-directory)
(message "Directory %s" default-directory)))
(defvar cd-path nil
"Value of the CDPATH environment variable, as a list.
Not actually set up until the first time you use it.")
(defun parse-colon-path (search-path)
"Explode a search path into a list of directory names.
Directories are separated by `path-separator' (which is colon in
GNU and Unix systems). Substitute environment variables into the
resulting list of directory names. For an empty path element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
(declare (ftype (function (string) list)))
(when (stringp search-path)
(let ((spath (substitute-env-vars search-path))
(double-slash-special-p
(memq system-type '(windows-nt cygwin ms-dos))))
(mapcar (lambda (f)
(if (equal "" f) nil
(let ((dir (file-name-as-directory f)))
;; Previous implementation used `substitute-in-file-name'
;; which collapses multiple "/" in front, while
;; preserving double slash where it matters. Do
;; the same for backward compatibility.
(if (string-match "\\`//+" dir)
(substring dir (- (match-end 0)
(if double-slash-special-p 2 1)))
dir))))
(split-string spath path-separator)))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
;; Put the name into directory syntax now,
;; because otherwise expand-file-name may give some bad results.
(setq dir (file-name-as-directory dir))
;; We used to additionally call abbreviate-file-name here, for an
;; unknown reason. Problem is that most buffers are setup
;; without going through cd-absolute and don't call
;; abbreviate-file-name on their default-directory, so the few that
;; do end up using a superficially different directory.
(setq dir (expand-file-name dir))
(if (not (file-directory-p dir))
(error (if (file-exists-p dir)
"%s is not a directory"
"%s: no such directory")
dir)
(unless (file-accessible-directory-p dir)
(error "Cannot cd to %s: Permission denied" dir))
(setq default-directory dir)
(setq list-buffers-directory dir)))
(defun cd (dir)
"Make DIR become the current buffer's default directory.
If your environment includes a `CDPATH' variable, try each one of
that list of directories (separated by occurrences of
`path-separator') when resolving a relative directory name.
The path separator is colon in GNU and GNU-like systems."
(interactive
(list
;; FIXME: There's a subtle bug in the completion below. Seems linked
;; to a fundamental difficulty of implementing `predicate' correctly.
;; The manifestation is that TAB may list non-directories in the case where
;; those files also correspond to valid directories (if your cd-path is (A/
;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/'
;; will be listed as valid completions).
;; This is because `a' (listed because of A/a) is indeed a valid choice
;; (which will lead to the use of B/a).
(minibuffer-with-setup-hook
(lambda ()
(setq-local minibuffer-completion-table
(apply-partially #'locate-file-completion-table
cd-path nil))
(setq-local minibuffer-completion-predicate
(lambda (dir)
(locate-file dir cd-path nil
(lambda (f) (and (file-directory-p f) 'dir-ok))))))
(unless cd-path
(setq cd-path (or (parse-colon-path (getenv "CDPATH"))
(list "./"))))
(read-directory-name "Change default directory: "
default-directory default-directory
t))))
(unless cd-path
(setq cd-path (or (parse-colon-path (getenv "CDPATH"))
(list "./"))))
(cd-absolute
(or
;; locate-file doesn't support remote file names, so detect them
;; and support them here by hand.
(and (file-remote-p (expand-file-name dir))
(file-accessible-directory-p (expand-file-name dir))
(expand-file-name dir))
(locate-file dir cd-path nil
(lambda (f) (and (file-directory-p f) 'dir-ok)))
(if (getenv "CDPATH")
(error "No such directory found via CDPATH environment variable: %s" dir)
(error "No such directory: %s" dir)))))
(defun directory-files-recursively (dir regexp
&optional include-directories predicate
follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(ignore-error file-error
(directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))
(directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
(defun directory-empty-p (dir)
"Return t if DIR names an existing directory containing no other files.
Return nil if DIR does not name a directory, or if there was
trouble determining whether DIR is a directory or empty.
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks."
(and (file-directory-p dir)
(null (directory-files dir nil directory-files-no-dot-files-regexp t 1))))
(defvar module-file-suffix)
(defun load-file (file)
"Load the Lisp file named FILE."
;; This is a case where .elc and .so/.dll make a lot of sense.
(interactive (list (let ((completion-ignored-extensions
(remove module-file-suffix
(remove ".elc"
completion-ignored-extensions))))
(read-file-name "Load file: " nil nil 'lambda))))
(load (expand-file-name file) nil nil t))
(defvar comp-eln-to-el-h)
(defun locate-file (filename path &optional suffixes predicate)
"Search for FILENAME through PATH.
If found, return the absolute file name of FILENAME; otherwise
return nil.
PATH should be a list of directories to look in, like the lists in
`exec-path' or `load-path'.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching. If SUFFIXES is nil, it is equivalent to (\"\").
Use (\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
If non-nil, PREDICATE is used instead of `file-readable-p'.
This function will normally skip directories, so if you want it to find
directories, make sure the PREDICATE function returns `dir-ok' for them.
PREDICATE can also be an integer to pass to the `access' system call,
in which case file name handlers are ignored. This usage is deprecated.
For compatibility, PREDICATE can also be one of the symbols
`executable', `readable', `writable', or `exists', or a list of
one or more of those symbols."
(if (and predicate (symbolp predicate) (not (functionp predicate)))
(setq predicate (list predicate)))
(when (and (consp predicate) (not (functionp predicate)))
(setq predicate
(logior (if (memq 'executable predicate) 1 0)
(if (memq 'writable predicate) 2 0)
(if (memq 'readable predicate) 4 0))))
(locate-file-internal filename path suffixes predicate))
(defun locate-file-completion-table (dirs suffixes string pred action)
"Do completion for file names passed to `locate-file'."
(cond
((file-name-absolute-p string)
;; FIXME: maybe we should use completion-file-name-table instead,
;; tho at least for `load', the arg is passed through
;; substitute-in-file-name for historical reasons.
(read-file-name-internal string pred action))
((eq (car-safe action) 'boundaries)
(let ((suffix (cdr action)))
`(boundaries
,(length (file-name-directory string))
,@(let ((x (file-name-directory suffix)))
(if x (1- (length x)) (length suffix))))))
(t
(let ((names '())
;; If we have files like "foo.el" and "foo.elc", we could load one of
;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
;; preferred way. So if we list all 3, that gives a lot of redundant
;; entries for the poor soul looking just for "foo". OTOH, sometimes
;; the user does want to pay attention to the extension. We try to
;; diffuse this tension by stripping the suffix, except when the
;; result is a single element (i.e. usually we list only "foo" unless
;; it's the only remaining element in the list, in which case we do
;; list "foo", "foo.elc" and "foo.el").
(fullnames '())
(suffix (concat (regexp-opt suffixes t) "\\'"))
(string-dir (file-name-directory string))
(string-file (file-name-nondirectory string)))
(dolist (dir dirs)
(unless dir
(setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(when (file-directory-p dir)
(dolist (file (file-name-all-completions
string-file dir))
(if (not (string-match suffix file))
(push file names)
(push file fullnames)
(push (substring file 0 (match-beginning 0)) names)))))
;; Switching from names to names+fullnames creates a non-monotonicity
;; which can cause problems with things like partial-completion.
;; To minimize the problem, filter out completion-regexp-list, so that
;; M-x load-library RET t/x.e TAB finds some files. Also remove elements
;; from `names' that matched `string' only when they still had
;; their suffix.
(setq names (all-completions string-file names))
;; Remove duplicates of the first element, so that we can easily check
;; if `names' really contains only a single element.
(when (cdr names) (setcdr names (delete (car names) (cdr names))))
(unless (cdr names)
;; There's no more than one matching non-suffixed element, so expand
;; the list by adding the suffixed elements as well.
(setq names (nconc names fullnames)))
(completion-table-with-context
string-dir names string-file pred action)))))
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
"Regexp of directory names that stop the search in `locate-dominating-file'.
Any directory whose name matches this regexp will be treated like
a kind of root directory by `locate-dominating-file', which will stop its
search when it bumps into it.
The default regexp prevents fruitless and time-consuming attempts to find
special files in directories in which file names are interpreted as host names,
or mount points potentially requiring authentication as a different user.")
(defun locate-dominating-file (file name)
"Starting at FILE, look up directory hierarchy for directory containing NAME.
FILE can be a file or a directory. If it's a file, its directory will
serve as the starting point for searching the hierarchy of directories.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
Instead of a string, NAME can also be a predicate taking one argument
\(a directory) and returning a non-nil value if that directory is the one for
which we're looking. The predicate will be called with every file/directory
the function needs to examine, starting with FILE."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /.
(setq file (abbreviate-file-name (expand-file-name file)))
(let ((root nil)
try)
(while (not (or root
(null file)
(string-match locate-dominating-stop-dir-regexp file)))
(setq file (if (file-directory-p file)
file
(file-name-directory file))
try (if (stringp name)
(file-exists-p (expand-file-name name file))
(funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
(if root (file-name-as-directory root))))
(defcustom user-emacs-directory-warning t
"Non-nil means warn if unable to access or create `user-emacs-directory'.
Set this to nil at your own risk, as it might lead to data loss
when Emacs tries to write something to a non-existent or
inaccessible location."
:type 'boolean
:group 'initialization
:version "24.4")
(defun locate-user-emacs-file (new-name &optional old-name)
"Return an absolute per-user Emacs-specific file name.
If NEW-NAME exists in `user-emacs-directory', return it.
Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
Else return NEW-NAME in `user-emacs-directory', creating the
directory if it does not exist."
(convert-standard-filename
(let* ((home (concat "~" (or init-file-user "")))
(at-home (and old-name (expand-file-name old-name home)))
(bestname (abbreviate-file-name
(expand-file-name new-name user-emacs-directory))))
(if (and at-home (not (file-readable-p bestname))
(file-readable-p at-home))
at-home
;; Make sure `user-emacs-directory' exists,
;; unless we're in batch mode or dumping Emacs.
(or noninteractive
dump-mode
(let (errtype)
(if (file-directory-p user-emacs-directory)
(or (file-accessible-directory-p user-emacs-directory)
(setq errtype "access"))
;; We don't want to create HOME if it doesn't exist.
(if (and (not (file-exists-p "~"))
(string-prefix-p
(expand-file-name "~")
(expand-file-name user-emacs-directory)))
(setq errtype "create")
;; Create `user-emacs-directory'.
(with-file-modes ?\700
(condition-case nil
(make-directory user-emacs-directory t)
(error (setq errtype "create"))))))
(when (and errtype
user-emacs-directory-warning
(not (get 'user-emacs-directory-warning 'this-session)))
;; Warn only once per Emacs session.
(put 'user-emacs-directory-warning 'this-session t)
(display-warning 'initialization
(format "\
Unable to %s `user-emacs-directory' (%s).
Any data that would normally be written there may be lost!
If you never want to see this message again,
customize the variable `user-emacs-directory-warning'."
errtype user-emacs-directory)))))
bestname))))
(defun exec-path ()
"Return list of directories to search programs to run in remote subprocesses.
The remote host is identified by `default-directory'. For remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
(let ((handler (find-file-name-handler default-directory 'exec-path)))
(if handler
(funcall handler 'exec-path)
exec-path)))
(defun executable-find (command &optional remote)
"Search for COMMAND in `exec-path' and return the absolute file name.
Return nil if COMMAND is not found anywhere in `exec-path'. If
REMOTE is non-nil, search on the remote host indicated by
`default-directory' instead."
(if (and remote (file-remote-p default-directory))
(let ((res (locate-file
command
(mapcar
(lambda (x) (concat (file-remote-p default-directory) x))
(exec-path))
exec-suffixes 'file-executable-p)))
(when (stringp res) (file-local-name res)))
;; Use 1 rather than file-executable-p to better match the
;; behavior of call-process.
(let ((default-directory (file-name-quote default-directory 'top)))
(locate-file command exec-path exec-suffixes 1))))
(declare-function read-library-name "find-func" nil)
(defun load-library (library)
"Load the Emacs Lisp library named LIBRARY.
LIBRARY should be a string.
This is an interface to the function `load'. LIBRARY is searched
for in `load-path', both with and without `load-suffixes' (as
well as `load-file-rep-suffixes').
See Info node `(emacs)Lisp Libraries' for more details.
See `load-file' for a different interface to `load'."
(interactive (list (read-library-name)))
(load library))
(defun require-with-check (feature &optional filename noerror)
"If FEATURE is not already loaded, load it from FILENAME.
This is like `require' except if FEATURE is already a member of the list
`features’, then check if it was provided by a different file than the
one that is about to be loaded now (presumably because `load-path' has
been changed since FILENAME was loaded). If that is the case, either
signal an error (the default), or forcibly reload the new file (if
NOERROR is equal to `reload'), or otherwise emit a warning."
(let ((lh load-history)
(res (require feature filename (if (eq noerror 'reload) nil noerror))))
;; If the `feature' was not yet provided, `require' just loaded the right
;; file, so we're done.
(when (and res (eq lh load-history))
;; If `require' did nothing, we need to make sure that was warranted.
(let* ((fn (locate-file (or filename (symbol-name feature))
load-path (get-load-suffixes) nil
)) ;; load-prefer-newer
;; We used to look for `fn' in `load-history' with `assoc'
;; which works in most cases, but in some cases (e.g. when
;; `load-prefer-newer' is set) `locate-file' can return a
;; different file than the file that `require' would load,
;; so the file won't be found in `load-history' even though
;; we did load "it". (bug#74040)
;; So use a "permissive" search which doesn't pay attention to
;; differences between file extensions.
(prefix (if (string-match
(concat (regexp-opt (get-load-suffixes)) "\\'") fn)
(concat (substring fn 0 (match-beginning 0)) ".")
fn))
(lh load-history))
(while (and lh (let ((file (car-safe (car lh))))
(not (and file (string-prefix-p prefix file)))))
(setq lh (cdr lh)))
(cond
(lh nil) ;We loaded the right file.
((eq noerror 'reload) (load fn nil 'nomessage))
((and fn (memq feature features))
(funcall (if noerror #'warn #'error)
"Feature `%S' is now provided by a different file %s"
feature fn))
(fn
(funcall (if noerror #'warn #'error)
"Could not load file %s" fn))
(t
(funcall (if noerror #'warn #'error)
"Could not locate file %s in load path"
(or filename (symbol-name feature)))))))
res))
(defun file-remote-p (file &optional identification connected)
"Test whether FILE specifies a location on a remote system.
A file is considered remote if accessing it is likely to
be slower or less reliable than accessing local files.
`file-remote-p' never opens a new remote connection. It can
reuse only a connection that is already open.
Return nil or a string identifying the remote connection
\(ideally a prefix of FILE). Return nil if FILE is a relative
file name.
When IDENTIFICATION is nil, the returned string is a complete
remote identifier: with components method, user, and host. The
components are those present in FILE, with defaults filled in for
any that are missing.
IDENTIFICATION can specify which part of the identification to
return. IDENTIFICATION can be the symbol `method', `user',
`host', or `localname'. Any other value is handled like nil and
means to return the complete identification.
If the remote FILE does not contain a method, a user name, or a host
name, the respective default value is returned. The string returned for
IDENTIFICATION `localname' can differ depending on whether there is an
existing connection. File name handler specific implementations could
support further IDENTIFICATION symbols; Tramp, for example, knows also
the `hop' symbol.
If CONNECTED is non-nil, return an identification only if FILE is
located on a remote system and a connection is established to
that remote system. If CONNECTED is `never', never use an
existing connection to return the identification (this is
otherwise like a value of nil).
Tip: You can use this expansion of remote identifier components
to derive a new remote file name from an existing one. For
example, if FILE is \"/sudo::/path/to/file\" then
(concat (file-remote-p FILE) \"/bin/sh\")
returns a remote file name for file \"/bin/sh\" that has the
same remote identifier as FILE but expanded; a name such as
\"/sudo:root@myhost:/bin/sh\"."
(when-let ((handler (find-file-name-handler file 'file-remote-p)))
(funcall handler 'file-remote-p file identification connected)))
;; Probably this entire variable should be obsolete now, in favor of
;; something Tramp-related (?). It is not used in many places.
;; It's not clear what the best file for this to be in is, but given
;; it uses custom-initialize-delay, it is easier if it is preloaded
;; rather than autoloaded.
(defcustom remote-shell-program (or (executable-find "ssh") "ssh")
"Program to use to execute commands on a remote host (i.e. ssh)."
:version "29.1"
:initialize #'custom-initialize-delay
:group 'environment
:type 'file)
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
When nil, never expire cached values (caution).
When t, never use the cache (safe, but may be slow).
A number means use cached values for that amount of seconds since caching.
The attributes of remote files are cached for better performance.
If they are changed outside of Emacs's control, the cached values
become invalid, and must be reread. If you are sure that nothing
other than Emacs changes the files, you can set this variable to nil.
If a remote file is checked regularly, it might be a good idea to
let-bind this variable to a value less than the interval between
consecutive checks. For example:
(defun display-time-file-nonempty-p (file)
(let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
(and (file-exists-p file)
(< 0 (file-attribute-size
(file-attributes (file-chase-links file)))))))"
:group 'files
:group 'tramp
:version "24.1"
:type '(choice
(const :tag "Do not cache remote file attributes" t)
(const :tag "Cache remote file attributes" nil)
(integer :tag "Cache remote file attributes with expiration"
:format "Cache expiry in seconds: %v"
:value 10)))
(defcustom remote-file-name-access-timeout nil
"Timeout (in seconds) for `access-file'.
This timeout limits the time to check, whether a remote file is
accessible. `access-file' returns an error after that time. If
the value is 0 or nil, no timeout is used.
This applies only when there isn't time spent for other actions,
like reading passwords."
:group 'files
:group 'tramp
:version "30.1"
;;:type '(choice :tag "Timeout (seconds)" natnum (const nil)))
:type '(choice
(natnum :tag "Timeout (seconds)")
(const :tag "Do not use timeout" nil)))
(defun file-local-name (file)
"Return the local name component of FILE.
This function removes from FILE the specification of the remote host
and the method of accessing the host, leaving only the part that
identifies FILE locally on the remote system.
The returned file name can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
(or (file-remote-p file 'localname) file))
(defun file-local-copy (file)
"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible."
;; This formerly had an optional BUFFER argument that wasn't used by
;; anything.
(let ((handler (find-file-name-handler file 'file-local-copy)))
(if handler
(funcall handler 'file-local-copy file)
nil)))
(defun files--name-absolute-system-p (file)
"Return non-nil if FILE is an absolute name to the operating system.
This is like `file-name-absolute-p', except that it returns nil for
names beginning with `~'."
(and (file-name-absolute-p file)
(not (eq (aref file 0) ?~))))
(defun files--splice-dirname-file (dirname file)
"Splice DIRNAME to FILE like the operating system would.
If FILE is relative, return DIRNAME concatenated to FILE.
Otherwise return FILE, quoted as needed if DIRNAME and FILE have
different file name handlers; although this quoting is dubious if
DIRNAME is magic, it is not clear what would be better. This
function differs from `expand-file-name' in that DIRNAME must be
a directory name and leading `~' and `/:' are not special in
FILE."
(let ((unquoted (if (files--name-absolute-system-p file)
file
(concat dirname file))))
(if (eq (find-file-name-handler dirname 'file-symlink-p)
(find-file-name-handler unquoted 'file-symlink-p))
unquoted
(let (file-name-handler-alist) (file-name-quote unquoted)))))
(defun file-truename (filename &optional counter prev-dirs)
"Return the truename of FILENAME.
If FILENAME is not absolute, first expands it against `default-directory'.
The truename of a file name is found by chasing symbolic links
both at the level of the file and at the level of the directories
containing it, until no links are left at any level.
\(fn FILENAME)" ;; Don't document the optional arguments.
;; COUNTER and PREV-DIRS are used only in recursive calls.
;; COUNTER can be a cons cell whose car is the count of how many
;; more links to chase before getting an error.
;; PREV-DIRS can be a cons cell whose car is an alist
;; of truenames we've just recently computed.
(cond ((or (string= filename "") (string= filename "~"))
(setq filename (expand-file-name filename))
(if (string= filename "")
(setq filename "/")))
((and (string= (substring filename 0 1) "~")
(string-match "~[^/]*/?" filename))
(let ((first-part
(substring filename 0 (match-end 0)))
(rest (substring filename (match-end 0))))
(setq filename (concat (expand-file-name first-part) rest)))))
(or counter (setq counter (list 100)))
(let (done
;; For speed, remove the ange-ftp completion handler from the list.
;; We know it's not needed here.
;; For even more speed, do this only on the outermost call.
(file-name-handler-alist
(if prev-dirs file-name-handler-alist
(let ((tem (copy-sequence file-name-handler-alist)))
(delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
(or prev-dirs (setq prev-dirs (list nil)))
;; andrewi@harlequin.co.uk - on Windows, there is an issue with
;; case differences being ignored by the OS, and short "8.3 DOS"
;; name aliases existing for all files. (The short names are not
;; reported by directory-files, but can be used to refer to files.)
;; It seems appropriate for file-truename to resolve these issues in
;; the most natural way, which on Windows is to call the function
;; `w32-long-file-name' - this returns the exact name of a file as
;; it is stored on disk (expanding short name aliases with the full
;; name in the process).
(if (eq system-type 'windows-nt)
(unless (string-match "[[*?]" filename)
;; If filename exists, use its long name. If it doesn't
;; exist, the recursion below on the directory of filename
;; will drill down until we find a directory that exists,
;; and use the long name of that, with the extra
;; non-existent path components concatenated.
(let ((longname (w32-long-file-name filename)))
(if longname
(setq filename longname)))))
;; If this file directly leads to a link, process that iteratively
;; so that we don't use lots of stack.
(while (not done)
(setcar counter (1- (car counter)))
(if (< (car counter) 0)
(error "Apparent cycle of symbolic links for %s" filename))
(let ((handler (find-file-name-handler filename 'file-truename)))
;; For file name that has a special handler, call handler.
;; This is so that ange-ftp can save time by doing a no-op.
(if handler
(setq filename (funcall handler 'file-truename filename)
done t)
(let ((dir (or (file-name-directory filename) default-directory))
target dirfile)
;; Get the truename of the directory.
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
(and (file-name-case-insensitive-p dir)
(string-equal-ignore-case dir dirfile))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (assoc dir (car prev-dirs))
(setq dir (cdr (assoc dir (car prev-dirs))))
(let ((old dir)
(new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
(setcar prev-dirs (cons (cons old new) (car prev-dirs)))
(setq dir new))))
(let ((filename-no-dir (file-name-nondirectory filename)))
(if (equal ".." filename-no-dir)
(setq filename
(directory-file-name (file-name-directory (directory-file-name dir)))
done t)
(if (equal "." filename-no-dir)
(setq filename (directory-file-name dir)
done t)
;; Put it back on the file name.
(setq filename (concat dir filename-no-dir))
;; Is the file name the name of a link?
(setq target (file-symlink-p filename))
(if target
;; Yes => chase that link, then start all over
;; since the link may point to a directory name that uses links.
;; We can't safely use expand-file-name here
;; since target might look like foo/../bar where foo
;; is itself a link. Instead, we handle . and .. above.
(setq filename (files--splice-dirname-file dir target)
done nil)
;; No, we are done!
(setq done t)))))))))
filename))
(defun file-chase-links (filename &optional limit)
"Chase links in FILENAME until a name that is not a link.
Unlike `file-truename', this does not check whether a parent
directory name is a symbolic link.
If the optional argument LIMIT is a number,
it means chase no more than that many links and then stop."
(let (tem (newname filename)
(count 0))
(while (and (or (null limit) (< count limit))
(setq tem (file-symlink-p newname)))
(save-match-data
(if (and (null limit) (= count 100))
(error "Apparent cycle of symbolic links for %s" filename))
;; In the context of a link, `//' doesn't mean what Emacs thinks.
(while (string-match "//+" tem)
(setq tem (replace-match "/" nil nil tem)))
;; Handle `..' by hand, since it needs to work in the
;; target of any directory symlink.
;; This code is not quite complete; it does not handle
;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
(while (string-match "\\`\\.\\./" tem)
(setq tem (substring tem 3))
(setq newname (expand-file-name newname))
;; Chase links in the default dir of the symlink.
(setq newname
(file-chase-links
(directory-file-name (file-name-directory newname))))
;; Now find the parent of that dir.
(setq newname (file-name-directory newname)))
(setq newname (files--splice-dirname-file (file-name-directory newname)
tem))
(setq count (1+ count))))
newname))
;; A handy function to display file sizes in human-readable form.
;; See https://en.wikipedia.org/wiki/Kibibyte for the reference.
(defun file-size-human-readable (file-size &optional flavor space unit)
"Produce a string showing FILE-SIZE in human-readable form.
Optional second argument FLAVOR controls the units and the display format:
If FLAVOR is nil or omitted, each kilobyte is 1024 bytes and the produced
suffixes are \"k\", \"M\", \"G\", \"T\", etc.
If FLAVOR is `si', each kilobyte is 1000 bytes and the produced suffixes
are \"k\", \"M\", \"G\", \"T\", etc.
If FLAVOR is `iec', each kilobyte is 1024 bytes and the produced suffixes
are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc.
Optional third argument SPACE is a string put between the number and unit.
It defaults to the empty string. We recommend a single space or
non-breaking space, unless other constraints prohibit a space in that
position.
Optional fourth argument UNIT is the unit to use. It defaults to \"B\"
when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\"
in all cases, since that is the standard symbol for byte."
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
(prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y" "R" "Q")))
(while (and (>= file-size power) (cdr prefixes))
(setq file-size (/ file-size power)
prefixes (cdr prefixes)))
(let* ((prefix (car prefixes))
(prefixed-unit (if (eq flavor 'iec)
(concat
(if (string= prefix "k") "K" prefix)
(if (string= prefix "") "" "i")
(or unit "B"))
(concat prefix unit))))
;; Mimic what GNU "ls -lh" does:
;; If the formatted size will have just one digit before the decimal...
(format (if (and (< file-size 10)
;; ...and its fractional part is not too small...
(>= (mod file-size 1.0) 0.05)
(< (mod file-size 1.0) 0.95))
;; ...then emit one digit after the decimal.
"%.1f%s%s"
"%.0f%s%s")
file-size
(if (string= prefixed-unit "") "" (or space ""))
prefixed-unit))))
(defun file-size-human-readable-iec (size)
"Human-readable string for SIZE bytes, using IEC prefixes."
(file-size-human-readable size 'iec " "))
(defcustom byte-count-to-string-function #'file-size-human-readable-iec
"Function that turns a number of bytes into a human-readable string.
It is for use when displaying file sizes and disk space where other
constraints do not force a specific format."
:type '(radio
(function-item file-size-human-readable-iec)
(function-item file-size-human-readable)
(function :tag "Custom function" :value number-to-string))
:group 'files
:version "27.1")
(defcustom mounted-file-systems
(if (memq system-type '(windows-nt cygwin))
"^//[^/]+/"
;; regexp-opt.el is not dumped into emacs binary.
;;(concat
;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
"^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
"File systems that ought to be mounted."
:group 'files
:version "26.1"
:require 'regexp-opt
:type 'regexp)
(defun temporary-file-directory ()
"The directory for writing temporary files.
In case of a remote `default-directory', this is a directory for
temporary files on that remote host. If such a directory does
not exist, or `default-directory' ought to be located on a
mounted file system (see `mounted-file-systems'), the function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
(if handler
(funcall handler 'temporary-file-directory)
(if (string-match mounted-file-systems default-directory)
default-directory
temporary-file-directory))))
(defun make-temp-file (prefix &optional dir-flag suffix text)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
of PREFIX, and expanding against `temporary-file-directory' if necessary),
is guaranteed to point to a newly created file.
You can then use `write-region' to write new data into the file.
If DIR-FLAG is non-nil, create a new empty directory instead of a file.
If SUFFIX is non-nil, add that at the end of the file name.
If TEXT is a string, insert it into the new file; DIR-FLAG should be nil.
Otherwise the file will be empty."
(let ((absolute-prefix
(if (or (zerop (length prefix)) (member prefix '("." "..")))
(concat (file-name-as-directory temporary-file-directory) prefix)
(expand-file-name prefix temporary-file-directory))))
(if (find-file-name-handler absolute-prefix 'write-region)
(files--make-magic-temp-file absolute-prefix dir-flag suffix text)
(make-temp-file-internal absolute-prefix
(if dir-flag t) (or suffix "") text))))
(defun files--make-magic-temp-file (absolute-prefix
&optional dir-flag suffix text)
"Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX TEXT).
This implementation works on magic file names."
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(with-file-modes ?\700
(let ((contents (if (stringp text) text ""))
file)
(while (condition-case ()
(progn
(setq file (make-temp-name absolute-prefix))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(make-directory file)
(write-region contents nil file nil 'silent nil 'excl))
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
;; `make-temp-name' and `write-region', let's try again.
nil)
file)))
(defun make-nearby-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file as close as possible to `default-directory'.
Return the absolute file name of the created file.
If PREFIX is a relative file name, and `default-directory' is a
remote file name or located on a mounted file systems, the
temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
(let ((handler (find-file-name-handler
default-directory 'make-nearby-temp-file)))
(if (and handler (not (file-name-absolute-p default-directory)))
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))))
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
The value is a new name of FILE.
Signals a `file-already-exists' error if a file of the new name
already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
is non-nil. A number as fourth arg means request confirmation if
the new name already exists. This is what happens in interactive
use with \\[execute-extended-command]."
(interactive
(let ((default-coding (or file-name-coding-system
default-file-name-coding-system))
(filename (read-file-name "Recode filename: " nil nil t))
from-coding to-coding)
(if (and default-coding
;; We provide the default coding only when it seems that
;; the filename is correctly decoded by the default
;; coding.
(let ((charsets (find-charset-string filename)))
(and (not (memq 'eight-bit-control charsets))
(not (memq 'eight-bit-graphic charsets)))))
(setq from-coding (read-coding-system
(format-prompt "Recode filename %s from"
filename default-coding)
default-coding))
(setq from-coding (read-coding-system
(format "Recode filename %s from: " filename))))
;; We provide the default coding only when a user is going to
;; change the encoding not from the default coding.
(if (eq from-coding default-coding)
(setq to-coding (read-coding-system
(format "Recode filename %s from %s to: "
filename from-coding)))
(setq to-coding (read-coding-system
(format-prompt "Recode filename %s from %s to"
default-coding filename from-coding)
default-coding)))
(list filename from-coding to-coding)))
(let* ((default-coding (or file-name-coding-system
default-file-name-coding-system))
;; FILE should have been decoded by DEFAULT-CODING.
(encoded (encode-coding-string file default-coding))
(newname (decode-coding-string encoded coding))
(new-encoded (encode-coding-string newname new-coding))
;; Suppress further encoding.
(file-name-coding-system nil)
(default-file-name-coding-system nil)
(locale-coding-system nil))
(rename-file encoded new-encoded ok-if-already-exists)
newname))
(defcustom confirm-nonexistent-file-or-buffer 'after-completion
"Whether confirmation is requested before visiting a new file or buffer.
If nil, confirmation is not requested.
If the value is `after-completion', confirmation is requested
only if the user called `minibuffer-complete' right before
`minibuffer-complete-and-exit'.
Any other non-nil value means to request confirmation.
This affects commands like `switch-to-buffer' and `find-file'."
:group 'find-file
:version "23.1"
:type '(choice (const :tag "After completion" after-completion)
(const :tag "Never" nil)
(other :tag "Always" t)))
(defun confirm-nonexistent-file-or-buffer ()
"Whether to request confirmation before visiting a new file or buffer.
The variable `confirm-nonexistent-file-or-buffer' determines the
return value, which may be passed as the REQUIRE-MATCH arg to
`read-buffer' or `find-file-read-args'."
(cond ((eq confirm-nonexistent-file-or-buffer 'after-completion)
'confirm-after-completion)
(confirm-nonexistent-file-or-buffer
'confirm)
(t nil)))
(defmacro minibuffer-with-setup-hook (fun &rest body)
"Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
By default, FUN is prepended to `minibuffer-setup-hook'. But if FUN is of
the form `(:append FUN1)', FUN1 will be appended to `minibuffer-setup-hook'
instead of prepending it.
BODY should use the minibuffer at most once.
Recursive uses of the minibuffer are unaffected (FUN is not
called additional times).
This macro actually adds an auxiliary function that calls FUN,
rather than FUN itself, to `minibuffer-setup-hook'."
(declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body)))
(let ((hook (make-symbol "setup-hook"))
(funsym (make-symbol "fun"))
(append nil))
(when (eq (car-safe fun) :append)
(setq append '(t) fun (cadr fun)))
`(let ((,funsym ,fun)
;; Use a symbol to make sure `add-hook' doesn't waste time
;; in `equal'ity testing (bug#46326).
(,hook (make-symbol "minibuffer-setup")))
(fset ,hook (lambda ()
;; Clear out this hook so it does not interfere
;; with any recursive minibuffer usage.
(remove-hook 'minibuffer-setup-hook ,hook)
(funcall ,funsym)))
(unwind-protect
(progn
(add-hook 'minibuffer-setup-hook ,hook ,@append)
,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))
(defun find-file-read-args (prompt mustmatch)
(list (read-file-name prompt nil default-directory mustmatch)
t))
(defun file-name-history--add (file)
"Add FILE to `file-name-history'."
(add-to-history 'file-name-history (abbreviate-file-name file)))
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
\\<minibuffer-local-map>Switch to a buffer visiting file FILENAME, creating one if none
already exists.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
type \\[next-history-element] to pull it into the minibuffer.
The first time \\[next-history-element] is used after Emacs prompts for the file name,
the result is affected by `file-name-at-point-functions', which by
default try to guess the file name by looking at point in the current
buffer. Customize the value of `file-name-at-point-functions' or set
it to nil, if you want only the visited file name and the current
directory to be available on first \\[next-history-element] request.
You can visit files on remote machines by specifying something
like /ssh:SOME_REMOTE_MACHINE:FILE for the file name. You can
also visit local files as a different user by specifying
/sudo::FILE for the file name.
See the Info node `(tramp)File name Syntax' in the Tramp Info
manual, for more about this.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files. You can
suppress wildcard expansion by setting `find-file-wildcards' to nil.
\\<global-map>To visit a file without any kind of conversion and without
automatically choosing a major mode, use \\[find-file-literally]."
(interactive
(find-file-read-args "Find file: "
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'pop-to-buffer-same-window (nreverse value))
(pop-to-buffer-same-window value))))
(defun find-file-other-window (filename &optional wildcards)
"Edit file FILENAME, in another window.
Like \\[find-file] (which see), but creates a new window or reuses
an existing one. See the function `display-buffer'.
\\<minibuffer-local-map>\
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
type \\[next-history-element] to pull it into the minibuffer.
The first time \\[next-history-element] is used after Emacs prompts for
the file name, the result is affected by `file-name-at-point-functions',
which by default try to guess the file name by looking at point in the
current buffer. Customize the value of `file-name-at-point-functions'
or set it to nil, if you want only the visited file name and the
current directory to be available on first \\[next-history-element]
request.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
(interactive
(find-file-read-args "Find file in other window: "
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(setq value (nreverse value))
(switch-to-buffer-other-window (car value))
(mapc 'switch-to-buffer (cdr value))
value)
(switch-to-buffer-other-window value))))
(defun find-file-other-frame (filename &optional wildcards)
"Edit file FILENAME, in another frame.
Like \\[find-file] (which see), but creates a new frame or reuses
an existing one. See the function `display-buffer'.
\\<minibuffer-local-map>\
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
type \\[next-history-element] to pull it into the minibuffer.
The first time \\[next-history-element] is used after Emacs prompts for
the file name, the result is affected by `file-name-at-point-functions',
which by default try to guess the file name by looking at point in the
current buffer. Customize the value of `file-name-at-point-functions'
or set it to nil, if you want only the visited file name and the
current directory to be available on first \\[next-history-element]
request.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
(interactive
(find-file-read-args "Find file in other frame: "
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(setq value (nreverse value))
(switch-to-buffer-other-frame (car value))
(mapc 'switch-to-buffer (cdr value))
value)
(switch-to-buffer-other-frame value))))
(defun find-file-existing (filename)
"Edit the existing file FILENAME.
Like \\[find-file], but allow only a file that exists, and do not allow
file names with wildcards."
(interactive (nbutlast (find-file-read-args "Find existing file: " t)))
(if (and (not (called-interactively-p 'interactive))
(not (file-exists-p filename)))
(error "%s does not exist" filename)
(find-file filename)
(current-buffer)))
(defun find-file--read-only (fun filename wildcards)
(unless (or (and wildcards find-file-wildcards
(not (file-name-quoted-p filename))
(string-match "[[*?]" filename))
(file-exists-p filename))
(error "%s does not exist" filename))
(let ((value (funcall fun filename wildcards)))
(mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
(if (listp value) value (list value)))
value))
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
Like \\[find-file], but marks buffer as read-only.
Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only: "
(confirm-nonexistent-file-or-buffer)))
(find-file--read-only #'find-file filename wildcards))
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
(find-file--read-only #'find-file-other-window filename wildcards))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame], but marks buffer as read-only.
Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
(find-file--read-only #'find-file-other-frame filename wildcards))
(defun find-alternate-file-other-window (filename &optional wildcards)
"Find file FILENAME as a replacement for the file in the next window.
This command does not select that window.
See \\[find-file] for the possible forms of the FILENAME argument.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and replace the file with multiple files."
(interactive
(save-selected-window
(other-window 1)
(let ((file buffer-file-name)
(file-name nil)
(file-dir nil))
(and file
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil
(confirm-nonexistent-file-or-buffer) file-name)
t))))
(if (one-window-p)
(find-file-other-window filename wildcards)
(save-selected-window
(other-window 1)
(find-alternate-file filename wildcards))))
;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
(defvar kill-buffer-hook nil
"Hook run when a buffer is killed.
The buffer being killed is current while the hook is running.
See `kill-buffer'.
This hook is not run for internal or temporary buffers created by
`get-buffer-create' or `generate-new-buffer' with argument
INHIBIT-BUFFER-HOOKS non-nil.
Note: Be careful with let-binding this hook considering it is
frequently used for cleanup.")
(defvar find-alternate-file-dont-kill-client nil
"If non-nil, `server-buffer-done' should not delete the client.")
(defun find-alternate-file (filename &optional wildcards)
"Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
\(presumably by mistake), use this command to visit the file you really want.
See \\[find-file] for the possible forms of the FILENAME argument.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and replace the file with multiple files.
If the current buffer is an indirect buffer, or the base buffer
for one or more indirect buffers, the other buffer(s) are not
killed."
(interactive
(let ((file buffer-file-name)
(file-name nil)
(file-dir nil))
(and file
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil
(confirm-nonexistent-file-or-buffer) file-name)
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
(user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
(not (yes-or-no-p
(format-message "Kill and replace buffer `%s' without saving it? "
(buffer-name))))
(user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
(odir dired-directory)
(otrue buffer-file-truename)
(oname (buffer-name)))
;; Run `kill-buffer-hook' here. It needs to happen before
;; variables like `buffer-file-name' etc are set to nil below,
;; because some of the hooks that could be invoked
;; (e.g., `save-place-to-alist') depend on those variables.
;;
;; Note that `kill-buffer-hook' is not what queries whether to
;; save a modified buffer visiting a file. Rather, `kill-buffer'
;; asks that itself. Thus, there's no need to temporarily do
;; `(set-buffer-modified-p nil)' before running this hook.
(let ((find-alternate-file-dont-kill-client 'dont-kill-client))
(run-hooks 'kill-buffer-hook))
;; Okay, now we can end-of-life the old buffer.
(if (get-buffer " **lose**")
(kill-buffer " **lose**"))
(rename-buffer " **lose**")
(unwind-protect
(progn
(unlock-buffer)
;; This prevents us from finding the same buffer
;; if we specified the same file again.
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
;; Likewise for dired buffers.
(setq dired-directory nil)
;; Don't use `find-file' because it may end up using another window
;; in some corner cases, e.g. when the selected window is
;; softly-dedicated.
(let ((newbuf (find-file-noselect filename nil nil wildcards)))
(switch-to-buffer (if (consp newbuf) (car newbuf) newbuf))))
(when (eq obuf (current-buffer))
;; This executes if find-file gets an error
;; and does not really find anything.
;; We put things back as they were.
;; If find-file actually finds something, we kill obuf below.
(setq buffer-file-name ofile)
(setq buffer-file-number onum)
(setq buffer-file-truename otrue)
(setq dired-directory odir)
(lock-buffer)
(if (get-buffer oname)
(kill-buffer oname))
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(with-current-buffer obuf
;; Restore original buffer's file names so they can be still
;; used when referencing the now defunct buffer (Bug#68235).
(setq buffer-file-name ofile)
(setq buffer-file-number onum)
(setq buffer-file-truename otrue)
(unless (get-buffer oname)
;; Restore original's buffer name so 'kill-buffer' can use it
;; to assign its last name (Bug#68235).
(rename-buffer oname))
;; We already ran these; don't run them again.
(let (kill-buffer-query-functions kill-buffer-hook)
(kill-buffer obuf))))))
;; FIXME we really need to fold the uniquify stuff in here by default,
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
FILENAME (sans directory) is used unchanged if that name is free;
otherwise the buffer is renamed according to
`uniquify-buffer-name-style' to get an unused name.
Emacs treats buffers whose names begin with a space as internal buffers.
To avoid confusion when visiting a file whose name begins with a space,
this function prepends a \"|\" to the final result if necessary."
(let* ((lastname (file-name-nondirectory (directory-file-name filename)))
(lastname (if (string= lastname "") ; FILENAME is a root directory
filename lastname))
(lastname (cond
((not (and uniquify-trailing-separator-p
(file-directory-p filename)))
lastname)
((eq uniquify-buffer-name-style 'forward)
(file-name-as-directory lastname))
((eq uniquify-buffer-name-style 'reverse)
(concat (or uniquify-separator "\\") lastname))
(t lastname)))
(basename (if (string-prefix-p " " lastname)
(concat "|" lastname)
lastname))
(buf (generate-new-buffer basename)))
(uniquify--create-file-buffer-advice buf filename basename)
buf))
(defvar abbreviated-home-dir nil
"Regexp matching the user's homedir at the beginning of file name.
The value includes abbreviation according to `directory-abbrev-alist'.")
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
This also substitutes \"~\" for the user's home directory (unless the
home directory is a root directory).
When this function is first called, it caches the user's home
directory as a regexp in `abbreviated-home-dir', and reuses it
afterwards (so long as the home directory does not change;
if you want to permanently change your home directory after having
started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
;; Get rid of the prefixes added by the automounter.
(save-match-data ;FIXME: Why?
(if-let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
(funcall handler 'abbreviate-file-name filename)
;; Avoid treating /home/foo as /home/Foo during `~' substitution.
(let ((case-fold-search (file-name-case-insensitive-p filename)))
;; If any elt of directory-abbrev-alist matches this name,
;; abbreviate accordingly.
(setq filename (directory-abbrev-apply filename))
;; Compute and save the abbreviated homedir name.
;; We defer computing this until the first time it's needed, to
;; give time for directory-abbrev-alist to be set properly.
(unless abbreviated-home-dir
(put 'abbreviated-home-dir 'home (expand-file-name "~"))
(setq abbreviated-home-dir
(directory-abbrev-make-regexp
(let ((abbreviated-home-dir "\\`\\'.")) ;Impossible regexp.
(abbreviate-file-name
(get 'abbreviated-home-dir 'home))))))
;; If FILENAME starts with the abbreviated homedir,
;; and ~ hasn't changed since abbreviated-home-dir was set,
;; make it start with `~' instead.
;; If ~ has changed, we ignore abbreviated-home-dir rather than
;; invalidating it, on the assumption that a change in HOME
;; is likely temporary (eg for testing).
;; FIXME Is it even worth caching abbreviated-home-dir?
;; Ref: https://debbugs.gnu.org/19657#20
(let (mb1)
(if (and (string-match abbreviated-home-dir filename)
(setq mb1 (match-beginning 1))
;; If the home dir is just /, don't change it.
(not (and (= (match-end 0) 1)
(= (aref filename 0) ?/)))
;; MS-DOS root directories can come with a drive letter;
;; Novell Netware allows drive letters beyond `Z:'.
(not (and (memq system-type '(ms-dos windows-nt cygwin))
(string-match "\\`[a-zA-`]:/\\'" filename)))
(equal (get 'abbreviated-home-dir 'home)
(expand-file-name "~")))
(setq filename
(concat "~"
(substring filename mb1))))
filename)))))
(defun find-buffer-visiting (filename &optional predicate)
"Return the buffer visiting file FILENAME (a string).
This is like `get-file-buffer', except that it checks for any buffer
visiting the same file, possibly under a different name.
If PREDICATE is non-nil, only buffers satisfying it are eligible,
and others are ignored. PREDICATE is called with the buffer as
the only argument, but not with the buffer as the current buffer.
If there is no such live buffer, return nil."
(or (let ((buf (get-file-buffer filename)))
(when (and buf (or (not predicate) (funcall predicate buf))) buf))
(let ((truename (abbreviate-file-name (file-truename filename))))
(or
(let ((buf (get-truename-buffer truename)))
(when (and buf (buffer-local-value 'buffer-file-name buf)
(or (not predicate) (funcall predicate buf)))
buf))
(let* ((attributes (file-attributes truename))
(number (file-attribute-file-identifier attributes)))
(and buffer-file-numbers-unique
(car-safe number) ;Make sure the inode is not just nil.
(let* ((buf (find-buffer 'buffer-file-number number))
(buf-file-name
(and buf (buffer-local-value 'buffer-file-name buf))))
(when (and buf-file-name
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buf-file-name)
(equal (file-attributes
(buffer-local-value
'buffer-file-truename buf))
attributes)
(or (not predicate)
(funcall predicate buf)))
buf))))))))
(defcustom find-file-wildcards t
"Non-nil means file-visiting commands should handle wildcards.
For example, if you specify `*.c', that would visit all the files
whose names match the pattern."
:group 'files
:version "20.4"
:type 'boolean)
(defcustom find-file-suppress-same-file-warnings nil
"Non-nil means suppress warning messages for symlinked files.
When nil, Emacs prints a warning when visiting a file that is already
visited, but with a different name. Setting this option to t
suppresses this warning."
:group 'files
:version "21.1"
:type 'boolean)
(defcustom large-file-warning-threshold 10000000
"Maximum size of file above which a confirmation is requested.
When nil, never request confirmation."
:group 'files
:group 'find-file
:version "22.1"
:type '(choice integer (const :tag "Never request confirmation" nil)))
(defcustom out-of-memory-warning-percentage nil
"Warn if file size exceeds this percentage of available free memory.
When nil, never issue warning. Beware: This probably doesn't do what you
think it does, because \"free\" is pretty hard to define in practice."
:group 'files
:group 'find-file
:version "25.1"
:type '(choice integer (const :tag "Never issue warning" nil)))
(defcustom query-about-changed-file t
"If non-nil, query the user when re-visiting a file that has changed.
This happens if the file is already visited in a buffer, the
file was changed externally, and the user re-visits the file.
If nil, don't prompt the user, but instead provide instructions for
reverting, after switching to the buffer with its contents before
the external changes."
:group 'files
:group 'find-file
:version "28.1"
:type 'boolean)
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
(defun files--ask-user-about-large-file-help-text (op-type size)
"Format the text that explains the options to open large files in Emacs.
OP-TYPE contains the kind of file operation that will be
performed. SIZE is the size of the large file."
(format
"The file that you want to %s is large (%s), which exceeds the
threshold above which Emacs asks for confirmation (%s).
Large files may be slow to edit or navigate so Emacs asks you
before you try to %s such files.
You can press:
'y' to %s the file.
'n' to abort, and not %s the file.
'l' (the letter ell) to %s the file literally, which means that
Emacs will %s the file without doing any format or character code
conversion and in Fundamental mode, without loading any potentially
expensive features.
You can customize the option `large-file-warning-threshold' to be the
file size, in bytes, from which Emacs will ask for confirmation. Set
it to nil to never request confirmation."
op-type
size
(funcall byte-count-to-string-function large-file-warning-threshold)
op-type
op-type
op-type
op-type
op-type))
(defun files--ask-user-about-large-file (size op-type filename offer-raw)
"Query the user about what to do with large files.
Files are \"large\" if file SIZE is larger than `large-file-warning-threshold'.
OP-TYPE specifies the file operation being performed on FILENAME.
If OFFER-RAW is true, give user the additional option to open the
file literally."
(let ((prompt (format "File %s is large (%s), really %s?"
(file-name-nondirectory filename)
(funcall byte-count-to-string-function size) op-type)))
(if (not offer-raw)
(if (y-or-n-p prompt) nil 'abort)
(let ((choice
(car
(read-multiple-choice
prompt '((?y "yes")
(?n "no")
(?l "literally"))
(files--ask-user-about-large-file-help-text
op-type (funcall byte-count-to-string-function size))))))
(cond ((eq choice ?y) nil)
((eq choice ?l) 'raw)
(t 'abort))))))
(defun abort-if-file-too-large (size op-type filename &optional offer-raw)
"If file SIZE larger than `large-file-warning-threshold', allow user to abort.
OP-TYPE specifies the file operation being performed (for message
to user). If OFFER-RAW is true, give user the additional option
to open the file literally. If the user chooses this option,
`abort-if-file-too-large' returns the symbol `raw'. Otherwise,
it returns nil or exits non-locally."
(let ((choice (and large-file-warning-threshold size
(> size large-file-warning-threshold)
;; No point in warning if we can't read it.
(file-readable-p filename)
(files--ask-user-about-large-file
size op-type filename offer-raw))))
(when (eq choice 'abort)
(user-error "Aborted"))
choice))
(defun warn-maybe-out-of-memory (size)
"Warn if an attempt to open file of SIZE bytes may run out of memory."
(when (and (numberp size) (not (zerop size))
(integerp out-of-memory-warning-percentage))
(let* ((default-directory temporary-file-directory)
(meminfo (memory-info)))
(when (consp meminfo)
(let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
(when (> (/ size 1024)
(/ (* total-free-memory out-of-memory-warning-percentage)
100.0))
(warn
"You are trying to open a file whose size (%s)
exceeds the %S%% of currently available free memory (%s).
If that fails, try to open it with `find-file-literally'
\(but note that some characters might be displayed incorrectly)."
(funcall byte-count-to-string-function size)
out-of-memory-warning-percentage
(funcall byte-count-to-string-function
(* total-free-memory 1024)))))))))
(defun files--message (format &rest args)
"Like `message', except sometimes don't show the message text.
If the variable `save-silently' is non-nil, the message will not
be visible in the echo area."
(apply #'message format args)
(when save-silently (message nil)))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
The buffer is not selected, just returned to the caller.
Optional second arg NOWARN non-nil means suppress any warning messages.
Optional third arg RAWFILE non-nil means the file is read literally.
Optional fourth arg WILDCARDS non-nil means do wildcard processing
and visit all the matching files. When wildcards are actually
used and expanded, return a list of buffers that are visiting
the various files."
(setq filename
(abbreviate-file-name
(expand-file-name filename)))
(if (file-directory-p filename)
(or (and find-file-run-dired
(run-hook-with-args-until-success
'find-directory-functions
(if find-file-visit-truename
(abbreviate-file-name (file-truename filename))
filename)))
(error "%s is a directory" filename))
(if (and wildcards
find-file-wildcards
(not (file-name-quoted-p filename))
(string-match "[[*?]" filename))
(let ((files (condition-case nil
(file-expand-wildcards filename t)
(error (list filename))))
(find-file-wildcards nil))
(if (null files)
(find-file-noselect filename)
(mapcar #'find-file-noselect files)))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(attributes (file-attributes truename))
(number (file-attribute-file-identifier attributes))
;; Find any buffer for a file that has same truename.
(other (and (not buf)
(find-buffer-visiting
filename
;; We want to filter out buffers that we've
;; visited via symlinks and the like, where
;; the symlink no longer exists.
(lambda (buffer)
(let ((file (buffer-local-value
'buffer-file-name buffer)))
(and file (file-exists-p file))))))))
;; Let user know if there is a buffer with the same truename.
(when other
(or nowarn
find-file-suppress-same-file-warnings
(string-equal filename (buffer-file-name other))
(files--message "%s and %s are the same file"
filename (buffer-file-name other)))
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other)))
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
(when (eq (abort-if-file-too-large
(file-attribute-size attributes) "open" filename
(not rawfile))
'raw)
(setf rawfile t))
(warn-maybe-out-of-memory (file-attribute-size attributes)))
(if buf
;; We are using an existing buffer.
(let (nonexistent)
(or nowarn
(verify-visited-file-modtime buf)
(cond ((not (file-exists-p filename))
(setq nonexistent t)
(message "File %s no longer exists!" filename))
;; Certain files should be reverted automatically
;; if they have changed on disk and not in the buffer.
((and (not (buffer-modified-p buf))
(let ((tail revert-without-query)
(found nil))
(while tail
(if (string-match (car tail) filename)
(setq found t))
(setq tail (cdr tail)))
found))
(with-current-buffer buf
(message "Reverting file %s..." filename)
(revert-buffer t t)
(message "Reverting file %s...done" filename)))
((not query-about-changed-file)
(message
(substitute-command-keys
"File %s changed on disk. \\[revert-buffer-quick] to load new contents%s")
(file-name-nondirectory filename)
(if (buffer-modified-p buf)
" and discard your edits"
"")))
((yes-or-no-p
(if (string= (file-name-nondirectory filename)
(buffer-name buf))
(format
(if (buffer-modified-p buf)
"File %s changed on disk. Discard your edits? "
"File %s changed on disk. Reread from disk? ")
(file-name-nondirectory filename))
(format
(if (buffer-modified-p buf)
"File %s changed on disk. Discard your edits in %s? "
"File %s changed on disk. Reread from disk into %s? ")
(file-name-nondirectory filename)
(buffer-name buf))))
(with-current-buffer buf
(revert-buffer t t)))))
(with-current-buffer buf
;; Check if a formerly read-only file has become
;; writable and vice versa, but if the buffer agrees
;; with the new state of the file, that is ok too.
(let ((read-only (not (file-writable-p buffer-file-name))))
(unless (or nonexistent
(eq read-only buffer-file-read-only)
(eq read-only buffer-read-only))
(when (or nowarn
(let* ((new-status
(if read-only "read-only" "writable"))
(question
(format "File %s is %s on disk. Make buffer %s, too? "
buffer-file-name
new-status new-status)))
(y-or-n-p question)))
(setq buffer-read-only read-only)))
(setq buffer-file-read-only read-only))
(unless (or (eq (null rawfile) (null find-file-literally))
nonexistent
;; It is confusing to ask whether to visit
;; non-literally if they have the file in
;; hexl-mode or image-mode.
(memq major-mode '(hexl-mode image-mode)))
(if (buffer-modified-p)
(if (let ((help-form
(format-message
(if rawfile "\
The file %s is already visited normally,
and you have edited the buffer. Now you have asked to visit it literally,
meaning no coding system handling, format conversion, or local variables.
Emacs can visit a file in only one way at a time."
"\
The file %s is already visited literally,
meaning no coding system handling, format conversion, or local variables.
You have edited the buffer. Now you have asked to visit the file normally,
but Emacs can visit a file in only one way at a time.")
(file-name-nondirectory filename))))
(y-or-n-p
(if rawfile "\
Do you want to save the file, and visit it literally instead? " "\
Do you want to save the file, and visit it normally instead? ")))
(progn
(save-buffer)
(find-file-noselect-1 buf filename nowarn
rawfile truename number))
(if (y-or-n-p
(if rawfile "\
Do you want to discard your changes, and visit the file literally now? " "\
Do you want to discard your changes, and visit the file normally now? "))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
"File already visited literally"))))
(if (let ((help-form
(format-message
(if rawfile "\
The file %s is already visited normally.
You have asked to visit it literally,
meaning no coding system decoding, format conversion, or local variables.
But Emacs can visit a file in only one way at a time."
"\
The file %s is already visited literally,
meaning no coding system decoding, format conversion, or local variables.
You have asked to visit it normally,
but Emacs can visit a file in only one way at a time.")
(file-name-nondirectory filename))))
(y-or-n-p
(if rawfile "\
Do you want to revisit the file literally now? " "\
Do you want to revisit the file normally now? ")))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
"File already visited literally"))))))
;; Return the buffer we are using.
buf)
;; Create a new buffer.
(setq buf (create-file-buffer filename))
;; find-file-noselect-1 may use a different buffer.
(find-file-noselect-1 buf filename nowarn
rawfile truename number))))))
(defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
(let (error)
(with-current-buffer buf
(kill-local-variable 'find-file-literally)
;; Needed in case we are re-visiting the file with a different
;; text representation.
(kill-local-variable 'buffer-file-coding-system)
(kill-local-variable 'cursor-type)
(let ((inhibit-read-only t))
(erase-buffer))
(and (not rawfile)
(set-buffer-multibyte t))
(if rawfile
(condition-case ()
(let ((inhibit-read-only t)
(enable-local-variables nil))
(insert-file-contents-literally filename t))
(file-error
(when (and (file-exists-p filename)
(not (file-readable-p filename)))
(kill-buffer buf)
(signal 'file-error (list "File is not readable"
filename)))
;; Unconditionally set error
(setq error t)))
(condition-case ()
(let ((inhibit-read-only t))
(insert-file-contents filename t))
(file-error
(when (and (file-exists-p filename)
(not (file-readable-p filename)))
(kill-buffer buf)
(signal 'file-error (list "File is not readable"
filename)))
;; Run find-file-not-found-functions until one returns non-nil.
(or (run-hook-with-args-until-success 'find-file-not-found-functions)
;; If they fail too, set error.
(setq error t)))))
;; Record the file's truename, and maybe use that as visited name.
(setq buffer-file-truename
(if (equal filename buffer-file-name)
truename
(abbreviate-file-name (file-truename buffer-file-name))))
(setq buffer-file-number number)
(if find-file-visit-truename
(setq buffer-file-name (expand-file-name buffer-file-truename)))
;; Set buffer's default directory to that of the file.
(setq default-directory (file-name-directory buffer-file-name))
;; Turn off backup files for certain file names. Since
;; this is a permanent local, the major mode won't eliminate it.
(and backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
(setq-local backup-inhibited t))
(if rawfile
(let ((enable-local-variables nil))
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
(set-buffer-major-mode buf)
(setq-local find-file-literally t))
(after-find-file error (not nowarn)))
(current-buffer))))
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only read in the file literally.
See `insert-file-contents' for an explanation of the parameters.
A buffer may be modified in several ways after reading into the buffer,
due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place.
Unlike `find-file-literally', this function does not make the
buffer unibyte, so if this function is used when handling
binary (non-character) data, it can be convenient to make the
buffer unibyte first. This isn't, strictly speaking, necessary,
because multibyte buffers can also deal with raw bytes. See info
node `(elisp)Character Codes' for details."
(let ((format-alist nil)
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(inhibit-file-name-handlers
;; FIXME: Yuck!! We should turn insert-file-contents-literally
;; into a file operation instead!
(append '(jka-compr-handler image-file-handler epa-file-handler)
(and (eq inhibit-file-name-operation 'insert-file-contents)
inhibit-file-name-handlers)))
(inhibit-file-name-operation 'insert-file-contents))
(insert-file-contents filename visit beg end replace)))
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
(signal 'file-error (list "Opening input file" "Is a directory"
filename)))
;; Check whether the file is uncommonly large
(abort-if-file-too-large (file-attribute-size (file-attributes filename))
"insert" filename)
(let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
#'buffer-modified-p))
(tem (funcall insert-func filename)))
(push-mark (+ (point) (car (cdr tem))))
(when buffer
(message "File %s already visited and modified in buffer %s"
filename (buffer-name buffer)))))
(defun insert-file-literally (filename)
"Insert contents of file FILENAME into buffer after point with no conversion.
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents-literally' instead.
\(Its calling sequence is different; see its documentation)."
(declare (interactive-only insert-file-contents-literally))
(interactive "*fInsert file literally: ")
(insert-file-1 filename #'insert-file-contents-literally))
(defvar find-file-literally nil
"Non-nil if this buffer was made by `find-file-literally' or equivalent.
This has the `permanent-local' property, which takes effect if you
make the variable buffer-local.")
(put 'find-file-literally 'permanent-local t)
(defun find-file-literally (filename)
"Visit file FILENAME with no conversion of any kind.
Format conversion and character code conversion are both disabled,
and multibyte characters are disabled in the resulting buffer.
The major mode used is Fundamental mode regardless of the file name,
and local variable specifications in the file are ignored.
Automatic uncompression and adding a newline at the end of the
file due to `require-final-newline' is also disabled.
If Emacs already has a buffer that is visiting the file,
this command asks you whether to visit it literally instead.
In non-interactive use, the value is the buffer where the file is
visited literally. If the file was visited in a buffer before
this command was invoked, it will reuse the existing buffer,
regardless of whether it was created literally or not; however,
the contents of that buffer will be the literal text of the file
without any conversions.
In a Lisp program, if you want to be sure of accessing a file's
contents literally, you should create a temporary buffer and then read
the file contents into it using `insert-file-contents-literally'."
(interactive
(list (read-file-name
"Find file literally: " nil default-directory
(confirm-nonexistent-file-or-buffer))))
(switch-to-buffer (find-file-noselect filename nil t)))
(defun after-find-file (&optional error warn noauto
_after-find-file-from-revert-buffer
nomodes)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses file-local and directory-local variables.
Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
NOAUTO means don't mess with auto-save mode.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER is ignored
\(see `revert-buffer-in-progress-p' for similar functionality).
Fifth arg NOMODES non-nil means don't alter the file's modes.
Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
;; The above is sufficiently like turning on read-only-mode, so run
;; the mode hook here by hand.
(if buffer-read-only
(run-hooks 'read-only-mode-hook))
(if noninteractive
nil
(let* (not-serious
(msg
(cond
((and error (file-exists-p buffer-file-name))
(setq buffer-read-only t)
"File exists, but cannot be read")
((and error (file-symlink-p buffer-file-name))
"Symbolic link that points to nonexistent file")
((not buffer-read-only)
(if (and
;; No need to warn if buffer is auto-saved
;; under the name of the visited file.
(not (and buffer-file-name
auto-save-visited-file-name))
(file-newer-than-file-p (or buffer-auto-save-file-name
(make-auto-save-file-name))
buffer-file-name))
(format (substitute-command-keys
"%s has auto save data; consider \\`M-x recover-this-file'")
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
((not error)
(setq not-serious t)
"Note: file is write protected")
((file-accessible-directory-p default-directory)
"File not found and directory write-protected")
(t
(setq buffer-read-only nil)
(unless (file-directory-p default-directory)
"Use M-x make-directory RET RET to create the directory and its parents")))))
(when (and warn msg)
(message "%s" msg)
(or not-serious (sit-for 1 t))))
(when (and auto-save-default (not noauto))
(auto-save-mode 1)))
;; Make people do a little extra work (C-x C-q)
;; before altering a backup file.
;; When a file is marked read-only,
;; make the buffer read-only even if root is looking at it.
(unless buffer-read-only
(when (or (backup-file-name-p buffer-file-name)
(let ((modes (file-modes (buffer-file-name))))
(and modes (zerop (logand modes #o222)))))
(setq buffer-read-only t)))
(unless nomodes
(when (and view-read-only view-mode)
(view-mode -1))
(normal-mode t)
;; If requested, add a newline at the end of the file.
(and (memq require-final-newline '(visit visit-save))
(> (point-max) (point-min))
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
(not buffer-read-only)
(save-excursion
(goto-char (point-max))
(ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
(view-mode-enter))
(run-hooks 'find-file-hook)))
(define-obsolete-function-alias 'report-errors 'with-demoted-errors "25.1")
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
Also sets up any specified local variables of the file or its directory.
Uses the visited file name, the -*- line, and the local variables spec.
This function is called automatically from `find-file'. In that case,
we may set up the file-specified mode and local variables,
depending on the value of `enable-local-variables'.
In addition, if `local-enable-local-variables' is nil, we do
not set local variables (though we do notice a mode specified with -*-.)
`enable-local-variables' is ignored if you run `normal-mode' interactively,
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t.
If invoked in a buffer that doesn't visit a file, this function
processes only the major mode specification in the -*- line and
the local variables spec."
(interactive)
(kill-all-local-variables)
(unless delay-mode-hooks
(run-hooks 'change-major-mode-after-body-hook
'after-change-major-mode-hook))
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
;; FIXME this is less efficient than it could be, since both
;; s-a-m and h-l-v may parse the same regions, looking for "mode:".
(with-demoted-errors "File mode specification error: %s"
(set-auto-mode))
;; `delay-mode-hooks' being non-nil will have prevented the major
;; mode's call to `run-mode-hooks' from calling
;; `hack-local-variables'. In that case, call it now.
(when delay-mode-hooks
(with-demoted-errors "File local-variables error: %s"
(hack-local-variables 'no-mode))))
;; Turn font lock off and on, to make sure it takes account of
;; whatever file local variables are relevant to it.
(when (and font-lock-mode
;; Font-lock-mode (now in font-core.el) can be ON when
;; font-lock.el still hasn't been loaded.
(boundp 'font-lock-keywords)
(eq (car font-lock-keywords) t))
(setq font-lock-keywords (cadr font-lock-keywords))
(font-lock-mode 1)))
(defcustom auto-mode-case-fold t
"Non-nil means to try second pass through `auto-mode-alist'.
This means that if the first case-sensitive search through the alist fails
to find a matching major mode, a second case-insensitive search is made.
On systems with case-insensitive file names, this variable is ignored,
since only a single case-insensitive search through the alist is made."
:group 'files
:version "22.1"
:type 'boolean)
(defvar auto-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (c-mode,
;; c++-mode, java-mode and more) are added through autoload
;; directives in that file.
(mapcar
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
`(;; do this first, so that .html.pl is Polish html, not Perl
("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode)
("\\.svgz?\\'" . image-mode)
("\\.svgz?\\'" . xml-mode)
("\\.x[bp]m\\'" . image-mode)
("\\.x[bp]m\\'" . c-mode)
("\\.p[bpgn]m\\'" . image-mode)
("\\.tiff?\\'" . image-mode)
("\\.gif\\'" . image-mode)
("\\.png\\'" . image-mode)
("\\.jpe?g\\'" . image-mode)
("\\.webp\\'" . image-mode)
("\\.te?xt\\'" . text-mode)
("\\.[tT]e[xX]\\'" . tex-mode)
("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
("\\.org\\'" . org-mode)
;; .dir-locals.el is not really Elisp. Could use the
;; `dir-locals-file' constant if it weren't defined below.
("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
("\\.eld\\'" . lisp-data-mode)
;; FIXME: The lisp-data-mode files below should use the `.eld' extension
;; (or a -*- mode cookie) so we don't need ad-hoc entries here.
("eww-bookmarks\\'" . lisp-data-mode)
("tramp\\'" . lisp-data-mode)
("/archive-contents\\'" . lisp-data-mode)
("places\\'" . lisp-data-mode)
("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
("\\(?:\\.\\(?:scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\|/\\.guile\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.li?sp\\'" . lisp-mode)
("\\.[fF]\\'" . fortran-mode)
("\\.for\\'" . fortran-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("Imakefile\\'" . makefile-imake-mode)
("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
("\\.makepp\\'" . makefile-makepp-mode)
,@(if (memq system-type '(berkeley-unix darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
("\\.make\\'" . makefile-bsdmake-mode)
("GNUmakefile\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
'(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give GNU the host advantage
("\\.make\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-gmake-mode)))
("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here
;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
("\\.te?xi\\'" . texinfo-mode)
("\\.[sS]\\'" . asm-mode)
("\\.asm\\'" . asm-mode)
("\\.css\\'" . css-mode)
("\\.mixal\\'" . mixal-mode)
("\\.gcov\\'" . compilation-mode)
;; Besides .gdbinit, gdb documents other names to be usable for init
;; files, cross-debuggers can use something like
;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
;; don't interfere with each other.
("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)
;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file
;; named 'emacs-gdb.gdb', if it exists, will be automatically
;; loaded when GDB reads an objfile called 'emacs'.
("-gdb\\.gdb" . gdb-script-mode)
("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode)
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
("\\.bash\\'" . sh-mode)
("/PKGBUILD\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.m?spec\\'" . sh-mode)
("\\.m[mes]\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
("\\.sty\\'" . latex-mode)
("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option
("\\.bbl\\'" . latex-mode)
("\\.bib\\'" . bibtex-mode)
("\\.bst\\'" . bibtex-style-mode)
("\\.sql\\'" . sql-mode)
;; These .m4 files are Autoconf files.
("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode)
("\\.m[4c]\\'" . m4-mode)
("\\.mf\\'" . metafont-mode)
("\\.mp\\'" . metapost-mode)
("\\.vhdl?\\'" . vhdl-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.i?tcl\\'" . tcl-mode)
("\\.exp\\'" . tcl-mode)
("\\.itk\\'" . tcl-mode)
("\\.icn\\'" . icon-mode)
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
;; The Fortran standard does not say anything about file extensions.
;; .f90 was widely used for F90, now we seem to be trapped into
;; using a different extension for each language revision.
;; Anyway, the following extensions are supported by gfortran.
("\\.f9[05]\\'" . f90-mode)
("\\.f0[38]\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
("\\.srt\\'" . srecode-template-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
;; The list of archive file extensions should be in sync with
;; `auto-coding-alist' with `no-conversion' coding system.
("\\.\\(\
arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . archive-mode)
("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("/Message[0-9]*\\'" . text-mode)
;; some news reader is reported to use this
("\\`/tmp/fol/" . text-mode)
("\\.oak\\'" . scheme-mode)
("\\.sgml?\\'" . sgml-mode)
("\\.x[ms]l\\'" . xml-mode)
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js[mx]?\\'" . javascript-mode)
;; https://en.wikipedia.org/wiki/.har
("\\.har\\'" . javascript-mode)
("\\.json\\'" . js-json-mode)
("\\.[ds]?va?h?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)
("\\.wy\\'" . wisent-grammar-mode)
("\\.erts\\'" . erts-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix or MS-DOS syntax.
("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\`\\..*emacs\\'" . emacs-lisp-mode)
;; _emacs following a directory delimiter in MS-DOS syntax
("[:/]_emacs\\'" . emacs-lisp-mode)
("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
("\\.ml\\'" . lisp-mode)
;; Linux-2.6.9 uses some different suffix for linker scripts:
;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo".
;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*".
("\\.ld[si]?\\'" . ld-script-mode)
("ld\\.?script\\'" . ld-script-mode)
;; .xs is also used for ld scripts, but seems to be more commonly
;; associated with Perl .xs files (C with Perl bindings). (Bug#7071)
("\\.xs\\'" . c-mode)
;; Explained in binutils ld/genscripts.sh. Eg:
;; A .x script file is the default script.
;; A .xr script is for linking without relocation (-r flag). Etc.
("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode)
("\\.zone\\'" . dns-mode)
("\\.soa\\'" . dns-mode)
;; Common Lisp ASDF package system.
("\\.asd\\'" . lisp-mode)
("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS
("\\.[eE]?[pP][sS]\\'" . ps-mode)
("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("#\\*mail\\*" . mail-mode)
("\\.g\\'" . antlr-mode)
("\\.mod\\'" . m2-mode)
("\\.ses\\'" . ses-mode)
("\\.docbook\\'" . sgml-mode)
("\\.com\\'" . dcl-mode)
("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode)
;; Windows candidates may be opened case sensitively on Unix
("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
("\\.la\\'" . conf-unix-mode)
("\\.ppd\\'" . conf-ppd-mode)
("java.+\\.conf\\'" . conf-javaprop-mode)
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
("\\.toml\\'" . conf-toml-mode)
("\\.desktop\\'" . conf-desktop-mode)
("/\\.redshift\\.conf\\'" . conf-windows-mode)
("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; ChangeLog.old etc. Other change-log-mode entries are above;
;; this has lower priority to avoid matching changelog.sgml etc.
("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
;; either user's dot-files or under /etc or some such
("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
("/\\.mailmap\\'" . conf-unix-mode)
;; alas not all ~/.*rc files are like this
("/\\.\\(?:asound\\|enigma\\|fetchmail\\|gltron\\|gtk\\|hxplayer\\|mairix\\|mbsync\\|msmtp\\|net\\|neverball\\|nvidia-settings-\\|offlineimap\\|qt/.+\\|realplayer\\|reportbug\\|rtorrent\\.\\|screen\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
("/\\.\\(?:gdbtkinit\\|grip\\|mpdconf\\|notmuch-config\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode)
("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
;; this contains everything twice, with space and with colon :-(
("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
;; Get rid of any trailing .n.m and try again.
;; This is for files saved by cvs-merge that look like .#<file>.<rev>
;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
;; Using mode nil rather than `ignore' would let the search continue
;; through this list (with the shortened name) rather than start over.
("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t)
;; This should come after "in" stripping (e.g. config.h.in).
;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe)
;; The following should come after the ChangeLog pattern
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
("\\.[1-9]\\'" . nroff-mode)
;; Image file types probably supported by `image-convert'.
("\\.art\\'" . image-mode)
("\\.avs\\'" . image-mode)
("\\.bmp\\'" . image-mode)
("\\.cmyk\\'" . image-mode)
("\\.cmyka\\'" . image-mode)
("\\.crw\\'" . image-mode)
("\\.dcr\\'" . image-mode)
("\\.dcx\\'" . image-mode)
("\\.dng\\'" . image-mode)
("\\.dpx\\'" . image-mode)
("\\.fax\\'" . image-mode)
("\\.heic\\'" . image-mode)
("\\.hrz\\'" . image-mode)
("\\.icb\\'" . image-mode)
("\\.icc\\'" . image-mode)
("\\.icm\\'" . image-mode)
("\\.ico\\'" . image-mode)
("\\.icon\\'" . image-mode)
("\\.jbg\\'" . image-mode)
("\\.jbig\\'" . image-mode)
("\\.jng\\'" . image-mode)
("\\.jnx\\'" . image-mode)
("\\.miff\\'" . image-mode)
("\\.mng\\'" . image-mode)
("\\.mvg\\'" . image-mode)
("\\.otb\\'" . image-mode)
("\\.p7\\'" . image-mode)
("\\.pcx\\'" . image-mode)
("\\.pdb\\'" . image-mode)
("\\.pfa\\'" . image-mode)
("\\.pfb\\'" . image-mode)
("\\.picon\\'" . image-mode)
("\\.pict\\'" . image-mode)
("\\.rgb\\'" . image-mode)
("\\.rgba\\'" . image-mode)
("\\.tga\\'" . image-mode)
("\\.wbmp\\'" . image-mode)
("\\.webp\\'" . image-mode)
("\\.wmf\\'" . image-mode)
("\\.wpg\\'" . image-mode)
("\\.xcf\\'" . image-mode)
("\\.xmp\\'" . image-mode)
("\\.xwd\\'" . image-mode)
("\\.yuv\\'" . image-mode)))
"Alist of file name patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
Visiting a file whose name matches REGEXP specifies FUNCTION as the
mode function to use. FUNCTION will be called, unless it is nil.
If the element has the form (REGEXP FUNCTION NON-NIL), then after
calling FUNCTION (if it's not nil), we delete the suffix that matched
REGEXP and search the list again for another match.
The extensions whose FUNCTION is `archive-mode' should also
appear in `auto-coding-alist' with `no-conversion' coding system.
See also `interpreter-mode-alist', which detects executable script modes
based on the interpreters they specify to run,
and `magic-mode-alist', which determines modes based on file contents.")
(put 'auto-mode-alist 'risky-local-variable t)
(defun conf-mode-maybe ()
"Select Conf mode or XML mode according to start of file."
(if (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(looking-at "<\\?xml \\|<!-- \\|<!DOCTYPE ")))
(xml-mode)
(conf-mode)))
(defvar interpreter-mode-alist
;; Note: The entries for the modes defined in cc-mode.el (awk-mode
;; and pike-mode) are added through autoload directives in that
;; file.
(mapcar
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
'(("\\(mini\\)?perl5?" . perl-mode)
("wishx?" . tcl-mode)
("tcl\\(sh\\)?" . tcl-mode)
("expect" . tcl-mode)
("octave" . octave-mode)
("scm" . scheme-mode)
("[acjkwz]sh" . sh-mode)
("r?bash2?" . sh-mode)
("dash" . sh-mode)
("mksh" . sh-mode)
("\\(dt\\|pd\\|w\\)ksh" . sh-mode)
("es" . sh-mode)
("i?tcsh" . sh-mode)
("oash" . sh-mode)
("rc" . sh-mode)
("rpm" . sh-mode)
("sh5?" . sh-mode)
("tail" . text-mode)
("more" . text-mode)
("less" . text-mode)
("pg" . text-mode)
("make" . makefile-gmake-mode) ; Debian uses this
("guile" . scheme-mode)
("clisp" . lisp-mode)
("emacs" . emacs-lisp-mode)))
"Alist mapping interpreter names to major modes.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
Each element looks like (REGEXP . MODE).
If REGEXP matches the entire name (minus any directory part) of
the interpreter specified in the first line of a script, enable
major mode MODE.
See also `auto-mode-alist'.")
;; TODO really this should be a list of modes (eg tar-mode), not regexps,
;; because we are duplicating info from auto-mode-alist.
;; TODO many elements of this list are also in auto-coding-alist.
(defvar inhibit-local-variables-regexps
(mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
"\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
"\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
"\\.7z\\'"
"\\.sx[dmicw]\\'" "\\.odt\\'"
"\\.diff\\'" "\\.patch\\'"
"\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
"List of regexps matching file names in which to ignore local variables.
This includes `-*-' lines as well as trailing \"Local Variables\" sections.
Files matching this list are typically binary file formats.
They may happen to contain sequences that look like local variable
specifications, but are not really, or they may be containers for
member files with their own local variable sections, which are
not appropriate for the containing file.
The function `inhibit-local-variables-p' uses this.")
(defvar inhibit-local-variables-suffixes nil
"List of regexps matching suffixes to remove from file names.
The function `inhibit-local-variables-p' uses this: when checking
a file name, it first discards from the end of the name anything that
matches one of these regexps.")
;; Can't think of any situation in which you'd want this to be nil...
(defvar inhibit-local-variables-ignore-case t
"Non-nil means `inhibit-local-variables-p' ignores case.")
(defun inhibit-local-variables-p ()
"Return non-nil if file local variables should be ignored.
This checks the file (or buffer) name against `inhibit-local-variables-regexps'
and `inhibit-local-variables-suffixes'. If
`inhibit-local-variables-ignore-case' is non-nil, this ignores case."
(let ((temp inhibit-local-variables-regexps)
(name (if buffer-file-name
(file-name-sans-versions buffer-file-name)
(buffer-name)))
(case-fold-search inhibit-local-variables-ignore-case))
(while (let ((sufs inhibit-local-variables-suffixes))
(while (and sufs (not (string-match (car sufs) name)))
(setq sufs (cdr sufs)))
sufs)
(setq name (substring name 0 (match-beginning 0))))
(while (and temp
(not (string-match (car temp) name)))
(setq temp (cdr temp)))
temp))
(defvar auto-mode-interpreter-regexp
(purecopy
(concat
"#![ \t]*"
;; Optional group 1: env(1) invocation.
"\\("
"[^ \t\n]*/bin/env[ \t]*"
;; Within group 1: possible -S/--split-string and environment
;; adjustments.
"\\(?:"
;; -S/--split-string
"\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)"
;; More env arguments.
"\\(?:-[^ \t\n]+[ \t]+\\)*"
;; Interpreter environment modifications.
"\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*"
"\\)?"
"\\)?"
;; Group 2: interpreter.
"\\([^ \t\n]+\\)"))
"Regexp matching interpreters, for file mode determination.
This regular expression is matched against the first line of a file
to determine the file's mode in `set-auto-mode'. If it matches, the file
is assumed to be interpreted by the interpreter matched by the second group
of the regular expression. The mode is then determined as the mode
associated with that interpreter in `interpreter-mode-alist'.")
(defvar magic-mode-alist nil
"Alist of buffer beginnings vs. corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
After visiting a file, if REGEXP matches the text at the beginning of the
buffer (case-sensitively), or calling MATCH-FUNCTION returns non-nil,
`normal-mode' will call FUNCTION rather than allowing `auto-mode-alist' to
decide the buffer's major mode.
If FUNCTION is nil, then it is not called. (That is a way of saying
\"allow `auto-mode-alist' to decide for these files.\")")
(put 'magic-mode-alist 'risky-local-variable t)
(defvar magic-fallback-mode-alist
(purecopy
`((image-type-auto-detected-p . image-mode)
("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip
;; The < comes before the groups (but the first) to reduce backtracking.
;; TODO: UTF-16 <?xml may be preceded by a BOM 0xff 0xfe or 0xfe 0xff.
;; We use [ \t\r\n] instead of `\\s ' to make regex overflow less likely.
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
(comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
(concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
comment-re "*"
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
"[Hh][Tt][Mm][Ll]"))
. mhtml-mode)
("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
(comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
(concat "[ \t\r\n]*<" comment-re "*!DOCTYPE "))
. sgml-mode)
("\320\317\021\340\241\261\032\341" . doc-view-mode-maybe) ; Word documents 1997-2004
("%!PS" . ps-mode)
("# xmcd " . conf-unix-mode)))
"Like `magic-mode-alist' but has lower priority than `auto-mode-alist'.
Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION).
After visiting a file, if REGEXP matches the text at the beginning of the
buffer (case-sensitively), or calling MATCH-FUNCTION returns non-nil,
`normal-mode' will call FUNCTION, provided that `magic-mode-alist' and
`auto-mode-alist' have not specified a mode for this file.
If FUNCTION is nil, then it is not called.")
(put 'magic-fallback-mode-alist 'risky-local-variable t)
(defvar magic-mode-regexp-match-limit 4000
"Upper limit on `magic-mode-alist' regexp matches.
Also applies to `magic-fallback-mode-alist'.")
(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)
"Helper function for `set-auto-mode'.
This function takes an alist of the same form as
`auto-mode-alist'. It then tries to find the appropriate match
in the alist for the current buffer; setting the mode if
possible.
Return non-nil if the mode was set, nil otherwise.
DIR-LOCAL non-nil means this call is via directory-locals, and
extra checks should be done."
(if buffer-file-name
(let (mode
(name buffer-file-name)
(remote-id (file-remote-p buffer-file-name))
(case-insensitive-p (file-name-case-insensitive-p
buffer-file-name)))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification.
(when (and (stringp remote-id)
(string-match (regexp-quote remote-id) name))
(setq name (substring name (match-end 0))))
(while name
;; Find first matching alist entry.
(setq mode
(if case-insensitive-p
;; Filesystem is case-insensitive.
(let ((case-fold-search t))
(assoc-default name alist 'string-match))
;; Filesystem is case-sensitive.
(or
;; First match case-sensitively.
(let ((case-fold-search nil))
(assoc-default name alist 'string-match))
;; Fallback to case-insensitive match.
(and auto-mode-case-fold
(let ((case-fold-search t))
(assoc-default name alist 'string-match))))))
(if (and mode
(not (functionp mode))
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name nil)))
(when (and dir-local mode
(not (set-auto-mode--dir-local-valid-p mode)))
(message "Ignoring invalid mode `%s'" mode)
(setq mode nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
t))))
(defun set-auto-mode--dir-local-valid-p (mode)
"Say whether MODE can be used in a .dir-local.el `auto-mode-alist'."
(and (symbolp mode)
(string-suffix-p "-mode" (symbol-name mode))
(commandp mode)
(not (provided-mode-derived-p mode 'special-mode))))
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
To find the right major mode, this function checks for a -*- mode tag
checks for a `mode:' entry in the Local Variables section of the file,
checks if there an `auto-mode-alist' entry in `.dir-locals.el',
checks if it uses an interpreter listed in `interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the file name against the entries in `auto-mode-alist',
then matches the buffer beginning against `magic-fallback-mode-alist'.
It also obeys `major-mode-remap-alist' and `major-mode-remap-defaults'.
If `enable-local-variables' is nil, or if the file name matches
`inhibit-local-variables-regexps', this function does not check
for any mode: tag anywhere in the file. If `local-enable-local-variables'
is nil, then the only mode: tag that can be relevant is a -*- one.
If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
set the major mode only if that would change it. In other words
we don't actually set it to the same mode the buffer already has."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let ((try-locals (not (inhibit-local-variables-p)))
end modes)
;; Once we drop the deprecated feature where mode: is also allowed to
;; specify minor-modes (ie, there can be more than one "mode:"), we can
;; remove this section and just let (hack-local-variables t) handle it.
;; Find a -*- mode tag.
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
;; Note by design local-enable-local-variables does not matter here.
(and enable-local-variables
try-locals
(setq end (set-auto-mode-1))
(if (save-excursion (search-forward ":" end t))
;; Find all specifications for the `mode:' variable
;; and execute them left to right.
(while (let ((case-fold-search t))
(or (and (looking-at "mode:")
(goto-char (match-end 0)))
(re-search-forward "[ \t;]mode:" end t)))
(skip-chars-forward " \t")
(let ((beg (point)))
(if (search-forward ";" end t)
(forward-char -1)
(goto-char end))
(skip-chars-backward " \t")
(push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
modes)))
;; Simple -*-MODE-*- case.
(push (intern (concat (downcase (buffer-substring (point) end))
"-mode"))
modes))))
(or
;; If we found modes to use, invoke them now, outside the save-excursion.
;; Presume `modes' holds a major mode followed by minor modes.
(let ((done ()))
(dolist (mode (nreverse modes))
(if (eq done :keep)
;; `keep-mode-if-same' is set and the (major) mode
;; was already set. Refrain from calling the following
;; minor modes since they have already been set.
;; It was especially important in the past when calling
;; minor modes without an arg would toggle them, but it's
;; still preferable to avoid re-enabling them,
nil
(let ((res (set-auto-mode-0 mode keep-mode-if-same)))
(setq done (or res done)))))
done)
;; Check for auto-mode-alist entry in dir-locals.
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
;; We don't use `hack-dir-local-get-variables-functions' here, because
;; modes are specific to Emacs.
(let* ((mode-alist (cdr (hack-dir-local--get-variables
(lambda (key) (eq key 'auto-mode-alist))))))
(set-auto-mode--apply-alist mode-alist keep-mode-if-same t)))
(let ((mode (hack-local-variables t (not try-locals))))
(unless (memq mode modes) ; already tried and failed
(set-auto-mode-0 mode keep-mode-if-same)))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
(when-let
((interp (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2))))
;; Map interpreter name to a mode, signaling we're done at the
;; same time.
(mode (assoc-default
(file-name-nondirectory interp)
(mapcar (lambda (e)
(cons
(format "\\`%s\\'" (car e))
(cdr e)))
interpreter-mode-alist)
#'string-match-p)))
;; If we found an interpreter mode to use, invoke it now.
(set-auto-mode-0 mode keep-mode-if-same))
;; Next try matching the buffer beginning against magic-mode-alist.
(let ((mode (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default
nil magic-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem in magic-mode-alist with element %s"
re)))))))))
(set-auto-mode-0 mode keep-mode-if-same))
;; Next compare the filename against the entries in auto-mode-alist.
(set-auto-mode--apply-alist auto-mode-alist
keep-mode-if-same nil)
;; Next try matching the buffer beginning against magic-fallback-mode-alist.
(let ((mode (save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-region (point-min)
(min (point-max)
(+ (point-min) magic-mode-regexp-match-limit)))
(assoc-default nil magic-fallback-mode-alist
(lambda (re _dummy)
(cond
((functionp re)
(funcall re))
((stringp re)
(let ((case-fold-search nil))
(looking-at re)))
(t
(error
"Problem with magic-fallback-mode-alist element: %s"
re)))))))))
(set-auto-mode-0 mode keep-mode-if-same))
(set-buffer-major-mode (current-buffer)))))
(defvar-local set-auto-mode--last nil
"Remember the mode we have set via `set-auto-mode-0'.")
(defcustom major-mode-remap-alist nil
"Alist mapping file-specified modes to alternative modes.
Each entry is of the form (MODE . FUNCTION) which means that in place
of activating the major mode MODE (specified via something like
`auto-mode-alist', file-local variables, ...) we actually call FUNCTION
instead.
FUNCTION is typically a major mode which \"does the same thing\" as
MODE, but can also be nil to hide other entries (either in this var or
in `major-mode-remap-defaults') and means that we should call MODE."
:type '(alist (symbol) (function)))
(defvar major-mode-remap-defaults nil
"Alist mapping file-specified modes to alternative modes.
This works like `major-mode-remap-alist' except it has lower priority
and it is meant to be modified by packages rather than users.")
(defun major-mode-remap (mode)
"Return the function to use to enable MODE."
(or (cdr (or (assq mode major-mode-remap-alist)
(assq mode major-mode-remap-defaults)))
mode))
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
;; same one we already have, don't actually reset it. We don't want to lose
;; minor modes such as Font Lock.
(defun set-auto-mode-0 (mode &optional keep-mode-if-same)
"Apply MODE and return it.
If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
any aliases and compared to current major mode. If they are the
same, do nothing and return `:keep'.
Return nil if MODE could not be applied."
(when mode
(if (and keep-mode-if-same
(or (eq (indirect-function mode)
(indirect-function major-mode))
(and set-auto-mode--last
(eq mode (car set-auto-mode--last))
(eq major-mode (cdr set-auto-mode--last)))))
:keep
(let ((modefun (major-mode-remap mode)))
(if (not (functionp modefun))
(progn
(message "Ignoring unknown mode `%s'%s" mode
(if (eq mode modefun) ""
(format " (remapped to `%S')" modefun)))
nil)
(funcall modefun)
(unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill.
;; `modefun' is something like a minor mode.
(local-variable-p 'set-auto-mode--last))
(setq set-auto-mode--last (cons mode major-mode)))
mode)))))
(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
"Regexp of lines to skip when looking for file-local settings.
If the first line matches this regular expression, then the -*-...-*- file-
local settings will be consulted on the second line instead of the first.")
(defun set-auto-mode-1 ()
"Find the -*- spec in the buffer.
Call with point at the place to start searching from.
If one is found, set point to the beginning and return the position
of the end. Otherwise, return nil; may change point.
The variable `inhibit-local-variables-regexps' can cause a -*- spec to
be ignored; but `enable-local-variables' and `local-enable-local-variables'
have no effect."
(let (beg end)
(and
;; Don't look for -*- if this file name matches any
;; of the regexps in inhibit-local-variables-regexps.
(not (inhibit-local-variables-p))
(search-forward "-*-" (line-end-position
;; If the file begins with "#!" (exec
;; interpreter magic), look for mode frobs
;; in the first two lines. You cannot
;; necessarily put them in the first line
;; of such a file without screwing up the
;; interpreter invocation. The same holds
;; for '\" in man pages (preprocessor
;; magic for the `man' program).
(and (looking-at file-auto-mode-skip) 2))
t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
(search-forward "-*-" (line-end-position) t))
(progn
(forward-char -3)
(skip-chars-backward " \t")
(setq end (point))
(goto-char beg)
end))))
;;; Handling file local variables
(defvar ignored-local-variables
'(ignored-local-variables safe-local-variable-values
file-local-variables-alist dir-local-variables-alist)
"Variables to be ignored in a file's local variable spec.")
(put 'ignored-local-variables 'risky-local-variable t)
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
Major modes can use this to examine user-specified local variables
in order to initialize other data structure based on them.")
(defcustom safe-local-variable-values nil
"List of variable-value pairs that are considered safe.
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is a value that is considered safe.
Also see `ignored-local-variable-values'."
:risky t
:group 'find-file
:type 'alist)
(defcustom ignored-local-variable-values nil
"List of variable-value pairs that should always be ignored.
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is its value; if VAR is set to VAL by a file-local
variables section, that setting should be ignored.
Also see `safe-local-variable-values'."
:risky t
:group 'find-file
:type 'alist
:version "28.1")
(defcustom safe-local-eval-forms
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
(add-hook 'write-file-functions 'time-stamp)
(add-hook 'before-save-hook 'time-stamp nil t)
(add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
"Expressions that are considered safe in an `eval:' local variable.
Add expressions to this list if you want Emacs to evaluate them, when
they appear in an `eval' local variable specification, without first
asking you for confirmation."
:risky t
:group 'find-file
:version "24.1" ; added write-file-hooks
:type '(repeat sexp))
;; Risky local variables:
(mapc (lambda (var) (put var 'risky-local-variable t))
'(after-load-alist
buffer-auto-save-file-name
buffer-file-name
buffer-file-truename
buffer-undo-list
debugger
default-text-properties
eval
exec-directory
exec-path
file-name-handler-alist
frame-title-format
global-mode-string
header-line-format
icon-title-format
inhibit-quit
load-path
max-lisp-eval-depth
minor-mode-map-alist
minor-mode-overriding-map-alist
mode-line-format
mode-name
overriding-local-map
overriding-terminal-local-map
process-environment
standard-input
standard-output
unread-command-events))
;; Safe local variables:
;;
;; For variables defined by major modes, the safety declarations can go into
;; the major mode's file, since that will be loaded before file variables are
;; processed.
;;
;; For variables defined by minor modes, put the safety declarations in the
;; file defining the minor mode after the defcustom/defvar using an autoload
;; cookie, e.g.:
;;
;; ;;;###autoload(put 'variable 'safe-local-variable 'stringp)
;;
;; Otherwise, when Emacs visits a file specifying that local variable, the
;; minor mode file may not be loaded yet.
;;
;; For variables defined in the C source code the declaration should go here:
(dolist (pair
'((buffer-read-only . booleanp) ;; C source code
(default-directory . stringp) ;; C source code
(fill-column . integerp) ;; C source code
(indent-tabs-mode . booleanp) ;; C source code
(left-margin . integerp) ;; C source code
(inhibit-compacting-font-caches . booleanp) ;; C source code
(no-update-autoloads . booleanp)
(lexical-binding . booleanp) ;; C source code
(tab-width . integerp) ;; C source code
(truncate-lines . booleanp) ;; C source code
(word-wrap . booleanp) ;; C source code
(bidi-display-reordering . booleanp))) ;; C source code
(put (car pair) 'safe-local-variable (cdr pair)))
(put 'bidi-paragraph-direction 'safe-local-variable
(lambda (v) (memq v '(nil right-to-left left-to-right))))
(put 'c-set-style 'safe-local-eval-function t)
(defvar-local file-local-variables-alist nil
"Alist of file-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a file-local variable (a symbol) and VALUE is the value
specified. The actual value in the buffer may differ from VALUE,
if it is changed by the major or minor modes, or by the user.")
(put 'file-local-variables-alist 'permanent-local t)
(defvar-local dir-local-variables-alist nil
"Alist of directory-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a directory-local variable (a symbol) and VALUE is the value
specified in .dir-locals.el. The actual value in the buffer
may differ from VALUE, if it is changed by the major or minor modes,
or by the user.")
(defvar before-hack-local-variables-hook nil
"Normal hook run before setting file-local variables.
It is called after checking for unsafe/risky variables and
setting `file-local-variables-alist', and before applying the
variables stored in `file-local-variables-alist'. A hook
function is allowed to change the contents of this alist.
This hook is called only if there is at least one file-local
variable to set.")
(defvar permanently-enabled-local-variables
'(lexical-binding read-symbol-shorthands)
"A list of file-local variables that are always enabled.
This overrides any `enable-local-variables' setting.")
(defcustom safe-local-variable-directories '()
"A list of directories where local variables are always enabled.
Directory-local variables loaded from these directories, such as the
variables in .dir-locals.el, will be enabled even if they are risky.
The names of the directories in the list must be absolute, and must
end in a slash. Remote directories can be included if the
variable `enable-remote-dir-locals' is non-nil."
:version "30.1"
:type '(repeat string)
:risky t
:group 'find-file)
(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
"Get confirmation before setting up local variable values.
ALL-VARS is the list of all variables to be set up.
UNSAFE-VARS is the list of those that aren't marked as safe or risky.
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
(unless noninteractive
(let ((name (cond (dir-name)
(buffer-file-name
(file-name-nondirectory buffer-file-name))
((concat "buffer " (buffer-name)))))
(offer-save (and (eq enable-local-variables t)
unsafe-vars))
(buf (get-buffer-create "*Local Variables*")))
;; Set up the contents of the *Local Variables* buffer.
(with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
(insert "The local variables list in " name
"\nor .dir-locals.el contains values that may not be safe (*)"
(if risky-vars
", and variables that are risky (**)."
".")))
(risky-vars
(insert "The local variables list in " name
"\ncontains variables that are risky (**)."))
(t
(insert "A local variables list is specified in " name ".")))
(insert "\n\nDo you want to apply it? You can type
y -- to apply the local variables list.
n -- to ignore the local variables list.")
(if offer-save
(insert "
! -- to apply the local variables list, and permanently mark these
values (*) as safe (in the future, they will be set automatically.)
i -- to ignore the local variables list, and permanently mark these
values (*) as ignored"
(if dir-name "
+ -- to apply the local variables list, and trust all directory-local
variables in this directory\n\n"
"\n\n"))
(insert "\n\n"))
(dolist (elt all-vars)
(cond ((member elt unsafe-vars)
(insert " * "))
((member elt risky-vars)
(insert " ** "))
(t
(insert " ")))
(princ (car elt) buf)
(insert " : ")
;; Make strings with embedded whitespace easier to read.
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
(setq-local cursor-type nil)
(set-buffer-modified-p nil)
(goto-char (point-min)))
;; Display the buffer and read a choice.
(save-window-excursion
(pop-to-buffer buf '(display-buffer--maybe-at-bottom))
(let* ((exit-chars '(?y ?n ?\s))
(prompt (format "Please type %s%s: "
(if offer-save
(if dir-name
"y, n, !, i, +"
"y, n, !, i")
"y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
", or C-v/M-v to scroll")))
char)
(when offer-save
(push ?i exit-chars)
(push ?! exit-chars)
(when dir-name
(push ?+ exit-chars)))
(setq char (read-char-choice prompt exit-chars))
(when (and offer-save dir-name (= char ?+))
(customize-push-and-save 'safe-local-variable-directories
(list dir-name)))
(when (and offer-save
(or (= char ?!) (= char ?i))
unsafe-vars)
(customize-push-and-save
(if (= char ?!)
'safe-local-variable-values
'ignored-local-variable-values)
unsafe-vars))
(prog1 (memq char '(?! ?\s ?y ?+))
(quit-window t)))))))
(defconst hack-local-variable-regexp
"[ \t]*\\([^][;\"'?()\\ \t\n]+\\)[ \t]*:[ \t]*")
(defun hack-local-variables-prop-line (&optional handle-mode)
"Return local variables specified in the -*- line.
Usually returns an alist of elements (VAR . VAL), where VAR is a
variable and VAL is the specified value. Ignores any
specification for `coding:', and sometimes for `mode' (which
should have already been handled by `set-auto-coding' and
`set-auto-mode', respectively). Return nil if the -*- line is
malformed.
If HANDLE-MODE is nil, we return the alist of all the local
variables in the line except `coding' as described above. If it
is neither nil nor t, we do the same, except that any settings of
`mode' and `coding' are ignored. If HANDLE-MODE is t, we ignore
all settings in the line except for `mode', which \(if present) we
return as the symbol specifying the mode."
(catch 'malformed-line
(save-excursion
(goto-char (point-min))
(let ((end (set-auto-mode-1))
result)
(cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-".
(if (eq handle-mode t)
(intern (concat (match-string 1) "-mode"))))
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
;; If HANDLE-MODE is t, just check for `mode'.
;; Otherwise, parse the -*- line into the RESULT alist.
(while (not (or (and (eq handle-mode t) result)
(>= (point) end)))
(unless (looking-at hack-local-variable-regexp)
(message "Malformed mode-line: %S in buffer %S"
(buffer-substring-no-properties (point) end) (buffer-name))
(throw 'malformed-line nil))
(goto-char (match-end 0))
;; There used to be a downcase here,
;; but the manual didn't say so,
;; and people want to set var names that aren't all lc.
(let* ((key (intern (match-string 1)))
(val (save-restriction
(narrow-to-region (point) end)
;; As a defensive measure, we do not allow
;; circular data in the file-local data.
(let ((read-circle nil))
(read (current-buffer)))))
;; It is traditional to ignore
;; case when checking for `mode' in set-auto-mode,
;; so we must do that here as well.
;; That is inconsistent, but we're stuck with it.
;; The same can be said for `coding' in set-auto-coding.
(keyname (downcase (symbol-name key))))
(cond
((eq handle-mode t)
(and (equal keyname "mode")
(setq result
(intern (concat (downcase (symbol-name val))
"-mode")))))
((equal keyname "coding"))
(t
(when (or (not handle-mode)
(not (equal keyname "mode")))
(condition-case nil
(push (cons (cond ((eq key 'eval) 'eval)
;; Downcase "Mode:".
((equal keyname "mode") 'mode)
(t (indirect-variable key)))
val)
result)
(error nil)))))
(skip-chars-forward " \t;")))
result))))))
(defun hack-local-variables-filter (variables dir-name)
"Filter local variable settings, querying the user if necessary.
VARIABLES is the alist of variable-value settings. This alist is
filtered based on the values of `ignored-local-variables',
`enable-local-eval', `enable-local-variables', and (if necessary)
user interaction. The results are added to
`file-local-variables-alist', without applying them.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
(let (all-vars risky-vars unsafe-vars)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
(cond ((memq var ignored-local-variables)
;; Ignore any variable in `ignored-local-variables'.
nil)
;; Ignore variables with the specified values.
((member elt ignored-local-variable-values)
nil)
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
(let ((safe (or (hack-one-local-variable-eval-safep val)
;; In case previously marked safe (bug#5636).
(safe-local-variable-p var val))))
;; If not safe and e-l-v = :safe, ignore totally.
(when (or safe (not (eq enable-local-variables :safe)))
(push elt all-vars)
(or (eq enable-local-eval t)
safe
(push elt unsafe-vars))))))
;; Ignore duplicates (except `mode') in the present list.
((and (assq var all-vars) (not (eq var 'mode))) nil)
;; Accept known-safe variables.
((or (memq var '(mode unibyte coding))
(safe-local-variable-p var val))
(push elt all-vars))
;; The variable is either risky or unsafe:
((not (eq enable-local-variables :safe))
(push elt all-vars)
(if (risky-local-variable-p var val)
(push elt risky-vars)
(push elt unsafe-vars))))))
(and all-vars
;; Query, unless all vars are safe or user wants no querying.
(or (and (eq enable-local-variables t)
(null unsafe-vars)
(null risky-vars))
(memq enable-local-variables '(:all :safe))
(delq nil (mapcar (lambda (dir)
(and dir-name dir
(file-equal-p dir dir-name)))
safe-local-variable-directories))
(hack-local-variables-confirm all-vars unsafe-vars
risky-vars dir-name))
(dolist (elt all-vars)
(unless (memq (car elt) '(eval mode))
(unless dir-name
(setq dir-local-variables-alist
(assq-delete-all (car elt) dir-local-variables-alist)))
(setq file-local-variables-alist
(assq-delete-all (car elt) file-local-variables-alist)))
(push elt file-local-variables-alist)))))
;; TODO? Warn once per file rather than once per session?
(defvar hack-local-variables--warned-lexical nil)
(defun hack-local-variables (&optional handle-mode inhibit-locals)
"Parse and put into effect this buffer's local variables spec.
For buffers visiting files, also puts into effect directory-local
variables.
Uses `hack-local-variables-apply' to apply the variables.
If `enable-local-variables' or `local-enable-local-variables' is
nil, or INHIBIT-LOCALS is non-nil, this function disregards all
normal local variables. If `inhibit-local-variables-regexps'
applies to the file in question, the file is not scanned for
local variables, but directory-local variables may still be
applied.
Variables present in `permanently-enabled-local-variables' will
still be evaluated, even if local variables are otherwise
inhibited.
If HANDLE-MODE is t, the function only checks whether a \"mode:\"
is specified, and returns the corresponding mode symbol, or nil.
In this case, try to ignore minor-modes, and return only a major-mode.
If HANDLE-MODE is nil, the function gathers all the specified local
variables. If HANDLE-MODE is neither nil nor t, the function gathers
all the specified local variables, but ignores any settings of \"mode:\"."
;; We don't let inhibit-local-variables-p influence the value of
;; enable-local-variables, because then it would affect dir-local
;; variables. We don't want to search eg tar files for file local
;; variable sections, but there is no reason dir-locals cannot apply
;; to them. The real meaning of inhibit-local-variables-p is "do
;; not scan this file for local variables".
(let ((enable-local-variables
(and (not inhibit-locals)
local-enable-local-variables enable-local-variables)))
(if (eq handle-mode t)
;; We're looking just for the major mode setting.
(and enable-local-variables
(not (inhibit-local-variables-p))
;; If HANDLE-MODE is t, and the prop line specifies a
;; mode, then we're done, and have no need to scan further.
(or (hack-local-variables-prop-line t)
;; Look for the mode elsewhere in the buffer.
(hack-local-variables--find-variables t)))
;; Normal handling of local variables.
(setq file-local-variables-alist nil)
(when (and (file-remote-p default-directory)
(fboundp 'hack-connection-local-variables)
(fboundp 'connection-local-criteria-for-default-directory))
(with-demoted-errors "Connection-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(hack-connection-local-variables
(connection-local-criteria-for-default-directory))))
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(hack-dir-local-variables))
(let ((result (append (hack-local-variables--find-variables handle-mode)
(hack-local-variables-prop-line handle-mode))))
(if (and enable-local-variables
(not (inhibit-local-variables-p)))
(progn
;; Set the variables.
(hack-local-variables-filter result nil)
(hack-local-variables-apply))
;; Handle `lexical-binding' and other special local
;; variables.
(dolist (variable permanently-enabled-local-variables)
(when-let ((elem (assq variable result)))
(push elem file-local-variables-alist)))
(hack-local-variables-apply))))))
(defun hack-local-variables--find-variables (&optional handle-mode)
"Return all local variables in the current buffer.
If HANDLE-MODE is nil, we gather all the specified local
variables. If HANDLE-MODE is neither nil nor t, we do the same,
except that any settings of `mode' are ignored.
If HANDLE-MODE is t, all we do is check whether a \"mode:\"
is specified, and return the corresponding mode symbol, or nil.
In this case, we try to ignore minor-modes, and return only a
major-mode."
(let ((result nil))
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
'move)
(when (let ((case-fold-search t))
(search-forward "Local Variables:" nil t))
(skip-chars-forward " \t")
;; suffix is what comes after "local variables:" in its line.
;; prefix is what comes before "local variables:" in its line.
(let ((suffix
(concat
(regexp-quote (buffer-substring (point)
(line-end-position)))
"$"))
(prefix
(concat "^" (regexp-quote
(buffer-substring (line-beginning-position)
(match-beginning 0))))))
(forward-line 1)
(let ((startpos (point))
endpos
(selective-p (eq selective-display t))
(thisbuf (current-buffer)))
(save-excursion
(unless (let ((case-fold-search t))
(re-search-forward
(concat prefix "[ \t]*End:[ \t]*" suffix)
nil t))
;; This used to be an error, but really all it means is
;; that this may simply not be a local-variables section,
;; so just ignore it.
(message "Local variables list is not properly terminated"))
(beginning-of-line)
(setq endpos (point)))
(with-temp-buffer
(insert-buffer-substring thisbuf startpos endpos)
(goto-char (point-min))
(if selective-p
(subst-char-in-region (point) (point-max) ?\r ?\n))
(while (not (eobp))
;; Discard the prefix.
(if (looking-at prefix)
(delete-region (point) (match-end 0))
(user-error "Local variables entry is missing the prefix"))
(end-of-line)
;; Discard the suffix.
(if (looking-back suffix (line-beginning-position))
(delete-region (match-beginning 0) (point))
(user-error "Local variables entry is missing the suffix"))
(forward-line 1))
(goto-char (point-min))
(while (not (eobp))
;; Find the variable name;
(unless (looking-at hack-local-variable-regexp)
(user-error "Malformed local variable line: %S"
(buffer-substring-no-properties
(point) (line-end-position))))
(goto-char (match-end 1))
(let* ((str (match-string 1))
(var (intern str))
val val2)
(and (equal (downcase (symbol-name var)) "mode")
(setq var 'mode))
;; Read the variable value.
(skip-chars-forward "^:")
(forward-char 1)
;; As a defensive measure, we do not allow
;; circular data in the file-local data.
(let ((read-circle nil))
(setq val (read (current-buffer))))
(if (eq handle-mode t)
(and (eq var 'mode)
;; Specifying minor-modes via mode: is
;; deprecated, but try to reject them anyway.
(not (string-match
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
(let ((mode (intern (concat val2 "-mode"))))
(when (fboundp (major-mode-remap mode))
(setq result mode))))
(cond ((eq var 'coding))
((eq var 'lexical-binding)
(unless hack-local-variables--warned-lexical
(setq hack-local-variables--warned-lexical t)
(display-warning
'files
(format-message
"%s: `lexical-binding' at end of file unreliable"
(file-name-nondirectory
;; We are called from
;; 'with-temp-buffer', so we need
;; to use 'thisbuf's name in the
;; warning message.
(or (buffer-file-name thisbuf) ""))))))
((eq var 'read-symbol-shorthands)
;; Sort automatically by shorthand length
;; in descending order.
(setq val (sort val
(lambda (sh1 sh2) (> (length (car sh1))
(length (car sh2))))))
(push (cons 'read-symbol-shorthands val) result))
((and (eq var 'mode) handle-mode))
(t
(ignore-errors
(push (cons (if (eq var 'eval)
'eval
(indirect-variable var))
val)
result))))))
(forward-line 1)))))))
result))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
If there are any elements, runs `before-hack-local-variables-hook',
then calls `hack-one-local-variable' to apply the alist elements one by one.
Finishes by running `hack-local-variables-hook', regardless of whether
the alist is empty or not.
Note that this function ignores a `mode' entry if it specifies the same
major mode as the buffer already has."
(when file-local-variables-alist
;; Any 'evals must run in the Right sequence.
(setq file-local-variables-alist
(nreverse file-local-variables-alist))
(run-hooks 'before-hack-local-variables-hook)
(dolist (elt file-local-variables-alist)
(hack-one-local-variable (car elt) (cdr elt))))
(run-hooks 'hack-local-variables-hook))
(defun safe-local-variable-p (sym val)
"Non-nil if SYM is safe as a file-local variable with value VAL.
It is safe if any of these conditions are met:
* There is a matching entry (SYM . VAL) in the
`safe-local-variable-values' user option.
* The `safe-local-variable' property of SYM is a function that
evaluates to a non-nil value with VAL as an argument."
(or (member (cons sym val) safe-local-variable-values)
(let ((safep (get sym 'safe-local-variable)))
(and (functionp safep)
;; If the function signals an error, that means it
;; can't assure us that the value is safe.
(with-demoted-errors "Local variable error: %S"
(funcall safep val))))))
(defun risky-local-variable-p (sym &optional _ignored)
"Non-nil if SYM could be dangerous as a file-local variable.
It is dangerous if either of these conditions are met:
* Its `risky-local-variable' property is non-nil.
* Its name ends with \"hook(s)\", \"function(s)\", \"form(s)\", \"map\",
\"program\", \"command(s)\", \"predicate(s)\", \"frame-alist\",
\"mode-alist\", \"font-lock-(syntactic-)keyword*\",
\"map-alist\", or \"bindat-spec\"."
;; If this is an alias, check the base name.
(condition-case nil
(setq sym (indirect-variable sym))
(error nil))
(or (get sym 'risky-local-variable)
(string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|\
-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords\
-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|\
-map$\\|-map-alist$\\|-bindat-spec$" (symbol-name sym))))
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
(define-obsolete-function-alias 'hack-one-local-variable-constantp
#'macroexp-const-p "29.1")
(defun hack-one-local-variable-eval-safep (exp)
"Return non-nil if it is safe to eval EXP when it is found in a file."
(or (not (consp exp))
;; Detect certain `put' expressions.
(and (eq (car exp) 'put)
(hack-one-local-variable-quotep (nth 1 exp))
(hack-one-local-variable-quotep (nth 2 exp))
(let ((prop (nth 1 (nth 2 exp)))
(val (nth 3 exp)))
(cond ((memq prop '(lisp-indent-hook
lisp-indent-function
scheme-indent-function))
;; Allow only safe values (not functions).
(or (numberp val)
(and (hack-one-local-variable-quotep val)
(eq (nth 1 val) 'defun))))
((eq prop 'edebug-form-spec)
;; Allow only indirect form specs.
;; During bootstrapping, edebug-basic-spec might not be
;; defined yet.
(and (fboundp 'edebug-basic-spec)
(hack-one-local-variable-quotep val)
(edebug-basic-spec (nth 1 val)))))))
;; Allow expressions that the user requested.
(member exp safe-local-eval-forms)
;; Certain functions can be allowed with safe arguments
;; or can specify verification functions to try.
(and (symbolp (car exp))
;; Allow (minor)-modes calls with no arguments.
;; This obsoletes the use of "mode:" for such things. (Bug#8613)
(or (and (member (cdr exp) '(nil (1) (0) (-1)))
(string-match "-mode\\'" (symbol-name (car exp))))
(let ((prop (get (car exp) 'safe-local-eval-function)))
(cond ((eq prop t)
(let ((ok t))
(dolist (arg (cdr exp))
(unless (macroexp-const-p arg)
(setq ok nil)))
ok))
((functionp prop)
(funcall prop exp))
((listp prop)
(let ((ok nil))
(dolist (function prop)
(if (funcall function exp)
(setq ok t)))
ok))))))))
(defun hack-one-local-variable--obsolete (var)
(let ((o (get var 'byte-obsolete-variable)))
(when o
(let ((instead (nth 0 o))
(since (nth 2 o)))
(message "%s is obsolete%s; %s"
var (if since (format " (since %s)" since))
(if (stringp instead)
(substitute-command-keys instead)
(format-message "use `%s' instead" instead)))))))
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
If VAR is `mode', call `VAL-mode' as a function unless it's
already the major mode."
(pcase var
('mode
(let ((mode (intern (concat (downcase (symbol-name val))
"-mode"))))
(set-auto-mode-0 mode t)))
('eval
(pcase val
(`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
(save-excursion (eval val t)))
(_
(hack-one-local-variable--obsolete var)
;; Make sure the string has no text properties.
;; Some text properties can get evaluated in various ways,
;; so it is risky to put them on with a local variable list.
(if (stringp val)
(set-text-properties 0 (length val) nil val))
(set (make-local-variable var) val))))
;;; Handling directory-local variables, aka project settings.
(defvar dir-locals-class-alist '()
"Alist mapping directory-local variable classes (symbols) to variable lists.")
(defvar dir-locals-directory-cache '()
"List of cached directory roots for directory-local variable classes.
Each element in this list has the form (DIR CLASS MTIME).
DIR is the name of the directory.
CLASS is the name of a variable class (a symbol).
MTIME is the recorded modification time of the directory-local
variables file associated with this entry. This time is a Lisp
timestamp (the same format as `current-time'), and is
used to test whether the cache entry is still valid.
Alternatively, MTIME can be nil, which means the entry is always
considered valid.")
(defsubst dir-locals-get-class-variables (class)
"Return the variable list for CLASS."
(cdr (assq class dir-locals-class-alist)))
(defun dir-locals-collect-mode-variables (mode-variables variables)
"Collect directory-local variables from MODE-VARIABLES.
VARIABLES is the initial list of variables.
Returns the new list."
(dolist (pair mode-variables variables)
(let* ((variable (car pair))
(value (cdr pair))
(slot (assq variable variables)))
;; If variables are specified more than once, use only the last. (Why?)
;; The pseudo-variables mode and eval are different (bug#3430).
(if (and slot (not (memq variable '(mode eval))))
(setcdr slot value)
;; Need a new cons in case we setcdr later.
(push (cons variable value) variables)))))
(defun dir-locals-collect-variables (class-variables root variables
&optional predicate)
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
Return the new variables list.
If PREDICATE is given, it is used to test a symbol key in the alist
to see whether it should be considered."
(let* ((file-name (or (buffer-file-name)
;; Handle non-file buffers, too.
(expand-file-name default-directory)))
(sub-file-name (if (and file-name
(file-name-absolute-p file-name))
;; FIXME: Why not use file-relative-name?
(substring file-name (length root)))))
(condition-case err
(dolist (entry class-variables variables)
(let ((key (car entry)))
(cond
((stringp key)
;; Don't include this in the previous condition, because we
;; want to filter all strings before the next condition.
(when (and sub-file-name
(>= (length sub-file-name) (length key))
(string-prefix-p key sub-file-name))
(setq variables (dir-locals-collect-variables
(cdr entry) root variables predicate))))
((if predicate
(funcall predicate key)
(or (not key)
(derived-mode-p key)))
;; If KEY is an extra parent it may remain not loaded
;; (hence with some of its mode-specific vars missing their
;; `safe-local-variable' property), leading to spurious
;; prompts about unsafe vars (bug#68246).
(if (and (symbolp key) (autoloadp (indirect-function key)))
(ignore-errors (autoload-do-load (indirect-function key))))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
(progn
(setq alist (remq subdirs alist))
(cdr-safe subdirs))
;; TODO someone might want to extend this to allow
;; integer values for subdir, where N means
;; variables apply to this directory and N levels
;; below it (0 == nil).
(equal root (expand-file-name default-directory)))
(setq variables (dir-locals-collect-mode-variables
alist variables))))))))
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
(message "%s error: %s" dir-locals-file (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
"Declare that the DIRECTORY root is an instance of CLASS.
DIRECTORY is the name of a directory, a string.
CLASS is the name of a project class, a symbol.
MTIME is either the modification time of the directory-local
variables file that defined this class, or nil.
When a file beneath DIRECTORY is visited, the mode-specific
variables from CLASS are applied to the buffer. The variables
for a class are defined using `dir-locals-set-class-variables'."
(setq directory (file-name-as-directory (expand-file-name directory)))
(unless (assq class dir-locals-class-alist)
(error "No such class `%s'" (symbol-name class)))
(push (list directory class mtime) dir-locals-directory-cache))
(defun dir-locals-set-class-variables (class variables)
"Map the type CLASS to a list of variable settings.
CLASS is the project class, a symbol. VARIABLES is a list
that declares directory-local variables for the class.
An element in VARIABLES is either of the form:
(MAJOR-MODE . ALIST)
or
(DIRECTORY . LIST)
In the first form, MAJOR-MODE is a symbol, and ALIST is an alist
whose elements are of the form (VARIABLE . VALUE).
In the second form, DIRECTORY is a directory name (a string), and
LIST is a list of the form accepted by the function.
When a file is visited, the file's class is found. A directory
may be assigned a class using `dir-locals-set-directory-class'.
Then variables are set in the file's buffer according to the
VARIABLES list of the class. The list is processed in order.
* If the element is of the form (MAJOR-MODE . ALIST), and the
buffer's major mode is derived from MAJOR-MODE (as determined
by `derived-mode-p'), then all the variables in ALIST are
applied. A MAJOR-MODE of nil may be used to match any buffer.
`make-local-variable' is called for each variable before it is
set.
* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
is an initial substring of the file's directory, then LIST is
applied by recursively following these rules."
(setf (alist-get class dir-locals-class-alist) variables))
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
It has to be constant to enforce uniform values across different
environments and users.
A second dir-locals file can be used by a user to specify their
personal dir-local variables even if the current directory
already has a `dir-locals-file' that is shared with other
users (such as in a git repository). The name of this second
file is derived by appending \"-2\" to the base name of
`dir-locals-file'. With the default value of `dir-locals-file',
a \".dir-locals-2.el\" file in the same directory will override
the \".dir-locals.el\".
See Info node `(elisp)Directory Local Variables' for details.")
(defun dir-locals--all-files (directory)
"Return a list of all readable dir-locals files in DIRECTORY.
The returned list is sorted by increasing priority. That is,
values specified in the last file should take precedence over
those in the first."
(when (file-readable-p directory)
(let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
(dosified-file-name dir-locals-file)
dir-locals-file)
directory))
(file-2 (when (string-match "\\.el\\'" file-1)
(replace-match "-2.el" t nil file-1)))
(out nil))
;; The order here is important.
(dolist (f (list file-2 file-1))
(when (and f
(file-readable-p f)
;; FIXME: Aren't file-regular-p and
;; file-directory-p mutually exclusive?
(file-regular-p f)
(not (file-directory-p f)))
(push f out)))
out)))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
This searches upward in the directory tree from FILE.
It stops at the first directory that has been registered in
`dir-locals-directory-cache' or contains a `dir-locals-file'.
If it finds an entry in the cache, it checks that it is valid.
A cache entry with no modification time element (normally, one that
has been assigned directly using `dir-locals-set-directory-class', not
set from a file) is always valid.
A cache entry based on a `dir-locals-file' is valid if the modification
time stored in the cache matches the current file modification time.
If not, the cache entry is cleared so that the file will be re-read.
This function returns either:
- nil (no directory local variables found),
- the matching entry from `dir-locals-directory-cache' (a list),
- or the full path to the directory (a string) containing at
least one `dir-locals-file' in the case of no valid cache
entry."
(setq file (expand-file-name file))
(let* ((locals-dir (locate-dominating-file (file-name-directory file)
#'dir-locals--all-files))
dir-elt)
;; `locate-dominating-file' may have abbreviated the name.
(when locals-dir
(setq locals-dir (expand-file-name locals-dir)))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (string-prefix-p (car elt) file
(memq system-type
'(windows-nt cygwin ms-dos)))
(> (length (car elt)) (length (car dir-elt))))
(setq dir-elt elt)))
(if (and dir-elt
(or (null locals-dir)
(<= (length locals-dir)
(length (car dir-elt)))))
;; Found a potential cache entry. Check validity.
;; A cache entry with no MTIME is assumed to always be valid
;; (ie, set directly, not from a dir-locals file).
;; Note, we don't bother to check that there is a matching class
;; element in dir-locals-class-alist, since that's done by
;; dir-locals-set-directory-class.
(if (or (null (nth 2 dir-elt))
(let ((cached-files (dir-locals--all-files (car dir-elt))))
;; The entry MTIME should match the most recent
;; MTIME among matching files.
(and cached-files
(time-equal-p
(nth 2 dir-elt)
(let ((latest 0))
(dolist (f cached-files latest)
(let ((f-time
(file-attribute-modification-time
(file-attributes f))))
(if (time-less-p latest f-time)
(setq latest f-time)))))))))
;; This cache entry is OK.
dir-elt
;; This cache entry is invalid; clear it.
(setq dir-locals-directory-cache
(delq dir-elt dir-locals-directory-cache))
;; Return the first existing dir-locals file. Might be the same
;; as dir-elt's, might not (eg latter might have been deleted).
locals-dir)
;; No cache entry.
locals-dir)))
(declare-function map-merge-with "map" (type function &rest maps))
(declare-function map-merge "map" (type &rest maps))
(defun dir-locals--get-sort-score (node)
"Return a number used for sorting the definitions of dir locals.
NODE is assumed to be a cons cell where the car is either a
string or a symbol representing a mode name.
If it is a mode then the depth of the mode (ie, how many parents
that mode has) will be returned.
If it is a string then the length of the string plus 1000 will be
returned.
Otherwise it returns -1.
That way the value can be used to sort the list such that deeper
modes will be after the other modes. This will be followed by
directory entries in order of length. If the entries are all
applied in order then that means the more specific modes will
override the values specified by the earlier modes and directory
variables will override modes."
(let ((key (car node)))
(cond ((null key) -1)
((symbolp key) (length (derived-mode-all-parents key)))
((stringp key)
(+ 1000 (length key)))
(t -2))))
(defun dir-locals--sort-variables (variables)
"Sort VARIABLES so that applying them in order has the right effect.
The variables are compared by `dir-locals--get-sort-score'.
Directory entries are then recursively sorted using the same
criteria."
(setq variables (sort variables
(lambda (a b)
(< (dir-locals--get-sort-score a)
(dir-locals--get-sort-score b)))))
(dolist (n variables)
(when (stringp (car n))
(setcdr n (dir-locals--sort-variables (cdr n)))))
variables)
(defun dir-locals-read-from-dir (dir)
"Load all variables files in DIR and register a new class and instance.
DIR is the absolute name of a directory, which must contain at
least one dir-local file (which is a file holding variables to
apply).
Return the new class name, which is a symbol named DIR."
(let* ((class-name (intern dir))
(files (dir-locals--all-files dir))
;; If there was a problem, use the values we could get but
;; don't let the cache prevent future reads.
(latest 0) (success 0)
(variables))
(with-demoted-errors "Error reading dir-locals: %S"
(dolist (file files)
(let ((file-time (file-attribute-modification-time
(file-attributes (file-chase-links file)))))
(if (time-less-p latest file-time)
(setq latest file-time)))
(with-temp-buffer
(insert-file-contents file)
(let ((newvars
(condition-case-unless-debug nil
;; As a defensive measure, we do not allow
;; circular data in the file/dir-local data.
(let ((read-circle nil))
(read (current-buffer)))
(end-of-file nil))))
(unless (listp newvars)
(message "Invalid data in %s: %s" file newvars)
(setq newvars nil))
(setq variables
;; Try and avoid loading `map' since that also loads cl-lib
;; which then might hamper bytecomp warnings (bug#30635).
(if (not (and newvars variables))
(or newvars variables)
(require 'map)
;; We want to make the variable setting from
;; newvars (the second .dir-locals file) take
;; presedence over the old variables, but we also
;; want to preserve all `eval' elements as is from
;; both lists.
(map-merge-with
'list
(lambda (a b)
(let ((ag
(seq-group-by
(lambda (e) (eq (car e) 'eval)) a))
(bg
(seq-group-by
(lambda (e) (eq (car e) 'eval)) b)))
(append (map-merge 'list
(assoc-default nil ag)
(assoc-default nil bg))
(assoc-default t ag)
(assoc-default t bg))))
variables
newvars))))))
(setq success latest))
(setq variables (dir-locals--sort-variables variables))
(dir-locals-set-class-variables class-name variables)
(dir-locals-set-directory-class dir class-name success)
class-name))
(define-obsolete-function-alias 'dir-locals-read-from-file
'dir-locals-read-from-dir "25.1")
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
:version "24.3"
:type 'boolean
:group 'find-file)
(defvar hack-dir-local-variables--warned-coding nil)
(defun hack-dir-local--get-variables (&optional predicate)
"Read per-directory local variables for the current buffer.
Return a cons of the form (DIR . ALIST), where DIR is the
directory name (maybe nil) and ALIST is an alist of all variables
that might apply. These will be filtered according to the
buffer's directory, but not according to its mode.
PREDICATE is passed to `dir-locals-collect-variables'."
(when (and enable-local-variables
enable-dir-local-variables
(or enable-remote-dir-locals
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
(let ((dir-or-cache (dir-locals-find-file
(or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
((stringp dir-or-cache)
(setq dir-name dir-or-cache
class (dir-locals-read-from-dir dir-or-cache)))
((consp dir-or-cache)
(setq dir-name (nth 0 dir-or-cache))
(setq class (nth 1 dir-or-cache))))
(when class
(cons dir-name
(dir-locals-collect-variables
(dir-locals-get-class-variables class)
dir-name nil predicate))))))
(defvar hack-dir-local-get-variables-functions
(list #'hack-dir-local--get-variables)
"Special hook to compute the set of dir-local variables.
Every function is called without arguments and should return either
a cons of the form (DIR . ALIST) or a (possibly empty) list of such conses,
where ALIST is an alist of (VAR . VAL) settings.
DIR should be a string (a directory name) and is used to obey
`safe-local-variable-directories'.
This hook is run after the major mode has been setup.")
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them.
This does nothing if either `enable-local-variables' or
`enable-dir-local-variables' are nil."
(let (items)
(when (and enable-local-variables
enable-dir-local-variables
(or enable-remote-dir-locals
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
(run-hook-wrapped 'hack-dir-local-get-variables-functions
(lambda (fun)
(let ((res (funcall fun)))
(cond
((null res))
((consp (car-safe res))
(setq items (append res items)))
(t (push res items))))
nil)))
;; Sort the entries from nearest dir to furthest dir.
(setq items (sort (nreverse items)
:key (lambda (x) (length (car-safe x))) :reverse t))
;; Filter out duplicates, preferring the settings from the nearest dir
;; and from the first hook function.
(let ((seen nil))
(dolist (item items)
(when seen ;; Special case seen=nil since it's the most common case.
(setcdr item (seq-filter (lambda (vv) (not (memq (car-safe vv) seen)))
(cdr item))))
(setq seen (nconc (seq-difference (mapcar #'car (cdr item))
'(eval mode))
seen))))
;; Rather than a loop, maybe we should handle all the dirs
;; "together", e.g. prompting the user only once. But if so, we'd
;; probably want to also merge the prompt for file-local vars,
;; which comes from the call to `hack-local-variables-filter' in
;; `hack-local-variables'.
(dolist (item items)
(let ((dir-name (car item))
(variables (cdr item)))
(when variables
(dolist (elt variables)
(if (eq (car elt) 'coding)
(unless hack-dir-local-variables--warned-coding
(setq hack-dir-local-variables--warned-coding t)
(display-warning 'files
"Coding cannot be specified by dir-locals"))
(unless (memq (car elt) '(eval mode))
(setq dir-local-variables-alist
(assq-delete-all (car elt) dir-local-variables-alist)))
(push elt dir-local-variables-alist)))
(hack-local-variables-filter variables dir-name))))))
(defun hack-dir-local-variables-non-file-buffer ()
"Apply directory-local variables to a non-file buffer.
For non-file buffers, such as Dired buffers, directory-local
variables are looked for in `default-directory' and its parent
directories."
(hack-dir-local-variables)
(hack-local-variables-apply))
(defcustom change-major-mode-with-file-name t
"Non-nil means \\[write-file] should set the major mode from the file name.
However, the mode will not be changed if
\(1) a local variables list or the `-*-' line specifies a major mode, or
\(2) the current major mode is a \"special\" mode,
not suitable for ordinary files, or
\(3) the new file name does not particularly specify any mode."
:type 'boolean
:group 'editing-basics)
(defvar after-set-visited-file-name-hook nil
"Normal hook run just after setting visited file name of current buffer.")
(defun set-visited-file-name (filename &optional no-query along-with-file)
"Change name of file visited in current buffer to FILENAME.
This also renames the buffer to correspond to the new file.
The next time the buffer is saved it will go in the newly specified file.
FILENAME nil or an empty string means mark buffer as not visiting any file.
Remember to delete the initial contents of the minibuffer
if you wish to pass an empty string as the argument.
The optional second argument NO-QUERY, if non-nil, inhibits asking for
confirmation in the case where another buffer is already visiting FILENAME.
The optional third argument ALONG-WITH-FILE, if non-nil, means that
the old visited file has been renamed to the new name FILENAME."
(interactive "FSet visited file name: ")
(if (buffer-base-buffer)
(error "An indirect buffer cannot visit a file"))
(let (truename old-try-locals)
(if filename
(setq filename
(if (string-equal filename "")
nil
(expand-file-name filename))))
(if filename
(progn
(setq truename (file-truename filename))
(if find-file-visit-truename
(setq filename truename))))
(if filename
(let ((new-name (file-name-nondirectory filename)))
(if (string= new-name "")
(error "Empty file name"))))
(let ((buffer (and filename (find-buffer-visiting filename))))
(and buffer (not (eq buffer (current-buffer)))
(not no-query)
(not (y-or-n-p (format "A buffer is visiting %s; proceed? "
filename)))
(user-error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
(unlock-buffer)))
(setq old-try-locals (not (inhibit-local-variables-p))
buffer-file-name filename)
(if filename ; make buffer name reflect filename.
(let ((new-name (file-name-nondirectory buffer-file-name)))
(setq default-directory (file-name-directory buffer-file-name))
;; If new-name == old-name, renaming would add a spurious <2>
;; and it's considered as a feature in rename-buffer.
(or (string= new-name (buffer-name))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
(or along-with-file
(clear-visited-file-modtime))
;; Abbreviate the file names of the buffer.
(if truename
(progn
(setq buffer-file-truename (abbreviate-file-name truename))
(if find-file-visit-truename
(setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
(file-attribute-file-identifier (file-attributes buffer-file-name))
nil))
;; write-file-functions is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
;; Changing to visit an ordinary local file instead should flush the hook.
(kill-local-variable 'write-file-functions)
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
;; If buffer was read-only because of version control,
;; that reason is gone now, so make it writable.
(if vc-mode
(setq buffer-read-only nil))
(kill-local-variable 'vc-mode)
;; Turn off backup files for certain file names.
;; Since this is a permanent local, the major mode won't eliminate it.
(and buffer-file-name
backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
(setq-local backup-inhibited t))
(let ((oauto buffer-auto-save-file-name))
(cond ((null filename)
(setq buffer-auto-save-file-name nil))
((not buffer-auto-save-file-name)
;; If auto-save was not already on, turn it on if appropriate.
(and buffer-file-name auto-save-default (auto-save-mode t)))
(t
;; If auto save is on, start using a new name. We
;; deliberately don't rename or delete the old auto save
;; for the old visited file name. This is because
;; perhaps the user wants to save the new state and then
;; compare with the previous state from the auto save
;; file.
(setq buffer-auto-save-file-name (make-auto-save-file-name))))
;; Rename the old auto save file if any.
(and oauto buffer-auto-save-file-name
(file-exists-p oauto)
(rename-file oauto buffer-auto-save-file-name t)))
(and buffer-file-name
(not along-with-file)
(set-buffer-modified-p t))
;; Update the major mode, if the file name determines it.
(condition-case nil
;; Don't change the mode if it is special.
(or (not change-major-mode-with-file-name)
(get major-mode 'mode-class)
;; Don't change the mode if the local variable list specifies it.
;; The file name can influence whether the local variables apply.
(and old-try-locals
;; h-l-v also checks it, but might as well be explicit.
(not (inhibit-local-variables-p))
(hack-local-variables t))
;; TODO consider making normal-mode handle this case.
(let ((old major-mode))
(set-auto-mode t)
(or (eq old major-mode)
(hack-local-variables))))
(error nil))
(run-hooks 'after-set-visited-file-name-hook)))
(defun write-file (filename &optional confirm)
"Write current buffer into file FILENAME.
This makes the buffer visit that file, and marks it as not modified.
Interactively, prompt for FILENAME.
If you specify just a directory name as FILENAME, that means to write
to a file in that directory. In this case, the base name of the file
is the same as that of the file visited in the buffer, or the buffer
name sans leading directories, if any, if the buffer is not already
visiting a file.
You can also yank the file name into the minibuffer to edit it,
using \\<minibuffer-local-map>\\[next-history-element].
If optional second arg CONFIRM is non-nil, this function
asks for confirmation before overwriting an existing file.
Interactively, confirmation is required unless you supply a prefix argument."
(interactive
(list (if buffer-file-name
(read-file-name "Write file: "
nil nil nil nil)
(read-file-name "Write file: " default-directory
(expand-file-name
(file-name-nondirectory (buffer-name))
default-directory)
nil nil))
(not current-prefix-arg)))
(let ((old-modes
(and buffer-file-name
;; File may have gone away; ignore errors in that case.
(ignore-errors (file-modes buffer-file-name)))))
(or (null filename) (string-equal filename "")
(progn
;; If arg is a directory name,
;; use the default file name, but in that directory.
(if (directory-name-p filename)
(setq filename (concat filename
(file-name-nondirectory
(or buffer-file-name (buffer-name))))))
(and confirm
(file-exists-p filename)
;; NS does its own confirm dialog.
(not (and (eq (framep-on-display) 'ns)
(listp last-nonmenu-event)
use-dialog-box))
(or (y-or-n-p (format-message
"File `%s' exists; overwrite? " filename))
(user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
;; Make buffer writable if file is writable.
(and buffer-file-name
(file-writable-p buffer-file-name)
(setq buffer-read-only nil))
(save-buffer)
;; If the old file was executable, then make the new file
;; executable, too.
(when (and old-modes
(not (zerop (logand #o111 old-modes))))
(set-file-modes buffer-file-name
(logior (logand #o111 old-modes)
(file-modes buffer-file-name))))
;; It's likely that the VC status at the new location is different from
;; the one at the old location.
(vc-refresh-state)))
(defun rename-visited-file (new-location)
"Rename the file visited by the current buffer to NEW-LOCATION.
This command also sets the visited file name. If the buffer
isn't visiting any file, that's all it does.
Interactively, this prompts for NEW-LOCATION."
(interactive
(list (if buffer-file-name
(read-file-name "Rename visited file to: ")
(read-file-name "Set visited file name: "
default-directory
(expand-file-name
(file-name-nondirectory (buffer-name))
default-directory)))))
;; If the user has given a directory name, the file should be moved
;; there (under the same file name).
(when (file-directory-p new-location)
(unless buffer-file-name
(user-error "Can't rename buffer to a directory file name"))
(setq new-location (expand-file-name
(file-name-nondirectory buffer-file-name)
new-location)))
(when (and buffer-file-name
(file-exists-p buffer-file-name))
(rename-file buffer-file-name new-location))
(set-visited-file-name new-location nil t))
(defun file-extended-attributes (filename)
"Return an alist of extended attributes of file FILENAME.
Extended attributes are platform-specific metadata about the file,
such as SELinux context, list of ACL entries, etc."
`((acl . ,(file-acl filename))
(selinux-context . ,(file-selinux-context filename))))
(defun set-file-extended-attributes (filename attributes)
"Set extended attributes of file FILENAME to ATTRIBUTES.
ATTRIBUTES must be an alist of file attributes as returned by
`file-extended-attributes'.
Value is t if the function succeeds in setting the attributes."
(let (result rv)
(dolist (elt attributes)
(let ((attr (car elt))
(val (cdr elt)))
(cond ((eq attr 'acl)
(setq rv (set-file-acl filename val)))
((eq attr 'selinux-context)
(setq rv (set-file-selinux-context filename val))))
(setq result (or result rv))))
result))
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
A backup may be done by renaming or by copying; see documentation of
variable `make-backup-files'. If it's done by renaming, then the file is
no longer accessible under its old name.
The value is non-nil after a backup was made by renaming.
It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME).
MODES is the result of `file-modes' on the original
file; this means that the caller, after saving the buffer, should change
the modes of the new file to agree with the old modes.
EXTENDED-ATTRIBUTES is the result of `file-extended-attributes'
on the original file; this means that the caller, after saving
the buffer, should change the extended attributes of the new file
to agree with the old attributes.
BACKUPNAME is the backup file name, which is the old file renamed."
(when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
(let ((attributes (file-attributes buffer-file-name)))
(when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
;; If specified name is a symbolic link, chase it to the target.
;; This makes backups in the directory where the real file is.
(let* ((real-file-name (file-chase-links buffer-file-name))
(backup-info (find-backup-file-name real-file-name)))
(when backup-info
(let* ((backupname (car backup-info))
(targets (cdr backup-info))
(old-versions
;; If have old versions to maybe delete,
;; ask the user to confirm now, before doing anything.
;; But don't actually delete til later.
(and targets
(booleanp delete-old-versions)
(or delete-old-versions
(y-or-n-p
(format "Delete excess backup versions of %s? "
real-file-name)))
targets))
(modes (file-modes buffer-file-name))
(extended-attributes
(file-extended-attributes buffer-file-name))
(copy-when-priv-mismatch
backup-by-copying-when-privileged-mismatch)
(make-copy
(or file-precious-flag backup-by-copying
;; Don't rename a suid or sgid file.
(and modes (< 0 (logand modes #o6000)))
(not (file-writable-p
(file-name-directory real-file-name)))
(and backup-by-copying-when-linked
(< 1 (file-nlinks real-file-name)))
(and (or backup-by-copying-when-mismatch
(and (integerp copy-when-priv-mismatch)
(let ((attr (file-attributes
real-file-name
'integer)))
(or (<= (file-attribute-user-id attr)
copy-when-priv-mismatch)
(<= (file-attribute-group-id attr)
copy-when-priv-mismatch)))))
(not (file-ownership-preserved-p real-file-name
t)))))
setmodes)
(condition-case ()
(progn
;; Actually make the backup file.
(if make-copy
(backup-buffer-copy real-file-name backupname
modes extended-attributes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
(setq setmodes (list modes extended-attributes
backupname)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(dolist (old-version old-versions)
(delete-file old-version)))
(file-error nil))
;; If trouble writing the backup, write it in .emacs.d/%backup%.
(when (not buffer-backed-up)
(setq backupname (locate-user-emacs-file "%backup%~"))
(message "Cannot write backup file; backing up in %s"
backupname)
(sleep-for 1)
(backup-buffer-copy real-file-name backupname
modes extended-attributes)
(setq buffer-backed-up t))
setmodes)))))))
(defun backup-buffer-copy (from-name to-name modes extended-attributes)
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(let (nofollow-flag)
(with-file-modes ?\700
(when (condition-case nil
;; Try to overwrite old backup first.
(copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
(copy-file from-name to-name nil t t)
(setq nofollow-flag 'nofollow)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
;; `delete-file' and `copy-file', so let's try again.
;; rms says "I think there is also a possible race
;; condition for making backup files" (emacs-devel 20070821).
nil)))
;; If set-file-extended-attributes fails, fall back on set-file-modes.
(unless (and extended-attributes
(with-demoted-errors "Error setting attributes: %S"
(set-file-extended-attributes to-name extended-attributes)))
(and modes
(set-file-modes to-name (logand modes #o1777) nofollow-flag)))))
(defvar file-name-version-regexp
"\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
;; The last ~[[:digit]]+ matches relative versions in git,
;; e.g. `foo.js.~HEAD~1~'.
"Regular expression matching the backup/version part of a file name.
Used by `file-name-sans-versions'.")
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return file NAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
redefine it.
If the optional argument KEEP-BACKUP-VERSION is non-nil,
we do not remove backup version numbers, only true file version numbers.
See `file-name-version-regexp' for what constitutes backup versions
and version strings."
(let ((handler (find-file-name-handler name 'file-name-sans-versions)))
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
(substring name 0
(unless keep-backup-version
(string-match (concat file-name-version-regexp "\\'")
name))))))
(defun file-ownership-preserved-p (file &optional group)
"Return t if deleting FILE and rewriting it would preserve the owner.
Return also t if FILE does not exist. If GROUP is non-nil, check whether
the group would be preserved too."
(let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
(if handler
(funcall handler 'file-ownership-preserved-p file group)
(let ((attributes (file-attributes file 'integer)))
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
(and (or (= (file-attribute-user-id attributes) (user-uid))
;; Files created on Windows by Administrator (RID=500)
;; have the Administrators group (RID=544) recorded as
;; their owner. Rewriting them will still preserve the
;; owner.
(and (eq system-type 'windows-nt)
(= (user-uid) 500)
(= (file-attribute-user-id attributes) 544)))
(or (not group)
;; On BSD-derived systems files always inherit the parent
;; directory's group, so skip the group-gid test.
(memq system-type '(berkeley-unix darwin gnu/kfreebsd))
(= (file-attribute-group-id attributes) (group-gid)))
(let* ((parent (or (file-name-directory file) "."))
(parent-attributes (file-attributes parent 'integer)))
(and parent-attributes
;; On some systems, a file created in a setuid directory
;; inherits that directory's owner.
(or
(= (file-attribute-user-id parent-attributes)
(user-uid))
(string-match
"^...[^sS]"
(file-attribute-modes parent-attributes)))
;; On many systems, a file created in a setgid directory
;; inherits that directory's group. On some systems
;; this happens even if the setgid bit is not set.
(or (not group)
(= (file-attribute-group-id parent-attributes)
(file-attribute-group-id attributes)))))))))))
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\" and any backup version strings.
The extension, in a file name, is the part that begins with the last `.',
except that a leading `.' of the file name, if there is one, doesn't count.
Any extensions that indicate backup versions and version strings are
removed by calling `file-name-sans-versions', which see, before looking
for the \"real\" file extension."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory)
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(if (setq directory (file-name-directory filename))
;; Don't use expand-file-name here; if DIRECTORY is relative,
;; we don't want to expand it.
(concat directory (substring file 0 (match-beginning 0)))
(substring file 0 (match-beginning 0)))
filename))))
(defun file-name-extension (filename &optional period)
"Return FILENAME's final \"extension\" sans any backup version strings.
The extension, in a file name, is the part that begins with the last `.',
except that a leading `.' of the file name, if there is one, doesn't count.
This function calls `file-name-sans-versions', which see, to remove from
the extension it returns any parts that indicate backup versions and
version strings.
Return nil for extensionless file names such as `foo'.
Return the empty string for file names such as `foo.' that end in a period.
By default, the returned value excludes the period that starts the
extension, but if the optional argument PERIOD is non-nil, the period
is included in the value, and in that case, if FILENAME has no
extension, the value is \"\"."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))))
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) (if period 0 1)))
(if period
"")))))
(defun file-name-with-extension (filename extension)
"Return FILENAME modified to have the specified EXTENSION.
The extension (in a file name) is the part that begins with the last \".\".
This function removes any existing extension from FILENAME, and then
appends EXTENSION to it.
EXTENSION may include the leading dot; if it doesn't, this function
will provide it.
It is an error if FILENAME or EXTENSION is empty, or if FILENAME
is in the form of a directory name according to `directory-name-p'.
See also `file-name-sans-extension'."
(let ((extn (string-trim-left extension "[.]")))
(cond ((string-empty-p filename)
(error "Empty filename"))
((string-empty-p extn)
(error "Malformed extension: %s" extension))
((directory-name-p filename)
(error "Filename is a directory: %s" filename))
(t
(concat (file-name-sans-extension filename) "." extn)))))
(defun file-name-base (&optional filename)
"Return the base name of the FILENAME: no directory, no extension."
(declare (advertised-calling-convention (filename) "27.1"))
(file-name-sans-extension
(file-name-nondirectory (or filename (buffer-file-name)))))
(defun file-name-split (filename)
"Return a list of all the components of FILENAME.
On most systems, this will be true:
(equal (string-join (file-name-split filename) \"/\") filename)"
(let ((components nil))
;; If this is a directory file name, then we have a null file name
;; at the end.
(when (directory-name-p filename)
(push "" components)
(setq filename (directory-file-name filename)))
;; Loop, chopping off components.
(while (length> filename 0)
(push (file-name-nondirectory filename) components)
(let ((dir (file-name-directory filename)))
(setq filename (and dir (directory-file-name dir)))
;; If there's nothing left to peel off, we're at the root and
;; we can stop.
(when (and dir (equal dir filename))
(push (if (equal dir "") ""
;; On Windows, the first component might be "c:" or
;; the like.
(substring dir 0 -1))
components)
(setq filename nil))))
components))
(defun file-name-parent-directory (filename)
"Return the directory name of the parent directory of FILENAME.
If FILENAME is at the root of the filesystem, return nil.
If FILENAME is relative, it is interpreted to be relative
to `default-directory', and the result will also be relative."
(let* ((expanded-filename (expand-file-name filename))
(parent (file-name-directory (directory-file-name expanded-filename))))
(cond
;; filename is at top-level, therefore no parent
((or (null parent)
;; `equal' is enough, we don't need to resolve symlinks here
;; with `file-equal-p', also for performance
(equal parent expanded-filename))
nil)
;; filename is relative, return relative parent
((not (file-name-absolute-p filename))
(file-relative-name parent))
(t
parent))))
(defcustom make-backup-file-name-function
#'make-backup-file-name--default-function
"A function that `make-backup-file-name' uses to create backup file names.
The function receives a single argument, the original file name.
If you change this, you may need to change `backup-file-name-p' and
`file-name-sans-versions' too.
You could make this buffer-local to do something special for specific files.
For historical reasons, a value of nil means to use the default function.
This should not be relied upon.
See also `backup-directory-alist'."
:version "24.4" ; nil -> make-backup-file-name--default-function
:group 'backup
:type '(choice (const :tag "Deprecated way to get the default function" nil)
(function :tag "Function")))
(defcustom backup-directory-alist nil
"Alist of file name patterns and backup directory names.
Each element looks like (REGEXP . DIRECTORY). Backups of files with
names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
relative or absolute. If it is absolute, so that all matching files
are backed up into the same directory, the file names in this
directory will be the full name of the file backed up with all
directory separators changed to `!' to prevent clashes. This will not
work correctly if your filesystem truncates the resulting name.
For the common case of all backups going into one directory, the alist
should contain a single element pairing \".\" with the appropriate
directory name.
If this variable is nil, or it fails to match a file name, the backup
is made in the original file's directory.
On MS-DOS filesystems without long names this variable is always
ignored."
:group 'backup
:type '(repeat (cons (regexp :tag "Regexp matching filename")
(directory :tag "Backup directory name"))))
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and \"/tmp\"."
(let ((temporary-file-directory temporary-file-directory)
caseless)
;; On MS-Windows, file-truename will convert short 8+3 aliases to
;; their long file-name equivalents, so compare-strings does TRT.
(if (memq system-type '(ms-dos windows-nt))
(setq temporary-file-directory (file-truename temporary-file-directory)
name (file-truename name)
caseless t))
(not (or (let ((comp (compare-strings temporary-file-directory 0 nil
name 0 nil caseless)))
;; Directory is under temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length temporary-file-directory)))))
(let ((comp (compare-strings "/tmp" 0 nil
name 0 nil)))
;; Directory is under /tmp.
(and (not (eq comp t))
(< comp (- (length "/tmp")))))
(if small-temporary-file-directory
(let ((comp (compare-strings small-temporary-file-directory
0 nil
name 0 nil caseless)))
;; Directory is under small-temporary-file-directory.
(and (not (eq comp t))
(< comp (- (length small-temporary-file-directory))))))))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
This calls the function that `make-backup-file-name-function' specifies,
with a single argument FILE."
(funcall (or make-backup-file-name-function
#'make-backup-file-name--default-function)
file))
(defun make-backup-file-name--default-function (file)
"Default function for `make-backup-file-name'.
Normally this just returns FILE's name with `~' appended.
It searches for a match for FILE in `backup-directory-alist'.
If the directory for the backup doesn't exist, it is created."
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
(let ((fn (file-name-nondirectory file)))
(concat (file-name-directory file)
(or (and (string-match "\\`[^.]+\\'" fn)
(concat (match-string 0 fn) ".~"))
(and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
(concat (match-string 0 fn) "~")))))
(concat (make-backup-file-name-1 file) "~")))
(defun make-backup-file-name-1 (file)
"Subroutine of `make-backup-file-name--default-function'.
The function `find-backup-file-name' also uses this."
(let ((alist backup-directory-alist)
elt backup-directory abs-backup-directory)
(while alist
(setq elt (pop alist))
(if (string-match (car elt) file)
(setq backup-directory (cdr elt)
alist nil)))
;; If backup-directory is relative, it should be relative to the
;; file's directory. By expanding explicitly here, we avoid
;; depending on default-directory.
(if backup-directory
(setq abs-backup-directory
(expand-file-name backup-directory
(file-name-directory file))))
(if (and abs-backup-directory (not (file-exists-p abs-backup-directory)))
(condition-case nil
(make-directory abs-backup-directory 'parents)
(file-error (setq backup-directory nil
abs-backup-directory nil))))
(if (null backup-directory)
file
(if (file-name-absolute-p backup-directory)
(progn
(when (memq system-type '(windows-nt ms-dos cygwin))
;; Normalize DOSish file names: downcase the drive
;; letter, if any, and replace the leading "x:" with
;; "/drive_x".
(or (file-name-absolute-p file)
(setq file (expand-file-name file))) ; make defaults explicit
(cond
((file-remote-p file)
;; Remove the leading slash, if any, to prevent
;; convert-standard-filename from converting that to a
;; backslash.
(and (memq (aref file 0) '(?/ ?\\))
(setq file (substring file 1)))
;; Replace any invalid file-name characters, then
;; prepend the leading slash back.
(setq file (concat "/" (convert-standard-filename file))))
(t
;; Replace any invalid file-name characters.
(setq file (expand-file-name (convert-standard-filename file)))
(if (eq (aref file 1) ?:)
(setq file (concat "/"
"drive_"
(char-to-string (downcase (aref file 0)))
(if (eq (aref file 2) ?/)
""
"/")
(substring file 2)))))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
(expand-file-name
(subst-char-in-string
?/ ?!
(string-replace "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
(file-name-as-directory abs-backup-directory))))))
(defun backup-file-name-p (file)
"Return non-nil if FILE is a backup file name (numeric or not).
This is a separate function so you can redefine it for customization.
You may need to redefine `file-name-sans-versions' as well."
(string-match "~\\'" file))
(defvar backup-extract-version-start)
;; This is used in various files.
;; The usage of backup-extract-version-start is not very clean,
;; but I can't see a good alternative, so as of now I am leaving it alone.
(defun backup-extract-version (fn)
"Given the name of a numeric backup file, FN, return the backup number.
Uses the free variable `backup-extract-version-start', whose value should be
the index in the name where the version number begins."
(if (and (string-match "[0-9]+~/?$" fn backup-extract-version-start)
(= (match-beginning 0) backup-extract-version-start))
(string-to-number (substring fn backup-extract-version-start -1))
0))
(defun find-backup-file-name (fn)
"Find a file name for a backup file FN, and suggestions for deletions.
Value is a list whose car is the name for the backup file
and whose cdr is a list of old versions to consider deleting now.
If the value is nil, don't make a backup.
Uses `backup-directory-alist' in the same way as
`make-backup-file-name--default-function' does."
(let ((handler (find-file-name-handler fn 'find-backup-file-name)))
;; Run a handler for this function so that ange-ftp can refuse to do it.
(if handler
(funcall handler 'find-backup-file-name fn)
(if (or (eq version-control 'never)
;; We don't support numbered backups on plain MS-DOS
;; when long file names are unavailable.
(and (eq system-type 'ms-dos)
(not (msdos-long-file-names))))
(list (make-backup-file-name fn))
(let* ((basic-name (make-backup-file-name-1 fn))
(base-versions (concat (file-name-nondirectory basic-name)
".~"))
(backup-extract-version-start (length base-versions))
(high-water-mark 0)
(number-to-delete 0)
possibilities deserve-versions-p versions)
(condition-case ()
(setq possibilities (file-name-all-completions
base-versions
(file-name-directory basic-name))
versions (sort (mapcar #'backup-extract-version
possibilities)
#'<)
high-water-mark (apply 'max 0 versions)
deserve-versions-p (or version-control
(> high-water-mark 0))
number-to-delete (- (length versions)
kept-old-versions
kept-new-versions
-1))
(file-error (setq possibilities nil)))
(if (not deserve-versions-p)
(list (make-backup-file-name fn))
(cons (format "%s.~%d~" basic-name (1+ high-water-mark))
(if (and (> number-to-delete 0)
;; Delete nothing if kept-new-versions and
;; kept-old-versions combine to an outlandish value.
(>= (+ kept-new-versions kept-old-versions -1) 0))
(mapcar (lambda (n)
(format "%s.~%d~" basic-name n))
(let ((v (nthcdr kept-old-versions versions)))
(rplacd (nthcdr (1- number-to-delete) v) ())
v))))))))))
(defun file-nlinks (filename)
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name that is equivalent to FILENAME
when used with that default directory as the default.
If FILENAME is a relative file name, it will be interpreted as existing in
`default-directory'.
If FILENAME and DIRECTORY lie on different machines or on different drives
on a DOS/Windows machine, it returns FILENAME in expanded form."
(save-match-data
(setq directory
(file-name-as-directory (expand-file-name (or directory
default-directory))))
(setq filename (expand-file-name filename))
(let ((fremote (file-remote-p filename))
(dremote (file-remote-p directory))
(fold-case (or (file-name-case-insensitive-p filename)
;; During bootstrap, it can happen that
;; `read-file-name-completion-ignore-case' is
;; not defined yet.
;; FIXME: `read-file-name-completion-ignore-case' is
;; a user-config which we shouldn't trust to reflect
;; the actual file system's semantics.
(and (boundp 'read-file-name-completion-ignore-case)
read-file-name-completion-ignore-case))))
(if ;; Conditions for separate trees
(or
;; Test for different filesystems on DOS/Windows
(and
;; Should `cygwin' really be included here? --stef
(memq system-type '(ms-dos cygwin windows-nt))
(or
;; Test for different drive letters
(not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers
(not (string-equal-ignore-case
(if (string-match "\\`//\\([^:/]+\\)/" filename)
(match-string 1 filename)
;; Windows file names cannot have ? in
;; them, so use that to detect when
;; neither FILENAME nor DIRECTORY is a
;; UNC.
"?")
(if (string-match "\\`//\\([^:/]+\\)/" directory)
(match-string 1 directory)
"?")))))
;; Test for different remote file system identification
(not (equal fremote dremote)))
filename
(let ((ancestor ".")
(filename-dir (file-name-as-directory filename)))
(while (not
(or (string-prefix-p directory filename-dir fold-case)
(string-prefix-p directory filename fold-case)))
(setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
(if (string-prefix-p directory filename fold-case)
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (length directory))))
(if (and (equal ancestor ".") (not (equal rest "")))
;; But don't bother with ANCESTOR if it would give us `./'.
rest
(concat (file-name-as-directory ancestor) rest)))
;; We matched FILENAME's directory equivalent.
ancestor))))))
(defun save-buffer (&optional arg)
"Save current buffer in visited file if modified.
Variations are described below.
By default, makes the previous version into a backup file
if previously requested or if this is the first save.
Prefixed with one \\[universal-argument], marks this version
to become a backup when the next save is done.
Prefixed with two \\[universal-argument]'s,
makes the previous version into a backup file.
Prefixed with three \\[universal-argument]'s, marks this version
to become a backup when the next save is done,
and makes the previous version into a backup file.
With a numeric prefix argument of 0, never make the previous version
into a backup file.
Note that the various variables that control backups, such
as `version-control', `backup-enable-predicate', `vc-make-backup-files',
and `backup-inhibited', to name just the more popular ones, still
control whether a backup will actually be produced, even when you
invoke this command prefixed with two or three \\[universal-argument]'s.
If a file's name is FOO, the names of its numbered backup versions are
FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
Numeric backups (rather than FOO~) will be made if value of
`version-control' is not the atom `never' and either there are already
numeric versions of the file being backed up, or `version-control' is
non-nil.
We don't want excessive versions piling up, so there are variables
`kept-old-versions', which tells Emacs how many oldest versions to keep,
and `kept-new-versions', which tells how many newest versions to keep.
Defaults are 2 old versions and 2 new.
`dired-kept-versions' controls Dired's clean-directory (.) command.
If `delete-old-versions' is nil, system will query user
before trimming versions. Otherwise it does it silently.
If `vc-make-backup-files' is nil, which is the default,
no backup files are made for files managed by version control.
(This is because the version control system itself records previous versions.)
See the subroutine `basic-save-buffer' for more information."
(interactive "p")
(let ((modp (buffer-modified-p))
(make-backup-files (or (and make-backup-files (not (eq arg 0)))
(memq arg '(16 64)))))
(and modp (memq arg '(16 64)) (setq buffer-backed-up nil))
;; We used to display the message below only for files > 50KB, but
;; then Rmail-mbox never displays it due to buffer swapping. If
;; the test is ever re-introduced, be sure to handle saving of
;; Rmail files.
(if (and modp
(buffer-file-name)
(not noninteractive)
(not save-silently))
(message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer (called-interactively-p 'any))
(and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
(defun delete-auto-save-file-if-necessary (&optional force)
"Delete auto-save file for current buffer if `delete-auto-save-files' is t.
Normally delete only if the file was written by this Emacs since
the last real save, but optional arg FORCE non-nil means delete anyway."
(and buffer-auto-save-file-name delete-auto-save-files
(not (string= buffer-file-name buffer-auto-save-file-name))
(or force (recent-auto-save-p))
(progn
(condition-case ()
(delete-file buffer-auto-save-file-name)
(file-error nil))
(set-buffer-auto-saved))))
(defvar auto-save-hook nil
"Normal hook run just before auto-saving.")
(defcustom before-save-hook nil
"Normal hook that is run before a buffer is saved to its file.
Used only by `save-buffer'."
:options '(copyright-update time-stamp)
:type 'hook
:group 'files)
(defcustom after-save-hook nil
"Normal hook that is run after a buffer is saved to its file.
Used only by `save-buffer'."
:options '(executable-make-buffer-file-executable-if-script-p)
:type 'hook
:group 'files)
(defcustom copy-directory-create-symlink nil
"This option influences the handling of symbolic links in `copy-directory'.
If non-nil, `copy-directory' will create a symbolic link if the
source directory is a symbolic link. If nil, it'll follow the
symbolic link and copy the contents instead."
:type 'boolean
:version "28.1"
:group 'files)
(defcustom file-preserve-symlinks-on-save nil
"If non-nil, saving a buffer visited via a symlink won't overwrite the symlink.
This is only relevant if `file-precious-flag' is non-nil -- if
this is nil, Emacs will preserve the symlinks anyway."
:type 'boolean
:version "28.1"
:group 'files)
(defvar-local save-buffer-coding-system nil
"If non-nil, use this coding system for saving the buffer.
More precisely, use this coding system in place of the
value of `buffer-file-coding-system', when saving the buffer.
Calling `write-region' for any purpose other than saving the buffer
will still use `buffer-file-coding-system'; this variable has no effect
in such cases.")
(put 'save-buffer-coding-system 'permanent-local t)
(defun basic-save-buffer (&optional called-interactively)
"Save the current buffer in its visited file, if it has been modified.
The hooks `write-contents-functions', `local-write-file-hooks'
and `write-file-functions' get a chance to do the job of saving;
if they do not, then the buffer is saved in the visited file in
the usual way.
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
(interactive '(called-interactively))
(save-current-buffer
;; In an indirect buffer, save its base buffer instead.
(if (buffer-base-buffer)
(set-buffer (buffer-base-buffer)))
(if (or (buffer-modified-p)
;; Handle the case when no modification has been made but
;; the file disappeared since visited.
(and buffer-file-name
(not (file-exists-p buffer-file-name))))
(let ((recent-save (recent-auto-save-p))
setmodes)
(or (null buffer-file-name)
(verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
(format
"%s has changed since visited or saved. Save anyway? "
(file-name-nondirectory buffer-file-name)))
(user-error "Save not confirmed"))
(save-restriction
(widen)
(save-excursion
(and (> (point-max) (point-min))
(not find-file-literally)
(null buffer-read-only)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
(or (eq require-final-newline t)
(eq require-final-newline 'visit-save)
(and require-final-newline
(y-or-n-p
(format "Buffer %s does not end in newline. Add one? "
(buffer-name)))))
(save-excursion
(goto-char (point-max))
(insert ?\n))))
;; Don't let errors prevent saving the buffer.
(with-demoted-errors "Before-save hook error: %S"
(run-hooks 'before-save-hook))
;; Give `write-contents-functions' a chance to
;; short-circuit the whole process.
(unless (run-hook-with-args-until-success 'write-contents-functions)
;; If buffer has no file name, ask user for one.
(or buffer-file-name
(let ((filename
(expand-file-name
(read-file-name "File to save in: "
nil (expand-file-name (buffer-name))))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name of an
;; existing directory.
(error "%s is a directory" filename)
(unless (y-or-n-p (format-message
"File `%s' exists; overwrite? "
filename))
(error "Canceled"))))
(set-visited-file-name filename)))
;; Support VC version backups.
(vc-before-save)
(or (run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(let ((file (buffer-file-name))
(dir (file-name-directory
(expand-file-name buffer-file-name))))
;; Some systems have directories (like /content on
;; Android) in which files can exist without a
;; corresponding parent directory.
(unless (or (file-exists-p file)
(file-exists-p dir))
(if (y-or-n-p
(format-message
"Directory `%s' does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1)))))
;; Now we have saved the current buffer. Let's make sure
;; that buffer-file-coding-system is fixed to what
;; actually used for saving by binding it locally.
(when buffer-file-name
(if save-buffer-coding-system
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
(file-attribute-file-identifier
(file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(progn
(unless
(with-demoted-errors "Error setting file modes: %S"
(set-file-modes buffer-file-name (car setmodes)))
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes))))
(error nil)))
;; Support VC `implicit' locking.
(vc-after-save))
;; If the auto-save file was recent before this command,
;; delete it now.
(delete-auto-save-file-if-necessary recent-save))
(run-hooks 'after-save-hook))
(or noninteractive
(not called-interactively)
(files--message "(No changes need to be saved)")))))
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
;; but inhibited if one of write-file-functions returns non-nil.
;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
;; backup-buffer.
(defun basic-save-buffer-1 ()
(prog1
(if save-buffer-coding-system
(let ((coding-system-for-write save-buffer-coding-system))
(basic-save-buffer-2))
(basic-save-buffer-2))
(if buffer-file-coding-system-explicit
(setcar buffer-file-coding-system-explicit last-coding-system-used))))
;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
;; backup-buffer.
(defun basic-save-buffer-2 ()
(let (tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
(let ((dir (file-name-directory buffer-file-name)))
(if (not (file-directory-p dir))
(if (file-exists-p dir)
(error "%s is not a directory" dir)
(error "%s: No such directory" dir))
(if (not (file-exists-p buffer-file-name))
(error "Directory %s write-protected" dir)
(if (yes-or-no-p
(format
"File %s is write-protected; try to save anyway? "
(file-name-nondirectory
buffer-file-name)))
(setq tempsetmodes t)
(error "Attempt to save to a file that you aren't allowed to write"))))))
(with-demoted-errors
"Backing up buffer: %s"
(or buffer-backed-up
(setq setmodes (backup-buffer))))
(let* ((dir (file-name-directory buffer-file-name))
(dir-writable (file-writable-p dir)))
(if (or (and file-precious-flag dir-writable)
(and break-hardlink-on-save
(file-exists-p buffer-file-name)
(> (file-nlinks buffer-file-name) 1)
(or dir-writable
(error (concat "Directory %s write-protected; "
"cannot break hardlink when saving")
dir))))
;; Write temp name, then rename it.
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
(let ((realname buffer-file-name)
tempname
(old-modtime (visited-file-modtime)))
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(condition-case err
(progn
(clear-visited-file-modtime)
;; Call write-region in the appropriate way
;; for saving the buffer.
(setq tempname
(make-temp-file
(expand-file-name "tmp" dir)))
;; Pass in nil&nil rather than point-min&max
;; cause we're saving the whole buffer.
;; write-region-annotate-functions may use it.
(write-region nil nil tempname nil realname
buffer-file-truename)
(when save-silently (message nil)))
;; If we failed, restore the buffer's modtime.
(error (set-visited-file-modtime old-modtime)
(signal (car err) (cdr err))))
;; Since we have created an entirely new file,
;; make sure it gets the right permission bits set.
(setq setmodes
(or setmodes
(list (or (file-modes buffer-file-name)
(logand ?\666 (default-file-modes)))
(with-demoted-errors
"Error getting extended attributes: %s"
(file-extended-attributes buffer-file-name))
buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(rename-file tempname
(if (and file-preserve-symlinks-on-save
(file-symlink-p buffer-file-name))
;; Write to the file that the symlink
;; points to.
(file-chase-links buffer-file-name)
buffer-file-name)
t))
;; If file not writable, see if we can make it writable
;; temporarily while we write it (its original modes will be
;; restored in 'basic-save-buffer' or, in case of an error, in
;; the `unwind-protect' below). But no need to do so if we
;; have just backed it up (setmodes is set) because that says
;; we're superseding.
(cond ((and tempsetmodes (not setmodes))
;; Change the mode back, after writing.
(setq setmodes
(list (file-modes buffer-file-name)
(with-demoted-errors
"Error getting extended attributes: %s"
(file-extended-attributes buffer-file-name))
buffer-file-name))
;; If set-file-extended-attributes fails to make the
;; file writable, fall back on set-file-modes. Calling
;; set-file-extended-attributes here may or may not be
;; actually necessary. However, since its exact
;; behavior is highly port-specific, since calling it
;; does not do any harm, and since the call has a long
;; history, we decided to leave it in (bug#66546).
(with-demoted-errors "Error setting attributes: %s"
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes)))
(unless (file-writable-p buffer-file-name)
(set-file-modes buffer-file-name
(logior (car setmodes) 128)))))
(let (success)
(unwind-protect
(progn
;; Pass in nil&nil rather than point-min&max to indicate
;; we're saving the buffer rather than just a region.
;; write-region-annotate-functions may make use of it.
(write-region nil nil
buffer-file-name nil t buffer-file-truename)
(when save-silently (message nil))
(setq success t))
(cond
;; If we get an error writing the file, and there is no
;; backup file, then we (most likely) made that file
;; writable above. Attempt to undo the write-access.
((and setmodes (not success)
(equal (nth 2 setmodes) buffer-file-name))
(with-demoted-errors "Error setting file modes: %S"
(set-file-modes buffer-file-name (car setmodes)))
(with-demoted-errors "Error setting attributes: %s"
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes))))
;; If we get an error writing the new file, and we made
;; the backup by renaming, undo the backing-up.
((and setmodes (not success))
(rename-file (nth 2 setmodes) buffer-file-name t)
(setq buffer-backed-up nil)))))))
setmodes))
(declare-function diff-no-select "diff"
(old new &optional switches no-async buf))
(defvar save-some-buffers--switch-window-callback nil)
(defvar save-some-buffers-action-alist
`((?\C-r
,(lambda (buf)
(if (not enable-recursive-minibuffers)
(progn (display-buffer buf)
(setq other-window-scroll-buffer buf))
(view-buffer buf (lambda (_) (exit-recursive-edit)))
(recursive-edit))
;; Return nil to ask about BUF again.
nil)
,(purecopy "view this buffer"))
(?\C-f
,(lambda (buf)
(funcall save-some-buffers--switch-window-callback buf)
(setq quit-flag t))
,(purecopy "view this buffer and quit"))
(?d ,(lambda (buf)
(if (null (buffer-file-name buf))
(message "Not applicable: no file")
(require 'diff) ;for diff-no-select.
(let ((diffbuf (diff-no-select (buffer-file-name buf) buf
nil 'noasync)))
(if (not enable-recursive-minibuffers)
(progn (display-buffer diffbuf)
(setq other-window-scroll-buffer diffbuf))
(view-buffer diffbuf (lambda (_) (exit-recursive-edit)))
(recursive-edit))))
;; Return nil to ask about BUF again.
nil)
,(purecopy "view changes in this buffer")))
"ACTION-ALIST argument used in call to `map-y-or-n-p'.")
(put 'save-some-buffers-action-alist 'risky-local-variable t)
(defvar-local buffer-save-without-query nil
"Non-nil means `save-some-buffers' should save this buffer without asking.")
(defcustom save-some-buffers-default-predicate nil
"Default predicate for `save-some-buffers'.
This allows you to stop `save-some-buffers' from asking
about certain files that you'd usually rather not save.
This function is called (with no parameters) from the buffer to
be saved. When the function's symbol has the property
`save-some-buffers-function', the higher-order function is supposed
to return a predicate used to check buffers."
:group 'auto-save
;; FIXME nil should not be a valid option, let alone the default,
;; eg so that add-function can be used.
:type '(choice (const :tag "Default" nil)
(function :tag "Only in subdirs of current project"
save-some-buffers-root)
(function :tag "Custom function"))
:version "26.1")
(defun save-some-buffers-root ()
"A predicate to check whether the buffer is under the project root directory.
Can be used as a value of `save-some-buffers-default-predicate'
to save buffers only under the project root or in subdirectories
of the directory that was default during command invocation."
(let ((root (or (and (featurep 'project) (project-current)
(fboundp 'project-root)
(project-root (project-current)))
default-directory)))
(lambda () (file-in-directory-p default-directory root))))
(put 'save-some-buffers-root 'save-some-buffers-function t)
(defun files--buffers-needing-to-be-saved (pred)
"Return a list of buffers to save according to PRED.
See `save-some-buffers' for PRED values."
(let ((buffers
(mapcar (lambda (buffer)
(if
;; Note that killing some buffers may kill others via
;; hooks (e.g. Rmail and its viewing buffer).
(and (buffer-live-p buffer)
(buffer-modified-p buffer)
(not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
(with-current-buffer buffer
(or (eq buffer-offer-save 'always)
(and pred buffer-offer-save
(> (buffer-size) 0)))))
(or (not (functionp pred))
(with-current-buffer buffer
(funcall pred))))
buffer))
(buffer-list))))
(delq nil buffers)))
(defvar save-some-buffers-functions nil
"Functions to be run by `save-some-buffers' after saving the buffers.
These functions should accept one mandatory and one optional
argument, and they can be called in two \"modes\", depending on
the first argument. If the first argument is `query', then the
function should return non-nil if there is something to be
saved (but it should not actually save anything).
If the first argument is something else, then the function should
save according to the value of the second argument, which is the
ARG argument with which `save-some-buffers' was called.
The main purpose of these functions is to save stuff that is kept
in variables (rather than in buffers).")
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
You can answer \\`y' or \\`SPC' to save, \\`n' or \\`DEL' not to save, \\`C-r'
to look at the buffer in question with `view-buffer' before
deciding, \\`d' to view the differences using
`diff-buffer-with-file', \\`!' to save the buffer and all remaining
buffers without any further querying, \\`.' to save only the
current buffer and skip the remaining ones and \\`q' or \\`RET' to exit
the function without saving any more buffers. \\`C-h' displays a
help message describing these options.
This command first saves any buffers where `buffer-save-without-query' is
non-nil, without asking.
Optional argument ARG (interactively, prefix argument) non-nil means save
all with no questions.
Optional second argument PRED determines which buffers are considered:
If PRED is nil, all the file-visiting buffers are considered.
If PRED is t, then certain non-file buffers will also be considered.
If PRED is a function, it is called with no argument in each buffer and
should return non-nil if that buffer should be considered.
PRED defaults to the value of `save-some-buffers-default-predicate'.
See `save-some-buffers-action-alist' if you want to
change the additional actions you can take on files.
The functions in `save-some-buffers-functions' will be called
after saving the buffers."
(interactive "P")
(unless pred
(setq pred
;; Allow `pred' to be a function that returns a predicate
;; with lexical bindings in its original environment (bug#46374).
(if (and (symbolp save-some-buffers-default-predicate)
(get save-some-buffers-default-predicate
'save-some-buffers-function))
(funcall save-some-buffers-default-predicate)
save-some-buffers-default-predicate)))
(let* ((switched-buffer nil)
(save-some-buffers--switch-window-callback
(lambda (buffer)
(setq switched-buffer buffer)))
queried autosaved-buffers
files-done inhibit-message)
(unwind-protect
(save-window-excursion
(dolist (buffer (buffer-list))
;; First save any buffers that we're supposed to save
;; unconditionally. That way the following code won't ask
;; about them.
(with-current-buffer buffer
(when (and buffer-save-without-query (buffer-modified-p))
(push (buffer-name) autosaved-buffers)
(save-buffer))))
;; Ask about those buffers that merit it,
;; and record the number thus saved.
(setq files-done
(map-y-or-n-p
(lambda (buffer)
(if arg
t
(setq queried t)
(if (buffer-file-name buffer)
(if (or
(equal (buffer-name buffer)
(file-name-nondirectory
(buffer-file-name buffer)))
(string-match
(concat "\\<"
(regexp-quote
(file-name-nondirectory
(buffer-file-name buffer)))
"<[^>]*>\\'")
(buffer-name buffer)))
;; The buffer name is similar to the file
;; name.
(format "Save file %s? "
(buffer-file-name buffer))
;; The buffer and file names are dissimilar;
;; display both.
(format "Save file %s (buffer %s)? "
(buffer-file-name buffer)
(buffer-name buffer)))
;; No file name.
(format "Save buffer %s? " (buffer-name buffer)))))
(lambda (buffer)
(with-current-buffer buffer
(save-buffer)))
(files--buffers-needing-to-be-saved pred)
'("buffer" "buffers" "save")
save-some-buffers-action-alist))
;; Allow other things to be saved at this time, like abbrevs.
(dolist (func save-some-buffers-functions)
(setq inhibit-message (or (funcall func nil arg) inhibit-message)))
(or queried (> files-done 0) inhibit-message
(cond
((null autosaved-buffers)
(when (called-interactively-p 'any)
(files--message "(No files need saving)")))
((= (length autosaved-buffers) 1)
(files--message "(Saved %s)" (car autosaved-buffers)))
(t
(files--message
"(Saved %d files: %s)" (length autosaved-buffers)
(mapconcat 'identity autosaved-buffers ", "))))))
(when switched-buffer
(pop-to-buffer-same-window switched-buffer)))))
(defun clear-visited-file-modtime ()
"Clear out records of last mod time of visited file.
Next attempt to save will not complain of a discrepancy."
(set-visited-file-modtime 0))
(defun not-modified (&optional arg)
"Mark current buffer as unmodified, not needing to be saved.
With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
It is not a good idea to use this function in Lisp programs, because it
prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(declare (interactive-only set-buffer-modified-p))
(interactive "P")
(files--message (if arg "Modification-flag set"
"Modification-flag cleared"))
(set-buffer-modified-p arg))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
Set mark after the inserted text.
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
(declare (interactive-only insert-file-contents))
(interactive "*fInsert file: ")
(insert-file-1 filename #'insert-file-contents))
(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
When called from a function, expects three arguments,
START, END and FILENAME. START and END are normally buffer positions
specifying the part of the buffer to write.
If START is nil, that means to use the entire buffer contents.
If START is a string, then output that string to the file
instead of any buffer contents; END is ignored.
This does character code conversion and applies annotations
like `write-region' does."
(interactive "r\nFAppend to file: ")
(prog1 (write-region start end filename t)
(when save-silently (message nil))))
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
(car (file-backup-file-names filename)))
(defun file-backup-file-names (filename)
"Return a list of backup files for FILENAME.
The list will be sorted by modification time so that the most
recent files are first."
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
(dir (file-name-directory filename)))
(when (file-directory-p dir)
(sort
(seq-filter
(lambda (candidate)
(and (backup-file-name-p candidate)
(string= (file-name-sans-versions candidate) filename)))
(mapcar
(lambda (file)
(concat dir file))
(file-name-all-completions (file-name-nondirectory filename) dir)))
#'file-newer-than-file-p))))
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
This function is useful for creating multiple shell process buffers
or multiple mail buffers, etc.
Note that some commands, in particular those based on `compilation-mode'
\(`compile', `grep', etc.) will reuse the current buffer if it has the
appropriate mode even if it has been renamed. So as well as renaming
the buffer, you also need to switch buffers before running another
instance of such commands."
(interactive)
(save-match-data
(let ((base-name (buffer-name)))
(and (string-match "<[0-9]+>\\'" base-name)
(not (and buffer-file-name
(string= base-name
(file-name-nondirectory buffer-file-name))))
;; If the existing buffer name has a <NNN>,
;; which isn't part of the file name (if any),
;; then get rid of that.
(setq base-name (substring base-name 0 (match-beginning 0))))
(rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
(defun files--ensure-directory (dir)
"Make directory DIR if it is not already a directory.
Return non-nil if DIR is already a directory."
(condition-case err
(make-directory-internal dir)
(error
(or (file-directory-p dir)
(signal (car err) (cdr err))))))
(defun make-directory (dir &optional parents)
"Create the directory DIR and optionally any nonexistent parent dirs.
Interactively, the default choice of directory to create is the
current buffer's default directory. That is useful when you have
visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS, if
non-nil, says whether to create parent directories that don't
exist. Interactively, this happens by default.
Return non-nil if PARENTS is non-nil and DIR already exists as a
directory, and nil if DIR did not already exist but was created.
Signal an error if unsuccessful."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
;; If default-directory is a remote directory,
;; make sure we find its make-directory handler.
(setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
(if (not parents)
(make-directory-internal dir)
(let ((dir (directory-file-name (expand-file-name dir)))
already-dir create-list parent)
(while (progn
(setq parent (directory-file-name
(file-name-directory dir)))
(condition-case ()
(ignore (setq already-dir
(files--ensure-directory dir)))
(error
;; Do not loop if root does not exist (Bug#2309).
(not (string= dir parent)))))
(setq create-list (cons dir create-list)
dir parent))
(dolist (dir create-list)
(setq already-dir (files--ensure-directory dir)))
already-dir)))))
(defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME.
Optional arg PARENTS, if non-nil then creates parent dirs as needed.
If called interactively, then PARENTS is non-nil."
(interactive
(let ((filename (read-file-name "Create empty file: ")))
(list filename t)))
(when (and (file-exists-p filename) (null parents))
(signal 'file-already-exists `("File exists" ,filename)))
(let ((paren-dir (file-name-directory filename)))
(when (and paren-dir (not (file-exists-p paren-dir)))
(make-directory paren-dir parents)))
(write-region "" nil filename nil 0))
(defconst directory-files-no-dot-files-regexp
"[^.]\\|\\.\\.\\."
"Regexp matching any file name except \".\" and \"..\".
More precisely, it matches parts of any nonempty string except those two.
It is useful as the regexp argument to `directory-files' and
`directory-files-and-attributes'.")
(defun files--force (no-such fn &rest args)
"Use NO-SUCH to affect behavior of function FN applied to list ARGS.
This acts like (apply FN ARGS) except it returns NO-SUCH if it is
non-nil and if FN fails due to a missing file or directory."
(condition-case err
(apply fn args)
(file-missing (or no-such (signal (car err) (cdr err))))))
(defun delete-file (filename &optional trash)
"Delete file named FILENAME. If it is a symlink, remove the symlink.
If file has multiple names, it continues to exist with the other names.
TRASH non-nil means to trash the file instead of deleting, provided
`delete-by-moving-to-trash' is non-nil.
When called interactively, TRASH is t if no prefix argument is given.
With a prefix argument, TRASH is nil."
(interactive (list (read-file-name
(if (and delete-by-moving-to-trash (null current-prefix-arg))
"Move file to trash: " "Delete file: ")
nil default-directory (confirm-nonexistent-file-or-buffer))
(null current-prefix-arg)))
(if (and (file-directory-p filename) (not (file-symlink-p filename)))
(signal 'file-error (list "Removing old name: is a directory" filename)))
(let* ((filename (expand-file-name filename))
(handler (find-file-name-handler filename 'delete-file)))
(cond (handler (funcall handler 'delete-file filename trash))
((and delete-by-moving-to-trash trash) (move-file-to-trash filename))
(t (delete-file-internal filename)))))
(defun delete-directory (directory &optional recursive trash)
"Delete the directory named DIRECTORY. Does not follow symlinks.
If RECURSIVE is non-nil, delete files in DIRECTORY as well, with
no error if something else is simultaneously deleting them.
TRASH non-nil means to trash the directory instead, provided
`delete-by-moving-to-trash' is non-nil.
When called interactively, TRASH is nil if and only if a prefix
argument is given, and a further prompt asks the user for
RECURSIVE if DIRECTORY is nonempty."
(interactive
(let* ((trashing (and delete-by-moving-to-trash
(null current-prefix-arg)))
(dir (expand-file-name
(read-directory-name
(if trashing
"Move directory to trash: "
"Delete directory: ")
default-directory default-directory nil nil))))
(list dir
(if (directory-files dir nil directory-files-no-dot-files-regexp)
(y-or-n-p
(format-message "Directory `%s' is not empty, really %s? "
dir (if trashing "trash" "delete")))
nil)
(null current-prefix-arg))))
;; If default-directory is a remote directory, make sure we find its
;; delete-directory handler.
(setq directory (directory-file-name (expand-file-name directory)))
(let ((handler (find-file-name-handler directory 'delete-directory)))
(cond
(handler
(funcall handler 'delete-directory directory recursive trash))
((and delete-by-moving-to-trash trash)
;; Move non-empty dir to trash only if recursive deletion was
;; requested. This mimics the non-`delete-by-moving-to-trash'
;; case, where the operation fails in delete-directory-internal.
;; As `move-file-to-trash' trashes directories (empty or
;; otherwise) as a unit, we do not need to recurse here.
(if (not (or recursive (directory-empty-p directory)))
(error "Directory is not empty, not moving to trash")
(move-file-to-trash directory)))
;; Otherwise, call ourselves recursively if needed.
(t
(when (or (not recursive) (file-symlink-p directory)
(let* ((files
(files--force t #'directory-files directory 'full
directory-files-no-dot-files-regexp))
(directory-exists (listp files)))
(when directory-exists
(mapc (lambda (file)
;; This test is equivalent to but more efficient
;; than (and (file-directory-p fn)
;; (not (file-symlink-p fn))).
(if (eq t (car (file-attributes file)))
(delete-directory file recursive)
(files--force t #'delete-file file)))
files))
directory-exists))
(files--force recursive #'delete-directory-internal directory))))))
(defcustom remote-file-name-inhibit-delete-by-moving-to-trash nil
"Whether remote files shall be moved to the Trash.
This overrules any setting of `delete-by-moving-to-trash'."
:version "30.1"
:group 'files
:group 'tramp
:type 'boolean)
(defun file-equal-p (file1 file2)
"Return non-nil if files FILE1 and FILE2 name the same file.
If FILE1 or FILE2 does not exist, the return value is unspecified."
(let ((handler (or (find-file-name-handler file1 'file-equal-p)
(find-file-name-handler file2 'file-equal-p))))
(if handler
(funcall handler 'file-equal-p file1 file2)
(let (f1-attr f2-attr)
(and (setq f1-attr (file-attributes (file-truename file1)))
(setq f2-attr (file-attributes (file-truename file2)))
(progn
;; Haiku systems change the file's last access timestamp
;; every time `stat' is called. Make sure to not compare
;; the timestamps in that case.
(or (equal f1-attr f2-attr)
(when (and (eq system-type 'haiku)
(consp (nthcdr 4 f1-attr))
(consp (nthcdr 4 f2-attr)))
(ignore-errors
(setcar (nthcdr 4 f1-attr) nil)
(setcar (nthcdr 4 f2-attr) nil))
(equal f1-attr f2-attr)))))))))
(defun file-in-directory-p (file dir)
"Return non-nil if DIR is a parent directory of FILE.
Value is non-nil if FILE is inside DIR or inside a subdirectory of DIR.
A directory is considered to be a \"parent\" of itself.
DIR must be an existing directory, otherwise the function returns nil."
(let ((handler (or (find-file-name-handler file 'file-in-directory-p)
(find-file-name-handler dir 'file-in-directory-p))))
(if handler
(funcall handler 'file-in-directory-p file dir)
(when (file-directory-p dir) ; DIR must exist.
(setq file (file-truename file)
dir (file-truename dir))
(let ((ls1 (split-string file "/" t))
(ls2 (split-string dir "/" t))
(root
(cond
;; A UNC on Windows systems, or a "super-root" on Apollo.
((string-match "\\`//" file) "//")
((string-match "\\`/" file) "/")
(t "")))
(mismatch nil))
(while (and ls1 ls2 (not mismatch))
(if (string-equal (car ls1) (car ls2))
(setq root (concat root (car ls1) "/"))
(setq mismatch t))
(setq ls1 (cdr ls1)
ls2 (cdr ls2)))
(unless mismatch
(file-equal-p root dir)))))))
(defvar file-has-changed-p--hash-table (make-hash-table :test #'equal)
"Internal variable used by `file-has-changed-p'.")
(defun file-has-changed-p (file &optional tag)
"Return non-nil if FILE has changed.
The size and modification time of FILE are compared to the size
and modification time of the same FILE during a previous
invocation of `file-has-changed-p'. Thus, the first invocation
of `file-has-changed-p' always returns non-nil when FILE exists.
The optional argument TAG, which must be a symbol, can be used to
limit the comparison to invocations with identical tags; it can be
the symbol of the calling function, for example."
(let* ((file (directory-file-name (expand-file-name file)))
(remote-file-name-inhibit-cache t)
(fileattr (file-attributes file 'integer))
(attr (and fileattr
(cons (file-attribute-size fileattr)
(file-attribute-modification-time fileattr))))
(sym (concat (symbol-name tag) "@" file))
(cachedattr (gethash sym file-has-changed-p--hash-table)))
(when (not (equal attr cachedattr))
(puthash sym attr file-has-changed-p--hash-table))))
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
This function always sets the file modes of the output files to match
the corresponding input file.
The third arg KEEP-TIME non-nil means give the output files the same
last-modified time as the old ones. (This works on only some systems.)
A prefix arg makes KEEP-TIME non-nil.
Noninteractively, the PARENTS argument says whether to create
parent directories if they don't exist. Interactively, this
happens by default.
If DIRECTORY is a symlink and `copy-directory-create-symlink' is
non-nil, create a symlink with the same target as DIRECTORY.
If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
there. However, if called from Lisp with a non-nil optional
argument COPY-CONTENTS, copy the contents of DIRECTORY directly
into NEWNAME instead."
(interactive
(let ((dir (read-directory-name
"Copy directory: " default-directory default-directory t nil)))
(list dir
(read-directory-name
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
(when (file-in-directory-p newname directory)
(error "Cannot copy `%s' into its subdirectory `%s'"
directory newname))
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory)))
follow)
(if handler
(funcall handler 'copy-directory directory
newname keep-time parents copy-contents)
;; Compute target name.
(setq directory (directory-file-name (expand-file-name directory))
newname (expand-file-name newname))
;; If DIRECTORY is a symlink, create a symlink with the same target.
(if (and (file-symlink-p directory)
copy-directory-create-symlink)
(let ((target (car (file-attributes directory))))
(if (directory-name-p newname)
(make-symbolic-link target
(concat newname
(file-name-nondirectory directory))
t)
(make-symbolic-link target newname t)))
;; Else proceed to copy as a regular directory
;; first by creating the destination directory if needed,
;; preparing to follow any symlink to a directory we did not create.
(setq follow
(if (not (directory-name-p newname))
;; If NEWNAME is not a directory name, create it;
;; that is where we will copy the files of DIRECTORY.
(make-directory newname parents)
;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
;; create NEWNAME if it is not already a directory;
;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
(unless copy-contents
(setq newname (concat newname
(file-name-nondirectory directory))))
(condition-case err
(make-directory (directory-file-name newname) parents)
(error
(or (file-directory-p newname)
(signal (car err) (cdr err)))))))
;; Copy recursively.
(dolist (file
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
(let ((target (concat (file-name-as-directory newname)
(file-name-nondirectory file)))
(filetype (car (file-attributes file))))
(cond
((eq filetype t) ; Directory but not a symlink.
(copy-directory file target keep-time parents t))
((stringp filetype) ; Symbolic link
(make-symbolic-link filetype target t))
((copy-file file target t keep-time)))))
;; Set directory attributes.
(let ((modes (file-modes directory))
(times (and keep-time (file-attribute-modification-time
(file-attributes directory))))
(follow-flag (unless follow 'nofollow)))
(if modes (set-file-modes newname modes follow-flag))
(when times
;; When built for an Android GUI build, don't attempt to
;; set file times for a file within /content, as the
;; Android VFS layer does not provide means to change file
;; timestamps.
(when (or (not (and (eq system-type 'android)
(featurep 'android)))
(not (string-prefix-p "/content/" newname)))
(set-file-times newname times follow-flag))))))))
;; At time of writing, only info uses this.
(defun prune-directory-list (dirs &optional keep reject)
"Return a copy of DIRS with all non-existent directories removed.
The optional argument KEEP is a list of directories to retain even if
they don't exist, and REJECT is a list of directories to remove from
DIRS, even if they exist; REJECT takes precedence over KEEP.
Note that membership in REJECT and KEEP is checked using simple string
comparison."
(apply #'nconc
(mapcar (lambda (dir)
(and (not (member dir reject))
(or (member dir keep) (file-directory-p dir))
(list dir)))
dirs)))
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function #'revert-buffer--default
"Function to use to revert this buffer.
The function receives two arguments IGNORE-AUTO and NOCONFIRM,
which are the arguments that `revert-buffer' received.
It also has access to the `preserve-modes' argument of `revert-buffer'
via the `revert-buffer-preserve-modes' dynamic variable.
For historical reasons, a value of nil means to use the default function.
This should not be relied upon.")
(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
(defvar revert-buffer-insert-file-contents-function
#'revert-buffer-insert-file-contents--default-function
"Function to use to insert contents when reverting this buffer.
The function receives two arguments: the first the nominal file name to use;
the second is t if reading the auto-save file.
The function is responsible for updating (or preserving) point.
For historical reasons, a value of nil means to use the default function.
This should not be relied upon.")
(defun buffer-stale--default-function (&optional _noconfirm)
"Default function to use for `buffer-stale-function'.
This function ignores its argument.
This returns non-nil if the current buffer is visiting a readable file
whose modification time does not match that of the buffer.
This function handles only buffers that are visiting files.
Non-file buffers need a custom function."
(and buffer-file-name
(file-readable-p buffer-file-name)
(not (buffer-modified-p (current-buffer)))
(not (verify-visited-file-modtime (current-buffer)))))
(defvar buffer-stale-function #'buffer-stale--default-function
"Function to check whether a buffer needs reverting.
This should be a function with one optional argument NOCONFIRM.
Auto Revert Mode passes t for NOCONFIRM. The function should return
non-nil if the buffer should be reverted. A return value of
`fast' means that the need for reverting was not checked, but
that reverting the buffer is fast. The buffer is current when
this function is called.
The idea behind the NOCONFIRM argument is that it should be
non-nil if the buffer is going to be reverted without asking the
user. In such situations, one has to be careful with potentially
time consuming operations.
For historical reasons, a value of nil means to use the default function.
This should not be relied upon.
For more information on how this variable is used by Auto Revert mode,
see Info node `(elisp)Reverting'.")
(defvar-local buffer-auto-revert-by-notification nil
"Whether a buffer can rely on notification in Auto-Revert mode.
If non-nil, monitoring changes to the directory of the current
buffer is sufficient for knowing when that buffer needs to be
updated in Auto Revert Mode. Such notification does not include
changes to files in that directory, only to the directory itself.
This variable applies only to buffers where `buffer-file-name' is
nil; other buffers are tracked by their files.")
(defvar before-revert-hook nil
"Normal hook for `revert-buffer' to run before reverting.
The function `revert-buffer--default' runs this.
A customized `revert-buffer-function' need not run this hook.")
(defvar after-revert-hook nil
"Normal hook for `revert-buffer' to run after reverting.
Note that the hook value that it runs is the value that was in effect
before reverting; that makes a difference if you have buffer-local
hook functions.
The function `revert-buffer--default' runs this.
A customized `revert-buffer-function' need not run this hook.")
(defvar revert-buffer-in-progress-p nil
"Non-nil if a `revert-buffer' operation is in progress, nil otherwise.")
(defvar revert-buffer-internal-hook)
;; `revert-buffer-function' was defined long ago to be a function of only
;; 2 arguments, so we have to use a dynbind variable to pass the
;; `preserve-modes' argument of `revert-buffer'.
(defvar revert-buffer-preserve-modes)
(defvar revert-buffer-restore-functions '(revert-buffer-restore-read-only)
"Functions to preserve any state during `revert-buffer'.
The value of this variable is a list of functions that are called before
reverting the buffer. Each of these functions are called without
arguments and should return a lambda that can restore a previous state
of the buffer. Then after reverting the buffer each of these lambdas
will be called one by one in the order of the list to restore previous
states of the buffer. An example of the buffer state is keeping the
buffer read-only, or keeping minor modes, etc.")
(defun revert-buffer-restore-read-only ()
"Preserve read-only state for `revert-buffer'."
(when-let ((state (and (boundp 'read-only-mode--state)
(list read-only-mode--state))))
(lambda ()
(setq buffer-read-only (car state))
(setq-local read-only-mode--state (car state)))))
(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
"Replace current buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
buffers). This is done via the variable `revert-buffer-function'.
In these cases, it should reconstruct the buffer contents from the
appropriate data.
When called from Lisp, the first argument is IGNORE-AUTO; offer to
revert from the auto-save file only when this is nil. Note that the
sense of this argument is the reverse of the prefix argument, for the
sake of backward compatibility. IGNORE-AUTO is optional, defaulting
to nil.
Optional second argument NOCONFIRM means don't ask for confirmation
at all. (The variable `revert-without-query' offers another way to
revert buffers without querying for confirmation.)
Optional third argument PRESERVE-MODES non-nil means don't alter
the files modes. Normally we reinitialize them using `normal-mode'.
This function binds `revert-buffer-in-progress-p' non-nil while it operates.
This function calls the function that `revert-buffer-function' specifies
to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
The default function runs the hooks `before-revert-hook' and
`after-revert-hook'.
Return value is whatever `revert-buffer-function' returns. For historical
reasons, that return value is non-nil when `revert-buffer-function'
succeeds in its job and returns non-nil.
Reverting a buffer will try to preserve markers in the buffer,
but it cannot always preserve all of them. For better results,
use `revert-buffer-with-fine-grain', which tries harder to
preserve markers and overlays, at the price of being slower."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there that assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
;; there's no straightforward way to encourage authors to notice a
;; reversal of the argument sense. So I'm just changing the user
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
(let ((revert-buffer-in-progress-p t)
(revert-buffer-preserve-modes preserve-modes)
restore-functions)
(run-hook-wrapped 'revert-buffer-restore-functions
(lambda (f) (push (funcall f) restore-functions) nil))
;; Return whatever 'revert-buffer-function' returns.
(prog1 (funcall (or revert-buffer-function #'revert-buffer--default)
ignore-auto noconfirm)
(mapc #'funcall (delq nil restore-functions)))))
(defun revert-buffer--default (ignore-auto noconfirm)
"Default function for `revert-buffer'.
The arguments IGNORE-AUTO and NOCONFIRM are as described for `revert-buffer'.
Runs the hooks `before-revert-hook' and `after-revert-hook' at the
start and end.
The function returns non-nil if it reverts the buffer; signals
an error if the buffer is not associated with a file.
Calls `revert-buffer-insert-file-contents-function' to reread the
contents of the visited file, with two arguments: the first is the file
name, the second is non-nil if reading an auto-save file.
This function handles only buffers that are visiting files.
Non-file buffers need a custom function."
(with-current-buffer (or (buffer-base-buffer (current-buffer))
(current-buffer))
(let* ((auto-save-p (and (not ignore-auto)
(recent-auto-save-p)
buffer-auto-save-file-name
(file-readable-p buffer-auto-save-file-name)
(y-or-n-p
"Buffer has been auto-saved recently. Revert from auto-save file? ")))
(file-name (if auto-save-p
buffer-auto-save-file-name
buffer-file-name)))
(cond ((null file-name)
(error "Buffer does not seem to be associated with any file"))
((or noconfirm
(and (not (buffer-modified-p))
(catch 'found
(dolist (regexp revert-without-query)
(when (string-match regexp file-name)
(throw 'found t)))))
(yes-or-no-p
(format (if (buffer-modified-p)
"Discard edits and reread from %s? "
"Revert buffer from file %s? ")
file-name)))
(run-hooks 'before-revert-hook)
;; If file was backed up but has changed since,
;; we should make another backup.
(and (not auto-save-p)
(not (verify-visited-file-modtime (current-buffer)))
(setq buffer-backed-up nil))
;; Effectively copy the after-revert-hook status,
;; since after-find-file will clobber it.
(let ((global-hook (default-value 'after-revert-hook))
(local-hook (when (local-variable-p 'after-revert-hook)
after-revert-hook))
(inhibit-read-only t))
;; FIXME: Throw away undo-log when preserve-modes is nil?
(funcall
(or revert-buffer-insert-file-contents-function
#'revert-buffer-insert-file-contents--default-function)
file-name auto-save-p)
;; Recompute the truename in case changes in symlinks
;; have changed the truename.
(setq buffer-file-truename
(abbreviate-file-name (file-truename buffer-file-name)))
(after-find-file nil nil t nil revert-buffer-preserve-modes)
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook
(setq-local revert-buffer-internal-hook
local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
t)))))
(defun revert-buffer-insert-file-contents--default-function (file-name auto-save-p)
"Default function for `revert-buffer-insert-file-contents-function'.
The function `revert-buffer--default' calls this.
FILE-NAME is the name of the file. AUTO-SAVE-P is non-nil if this is
an auto-save file."
(cond
((not (file-exists-p file-name))
(error (if buffer-file-number
"File %s no longer exists!"
"Cannot revert nonexistent file %s")
file-name))
((not (file-readable-p file-name))
(error (if buffer-file-number
"File %s no longer readable!"
"Cannot revert unreadable file %s")
file-name))
(t
(widen)
(let ((coding-system-for-read
;; Auto-saved file should be read by Emacs's
;; internal coding.
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
(and
buffer-file-coding-system-explicit
(car buffer-file-coding-system-explicit))))))
(if (and (not enable-multibyte-characters)
coding-system-for-read
(not (memq (coding-system-base
coding-system-for-read)
'(no-conversion raw-text))))
;; As a coding system suitable for multibyte
;; buffer is specified, make the current
;; buffer multibyte.
(set-buffer-multibyte t))
;; This force after-insert-file-set-coding
;; (called from insert-file-contents) to set
;; buffer-file-coding-system to a proper value.
(kill-local-variable 'buffer-file-coding-system)
;; Note that this preserves point in an intelligent way.
(if revert-buffer-preserve-modes
(let ((buffer-file-format buffer-file-format))
(insert-file-contents file-name (not auto-save-p)
nil nil 'if-regular))
(insert-file-contents file-name (not auto-save-p)
nil nil 'if-regular))))))
(defvar revert-buffer-with-fine-grain-max-seconds 2.0
"Maximum time that `revert-buffer-with-fine-grain' should use.
The command tries to preserve markers, properties and overlays.
If the operation takes more than this time, a single
delete+insert is performed. Actually, this value is passed as
the MAX-SECS argument to the function `replace-buffer-contents',
so it is not ensured that the whole execution won't take longer.
See `replace-buffer-contents' for more details.")
(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p)
"Optional function for `revert-buffer-insert-file-contents-function'.
The function `revert-buffer-with-fine-grain' uses this function by binding
`revert-buffer-insert-file-contents-function' to it.
As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is
the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file.
Since calling `replace-buffer-contents' can take a long time, depending of
the number of changes made to the buffer, it uses the value of the variable
`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately
reverting the buffer. If it fails, it does a delete+insert. For more details,
see `replace-buffer-contents'."
(cond
((not (file-exists-p file-name))
(error (if buffer-file-number
"File %s no longer exists"
"Cannot revert nonexistent file %s")
file-name))
((not (file-readable-p file-name))
(error (if buffer-file-number
"File %s no longer readable"
"Cannot revert unreadable file %s")
file-name))
(t
(let* ((buf (current-buffer)) ; current-buffer is the buffer to revert.
(success
(save-excursion
(save-restriction
(widen)
(with-temp-buffer
(insert-file-contents file-name)
(let ((temp-buf (current-buffer)))
(set-buffer buf)
(let ((buffer-file-name nil))
(replace-buffer-contents
temp-buf
revert-buffer-with-fine-grain-max-seconds))))))))
;; See comments in revert-buffer-with-fine-grain for an explanation.
(defun revert-buffer-with-fine-grain-success-p ()
success))
(set-buffer-modified-p nil)
(set-visited-file-modtime))))
(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
"Revert buffer preserving markers, overlays, etc.
This command is an alternative to `revert-buffer' because it tries to be as
non-destructive as possible, preserving markers, properties and overlays.
Binds `revert-buffer-insert-file-contents-function' to the function
`revert-buffer-insert-file-contents-delicately'.
With a prefix argument, offer to revert from latest auto-save file. For more
details on the arguments, see `revert-buffer'."
;; See revert-buffer for an explanation of this.
(interactive (list (not current-prefix-arg)))
;; Simply bind revert-buffer-insert-file-contents-function to the specialized
;; function, and call revert-buffer.
(let ((revert-buffer-insert-file-contents-function
#'revert-buffer-insert-file-contents-delicately))
(revert-buffer ignore-auto noconfirm t)
;; This closure is defined in revert-buffer-insert-file-contents-function.
;; It is needed because revert-buffer--default always returns t after
;; reverting, and it might be needed to report the success/failure of
;; reverting delicately.
(when (fboundp 'revert-buffer-with-fine-grain-success-p)
(prog1
(revert-buffer-with-fine-grain-success-p)
(fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
(defcustom revert-buffer-quick-short-answers nil
"How much confirmation to be done by the `revert-buffer-quick' command.
If non-nil, use `y-or-n-p' instead of `yes-or-no-p'."
:version "28.1"
:type 'boolean)
(defun revert-buffer-quick (&optional auto-save)
"Like `revert-buffer', but asks for less confirmation.
If the current buffer is visiting a file, and the buffer is not
modified, no confirmation is required.
This command heeds the `revert-buffer-quick-short-answers' user option.
If AUTO-SAVE (the prefix argument), offer to revert from latest
auto-save file, if that is more recent than the visited file."
(interactive "P")
(cond
;; If we've visiting a file, and we have no changes, don't ask for
;; confirmation.
((and buffer-file-name
(not (buffer-modified-p)))
(revert-buffer (not auto-save) t)
(message "Reverted buffer"))
;; Heed `revert-buffer-quick-short-answers'.
(revert-buffer-quick-short-answers
(let ((use-short-answers t))
(revert-buffer (not auto-save))))
;; Call `revert-buffer' normally.
(t
(revert-buffer (not auto-save)))))
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
(or buffer-file-name
(user-error "This buffer is not visiting a file"))
(recover-file buffer-file-name))
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save file."
;; Actually putting the file name in the minibuffer should be used
;; only rarely.
;; Not just because users often use the default.
(interactive "FRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
(user-error "%s is an auto-save file" (abbreviate-file-name file)))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
(cond ((and (file-exists-p file)
(not (file-exists-p file-name)))
(error "Auto save file %s does not exist"
(abbreviate-file-name file-name)))
((if (file-exists-p file)
(not (file-newer-than-file-p file-name file))
(not (file-exists-p file-name)))
(user-error "Auto-save file %s not current"
(abbreviate-file-name file-name)))
((with-temp-buffer-window
"*Directory*" nil
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(let ((prompt (format "Recover auto save file %s? " file-name))
(choices
'(("yes" ?y "recover auto save file")
("no" ?n "don't recover auto save file")
("diff" ?= "show changes between auto save file and current file")))
ans)
(while (equal "diff" (setq ans (read-answer prompt choices)))
(diff file file-name))
(equal ans "yes"))
(when (window-live-p window)
(quit-restore-window window 'kill)))))
(with-current-buffer standard-output
(let ((switches (connection-local-value dired-listing-switches)))
(if (file-symlink-p file)
(setq switches (concat switches " -L")))
;; Use insert-directory-safely, not insert-directory,
;; because these files might not exist. In particular,
;; FILE might not exist if the auto-save file was for
;; a buffer that didn't visit a file, such as "*mail*".
;; The code in v20.x called `ls' directly, so we need
;; to emulate what `ls' did in that case.
(insert-directory-safely file switches)
(insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
;; Auto-saved file should be read with special coding.
(coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system)
(set-buffer-auto-saved))
(after-find-file nil nil t))
(t (user-error "Recover-file canceled")))))
(declare-function dired-omit-mode "dired-x" (&optional arg))
(defun recover-session ()
"Recover auto save files from a previous Emacs session.
This command first displays a Dired buffer showing you the
previous sessions that you could recover from.
To choose one, move point to the proper line and then type C-c C-c.
Then you'll be asked about a number of files to recover."
(interactive)
(if (null auto-save-list-file-prefix)
(error "You set `auto-save-list-file-prefix' to disable making session files"))
(let ((dir (file-name-directory auto-save-list-file-prefix))
(nd (file-name-nondirectory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
(make-directory dir t))
(unless (directory-files dir nil
(if (string= "" nd)
directory-files-no-dot-files-regexp
(concat "\\`" (regexp-quote nd)))
t)
(error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
(concat (connection-local-value dired-listing-switches) " -t"))
;; Toggle omitting, if it is on.
(when (bound-and-true-p dired-omit-mode)
(dired-omit-mode -1)))
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
(define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)
(save-excursion
(goto-char (point-min))
(or (looking-at " Move to the session you want to recover,")
(let ((inhibit-read-only t))
;; Each line starts with a space
;; so that Font Lock mode won't highlight the first character.
(insert " To recover a session, move to it and type C-c C-c.\n"
(substitute-command-keys
" To delete a session file, type \
\\[dired-flag-file-deletion] on its line to flag
the file for deletion, then \\[dired-do-flagged-delete] to \
delete flagged files.\n\n"))))))
(defun recover-session-finish ()
"Choose one saved session to recover auto-save files from.
This command is used in the special Dired buffer created by
\\[recover-session]."
(interactive)
;; Get the name of the session file to recover from.
(let ((file (dired-get-filename))
files
(buffer (get-buffer-create " *recover*")))
(dired-unmark 1)
(dired-do-flagged-delete t)
(unwind-protect
(with-current-buffer buffer
;; Read in the auto-save-list file.
(erase-buffer)
(insert-file-contents file)
;; Loop thru the text of that file
;; and get out the names of the files to recover.
(while (not (eobp))
(let (thisfile autofile)
(if (eolp)
;; This is a pair of lines for a non-file-visiting buffer.
;; Get the auto-save file name and manufacture
;; a "visited file name" from that.
(progn
(forward-line 1)
;; If there is no auto-save file name, the
;; auto-save-list file is probably corrupted.
(unless (eolp)
(setq autofile
(buffer-substring-no-properties
(point)
(line-end-position)))
(setq thisfile
(expand-file-name
(substring
(file-name-nondirectory autofile)
1 -1)
(file-name-directory autofile))))
(forward-line 1))
;; This pair of lines is a file-visiting
;; buffer. Use the visited file name.
(progn
(setq thisfile
(buffer-substring-no-properties
(point) (progn (end-of-line) (point))))
(forward-line 1)
(setq autofile
(buffer-substring-no-properties
(point) (progn (end-of-line) (point))))
(forward-line 1)))
;; Ignore a file if its auto-save file does not exist now.
(if (and autofile (file-exists-p autofile))
(setq files (cons thisfile files)))))
(setq files (nreverse files))
;; The file contains a pair of line for each auto-saved buffer.
;; The first line of the pair contains the visited file name
;; or is empty if the buffer was not visiting a file.
;; The second line is the auto-save file name.
(if files
(map-y-or-n-p "Recover %s? "
(lambda (file)
(condition-case nil
(save-excursion (recover-file file))
(error
"Failed to recover `%s'" file)))
files
'("file" "files" "recover"))
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
(defun kill-buffer-ask (buffer)
"Kill BUFFER if confirmed."
(when (yes-or-no-p (format "Buffer %s %s. Kill? "
(buffer-name buffer)
(if (buffer-modified-p buffer)
"HAS BEEN EDITED" "is unmodified")))
(kill-buffer buffer)))
(defun kill-some-buffers (&optional list)
"Kill some buffers. Asks the user whether to kill each one of them.
Non-interactively, if optional argument LIST is non-nil, it
specifies the list of buffers to kill, asking for approval for each one."
(interactive)
(if (null list)
(setq list (buffer-list)))
(while list
(let* ((buffer (car list))
(name (buffer-name buffer)))
(and name ; Can be nil for an indirect buffer
; if we killed the base buffer.
(not (string-equal name ""))
(/= (aref name 0) ?\s)
(kill-buffer-ask buffer)))
(setq list (cdr list))))
(defun kill-matching-buffers (regexp &optional internal-too no-ask)
"Kill buffers whose names match the regular expression REGEXP.
Interactively, prompt for REGEXP.
Ignores buffers whose names start with a space, unless optional
prefix argument INTERNAL-TOO(interactively, the prefix argument)
is non-nil. Asks before killing each buffer, unless NO-ASK is non-nil."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
(let ((name (buffer-name buffer)))
(when (and name (not (string-equal name ""))
(or internal-too (/= (aref name 0) ?\s))
(string-match regexp name))
(funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer)))))
(defun kill-matching-buffers-no-ask (regexp &optional internal-too)
"Kill buffers whose names match the regular expression REGEXP.
Interactively, prompt for REGEXP.
Like `kill-matching-buffers', but doesn't ask for confirmation
before killing each buffer.
Ignores buffers whose names start with a space, unless the
optional argument INTERNAL-TOO (interactively, the prefix argument)
is non-nil."
(interactive "sKill buffers matching this regular expression: \nP")
(kill-matching-buffers regexp internal-too t))
(defun rename-auto-save-file ()
"Adjust current buffer's auto save file name for current conditions.
Also rename any existing auto save file, if it was made in this session."
(let ((osave buffer-auto-save-file-name))
(setq buffer-auto-save-file-name
(make-auto-save-file-name))
(if (and osave buffer-auto-save-file-name
(not (string= buffer-auto-save-file-name buffer-file-name))
(not (string= buffer-auto-save-file-name osave))
(file-exists-p osave)
(recent-auto-save-p))
(rename-file osave buffer-auto-save-file-name t))))
(defun make-auto-save-file-name ()
"Return file name to use for auto-saves of current buffer.
Does not consider `auto-save-visited-file-name' as that variable is checked
before calling this function.
See also `auto-save-file-name-p'."
(if buffer-file-name
(let ((handler (find-file-name-handler
buffer-file-name 'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
(files--transform-file-name
buffer-file-name auto-save-file-name-transforms
"#" "#")))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
;; Restrict the characters used in the file name to those that
;; are known to be safe on all filesystems, url-encoding the
;; rest.
;; We do this on all platforms, because even if we are not
;; running on DOS/Windows, the current directory may be on a
;; mounted VFAT filesystem, such as a USB memory stick.
(while (string-match "[^A-Za-z0-9_.~#+-]" buffer-name limit)
(let* ((character (aref buffer-name (match-beginning 0)))
(replacement
;; For multibyte characters, this will produce more than
;; 2 hex digits, so is not true URL encoding.
(format "%%%02X" character)))
(setq buffer-name (replace-match replacement t t buffer-name))
(setq limit (1+ (match-end 0)))))
;; Generate the file name.
(setq file-name
(make-temp-file
(let ((fname
(expand-file-name
(format "#%s#" buffer-name)
;; Try a few alternative directories, to get one we can
;; write it.
(cond
((file-writable-p default-directory) default-directory)
((file-writable-p "/var/tmp/") "/var/tmp/")
("~/")))))
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p fname)))
;; The call to convert-standard-filename is in case
;; buffer-name includes characters not allowed by the
;; DOS/Windows filesystems. make-temp-file writes to the
;; file it creates, so we must fix the file name _before_
;; make-temp-file is called.
(convert-standard-filename fname)
fname))
nil "#"))
;; make-temp-file creates the file,
;; but we don't want it to exist until we do an auto-save.
(condition-case ()
(delete-file file-name)
(file-error nil))
file-name)))
(defun files--transform-file-name (filename transforms prefix suffix)
"Transform FILENAME according to TRANSFORMS.
See `auto-save-file-name-transforms' for the format of
TRANSFORMS. PREFIX is prepended to the non-directory portion of
the resulting file name, and SUFFIX is appended."
(save-match-data
(let (result uniq)
;; Apply user-specified translations to the file name.
(while (and transforms (not result))
(if (string-match (car (car transforms)) filename)
(setq result (replace-match (cadr (car transforms)) t nil
filename)
uniq (car (cddr (car transforms)))))
(setq transforms (cdr transforms)))
(when result
(setq filename
(cond
((memq uniq (secure-hash-algorithms))
(concat
(file-name-directory result)
(secure-hash uniq filename)))
(uniq
(concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(string-replace
"!" "!!" filename))))
(t result))))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits before
;; doing anything else, because the regexp passed to
;; string-match below cannot handle extensions longer
;; than 3 characters, multiple dots, and other
;; atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
prefix (match-string 1 fn)
"." (match-string 3 fn) suffix))
(concat (file-name-directory filename)
prefix
(file-name-nondirectory filename)
suffix)))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(expand-file-name
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p result)))
(convert-standard-filename result)
result)))))
(defun make-lock-file-name (filename)
"Make a lock file name for FILENAME.
By default, this just prepends \".#\" to the non-directory part
of FILENAME, but the transforms in `lock-file-name-transforms'
are done first."
(let ((handler (find-file-name-handler filename 'make-lock-file-name)))
(if handler
(funcall handler 'make-lock-file-name filename)
(files--transform-file-name filename lock-file-name-transforms ".#" ""))))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes.
See also `make-auto-save-file-name'."
(string-match "\\`#.*#\\'" filename))
(defun wildcard-to-regexp (wildcard)
"Given a shell file name pattern WILDCARD, return an equivalent regexp.
The generated regexp will match a file name only if the file name
matches that wildcard according to shell rules. Only wildcards known
by `sh' are supported."
(let* ((i (string-match "[[.*+\\^$?]" wildcard))
;; Copy the initial run of non-special characters.
(result (substring wildcard 0 i))
(len (length wildcard)))
;; If no special characters, we're almost done.
(if i
(while (< i len)
(let ((ch (aref wildcard i))
j)
(setq
result
(concat result
(cond
((and (eq ch ?\[)
(< (1+ i) len)
(eq (aref wildcard (1+ i)) ?\]))
"\\[")
((eq ch ?\[) ; [...] maps to regexp char class
(progn
(setq i (1+ i))
(concat
(cond
((eq (aref wildcard i) ?!) ; [!...] -> [^...]
(progn
(setq i (1+ i))
(if (eq (aref wildcard i) ?\])
(progn
(setq i (1+ i))
"[^]")
"[^")))
((eq (aref wildcard i) ?^)
;; Found "[^". Insert a `\0' character
;; (which cannot happen in a filename)
;; into the character class, so that `^'
;; is not the first character after `[',
;; and thus non-special in a regexp.
(progn
(setq i (1+ i))
"[\000^"))
((eq (aref wildcard i) ?\])
;; I don't think `]' can appear in a
;; character class in a wildcard, but
;; let's be general here.
(progn
(setq i (1+ i))
"[]"))
(t "["))
(prog1 ; copy everything up to next `]'.
(substring wildcard
i
(setq j (string-search
"]" wildcard i)))
(setq i (if j (1- j) (1- len)))))))
((eq ch ?.) "\\.")
((eq ch ?*) "[^\000]*")
((eq ch ?+) "\\+")
((eq ch ?^) "\\^")
((eq ch ?$) "\\$")
((eq ch ?\\) "\\\\") ; probably cannot happen...
((eq ch ??) "[^\000]")
(t (char-to-string ch)))))
(setq i (1+ i)))))
;; Shell wildcards should match the entire filename,
;; not its part. Make the regexp say so.
(concat "\\`" result "\\'")))
(defcustom list-directory-brief-switches
(purecopy "-CF")
"Switches for `list-directory' to pass to `ls' for brief listing."
:type 'string
:group 'dired)
(defcustom list-directory-verbose-switches
(purecopy "-l")
"Switches for `list-directory' to pass to `ls' for verbose listing."
:type 'string
:group 'dired)
(defun file-expand-wildcards (pattern &optional full regexp)
"Expand (a.k.a. \"glob\") file-name wildcard pattern PATTERN.
This returns a list of file names that match PATTERN.
The returned list of file names is sorted in the `string<' order.
PATTERN is, by default, a \"glob\"/wildcard string, e.g.,
\"/tmp/*.png\" or \"/*/*/foo.png\", but can also be a regular
expression if the optional REGEXP parameter is non-nil. In any
case, the matches are applied per sub-directory, so a match can't
span a parent/sub directory, which means that a regexp bit can't
contain the \"/\" character.
The returned list of file names is sorted in the `string<' order.
If PATTERN is written as an absolute file name, the expansions in
the returned list are also absolute.
If PATTERN is written as a relative file name, it is interpreted
relative to the current `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
(save-match-data
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
;; A list of all dirs that DIRPART specifies.
;; This can be more than one dir
;; if DIRPART contains wildcards.
(dirs (if (and dirpart
(string-match "[[*?]" (file-local-name dirpart)))
(mapcar #'file-name-as-directory
(file-expand-wildcards
(directory-file-name dirpart) nil regexp))
(list dirpart)))
contents)
(dolist (dir (nreverse dirs))
(when (or (null dir) ; Possible if DIRPART is not wild.
(file-accessible-directory-p dir))
(if (equal "" nondir)
;; `nondir' is "" when the pattern ends in "/". Basically ""
;; refers to the directory itself, like ".", but it's not
;; among the names returned by `directory-files', so we have
;; to special-case it.
(push (or dir nondir) contents)
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
(mapcar (lambda (name)
(unless (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory
name))
name))
(directory-files
(or dir ".") full
(if regexp
;; We're matching each file name
;; element separately.
(concat "\\`" nondir "\\'")
(wildcard-to-regexp nondir)))))))
(setq contents
(nconc
(if (and dir (not full))
(mapcar (lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
contents))))))
contents)))
(defcustom find-sibling-rules nil
"Rules for finding \"sibling\" files.
This is used by the `find-sibling-file' command.
This variable is a list of (MATCH EXPANSION...) elements.
MATCH is a regular expression that should match a file name that
has a sibling. It can contain sub-expressions that will be used
in EXPANSIONS.
EXPANSION is a string that matches file names. For instance, to
define \".h\" files as siblings of any \".c\", you could say:
(\"\\\\([^/]+\\\\)\\\\.c\\\\\\='\" \"\\\\1.h\")
MATCH and EXPANSION can also be fuller paths. For instance, if
you want to define other versions of a project as being sibling
files, you could say something like:
(\"src/emacs/[^/]+/\\\\(.*\\\\)\\\\\\='\" \"src/emacs/.*/\\\\1\\\\\\='\")
In this example, if you're in \"src/emacs/emacs-27/lisp/abbrev.el\",
and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, it's now
defined as a sibling."
:type '(alist :key-type (regexp :tag "Match")
:value-type (repeat (string :tag "Expansion")))
:version "29.1")
(defun find-sibling-file (file)
"Visit a \"sibling\" file of FILE.
When called interactively, FILE is the currently visited file.
The \"sibling\" file is defined by the `find-sibling-rules' variable."
(interactive (progn
(unless buffer-file-name
(user-error "Not visiting a file"))
(list buffer-file-name)))
(unless find-sibling-rules
(user-error "The `find-sibling-rules' variable has not been configured"))
(let ((siblings (find-sibling-file-search (expand-file-name file)
find-sibling-rules)))
(cond
((null siblings)
(user-error "Couldn't find any sibling files"))
((length= siblings 1)
(find-file (car siblings)))
(t
(let ((relatives (mapcar (lambda (sibling)
(file-relative-name
sibling (file-name-directory file)))
siblings)))
(find-file
(completing-read (format-prompt "Find file" (car relatives))
relatives nil t nil nil (car relatives))))))))
(defun find-sibling-file-search (file &optional rules)
"Return a list of FILE's \"siblings\".
RULES should be a list on the form defined by `find-sibling-rules' (which
see), and if nil, defaults to `find-sibling-rules'."
(let ((results nil))
(pcase-dolist (`(,match . ,expansions) (or rules find-sibling-rules))
;; Go through the list and find matches.
(when (string-match match file)
(let ((match-data (match-data)))
(dolist (expansion expansions)
(let ((start 0))
;; Expand \\1 forms in the expansions.
(while (string-match "\\\\\\([&0-9]+\\)" expansion start)
(let ((index (string-to-number (match-string 1 expansion))))
(setq start (match-end 0)
expansion
(replace-match
(substring file
(elt match-data (* index 2))
(elt match-data (1+ (* index 2))))
t t expansion)))))
;; Then see which files we have that are matching. (And
;; expand from the end of the file's match, since we might
;; be doing a relative match.)
(let ((default-directory (substring file 0 (car match-data))))
;; Keep the first matches first.
(setq results
(nconc
results
(mapcar #'expand-file-name
(file-expand-wildcards expansion nil t)))))))))
;; Delete the file itself (in case it matched), and remove
;; duplicates, in case we have several expansions and some match
;; the same subsets of files.
(delete file (delete-dups results))))
;; Let Tramp know that `file-expand-wildcards' does not need an advice.
(provide 'files '(remote-wildcards))
(defun list-directory (dirname &optional verbose)
"Display a list of files in or matching DIRNAME, a la `ls'.
DIRNAME is globbed by the shell if necessary.
Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
Actions controlled by variables `list-directory-brief-switches'
and `list-directory-verbose-switches'."
(interactive
(let ((pfx current-prefix-arg))
(list (read-file-name
(if pfx "List directory (verbose): "
"List directory (brief): ")
nil default-directory
(lambda (file)
(or (file-directory-p file)
(insert-directory-wildcard-in-dir-p
(file-name-as-directory (expand-file-name file))))))
pfx)))
(let ((switches (if verbose list-directory-verbose-switches
list-directory-brief-switches))
buffer)
(or dirname (setq dirname default-directory))
(setq dirname (expand-file-name dirname))
(with-output-to-temp-buffer "*Directory*"
(setq buffer standard-output)
(buffer-disable-undo standard-output)
(princ "Directory ")
(princ dirname)
(terpri)
(with-current-buffer "*Directory*"
(let ((wildcard (not (file-directory-p dirname))))
(insert-directory dirname switches wildcard (not wildcard)))))
;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
(with-current-buffer buffer
(setq default-directory
(if (file-accessible-directory-p dirname)
(file-name-as-directory dirname)
(file-name-directory (directory-file-name dirname)))))))
(defun shell-quote-wildcard-pattern (pattern)
"Quote characters special to the shell in PATTERN, leave wildcards alone.
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern that don't include wildcard characters are
quoted with double quotes.
This function leaves alone existing quote characters (\\ on Unix and \"
on Windows), so PATTERN can use them to quote wildcard characters that
need to be passed verbatim to shell commands."
(save-match-data
(cond
((memq system-type '(ms-dos windows-nt cygwin))
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
(if (or (string-search "\"" pattern)
;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
;; passing arguments to batch files that use positional
;; arguments like %1.
(not (string-match "[ \t;&()#$`',=+]" pattern)))
pattern
(let ((result "\"")
(beg 0)
end)
(while (string-match "[*?]+" pattern beg)
(setq end (match-beginning 0)
result (concat result (substring pattern beg end)
"\""
(substring pattern end (match-end 0))
"\"")
beg (match-end 0)))
(concat result (substring pattern beg) "\""))))
(t
(let ((beg 0))
(while (string-match "[ \t\n;<>&|()`'\"#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
(substring pattern (match-beginning 0)))
beg (1+ (match-end 0)))))
pattern))))
(defcustom insert-directory-program
(if (and (memq system-type '(berkeley-unix darwin))
(executable-find "gls"))
(purecopy "gls")
(purecopy "ls"))
"Absolute or relative name of the `ls'-like program.
This is used by `insert-directory' and `dired-insert-directory'
\(thus, also by `dired'). For Dired, this should ideally point to
GNU ls, or another version of ls that supports the \"--dired\"
flag. See `dired-use-ls-dired'.
On GNU/Linux and other capable systems, the default is \"ls\".
On *BSD and macOS systems, the default \"ls\" does not support
the \"--dired\" flag. Therefore, the default is to use the
\"gls\" executable on such machines, if it exists. This means
that there should normally be no need to customize this when
installing GNU coreutils using something like ports or Homebrew."
:group 'dired
:type 'string
:initialize #'custom-initialize-delay
:version "30.1")
(defun files--use-insert-directory-program-p ()
"Return non-nil if we should use `insert-directory-program'.
Return nil if we should prefer `ls-lisp' instead."
;; FIXME: Should we also check `file-accessible-directory-p' so we
;; automatically redirect to ls-lisp when operating on magic file names?
(and (if (boundp 'ls-lisp-use-insert-directory-program)
ls-lisp-use-insert-directory-program
t)
insert-directory-program))
(defcustom directory-free-space-program (purecopy "df")
"Program to get the amount of free space on a file system.
We assume the output has the format of `df'.
The value of this variable must be just a command name or file name;
if you want to specify options, use `directory-free-space-args'.
A value of nil disables this feature."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
(make-obsolete-variable 'directory-free-space-program
"ignored, as Emacs uses `file-system-info' instead"
"27.1")
(defcustom directory-free-space-args
(purecopy (if (eq system-type 'darwin) "-k" "-Pk"))
"Options to use when running `directory-free-space-program'."
:type 'string
:group 'dired)
(make-obsolete-variable 'directory-free-space-args
"ignored, as Emacs uses `file-system-info' instead"
"27.1")
(defun get-free-disk-space (dir)
"String describing the amount of free space on DIR's file system.
If DIR's free space cannot be obtained, this function returns nil."
(save-match-data
(let ((avail (nth 2 (file-system-info dir))))
(if avail
(funcall byte-count-to-string-function avail)))))
(defvar directory-listing-before-filename-regexp
(let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
(l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
;; In some locales, month abbreviations are as short as 2 letters,
;; and they can be followed by ".".
;; In Breton, a month name can include a quote character.
(month (concat l-or-quote l-or-quote "+\\.?"))
(s " ")
(yyyy "[0-9][0-9][0-9][0-9]")
(dd "[ 0-3][0-9]")
(HH:MM "[ 0-2][0-9][:.][0-5][0-9]")
(seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
(zone "[-+][0-2][0-9][0-5][0-9]")
(iso-mm-dd "[01][0-9]-[0-3][0-9]")
(iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
(iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
"\\|" yyyy "-" iso-mm-dd "\\)"))
(western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
s "+"
"\\(" HH:MM "\\|" yyyy "\\)"))
(western-comma (concat month s "+" dd "," s "+" yyyy))
;; This represents the date in strftime(3) format "%e-%b-%Y"
;; (aka "%v"), as it is the default for many ls incarnations.
(DD-MMM-YYYY (concat dd "-" month "-" yyyy s HH:MM))
;; Japanese MS-Windows ls-lisp has one-digit months, and
;; omits the Kanji characters after month and day-of-month.
;; On Mac OS X 10.3, the date format in East Asian locales is
;; day-of-month digits followed by month digits.
(mm "[ 0-1]?[0-9]")
(east-asian
(concat "\\(" mm l "?" s dd l "?" s "+"
"\\|" dd s mm s "+" "\\)"
"\\(" HH:MM "\\|" yyyy l "?" "\\)")))
;; The "[0-9]" below requires the previous column to end in a digit.
;; This avoids recognizing `1 may 1997' as a date in the line:
;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
;; The "[BkKMGTPEZYRQ]?" below supports "ls -alh" output.
;; For non-iso date formats, we add the ".*" in order to find
;; the last possible match. This avoids recognizing
;; `jservice 10 1024' as a date in the line:
;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
;; vc dired listings provide the state or blanks between file
;; permissions and date. The state is always surrounded by
;; parentheses:
;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el
;; This is not supported yet.
(purecopy (concat "\\([0-9][BkKMGTPEZYRQ]? " iso
"\\|.*[0-9][BkKMGTPEZYRQ]? "
"\\(" western "\\|" western-comma
"\\|" DD-MMM-YYYY "\\|" east-asian "\\)"
"\\) +")))
"Regular expression to match up to the file name in a directory listing.
The default value is designed to recognize dates and times
regardless of the language.")
(defvar insert-directory-ls-version 'unknown)
(defun insert-directory-wildcard-in-dir-p (dir)
"Return non-nil if DIR contains shell wildcards in its parent directory part.
The return value is a cons (DIRECTORY . WILDCARD), where DIRECTORY is the
part of DIR up to and excluding the first component that includes
wildcard characters, and WILDCARD is the rest of DIR's components. The
DIRECTORY part of the value includes the trailing slash, to indicate that
it is a directory.
Valid wildcards are `*', `?', `[abc]' and `[a-z]'."
(let ((wildcards "[?*"))
(when (and (or (not (featurep 'ls-lisp))
ls-lisp-support-shell-wildcards)
(string-match (concat "[" wildcards "]") (file-name-directory dir))
(not (file-exists-p dir))) ; Prefer an existing file to wildcards.
(let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)"
wildcards wildcards wildcards)))
(string-match regexp dir)
(cons (match-string 1 dir) (match-string 2 dir))))))
(defun insert-directory-clean (beg switches)
(when (if (stringp switches)
(string-match "--dired\\>" switches)
(member "--dired" switches))
;; The following overshoots by one line for an empty
;; directory listed with "--dired", but without "-a"
;; switch, where the ls output contains a
;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
;; We take care of that case later.
(forward-line -2)
(when (looking-at "//SUBDIRED//")
(delete-region (point) (progn (forward-line 1) (point)))
(forward-line -1))
(if (looking-at "//DIRED//")
(let ((end (line-end-position))
(linebeg (point))
error-lines)
;; Find all the lines that are error messages,
;; and record the bounds of each one.
(goto-char beg)
(while (< (point) linebeg)
(or (eql (following-char) ?\s)
(push (list (point) (line-end-position)) error-lines))
(forward-line 1))
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
(forward-word-strictly 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines))
(end (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines)))
(if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|))
;; End is followed by \n or by output of -F.
(put-text-property start end 'dired-filename t)
;; It seems that we can't trust ls's output as to
;; byte positions of filenames.
(put-text-property beg (point) 'dired-filename nil)
(end-of-line))))
(goto-char end)
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point))))
;; Take care of the case where the ls output contains a
;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
;; and we went one line too far back (see above).
(forward-line 1))
(if (looking-at "//DIRED-OPTIONS//")
(delete-region (point) (progn (forward-line 1) (point))))))
;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; FULL-DIRECTORY-P is nil.
;; The single line of output must display FILE's name as it was
;; given, namely, an absolute path name.
;; - must insert exactly one line for each file if WILDCARD or
;; FULL-DIRECTORY-P is t, plus one optional "total" line
;; before the file lines, plus optional text after the file lines.
;; Lines are delimited by "\n", so filenames containing "\n" are not
;; allowed.
;; File lines should display the basename.
;; - must be consistent with
;; - functions dired-move-to-filename, (these two define what a file line is)
;; dired-move-to-end-of-filename,
;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
;; dired-insert-headerline
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
;; - may be passed "--dired" as the first argument in SWITCHES.
;; File name handlers might have to remove this switch if their
;; "ls" command does not support it.
(defun insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings
representing individual options.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
Depending on the value of `ls-lisp-use-insert-directory-program'
this works either using a Lisp emulation of the \"ls\" program
or by running a directory listing program
whose name is in the variable `insert-directory-program'
\(and if WILDCARD, it also runs the shell specified by `shell-file-name').
When SWITCHES contains the long `--dired' option, this function
treats it specially, for the sake of dired. However, the
normally equivalent short `-D' option is just passed on to
`insert-directory-program', as any other option."
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory)))
(cond
(handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p))
((not (files--use-insert-directory-program-p))
(require 'ls-lisp)
(declare-function ls-lisp--insert-directory "ls-lisp")
(ls-lisp--insert-directory file switches wildcard full-directory-p))
(t
(let (result (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; RESULT gets the status code.
(let* (;; We at first read by no-conversion, then after
;; putting text property `dired-filename, decode one
;; bunch by one to preserve that property.
(coding-system-for-read 'no-conversion)
;; This is to control encoding the arguments in call-process.
(coding-system-for-write
(and enable-multibyte-characters
(or file-name-coding-system
default-file-name-coding-system))))
(setq result
(if wildcard
;; If the wildcard is just in the file part, then run ls in
;; the directory part of the file pattern using the last
;; component as argument. Otherwise, run ls in the longest
;; subdirectory of the directory part free of wildcards; use
;; the remaining of the file pattern as argument.
(let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
(default-directory
(cond (dir-wildcard (car dir-wildcard))
(t
(if (file-name-absolute-p file)
(file-name-directory file)
(file-name-directory (expand-file-name file))))))
(pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
;; NB since switches is passed to the shell, be
;; careful of malicious values, eg "-l;reboot".
;; See eg dired-safe-switches-p.
(call-process
shell-file-name nil t nil
shell-command-switch
(concat (if (memq system-type '(ms-dos windows-nt))
""
"\\") ; Disregard Unix shell aliases!
insert-directory-program
" -d "
;; Quote switches that require quoting
;; such as "--block-size='1". But don't
;; quote switches that use patterns
;; such as "--ignore=PATTERN" (bug#71935).
(mapconcat #'shell-quote-wildcard-pattern
(if (stringp switches)
(split-string-and-unquote switches)
switches)
" ")
" -- "
;; Quote some characters that have
;; special meanings in shells; but
;; don't quote the wildcards--we want
;; them to be special. We also
;; currently don't quote the quoting
;; characters in case people want to
;; use them explicitly to quote
;; wildcard characters.
(shell-quote-wildcard-pattern pattern))))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
(unless full-directory-p
(setq switches
(cond
((stringp switches) (concat switches " -d"))
((member "-d" switches) switches)
(t (append switches '("-d"))))))
(if (string-match "\\`~" file)
(setq file (expand-file-name file)))
(apply #'call-process
insert-directory-program nil t nil
(append
(if (listp switches) switches
(unless (equal switches "")
;; Split the switches at any spaces so we can
;; pass separate options as separate args.
(split-string-and-unquote switches)))
;; Avoid lossage if FILE starts with `-'.
'("--")
(list file))))))
;; If we got "//DIRED//" in the output, it means we got a real
;; directory listing, even if `ls' returned nonzero.
;; So ignore any errors.
(when (if (stringp switches)
(string-match "--dired\\>" switches)
(member "--dired" switches))
(save-excursion
(forward-line -2)
(when (looking-at "//SUBDIRED//")
(forward-line -1))
(if (looking-at "//DIRED//")
(setq result 0))))
(when (and (not (eq 0 result))
(eq insert-directory-ls-version 'unknown))
;; The first time ls returns an error,
;; find the version numbers of ls,
;; and set insert-directory-ls-version
;; to > if it is more than 5.2.1, < if it is less, nil if it
;; is equal or if the info cannot be obtained.
;; (That can mean it isn't GNU ls.)
(let ((version-out
(with-temp-buffer
(call-process "ls" nil t nil "--version")
(buffer-string))))
(setq insert-directory-ls-version
(if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
(let* ((version (match-string 1 version-out))
(split (split-string version "[.]"))
(numbers (mapcar #'string-to-number split))
(min '(5 2 1))
comparison)
(while (and (not comparison) (or numbers min))
(cond ((null min)
(setq comparison #'>))
((null numbers)
(setq comparison #'<))
((> (car numbers) (car min))
(setq comparison #'>))
((< (car numbers) (car min))
(setq comparison #'<))
(t
(setq numbers (cdr numbers)
min (cdr min)))))
(or comparison #'=))
nil))))
;; For GNU ls versions 5.2.2 and up, ignore minor errors.
(when (and (eq 1 result) (eq insert-directory-ls-version #'>))
(setq result 0))
;; If `insert-directory-program' failed, signal an error.
(unless (eq 0 result)
;; Delete the error message it may have output.
(delete-region beg (point))
;; On non-Posix systems, we cannot open a directory, so
;; don't even try, because that will always result in
;; the ubiquitous "Access denied". Instead, show the
;; command line so the user can try to guess what went wrong.
(if (and (file-directory-p file)
(memq system-type '(ms-dos windows-nt)))
(error
"Reading directory: \"%s %s -- %s\" exited with status %s"
insert-directory-program
(if (listp switches) (concat switches) switches)
file result)
;; Unix. Access the file to get a suitable error.
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
(insert-directory-clean beg switches)
;; Now decode what read if necessary.
(let ((coding (or coding-system-for-read
file-name-coding-system
default-file-name-coding-system
'undecided))
coding-no-eol
val pos)
(when (and enable-multibyte-characters
(not (memq (coding-system-base coding)
'(raw-text no-conversion))))
;; If no coding system is specified or detection is
;; requested, detect the coding.
(if (eq (coding-system-base coding) 'undecided)
(setq coding (detect-coding-region beg (point) t)))
(if (not (eq (coding-system-base coding) 'undecided))
(save-restriction
(setq coding-no-eol
(coding-system-change-eol-conversion coding 'unix))
(narrow-to-region beg (point))
(goto-char (point-min))
(while (not (eobp))
(setq pos (point)
val (get-text-property (point) 'dired-filename))
(goto-char (next-single-property-change
(point) 'dired-filename nil (point-max)))
;; Force no eol conversion on a file name, so
;; that CR is preserved.
(decode-coding-region pos (point)
(if val coding-no-eol coding))
(if val
(put-text-property pos (point)
'dired-filename t))))))))))))
(defun insert-directory-adj-pos (pos error-lines)
"Convert `ls --dired' file name position value POS to a buffer position.
File name position values returned in ls --dired output
count only stdout; they don't count the error messages sent to stderr.
So this function converts to them to real buffer positions.
ERROR-LINES is a list of buffer positions of error message lines,
of the form (START END)."
(while (and error-lines (< (caar error-lines) pos))
(setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
(pop error-lines))
pos)
(defun insert-directory-safely (file switches
&optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Like `insert-directory', but if FILE does not exist, it inserts a
message to that effect instead of signaling an error."
(if (file-exists-p file)
(insert-directory file switches wildcard full-directory-p)
;; Simulate the message printed by `ls'.
(insert (format "%s: No such file or directory\n" file))))
(defcustom kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is canceled.
`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
the low level primitive, does not. See also `kill-emacs-hook'."
:type 'hook
:version "26.1"
:group 'convenience)
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
If nil, the default, don't ask at all. If the value is non-nil, it should
be a predicate function; for example `yes-or-no-p'."
:type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
(const :tag "Ask with y-or-n-p" y-or-n-p)
(const :tag "Don't confirm" nil)
(function :tag "Predicate function"))
:group 'convenience
:version "21.1")
(defcustom confirm-kill-processes t
"Non-nil if Emacs should confirm killing processes on exit.
If this variable is nil, the value of
`process-query-on-exit-flag' is ignored. Otherwise, if there are
processes with a non-nil `process-query-on-exit-flag', Emacs will
prompt the user before killing them."
:type 'boolean
:group 'convenience
:version "26.1")
(defun save-buffers-kill-emacs (&optional arg restart)
"Offer to save each buffer, then kill this Emacs process.
With prefix ARG, silently save all file-visiting buffers without asking.
If there are active processes where `process-query-on-exit-flag'
returns non-nil and `confirm-kill-processes' is non-nil,
asks whether processes should be killed.
Runs the members of `kill-emacs-query-functions' in turn and stops
if any returns nil. If `confirm-kill-emacs' is non-nil, calls it.
If RESTART, restart Emacs after killing the current Emacs process."
(interactive "P")
;; Don't use save-some-buffers-default-predicate, because we want
;; to ask about all the buffers before killing Emacs.
(when (or (files--buffers-needing-to-be-saved t)
(catch 'need-save
(dolist (func save-some-buffers-functions)
(when (funcall func 'query)
(throw 'need-save t)))))
(if (use-dialog-box-p)
(pcase (x-popup-dialog
t `("Unsaved Buffers"
("Close Without Saving" . no-save)
("Save All" . save-all)
("Cancel" . cancel)))
('cancel (user-error "Exit canceled"))
('save-all (save-some-buffers t)))
(save-some-buffers arg t)))
(let ((confirm confirm-kill-emacs))
(and
(or (not (memq t (mapcar (lambda (buf)
(and (buffer-file-name buf)
(buffer-modified-p buf)))
(buffer-list))))
(progn (setq confirm nil)
(yes-or-no-p "Modified buffers exist; exit anyway? ")))
(or (not (fboundp 'process-list))
;; process-list is not defined on MSDOS.
(not confirm-kill-processes)
(let ((processes (process-list))
active)
(while processes
(and (memq (process-status (car processes)) '(run stop open listen))
(process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
(with-current-buffer-window
(get-buffer-create "*Process List*")
`(display-buffer--maybe-at-bottom
(dedicated . t)
(window-height . fit-window-to-buffer)
(preserve-size . (nil . t))
(body-function
. ,#'(lambda (_window)
(list-processes t))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(progn
(setq confirm nil)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))
(when (window-live-p window)
(quit-restore-window window 'kill)))))))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm)
(funcall confirm "Really exit Emacs? "))
(kill-emacs nil restart))))
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
If the current frame has no client, kill Emacs itself using
`save-buffers-kill-emacs'.
With prefix ARG, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of file names to edit, then
only these files will be asked to be saved."
(interactive "P")
(if (frame-parameter nil 'client)
(server-save-buffers-kill-terminal arg)
(save-buffers-kill-emacs arg)))
(defun restart-emacs ()
"Kill the current Emacs process and start a new one.
This goes through the same shutdown procedure as
`save-buffers-kill-emacs', but instead of killing Emacs and
exiting, it re-executes Emacs (using the same command line
arguments as the running Emacs)."
(interactive)
(save-buffers-kill-emacs nil t))
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
(setq file-name-handler-alist
(cons (cons (purecopy "\\`/:") 'file-name-non-special)
file-name-handler-alist))
;; We depend on being the last handler on the list,
;; so that anything else that does need handling
;; has been handled already.
;; So it is safe for us to inhibit *all* magic file name handlers for
;; operations, which return a file name. See Bug#29579.
(defun file-name-non-special (operation &rest arguments)
(let ((inhibit-file-name-handlers
(cons 'file-name-non-special
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation)
;; Some operations respect file name handlers in
;; `default-directory'. Because core function like
;; `call-process' don't care about file name handlers in
;; `default-directory', we here have to resolve the directory
;; into a local one. For `process-file',
;; `start-file-process', and `shell-command', this fixes
;; Bug#25949.
(default-directory
(if (memq operation
'(insert-directory process-file start-file-process
make-process shell-command
temporary-file-directory))
(directory-file-name
(expand-file-name
(unhandled-file-name-directory default-directory)))
default-directory))
;; Get a list of the indices of the args that are file names.
(file-arg-indices
(cdr (or (assq operation
'(;; The first seven are special because they
;; return a file name. We want to include
;; the /: in the return value. So just
;; avoid stripping it in the first place.
(abbreviate-file-name)
(directory-file-name)
(file-name-as-directory)
(file-name-directory)
(file-name-sans-versions)
(file-remote-p)
(find-backup-file-name)
;; `identity' means just return the first
;; arg not stripped of its quoting.
(substitute-in-file-name identity)
;; `expand-file-name' shall do special case
;; for the first argument starting with
;; "/:~". (Bug#65685)
(expand-file-name expand-file-name)
;; `add' means add "/:" to the result.
(file-truename add 0)
;;`insert-file-contents' needs special handling.
(insert-file-contents insert-file-contents 0)
;; `unquote-then-quote' means set buffer-file-name
;; temporarily to unquoted filename.
(verify-visited-file-modtime unquote-then-quote)
;; Unquote `buffer-file-name' temporarily.
(make-auto-save-file-name buffer-file-name)
(set-visited-file-modtime buffer-file-name)
;; Use a temporary local copy.
(copy-file local-copy)
(rename-file local-copy)
(copy-directory local-copy)
;; List the arguments that are filenames.
(file-name-completion 0 1)
(file-name-all-completions 0 1)
(file-equal-p 0 1)
(file-newer-than-file-p 0 1)
(write-region 2 5)
(file-in-directory-p 0 1)
(make-symbolic-link 0 1)
(add-name-to-file 0 1)
;; These file-notify-* operations take a
;; descriptor.
(file-notify-rm-watch)
(file-notify-valid-p)
;; `make-process' uses keyword arguments and
;; doesn't mangle its filenames in any way.
;; It already strips /: from the binary
;; filename, so we don't have to do this
;; here.
(make-process)))
;; For all other operations, treat the first
;; argument only as the file name.
'(nil 0))))
method
;; Copy ARGUMENTS so we can replace elements in it.
(arguments (copy-sequence arguments)))
(if (symbolp (car file-arg-indices))
(setq method (pop file-arg-indices)))
;; Strip off the /: from the file names that have it.
(save-match-data ;FIXME: Why?
(while (consp file-arg-indices)
(let ((pair (nthcdr (car file-arg-indices) arguments)))
(when (car pair)
(setcar pair (file-name-unquote (car pair) t))))
(setq file-arg-indices (cdr file-arg-indices))))
;; In general, we don't want any file name handler, see Bug#47625,
;; Bug#48349. For some few cases, operations with two file name
;; arguments which might be bound to different file name handlers,
;; we still need this.
(let ((tramp-mode (and tramp-mode (eq method 'local-copy))))
(pcase method
('identity (car arguments))
('expand-file-name
(when (string-prefix-p "/:~" (car arguments))
(setcar arguments (file-name-unquote (car arguments) t)))
(apply operation arguments))
('add (file-name-quote (apply operation arguments) t))
('buffer-file-name
(let ((buffer-file-name (file-name-unquote buffer-file-name t)))
(apply operation arguments)))
('insert-file-contents
(let ((visit (nth 1 arguments)))
(unwind-protect
(apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (file-name-quote buffer-file-name t))))))
('unquote-then-quote
;; We can't use `cl-letf' with `(buffer-local-value)' here
;; because it wouldn't work during bootstrapping.
(let ((buffer (current-buffer)))
;; `unquote-then-quote' is used only for the
;; `verify-visited-file-modtime' action, which takes a
;; buffer as only optional argument.
(with-current-buffer (or (car arguments) buffer)
(let ((buffer-file-name (file-name-unquote buffer-file-name t)))
;; Make sure to hide the temporary buffer change from
;; the underlying operation.
(with-current-buffer buffer
(apply operation arguments))))))
('local-copy
(let ((source (car arguments))
(target (car (cdr arguments)))
(prefix (expand-file-name
"file-name-non-special" temporary-file-directory))
tmpfile)
(cond
;; If source is remote, we must create a local copy.
((file-remote-p source)
(setq tmpfile (make-temp-name prefix))
(apply operation source tmpfile (cddr arguments))
(setq source tmpfile))
;; If source is quoted, and the unquoted source looks
;; remote, we must create a local copy.
((file-name-quoted-p source t)
(setq source (file-name-unquote source t))
(when (file-remote-p source)
(setq tmpfile (make-temp-name prefix))
(let (file-name-handler-alist)
(apply operation source tmpfile (cddr arguments)))
(setq source tmpfile))))
;; If target is quoted, and the unquoted target looks
;; remote, we must disable the file name handler.
(when (file-name-quoted-p target t)
(setq target (file-name-unquote target t))
(when (file-remote-p target)
(setq file-name-handler-alist nil)))
;; Do it.
(setcar arguments source)
(setcar (cdr arguments) target)
(apply operation arguments)
;; Cleanup.
(when (and tmpfile (file-exists-p tmpfile))
(if (file-directory-p tmpfile)
(delete-directory tmpfile 'recursive) (delete-file tmpfile)))))
(_
(apply operation arguments))))))
;;;###autoload
(defsubst file-name-quoted-p (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(string-prefix-p "/:" (file-local-name name))))
(defsubst file-name-quote (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
If NAME is a remote file name and TOP is nil, the local part of
NAME is quoted. If NAME is already a quoted file name, NAME is
returned unchanged."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (file-name-quoted-p name top)
name
(concat (file-remote-p name) "/:" (file-local-name name)))))
(defsubst file-name-unquote (name &optional top)
"Remove quotation prefix \"/:\" from file NAME, if any.
If NAME is a remote file name and TOP is nil, the local part of
NAME is unquoted."
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
(localname (file-local-name name)))
(when (file-name-quoted-p localname top)
(setq
localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))
;; Symbolic modes and read-file-modes.
(defun file-modes-char-to-who (char)
"Convert CHAR to a numeric bit-mask for extracting mode bits.
CHAR is in [ugoa] and represents the category of users (Owner, Group,
Others, or All) for whom to produce the mask.
The bit-mask that is returned extracts from mode bits the access rights
for the specified category of users."
(cond ((eq char ?u) #o4700)
((eq char ?g) #o2070)
((eq char ?o) #o1007)
((eq char ?a) #o7777)
(t (error "%c: Bad `who' character" char))))
(defun file-modes-char-to-right (char &optional from)
"Convert CHAR to a numeric value of mode bits.
CHAR is in [rwxXstugo] and represents symbolic access permissions.
If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
(or from (setq from 0))
(cond ((eq char ?r) #o0444)
((eq char ?w) #o0222)
((eq char ?x) #o0111)
((eq char ?s) #o6000)
((eq char ?t) #o1000)
;; Rights relative to the previous file modes.
((eq char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((eq char ?u) (let ((uright (logand #o4700 from)))
;; FIXME: These divisions/shifts seem to be right
;; for the `7' part of the #o4700 mask, but not
;; for the `4' part. Same below for `g' and `o'.
(+ uright (/ uright #o10) (/ uright #o100))))
((eq char ?g) (let ((gright (logand #o2070 from)))
(+ gright (/ gright #o10) (* gright #o10))))
((eq char ?o) (let ((oright (logand #o1007 from)))
(+ oright (* oright #o10) (* oright #o100))))
(t (error "%c: Bad right character" char))))
(defun file-modes-rights-to-number (rights who-mask &optional from)
"Convert a symbolic mode string specification to an equivalent number.
RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]*)+\".
WHO-MASK is the bit-mask specifying the category of users to which to
apply the access permissions. See `file-modes-char-to-who'.
FROM (or 0 if nil) gives the mode bits on which to base permissions if
RIGHTS request to add, remove, or set permissions based on existing ones,
as in \"og+rX-w\"."
(let* ((num-rights (or from 0))
(list-rights (string-to-list rights))
(op (pop list-rights)))
(while (memq op '(?+ ?- ?=))
(let ((num-right 0)
char-right)
(while (memq (setq char-right (pop list-rights))
'(?r ?w ?x ?X ?s ?t ?u ?g ?o))
(setq num-right
(logior num-right
(file-modes-char-to-right char-right num-rights))))
(setq num-right (logand who-mask num-right)
num-rights
(cond ((= op ?+) (logior num-rights num-right))
((= op ?-) (logand num-rights (lognot num-right)))
(t (logior (logand num-rights (lognot who-mask)) num-right)))
op char-right)))
num-rights))
(defun file-modes-number-to-symbolic (mode &optional filetype)
"Return a description of a file's MODE as a string of 10 letters and dashes.
The returned string is like the mode description produced by \"ls -l\".
For instance, if MODE is #o700, then it produces `-rwx------'.
Note that this is NOT the same as the \"chmod\" style symbolic description
accepted by `file-modes-symbolic-to-number'.
FILETYPE, if provided, should be a character denoting the type of file,
such as `?d' for a directory, or `?l' for a symbolic link, and will override
the leading `-' character."
(string
(or filetype
(pcase (ash mode -12)
;; POSIX specifies that the file type is included in st_mode
;; and provides names for the file types but values only for
;; the permissions (e.g., S_IWOTH=2).
;; (#o017 ??) ;; #define S_IFMT 00170000
(#o014 ?s) ;; #define S_IFSOCK 0140000
(#o012 ?l) ;; #define S_IFLNK 0120000
;; (8 ??) ;; #define S_IFREG 0100000
(#o006 ?b) ;; #define S_IFBLK 0060000
(#o004 ?d) ;; #define S_IFDIR 0040000
(#o002 ?c) ;; #define S_IFCHR 0020000
(#o001 ?p) ;; #define S_IFIFO 0010000
(_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
(if (zerop (logand 2048 mode)) ?- ?S)
(if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
(if (zerop (logand 1024 mode)) ?- ?S)
(if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 512 mode))
(if (zerop (logand 1 mode)) ?- ?x)
(if (zerop (logand 1 mode)) ?T ?t))))
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match
\"[ugoa]*([+=-][rwxXstugo]*)+,...\".
See Info node `(coreutils)File permissions' for more information on this
notation.
FROM (or 0 if nil) gives the mode bits on which to base permissions if
MODES request to add, remove, or set permissions based on existing ones,
as in \"og+rX-w\"."
(save-match-data
(let ((case-fold-search nil)
(num-modes (or from 0)))
(while (/= (string-to-char modes) 0)
(if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]*\\)+\\(,\\|\\)" modes)
(let ((num-who (apply 'logior 0
(mapcar 'file-modes-char-to-who
(match-string 1 modes)))))
(when (= num-who 0)
(setq num-who (logior #o7000 (default-file-modes))))
(setq num-modes
(file-modes-rights-to-number (substring modes (match-end 1))
num-who num-modes)
modes (substring modes (match-end 3))))
(error "Parse error in modes near `%s'" (substring modes 0))))
num-modes)))
(defun read-file-modes (&optional prompt orig-file)
"Read file modes in octal or symbolic notation and return its numeric value.
PROMPT is used as the prompt, default to \"File modes (octal or symbolic): \".
ORIG-FILE is the name of a file on whose mode bits to base returned
permissions if what user types requests to add, remove, or set permissions
based on existing mode bits, as in \"og+rX-w\"."
(let* ((modes (or (if orig-file (file-modes orig-file) 0)
(error "File not found")))
(modestr (and (stringp orig-file)
(file-attribute-modes (file-attributes orig-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
(string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
(match-string 2 modestr)
(match-string 3 modestr)))))
(value (read-string (or prompt "File modes (octal or symbolic): ")
nil nil default)))
(save-match-data
(if (string-match "^[0-7]+" value)
(string-to-number value 8)
(file-modes-symbolic-to-number value modes)))))
(define-obsolete-variable-alias 'cache-long-line-scans
'cache-long-scans "24.4")
;; Trashcan handling.
(defcustom trash-directory nil
"Directory for `move-file-to-trash' to move files and directories to.
This directory is used only when the function `system-move-file-to-trash'
is not defined.
Relative paths are interpreted relative to `default-directory'.
If the value is nil, Emacs uses a freedesktop.org-style trashcan."
:type '(choice (const nil) directory)
:group 'auto-save
:version "23.2")
(defvar trash--hexify-table)
(declare-function system-move-file-to-trash "w32fns.c" (filename))
(defun move-file-to-trash (filename)
"Move the file (or directory) named FILENAME to the trash.
When `delete-by-moving-to-trash' is non-nil, this function is
called by `delete-file' and `delete-directory' instead of
deleting files outright.
If the function `system-move-file-to-trash' is defined, call it
with FILENAME as an argument.
Otherwise, if `trash-directory' is non-nil, move FILENAME to that
directory.
Otherwise, trash FILENAME using the freedesktop.org conventions,
like the GNOME, KDE and XFCE desktop environments. Emacs moves
files only to \"home trash\", ignoring per-volume trashcans."
(interactive "fMove file to trash: ")
;; If `system-move-file-to-trash' is defined, use it.
(cond ((fboundp 'system-move-file-to-trash)
(system-move-file-to-trash filename))
((connection-local-value trash-directory)
;; If `trash-directory' is non-nil, move the file there.
(let* ((trash-dir (expand-file-name
(connection-local-value trash-directory)))
(fn (directory-file-name (expand-file-name filename)))
(new-fn (concat (file-name-as-directory trash-dir)
(file-name-nondirectory fn))))
;; We can't trash a parent directory of trash-directory.
(if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
trash-dir filename))
(unless (file-directory-p trash-dir)
(make-directory trash-dir t))
;; Ensure that the trashed file-name is unique.
(if (file-attributes new-fn)
(let ((version-control t)
(backup-directory-alist nil))
(setq new-fn (car (find-backup-file-name new-fn)))))
(let (delete-by-moving-to-trash)
(rename-file fn new-fn))))
;; Otherwise, use the freedesktop.org method, as specified at
;; https://freedesktop.org/wiki/Specifications/trash-spec
(t
(let* ((xdg-data-dir
(directory-file-name
(expand-file-name "Trash"
(or (getenv "XDG_DATA_HOME")
"~/.local/share"))))
(trash-files-dir (expand-file-name "files" xdg-data-dir))
(trash-info-dir (expand-file-name "info" xdg-data-dir))
(fn (directory-file-name (expand-file-name filename))))
;; Check if we have permissions to delete.
(unless (file-writable-p (directory-file-name
(file-name-directory fn)))
(error "Cannot move %s to trash: Permission denied" filename))
;; The trashed file cannot be the trash dir or its parent.
(if (string-prefix-p fn trash-files-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-files-dir filename))
(if (string-prefix-p fn trash-info-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-info-dir filename))
;; Ensure that the trash directory exists; otherwise, create it.
(with-file-modes #o700
(unless (file-exists-p trash-files-dir)
(make-directory trash-files-dir t))
(unless (file-exists-p trash-info-dir)
(make-directory trash-info-dir t)))
;; Try to move to trash with .trashinfo undo information
(save-excursion
(with-temp-buffer
(set-buffer-file-coding-system 'utf-8-unix)
(insert "[Trash Info]\nPath=")
;; Perform url-encoding on FN. For compatibility with
;; other programs (e.g. XFCE Thunar), allow literal "/"
;; for path separators.
(unless (boundp 'trash--hexify-table)
(setq trash--hexify-table (make-vector 256 nil))
(let ((unreserved-chars
(list ?/ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A
?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O
?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2
?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?_ ?. ?! ?~ ?* ?'
?\( ?\))))
(dotimes (byte 256)
(aset trash--hexify-table byte
(if (memq byte unreserved-chars)
(char-to-string byte)
(format "%%%02x" byte))))))
(mapc (lambda (byte)
(insert (aref trash--hexify-table byte)))
(if (multibyte-string-p fn)
(encode-coding-string fn 'utf-8)
fn))
(insert "\nDeletionDate="
(format-time-string "%Y-%m-%dT%T")
"\n")
;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0.
(let* ((files-base (file-name-nondirectory fn))
(is-directory (and (file-directory-p fn)
(not (file-symlink-p fn))))
(overwrite nil)
info-fn)
;; We're checking further down whether the info file
;; exists, but the file name may exist in the trash
;; directory even if there is no info file for it.
(when (file-attributes
(file-name-concat trash-files-dir files-base))
(setq overwrite t
files-base (file-name-nondirectory
(make-temp-file
(file-name-concat
trash-files-dir files-base)
is-directory))))
(setq info-fn (file-name-concat
trash-info-dir
(concat files-base ".trashinfo")))
;; Re-check the existence (sort of).
(condition-case nil
(write-region nil nil info-fn nil 'quiet info-fn 'excl)
(file-already-exists
;; Uniquify new-fn. Some file managers do not
;; like Emacs-style backup file names. E.g.:
;; https://bugs.kde.org/170956
(setq info-fn (make-temp-file
(file-name-concat trash-info-dir files-base)
nil ".trashinfo"))
(setq files-base (substring (file-name-nondirectory info-fn)
0 (- (length ".trashinfo"))))
(write-region nil nil info-fn nil 'quiet info-fn)))
;; Finally, try to move the item to the trashcan. If
;; it's a file, just move it. Things are more
;; complicated for directories. If the target
;; directory already exists (due to uniquification)
;; and the trash directory is in a different
;; filesystem, rename-file will error out, even when
;; 'overwrite' is non-nil. Rather than worry about
;; whether we're crossing filesystems, just check if
;; we've moving a directory and the target directory
;; already exists. That handles both the
;; same-filesystem and cross-filesystem cases.
(let ((delete-by-moving-to-trash nil)
(new-fn (file-name-concat trash-files-dir files-base)))
(if (or (not is-directory)
(not (file-attributes new-fn)))
(rename-file fn new-fn overwrite)
(copy-directory fn
(file-name-as-directory new-fn)
t nil t)
(delete-directory fn t))))))))))
(defsubst file-attribute-type (attributes)
"The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
symbolic link, or nil."
(nth 0 attributes))
(defsubst file-attribute-link-number (attributes)
"Return the number of links in ATTRIBUTES returned by `file-attributes'."
(nth 1 attributes))
(defsubst file-attribute-user-id (attributes)
"The UID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 2 attributes))
(defsubst file-attribute-group-id (attributes)
"The GID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number. If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
(nth 3 attributes))
(defsubst file-attribute-access-time (attributes)
"The last access time in ATTRIBUTES returned by `file-attributes'.
This a Lisp timestamp in the style of `current-time'."
(nth 4 attributes))
(defsubst file-attribute-modification-time (attributes)
"The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
is a Lisp timestamp in the style of `current-time'."
(nth 5 attributes))
(defsubst file-attribute-status-change-time (attributes)
"The status modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of last change to the file's attributes: owner
and group, access mode bits, etc., and is a Lisp timestamp in the
style of `current-time'."
(nth 6 attributes))
(defsubst file-attribute-size (attributes)
"The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
(nth 7 attributes))
(defsubst file-attribute-modes (attributes)
"The file modes in ATTRIBUTES returned by `file-attributes'.
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes))
(defsubst file-attribute-inode-number (attributes)
"The inode number in ATTRIBUTES returned by `file-attributes'.
It is a nonnegative integer."
(nth 10 attributes))
(defsubst file-attribute-device-number (attributes)
"The file system device number in ATTRIBUTES returned by `file-attributes'.
It is an integer or a cons cell of integers."
(nth 11 attributes))
(defsubst file-attribute-file-identifier (attributes)
"The inode and device numbers in ATTRIBUTES returned by `file-attributes'.
The value is a list of the form (INODENUM DEVICE), where DEVICE could be
either a single number or a cons cell of two numbers.
This tuple of numbers uniquely identifies the file."
(nthcdr 10 attributes))
(defun file-attribute-collect (attributes &rest attr-names)
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
ATTR-NAMES are symbols with the selected attribute names.
Valid attribute names are: type, link-number, user-id, group-id,
access-time, modification-time, status-change-time, size, modes,
inode-number, device-number and file-number."
(let ((all '(type link-number user-id group-id access-time
modification-time status-change-time
size modes inode-number device-number file-number))
result)
(while attr-names
(let ((attr (pop attr-names)))
(if (memq attr all)
(push (funcall
(intern (format "file-attribute-%s" (symbol-name attr)))
attributes)
result)
(error "Wrong attribute name '%S'" attr))))
(nreverse result)))
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key ctl-x-map "\C-v" 'find-alternate-file)
(define-key ctl-x-map "\C-s" 'save-buffer)
(define-key ctl-x-map "s" 'save-some-buffers)
(define-key ctl-x-map "\C-w" 'write-file)
(define-key ctl-x-map "i" 'insert-file)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
(define-key ctl-x-map "\C-q" 'read-only-mode)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
(define-key ctl-x-4-map "\C-o" 'display-buffer)
(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
(define-key ctl-x-5-map "f" 'find-file-other-frame)
(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
(define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame)
;;; files.el ends here
|