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
|
;;; feedmail.el --- assist other email packages to massage outgoing messages -*- lexical-binding:t -*-
;; This file is in the public domain.
;; This file is part of GNU Emacs.
;; Author: Bill Carpenter <bill@carpenter.ORG>
;; Version: 11
;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
;; URL: http://www.carpenter.org/feedmail/feedmail.html
;;; Commentary:
;; A replacement for parts of sendmail.el (specifically,
;; it's what handles your outgoing mail after you hit C-c C-c in mail
;; mode). See below for a list of additional features, including the
;; ability to queue messages for later sending. This replaces
;; the standalone fakemail program that used to be distributed with Emacs.
;; Sorry, no manual yet in this release. Look for one with the next
;; release. Or the one after that. Or maybe later.
;; As far as I'm concerned, anyone can do anything they want with
;; this specific piece of code. No warranty or promise of support is
;; offered. This code is hereby released into the public domain.
;; Thanks: My thanks to the many people who have sent me suggestions
;; and fixes over time, as well as those who have tested many beta
;; iterations. Some are cited in comments in code fragments below,
;; but that doesn't correlate well with the list of folks who have
;; actually helped me along the way.
;; If you use feedmail, I invite you to send me some email about it.
;; I appreciate feedback about problems you find or suggestions for
;; improvements or added features (even though I can't predict when
;; I'll incorporate changes). It's also OK with me if you send me a
;; note along the lines of "I use feedmail and find it useful" or "I
;; tried feedmail and didn't find it useful, so I stopped using it".
;;
;; It is most useful, when sending a bug report, if you tell me what
;; version of Emacs you are using, what version of feedmail you are
;; using, and what versions of other email-related elisp packages you
;; are using. If in doubt about any of that, send the bug report
;; anyhow.
;;
;; =====
;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE... Since it is PD,
;; you're within your rights to do whatever you want. If you do
;; publish a new version with your changes in it, please (1) insert
;; Lisp comments describing the changes, (2) insert Lisp comments
;; that clearly delimit where your changes are, (3) email me a copy
;; (I can't always consistently follow the relevant usenet groups),
;; and (4) use a version number that is based on the version you're
;; changing along with something that indicates you changed it. For
;; example,
;;
;; (defconst feedmail-patch-level "123")
;; (defconst feedmail-patch-level "123-XYZ-mods")
;;
;; The point of the last item, of course, is to try to minimize
;; confusion. Odds are good that if your idea makes sense to me that
;; it will show up in some future version of feedmail, though it's
;; hard to say when releases will tumble out.
;; =====
;;
;; This file requires the mail-utils library.
;;
;; This file requires the smtpmail library if you use
;; feedmail-buffer-to-smtpmail. It requires the smtp library if
;; you use feedmail-buffer-smtp.
;;
;; This file requires the custom library. Unfortunately, there are
;; two incompatible versions of the custom library. If you don't have
;; custom or you have the old version, this file will still load and
;; work properly. If you don't know what custom is all about and want
;; to edit your user option elisp variables the old fashioned way,
;; just imagine that all the "defcustom" stuff you see below is really
;; "defvar", and ignore everything else. For info about custom, see
;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
;;
;; This code does in elisp a superset of the stuff that used to be done
;; by the separate program "fakemail" for processing outbound email.
;; In other words, it takes over after you hit "C-c C-c" in mail mode.
;; By appropriate setting of options, you can even revert to sendmail
;; (which is not too popular locally). See the variables at the top
;; of the elisp for how to achieve these effects (there are more
;; features than in this bullet list, so trolling through the variable
;; and function doc strings may be worth your while):
;;
;; --- you can park outgoing messages into a disk-based queue and
;; stimulate sending them all later (handy for laptop users);
;; there is also a queue for draft messages
;;
;; --- you can get one last look at the prepped outbound message and
;; be prompted for confirmation
;;
;; --- removes Bcc:/Resent-Bcc: headers after getting address info
;;
;; --- does smart filling of address headers
;;
;; --- calls a routine to process Fcc: lines and removes them
;;
;; --- empty headers are removed
;;
;; --- can force From: or Sender: line
;;
;; --- can generate a Message-Id: line
;;
;; --- can generate a Date: line; the date can be the time the
;; message was written or the time it is being sent
;;
;; --- strips comments from address info (both "()" and "<>" are
;; handled via a call to mail-strip-quoted-names); the
;; comments are stripped in the simplified address list given
;; to a subprocess, not in the headers in the mail itself
;; (they are left unchanged, modulo smart filling)
;;
;; --- error info is pumped into a normal buffer instead of the
;; minibuffer
;;
;; --- just before the optional prompt for confirmation, lets you
;; run a hook on the prepped message and simplified address
;; list
;;
;; --- you can specify something other than /bin/mail for the
;; subprocess
;;
;; --- you can generate/modify an X-Mailer: message header
;;
;; After a long list of options below, you will find the function
;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
;; Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
;;
;; If you plan to use the queue stuff, also use this:
;;
;; (setq feedmail-enable-queue t)
;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
;;
;; though VM users might find it more comfortable to use this instead of
;; the above example's last line:
;;
;; (setq auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist))
;;
;; If you end up getting asked about killing modified buffers all the time
;; you are probably being prompted from outside feedmail. You can probably
;; get cured by doing the defadvice stuff described in the documentation
;; for the variable feedmail-queue-buffer-file-name below.
;;
;; If you are wondering how to send your messages to some SMTP server
;; (which is not really a feedmail-specific issue), you are probably
;; looking for smtpmail.el, and it is probably already present in your
;; Emacs installation. Look at smtpmail.el for how to set that up, and
;; then do this to hook it into feedmail:
;;
;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail)
;;
;; Alternatively, the FLIM <https://www.m17n.org/FLIM/> project
;; provides a library called smtp.el. If you want to use that, the above lines
;; would be:
;;
;; (autoload 'feedmail-buffer-to-smtp "feedmail" nil t)
;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtp)
;;
;; If you are using the desktop.el library to restore your sessions, you might
;; like to add the suffix ".fqm" to the list of non-saved things via the variable
;; desktop-files-not-to-save.
;;
;; If you ever use rmail-resend and queue messages, you should do this:
;;
;; (setq feedmail-queue-alternative-mail-header-separator "")
;;
;; If you want to automatically spell-check messages, but not when sending
;; them from the queue, you could do something like this:
;;
;; (autoload 'feedmail-mail-send-hook-splitter "feedmail")
;; (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
;; (add-hook 'feedmail-mail-send-hook 'ispell-message)
;;
;; If you are using message-mode to compose and send mail, feedmail will
;; probably work fine with that (someone else tested it and told me it worked).
;; Follow the directions above, but make these adjustments instead:
;;
;; (setq message-send-mail-function 'feedmail-send-it)
;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
;;
;; If you use message-mode and you make use of feedmail's queueing
;; stuff, you might also like to adjust these variables to appropriate
;; values for message-mode:
;;
;; feedmail-queue-runner-mode-setter
;; feedmail-queue-runner-message-sender
;;
;; If you are using the "cmail" email package, there is some built-in
;; support for feedmail in recent versions. To enable it, you should:
;;
;; (setq cmail-use-feedmail t)
;;
;;;;;;;;
;;
;; Change log:
;; original, 31 March 1991
;; patchlevel 1, 5 April 1991
;; patchlevel 2, 24 May 1991
;; 5-may-92 jwz Conditionalized calling expand-mail-aliases, since that
;; function doesn't exist in Lucid Emacs or when using
;; mail-abbrevs.el.
;; patchlevel 3, 3 October 1996
;; added queue stuff; still works in v18
;; patchlevel 4, issued by someone else
;; patchlevel 5, issued by someone else
;; patchlevel 6, not issued as far as I know
;; patchlevel 7, 20 May 1997
;; abandon futile support of Emacs 18 (sorry if that hurts you)
;; provide a Date: header by default
;; provide a default for generating Message-Id: header contents
;; and use it by default (slightly changed API)
;; return value from feedmail-run-the-queue
;; new wrapper function feedmail-run-the-queue-no-prompts
;; user-mail-address as default for From:
;; properly deal with Resent-{To,Cc,Bcc}
;; Bcc and Resent-* now included in smart filling
;; limited support for a "drafts" directory
;; user-configurable default message action
;; allow timeout for confirmation prompt (where available)
;; move Fcc handling to as late as possible to get max
;; header munging in the saved file
;; work around sendmail.el's prompts when working from queue
;; more reliably detect voluntary user bailouts
;; offer to save modified buffers visiting queue files
;; offer to delete old file copies of messages being queued
;; offer to delete queue files when sending immediately
;; queue filename convention preserves queue order
;; default queue and draft directory names that work on VMS
;; deduced address list now really a list, not a string (API change)
;; no more address buffer
;; when sending immediately, brief reminder of queue/draft counts
;; copy trace of smtpmail stuff to feedmail error buffer on no-go
;; more granularity on when to confirm sending
;; pause a bit for errors while running queue
;; try to clean up some pesky auto-save files from the
;; queue/draft directories
;; feedmail-force-expand-mail-aliases in case you can't figure
;; any other way
;; cleanup some of my sloppiness about case-fold-search (a strange
;; variable)
;; best effort following coding conventions from Emacs
;; elisp manual appendix
;; "customize" (see custom.el)
;; when user selects "immediate send", clear action prompt since
;; hooks may take a while to operate, and user may think the
;; response didn't take
;; fixes to the argument conventions for the
;; feedmail-queue-runner-* functions; allows
;; feedmail-run-the-queue[-no-prompts] to properly be called
;; non-interactively
;; eliminate reliance on directory-sep-char and feedmail-sep-thing
;; tweak smart filling (reminded of comma problem by levitte@lp.se)
;; option to control writing in text vs binary mode
;; patchlevel 8, 15 June 1998
;; reliable re-editing of text-mode (vs binary) queued messages
;; user option to keep Bcc: in Fcc: copy (keep by default)
;; user option to delete body from Fcc: copy (keep by default)
;; feedmail-deduce-bcc-where for envelope (API change for
;; feedmail-deduce-address list)
;; feedmail-queue-alternative-mail-header-separator
;; at message action prompt, "I"/"S" bypass message confirmation prompt
;; feedmail-mail-send-hook-splitter, feedmail-mail-send-hook,
;; feedmail-mail-send-hook-queued
;; user can supply stuff for message action prompt
;; variable feedmail-queue-runner-confirm-global, function feedmail-run-the-queue-global-prompt
;; bugfix: absolute argument to directory-files (tracked down for me
;; by gray@austin.apc.slb.com (Douglas Gray Stephens)); relative
;; pathnames can tickle stuff in ange-ftp remote directories
;; (perhaps because feedmail is careless about its working
;; directory)
;; feedmail-deduce-envelope-from
;; always supply envelope "from" (user-mail-address) to sendmail
;; feedmail-message-id-suffix
;; feedmail-queue-reminder, feedmail-queue-reminder-alist (after suggestions
;; and/or code fragments from tonyl@Eng.Sun.COM (Tony Lam) and
;; burge@newvision.com (Shane Burgess); bumped up the default value of
;; feedmail-queue-chatty-sit-for since info is more complex sometimes
;; feedmail-enable-spray (individual transmissions, crude mailmerge)
;; blank Subject: no longer a special case; see feedmail-nuke-empty-headers
;; fiddle-plexes data structure used lots of places; see feedmail-fiddle-plex-blurb
;; feedmail-fiddle-plex-user-list
;; feedmail-is-a-resend
;; honor mail-from-style in constructing default for feedmail-from-line
;; re-implement feedmail-from-line and feedmail-sender-line with
;; fiddle-plexes; slightly modified semantics for feedmail-sender-line
;; feedmail-queue-default-file-slug; tidy up some other slug details
;; feedmail-queue-auto-file-nuke
;; feedmail-queue-express-to-queue and feedmail-queue-express-to-draft
;; strong versions of "q"ueue and "d"raft answers (always make a new file)
;; patchlevel 9, 23 March 2001
;; feedmail-queue-buffer-file-name to work around undesirable mail-send prompt
;; at message action prompt, can scroll message buffer with "<" and ">";
;; C-v no longer scrolls help buffer
;; conditionalize (discard-input) in message action prompt to avoid killing
;; define-kbd-macro
;; fixed error if feedmail-x-mailer-line was nil
;; feedmail-binmail-template only uses /bin/rmail if it exists
;; relocate feedmail-queue-alternative-mail-header-separator stuff
;; added feedmail-vm-mail-mode, which make a good auto-mode-alist entry
;; for FQM files if you're a VM user
;; change buffer-substring calls to buffer-substring-no-properties for
;; speed-up (suggested by Howard Melman <howard@silverstream.com>)
;; feedmail-sendmail-f-doesnt-sell-me-out to control "-f" in call to sendmail
;; in feedmail-buffer-to-sendmail
;; better trapping of odd conditions during the running of the queue;
;; thanks to Yigal Hochberg for helping me test much of this by remote
;; control
;; feedmail-debug and feedmail-debug-sit-for
;; feedmail-display-full-frame
;; feedmail-queue-express-hook
;; added example function feedmail-spray-via-bbdb
;; use expand-file-name for setting default directory names
;; define feedmail-binmail-gnulinuxish-template as a suggestion for
;; the value of feedmail-binmail-template on GNU/Linux and maybe other
;; systems with non-classic /bin/[r]mail behavior
;; guard against nil user-mail-address in generating MESSAGE-ID:
;; feedmail-queue-slug-suspect-regexp is now a variable to
;; accommodate non-ASCII environments (thanks to
;; Makoto.Nakagawa@jp.compaq.com for this suggestion)
;; feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail
;; patchlevel 10, 22 April 2001
;; DATE: and MESSAGE-ID stuff now forces system-time-locale to "C"
;; (brought to my attention by Makoto.Nakagawa@jp.compaq.com)
;; patchlevel 11
;; tweak default FROM: calculation to look at mail-host-address
;; (suggested by "Jason Eisner" <jason@cs.jhu.edu>)
;;
;; todo:
;; write texinfo manual
;; maybe partition into multiple files, including files of examples
;;
;;; Code:
(defconst feedmail-patch-level "11-beta-1")
(require 'mail-utils) ; pick up mail-strip-quoted-names
(autoload 'mail-do-fcc "sendmail")
(defgroup feedmail nil
"Assist other email packages to massage outgoing messages."
:link '(url-link "http://www.carpenter.org/feedmail/feedmail.html")
:link '(emacs-commentary-link "feedmail")
:group 'mail)
(defgroup feedmail-misc nil
"Miscellaneous feedmail options that don't fit in other groups."
:group 'feedmail)
(defgroup feedmail-headers nil
"Options related to manipulating specific headers or types of headers."
:group 'feedmail)
(defgroup feedmail-queue nil
"Options related to queuing messages for later sending."
:group 'feedmail)
(defgroup feedmail-debug nil
"Options related to debug messages for later sending."
:group 'feedmail)
(defcustom feedmail-confirm-outgoing nil
"If non-nil, give a y-or-n confirmation prompt before sending mail.
This is done after the message is completely prepped, and you'll be
looking at the top of the message in a buffer when you get the prompt.
If set to the symbol `queued', give the confirmation prompt only while
running the queue (however, the prompt is always suppressed if you are
processing the queue via `feedmail-run-the-queue-no-prompts'). If set
to the symbol `immediate', give the confirmation prompt only when
sending immediately. For any other non-nil value, prompt in both
cases. You can give a timeout for the prompt; see variable
`feedmail-confirm-outgoing-timeout'."
:group 'feedmail-misc
:type '(choice (const nil)
(const queued)
(const immediate)
(other t)))
(defcustom feedmail-display-full-frame 'queued
"If non-nil, show prepped messages in a full frame.
If nil, the prepped message will be shown, for confirmation or
otherwise, in some window in the current frame without resizing
anything. That may or may not display enough of the message to
distinguish it from others. If set to the symbol `queued', take
this action only when running the queue. If set to the symbol
`immediate', take this action only when sending immediately. For
any other non-nil value, take the action in both cases. Even if
you're not confirming the sending of immediate or queued messages,
it can still be interesting to see a lot about them as they are
shuttled robotically onward."
:version "24.1"
:group 'feedmail-misc
:type '(choice (const nil)
(const queued)
(const immediate)
(other t)))
(defcustom feedmail-confirm-outgoing-timeout nil
"If non-nil, a timeout in seconds at the send confirmation prompt.
If a positive number, it's a timeout before sending. If a negative
number, it's a timeout before not sending."
:version "24.1"
:group 'feedmail-misc
:type '(choice (const nil) integer)
)
(defcustom feedmail-nuke-bcc t
"If non-nil remove Bcc: lines from the message headers.
In any case, the Bcc: lines do participate in the composed address
list. You may want to leave them in if you're using sendmail
\(see `feedmail-buffer-eating-function')."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-nuke-resent-bcc t
"If non-nil remove Resent-Bcc: lines from the message headers.
In any case, the Resent-Bcc: lines do participate in the composed
address list. You may want to leave them in if you're using sendmail
\(see `feedmail-buffer-eating-function')."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-deduce-bcc-where nil
"Where Bcc:/Resent-Bcc: addresses should appear in the envelope list.
Addresses for the message envelope are deduced by examining
appropriate address headers in the message. Generally, they will show
up in the list of deduced addresses in the order that the headers
happen to appear (duplicate addresses are eliminated in any case).
This variable can be set to the symbol `first', in which case the
Bcc:/Resent-Bcc: addresses will appear at the beginning in the list;
or, it can be set to the symbol `last', in which case they will appear
at the end of the list.
Why should you care? Well, maybe you don't, and certainly the same
things could be accomplished by affecting the order of message headers
in the outgoing message. Some people use Bcc: as a way of getting
their own \"come back\" copy of each message they send. If Bcc:
addresses are not handled first, there can be substantial delays in
seeing the message again. Some configurations of sendmail, for example,
seem to try to deliver to each addressee at least once, immediately
and serially, so slow SMTP conversations can add up to a delay. There
is an option for either `first' or `last' because you might have a
delivery agent that processes the addresses backwards."
:group 'feedmail-headers
:type '(choice (const nil)
(const first)
(const last)))
(defcustom feedmail-fill-to-cc t
"If non-nil do smart filling of addressee header lines.
Smart filling means breaking long lines at appropriate points and
making continuation lines. Despite the function name, it includes
To:, Cc:, Bcc: (and their Resent-* forms), as well as From: and
Reply-To: (though they seldom need it). If nil, the lines are left
as-is. The filling is done after mail address alias expansion."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-fill-to-cc-fill-column (default-value 'fill-column)
"Fill column used by `feedmail-fill-to-cc'."
:group 'feedmail-headers
:type 'integer
)
(defcustom feedmail-nuke-bcc-in-fcc nil
"If non-nil remove [Resent-]Bcc: lines in message copies saved via Fcc:.
This is independent of whether the Bcc: header lines are actually sent
with the message (see feedmail-nuke-bcc). Though not implied in the name,
the same Fcc: treatment applies to both Bcc: and Resent-Bcc: lines."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-nuke-body-in-fcc nil
"If non-nil remove body of message in copies saved via Fcc:.
If a positive integer value, leave (up to) that many lines of the
beginning of the body intact. The result is that the Fcc: copy will
consist only of the message headers, serving as a sort of an outgoing
message log."
:group 'feedmail-headers
:type '(choice (const nil) (const t) integer)
)
(defcustom feedmail-force-expand-mail-aliases nil
"If non-nil, force the calling of `expand-mail-aliases'.
Normally, feedmail tries to figure out if you're using mailalias or
mailabbrevs and only calls `expand-mail-aliases' if it thinks you're
using the mailalias package. This user option can be used to force
the issue since there are configurations which fool the figuring
out."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-nuke-empty-headers t
"If non-nil, remove header lines which have no contents.
A completely empty Subject: header is always removed, regardless of
the setting of this variable. The only time you would want them left
in would be if you used some headers whose presence indicated
something rather than their contents. This is rare in Internet email
but common in some proprietary systems."
:group 'feedmail-headers
:type 'boolean
)
;; wjc sez: I think the use of the Sender: line is pretty pointless,
;; but I left it in to be compatible with sendmail.el and because
;; maybe some distant mail system needs it. Really, though, if you
;; want a sender line in your mail, just put one in there and don't
;; wait for feedmail to do it for you. (Yes, I know all about
;; RFC-822-or-later and RFC-1123, but are you *really* one of those cases
;; they're talking about? I doubt it.)
(defcustom feedmail-sender-line nil
"If non-nil and the email has no Sender: header, use this value.
May be nil, in which case nothing in particular is done with respect
to Sender: lines. By design, will not replace an existing Sender:
line, but you can achieve that with a fiddle-plex replace action.
NB: it makes no sense to use the value t since there is no sensible
default for Sender:.
If not nil, it may be a string, a fiddle-plex, or a function which
returns either nil, t, a string, or a fiddle-plex (or, in fact,
another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"Sender\" or \"Resent-Sender\".
You can probably leave this nil, but if you feel like using it, a good
value would be a string of a fully-qualified domain name form of your
address. For example, \"bill@example.net (WJCarpenter)\". The Sender:
header is fiddled after the From: header is fiddled."
:group 'feedmail-headers
:type '(choice (const nil) string)
)
(defcustom feedmail-force-binary-write t
"If non-nil, force writing file as binary (this applies to queues and Fcc:).
On systems where there is a difference between binary and text files,
feedmail will temporarily manipulate the value of `coding-system-for-write'
to make the writing as binary. If nil, writing will be in text mode.
On systems where there is no distinction or where it is controlled by other
variables or other means, this option has no effect."
:group 'feedmail-misc
:type 'boolean
)
(defcustom feedmail-from-line t
"If non-nil and the email has no From: header, use this value.
May be t, in which case a default is computed (and you probably won't
be happy with it). May be nil, in which case nothing in particular is
done with respect to From: lines. By design, will not replace an
existing From: line, but you can achieve that with a fiddle-plex `replace'
action.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
which returns either nil, t, a string, or a fiddle-plex (or, in fact,
another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"From\" or \"Resent-From\".
A good value would be a string fully-qualified domain name form of
your address. For example, \"bill@example.net (WJCarpenter)\". The
default value of this variable uses the standard elisp variable
`user-mail-address' which should be set on every system but has a decent
chance of being wrong. It also honors `mail-from-style'. Better to set
this variable explicitly to the string you want or find some other way
to arrange for the message to get a From: line."
:group 'feedmail-headers
:type '(choice (const t) (const nil) string)
)
(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
"If non-nil, call \"sendmail\" with \"-f\".
See `message-sendmail-f-is-evil' for an explanation of what the
\"-f\" parameter does."
:version "24.1"
:group 'feedmail-headers
:type 'boolean)
(defcustom feedmail-deduce-envelope-from t
"If non-nil, deduce message envelope \"from\" from header From: or Sender:.
In other words, if there is a Sender: header in the message, temporarily
change the value of `user-mail-address' to be the same while the message
is being sent. If there is no Sender: header, use the From: header,
if any. Address values are taken from the actual message just before
it is sent, and the process is independent of the values of
`feedmail-from-line' and/or `feedmail-sender-line'.
There are many and good reasons for having the message header
From:/Sender: be different from the message envelope \"from\"
information. However, for most people and for most circumstances, it
is usual for them to be the same (this is probably especially true for
the case where the user doesn't understand the difference between the
two in the first place).
The idea behind this feature is that you can have everything set up
some normal way for yourself. If for some reason you want to send a
message with another From: line, you can just type it at the top of
the message, and feedmail will take care of \"fixing up\" the envelope
\"from\". This only works for mail senders which make use of
`user-mail-address' as the envelope \"from\" value. For some mail
senders (e.g., feedmail-buffer-to-bin-mail), there is no simple way to
influence what they will use as the envelope."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-x-mailer-line-user-appendage nil
"See feedmail-x-mailer-line."
:group 'feedmail-headers
:type '(choice (const nil) (const t) string)
)
(defcustom feedmail-x-mailer-line t
"Control the form of an X-Mailer: header in an outgoing message.
Moderately useful for debugging, keeping track of your correspondents'
mailer preferences, or just wearing your MUA on your sleeve. You
should probably know that some people are fairly emotional about the
presence of X-Mailer: lines in email.
If nil, nothing is done about X-Mailer:.
If t, an X-Mailer: header of a predetermined format is produced,
combining its efforts with any existing X-Mailer: header. If you want
to take the default construct and just add a little blob of your own
at the end, define the variable feedmail-x-mailer-line-user-appendage
as that blob string. A value of t is equivalent to using the function
feedmail-default-x-mailer-generator.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
which returns either nil, t, a string, or a fiddle-plex (or, in fact,
another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
:group 'feedmail-headers
:type '(choice (const t) (const nil) string function)
)
(defcustom feedmail-message-id-generator t
"Specifies the creation of a Message-Id: header field.
If nil, nothing is done about Message-Id:.
If t, a Message-Id: header of a predetermined format is produced, but
only if there is not already a Message-Id: in the message. A value of
t is equivalent to using the function feedmail-default-message-id-generator.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
which returns either nil, t, a string, or a fiddle-plex (or, in fact,
another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
the message buffer. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"Message-Id\" or \"Resent-Message-Id\".
You should let feedmail generate a Message-Id: for you unless you are sure
that whatever you give your messages to will do it for you (e.g., most
configurations of sendmail). Even if the latter case is true, it
probably won't hurt you to generate your own, and it will then show up
in the saved message if you use Fcc:."
:group 'feedmail-headers
:type '(choice (const t) (const nil) function)
)
(defcustom feedmail-message-id-suffix nil
"If non-nil, used as a suffix for generating unique Message-Id: headers.
The function `feedmail-default-message-id-generator' creates its work based
on a formatted date-time string, a random number, and a domain-looking suffix.
You can control the suffix used by assigning a string value to this variable.
If you don't supply one, the value of the variable `user-mail-address' will be
used. If the value of `feedmail-message-id-suffix' contains an \"@\" character,
the string will be used verbatim, else an \"@\" character will be prepended
automatically."
:group 'feedmail-headers
:type '(choice (const nil) string)
)
;; this was suggested in various forms by several people; first was
;; Tony DeSimone in Oct 1992; sorry to be so tardy
(defcustom feedmail-date-generator t
"Specifies the creation of a Date: header field.
If nil, nothing is done about Date:.
If t, a Date: header of a predetermined format is produced, but only
if there is not already a Date: in the message. A value of t is
equivalent to using the function `feedmail-default-date-generator'.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
which returns either nil, t, a string, or a fiddle-plex (or, in fact,
another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
the message buffer. For an explanation of fiddle-plexes, see the
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"Date\" or \"Resent-Date\".
If you decide to format your own date field, do us all a favor and know
what you're doing. Study the relevant parts of RFC-822-or-later and RFC-1123.
Don't make me come up there!
You should let feedmail generate a Date: for you unless you are sure
that whatever you give your messages to will do it for you (e.g., most
configurations of sendmail). Even if the latter case is true, it
probably won't hurt you to generate your own, and it will then show up
in the saved message if you use Fcc:."
:group 'feedmail-headers
:type '(choice (const t) (const nil) function)
)
(defcustom feedmail-fiddle-headers-upwardly t
"Non-nil means fiddled header fields should go at the top of the header.
nil means insert them at the bottom. This is mostly a novelty issue since
the standards define the ordering of header fields to be immaterial and it's
fairly likely that some MTA/MUA along the way will have its own idea of what the
order should be, regardless of what you specify."
:group 'feedmail-headers
:type 'boolean
)
(defcustom feedmail-fiddle-plex-user-list nil
"If non-nil, should be a list of one or more fiddle-plexes.
Each element of the list can also be a function which returns a
fiddle-plex.
feedmail will use this list of fiddle-plexes to manipulate user-specified
message header fields. It does this after it has completed all normal
message header field manipulation and before calling
`feedmail-last-chance-hook'.
For an explanation of fiddle-plexes, see the documentation for the
variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex
manipulation functions, in this context, it makes no sense to have an element
which is nil, t, or a simple string."
:group 'feedmail-headers
:type '(repeat (choice function)
sexp) ; too complex to be described accurately
)
(defcustom feedmail-enable-spray nil
"If non-nil, transmit message separately to each addressee.
feedmail normally accumulates a list of addressees and passes the message
along with that list to a buffer-eating function which expects any number
of addressees. If this variable is non-nil, however, feedmail will
repeatedly call the same buffer-eating function. Each time, the list of
addressees will be just one item from the original list. This only affects
the message envelope addresses and doesn't affect what appears in the
message headers except as noted.
Spray mode is usually pointless, and if you can't think of a good reason for
it, you should avoid it since it is inherently less efficient than normal
multiple delivery. One reason to use it is to overcome mis-featured mail
transports which betray your trust by revealing Bcc: addressees in the
headers of a message. Another use is to do a crude form of mailmerge, for
which see `feedmail-spray-address-fiddle-plex-list'.
If one of the calls to the buffer-eating function results in an error,
what happens next is carelessly defined, so beware. This should get ironed
out in some future release, and there could be other API changes for spraying
as well."
:group 'feedmail-spray
:type 'boolean
)
(defvar feedmail-spray-this-address nil
"Do not set this variable, except via `feedmail-spray-address-fiddle-plex-list'.")
(defcustom feedmail-spray-address-fiddle-plex-list nil
"User-supplied specification for a crude form of mailmerge capability.
When spraying is enabled, feedmail composes a list of envelope addresses.
In turn, `feedmail-spray-this-address' is temporarily set to each address
\(stripped of any comments and angle brackets) and a function is called which
fiddles message headers according to this variable. See the documentation for
`feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
May be nil, in which case nothing in particular is done about message
headers for specific addresses.
May be t, in which case a \"To:\" header is added to the message with
the stripped address as the header contents. The fiddle-plex operator
is `supplement'.
May be a string, in which case the string is assumed to be the name of
a message header field with the stripped address serving as the value.
The fiddle-plex operator is `supplement'.
May be a function, in which case it is called with no arguments and is
expected to return nil, t, a string, another function, or a fiddle-plex.
The result is used recursively. The function may alter the value of the
variable feedmail-spray-this-address, perhaps to embellish it with a
human name. It would be logical in such a case to return as a value a
string naming a message header like \"TO\" or an appropriately constructed
fiddle-plex. For an example, see feedmail-spray-via-bbdb.
May be a list of any combination of the foregoing and/or
fiddle-plexes. (A value for this variable which consists of a single
fiddle-plex must be nested inside another list to avoid ambiguity.)
If a list, each item is acted on in turn as described above.
For example,
(setq feedmail-spray-address-fiddle-plex-list \\='feedmail-spray-via-bbdb)
The idea of the example is that, during spray mode, as each message is
about to be transmitted to an individual address, the function will be
called and will consult `feedmail-spray-this-address' to find the
stripped envelope email address (no comments or angle brackets). The
function should return an embellished form of the address.
The recipe for sending form letters is: (1) create a message with
all addressees on Bcc: headers; (2) tell feedmail to remove Bcc:
headers before sending the message; (3) create a function which
will embellish stripped addresses, if desired; (4) define
`feedmail-spray-address-fiddle-plex-list' appropriately; (5) send
the message with `feedmail-enable-spray' set non-nil; (6) stand
back and watch co-workers wonder at how efficient you are at
accomplishing inherently inefficient things."
:group 'feedmail-spray
:type 'sexp ; too complex to be described accurately
)
;; FIXME this is a macro?
(declare-function bbdb-search "ext:bbdb-com"
(records &optional name company net notes phone))
(declare-function bbdb-records "ext:bbdb"
(&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-dwim-net-address "ext:bbdb-com" (record &optional net))
(defun feedmail-spray-via-bbdb ()
"Example function for use with feedmail spray mode.
NB: it's up to the user to have the BBDB environment already set up properly
before using this."
(let (net-rec q-net-addy embellish)
(setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
(setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
(if (and (car net-rec) (not (cdr net-rec)))
(setq net-rec (car net-rec))
(setq net-rec nil))
(if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
(if embellish
(list "To" embellish 'supplement)
(list "To" feedmail-spray-this-address 'supplement))))
(defcustom feedmail-enable-queue nil
"If non-nil, provide for stashing outgoing messages in a queue.
This is the master on/off switch for feedmail message queuing.
Queuing is quite handy for laptop-based users. It's also handy if you
get a lot of mail and process it more or less sequentially. For
example, you might change your mind about contents of a reply based on
a message you see a bit later.
There is a separate queue for draft messages, intended to prevent
you from accidentally sending incomplete messages. The queues are
disk-based and intended for later transmission. The messages are
queued in their raw state as they appear in the `mail-mode' buffer and
can be arbitrarily edited later, before sending, by visiting the
appropriate file in the queue directory (and setting the buffer to
mail-mode or whatever). If you visit a file in the queue directory
and try to queue it again, it will just get saved in its existing file
name. You can move a message from the draft to the main queue or vice
versa by pretending to send it and then selecting whichever queue
directory you want at the prompt. The right thing will happen.
To transmit all the messages in the queue, invoke the command
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-queue-runner-confirm-global nil
"If non-nil, give a y-or-n confirmation prompt before running the queue.
Prompt even if the queue is about to be processed as a result of a call to
`feedmail-run-the-queue-no-prompts'. This gives you a way to bail out
without having to answer no to the individual message prompts."
:group 'feedmail-queue
:type 'boolean)
(defcustom feedmail-queue-directory
(expand-file-name "~/mail/q")
"Name of a directory where messages will be queued.
Directory will be created if necessary. Should be a string that
doesn't end with a slash. Default is \"~/mail/q\"."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-queue-draft-directory
(expand-file-name "~/mail/draft")
"Name of a directory where draft messages will be queued.
Directory will be created if necessary. Should be a string that
doesn't end with a slash. Default is \"~/mail/draft\"."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-ask-before-queue t
"If non-nil, feedmail will ask what you want to do with the message.
Default choices for the message action prompt will include sending it
immediately, putting it in the main queue, putting it in the draft
queue, or returning to the buffer to continue editing. Only matters if
queuing is enabled. If nil, the message is placed in the main queue
without a prompt."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
"A string which will be used for the message action prompt.
If it contains a \"%s\", that will be replaced with the value of
`feedmail-ask-before-queue-default'."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
"A string which will be used for reprompting after invalid input.
If it contains a \"%s\", that will be replaced with the value of
`feedmail-ask-before-queue-default'."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-ask-before-queue-default "queue"
"Meaning if user hits return in response to the message action prompt.
Should be a character or a string; if a string, only the first
character is significant. Useful values are those described in
the help for the message action prompt."
:group 'feedmail-queue
:type '(choice string integer) ;use integer to get char
)
(defvar feedmail-prompt-before-queue-standard-alist
'((?q . feedmail-message-action-queue)
(?Q . feedmail-message-action-queue-strong)
(?d . feedmail-message-action-draft)
(?r . feedmail-message-action-draft)
(?D . feedmail-message-action-draft-strong)
(?R . feedmail-message-action-draft-strong)
(?e . feedmail-message-action-edit)
(?E . feedmail-message-action-edit)
(?\C-g . feedmail-message-action-edit)
(?n . feedmail-message-action-edit)
(?N . feedmail-message-action-edit)
(?i . feedmail-message-action-send)
(?I . feedmail-message-action-send-strong)
(?s . feedmail-message-action-send)
(?S . feedmail-message-action-send-strong)
(?* . feedmail-message-action-toggle-spray)
(?> . feedmail-message-action-scroll-up)
(?< . feedmail-message-action-scroll-down)
(? . feedmail-message-action-scroll-up)
;; (?\C-v . feedmail-message-action-help)
(?? . feedmail-message-action-help))
"An alist of choices for the message action prompt.
All of the values are function names, except help, which is a special
symbol that calls up help for the prompt (the help describes the
actions from the standard alist). To customize your own choices,
define a similar alist called `feedmail-prompt-before-queue-user-alist'.
The actual alist used for message action will be the standard alist
overlaid with the user-alist. To neutralize an item in the standard
alist without providing a replacement, define an appropriate element
in the user alist with a value of nil." )
(defcustom feedmail-prompt-before-queue-user-alist nil
"See `feedmail-prompt-before-queue-standard-alist'."
:group 'feedmail-queue
:type '(repeat (cons character function))
)
(defcustom feedmail-prompt-before-queue-help-supplement nil
"User-provided supplementary help string for the message action prompt.
When the message action prompt is shown, the user can as for verbose help,
at which point a buffer pops up describing the meaning of possible
responses to the prompt. Through various customizations (see, for
example, `feedmail-prompt-before-queue-user-alist'), the available responses
and the prompt itself can be changed. If this variable is set to a string
value, that string is written to the help buffer after the standard info.
It may contain embedded line breaks. It will be printed via `princ'."
:group 'feedmail-queue
:type '(choice (const nil) string)
)
(defcustom feedmail-queue-reminder-alist
'((after-immediate . feedmail-queue-reminder-brief)
(after-queue . feedmail-queue-reminder-medium)
(after-draft . feedmail-queue-reminder-medium)
(after-run . feedmail-queue-reminder-brief)
(on-demand . feedmail-run-the-queue-global-prompt))
"See `feedmail-queue-reminder'."
:group 'feedmail-queue
:type '(repeat (cons (choice :tag "Event"
(const on-demand)
(const after-immediate)
(const after-queue)
(const after-draft)
(const after-run))
function))
)
(defcustom feedmail-queue-chatty t
"If non-nil, blat a few status messages and such in the mini-buffer.
If nil, just do the work and don't pester people about what's going on.
In some cases, though, specific options inspire mini-buffer prompting.
That's not affected by this variable setting. Also does not control
reporting of error/abnormal conditions."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-queue-chatty-sit-for 2
"Duration of pause after most queue-related messages.
After some messages are divulged, it is prudent to pause before
something else obliterates them. This value controls the duration of
the pause."
:group 'feedmail-queue
:type 'integer
)
(defcustom feedmail-queue-run-orderer nil
"If non-nil, name a function which will sort the queued messages.
The function is called during a running of the queue for sending, and
takes one argument, a list of the files in the queue directory. It
may contain the names of non-message files, and it's okay to leave
them in the list when reordering it; they get skipped over later.
When nil, the default action processes the messages in normal sort
order by queued file name, which will typically result in the order
they were placed in the queue."
:group 'feedmail-queue
:type '(choice (const nil) function)
)
(defcustom feedmail-queue-use-send-time-for-date nil
"If non-nil, use send time for the Date: header value.
This variable is used by the default date generating function,
feedmail-default-date-generator. If nil, the default, the
last-modified timestamp of the queue file is used to create the
message Date: header; if there is no queue file, the current time
is used. If you are using VM, it might be supplying this header
for you. To suppress VM's version
(setq vm-mail-header-insert-date nil)"
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-queue-use-send-time-for-message-id nil
"If non-nil, use send time for the Message-Id: header value.
This variable is used by the default Message-Id: generating function,
`feedmail-default-message-id-generator'. If nil, the default, the
last-modified timestamp of the queue file is used to create the
message Message-Id: header; if there is no queue file, the current time is
used. If you are using VM, it might be supplying this header for
you. To suppress VM's version
(setq vm-mail-header-insert-date nil)"
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-ask-for-queue-slug nil
"If non-nil, prompt user for part of the queue file name.
The file will automatically get the FQM suffix and an embedded
sequence number for uniqueness, so don't specify that. feedmail will
get rid of all characters other than alphanumeric and hyphen in the
results. If this variable is nil or if you just hit return in
response to the prompt, feedmail queuing will take care of things
properly. At the prompt, completion is available if you want to see
what filenames are already in use, though, as noted, you will not be
typing a complete file name. You probably don't want to be bothered
with this prompting since feedmail, by default, uses queue file names
based on the subjects of the messages."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
"If non-nil, a function which creates part of the queued file name.
Takes a single argument giving the name of the directory into
which the message will be queued. The returned string should be just
the non-directory filename part, without FQM suffix or uniquifying
sequence numbers. The current buffer holds the raw message. The
default function creates the slug based on the message subject, if
any."
:group 'feedmail-queue
:type '(choice (const nil) function)
)
(defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+"
"Regular expression for characters/substrings to be replaced.
When feedmail creates a filename from a subject string, it puts hyphens
in place of strings which may cause problems in filenames. By default,
only alphanumeric and hyphen characters are kept, and all others are
converted. In non-ASCII environments, it may be more helpful to
tweak this regular expression to reflect local or personal language
conventions. Substitutions are done repeatedly until the regular expression
no longer matches to transformed string. Used by function
feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
:version "24.1"
:group 'feedmail-queue
:type 'regexp
)
(defcustom feedmail-queue-default-file-slug t
"Indicates what to use for subject-less messages when forming a file name.
When feedmail queues a message, it creates a unique file name. By default,
the file name is based in part on the subject of the message being queued.
If there is no subject, consult this variable. See documentation for the
function `feedmail-queue-subject-slug-maker'.
If t, an innocuous default is used.
If a string, it is used directly.
If a function, it is called with no arguments from the buffer containing the raw
text of the message. It must return a string (which may be empty).
If the symbol `ask', you will be prompted for a string in the mini-buffer.
Filename completion is available so that you can inspect what's already been
used, but feedmail will do further manipulation on the string you return, so
it's not expected to be a complete filename."
:group 'feedmail-queue
:type '(choice (const :tag "Default" t) string function (const ask))
)
(defcustom feedmail-queue-fqm-suffix ".fqm"
"The FQM suffix used to distinguish feedmail queued message files.
You probably want this to be a period followed by some letters and/or
digits. The distinction is to be able to tell them from other random
files that happen to be in the `feedmail-queue-directory' or
`feedmail-queue-draft-directory'. By the way, FQM stands for feedmail
queued message."
:group 'feedmail-queue
:type 'string
)
(defcustom feedmail-nuke-buffer-after-queue nil
"If non-nil, silently kill the buffer after a message is queued.
You might like that since a side-effect of queueing the message is
that its buffer name gets changed to the filename. That means that
the buffer won't be reused for the next message you compose. If you
are using VM for creating messages, you probably want to leave this
nil, since VM has its own options for managing the recycling of
message buffers."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-queue-auto-file-nuke nil
"If non-nil, automatically delete queue files when a message is sent.
Normally, feedmail will notice such files when you send a message in
immediate mode (i.e., not when you're running the queue) and will ask if
you want to delete them. Since the answer is usually yes, setting this
variable to non-nil will tell feedmail to skip the prompt and just delete
the file without bothering you."
:group 'feedmail-queue
:type 'boolean
)
(defcustom feedmail-debug nil
"If non-nil, blat a debug messages and such in the mini-buffer.
This is intended as an aid to tracing what's going on but is probably
of casual real use only to the feedmail developer."
:version "24.1"
:group 'feedmail-debug
:type 'boolean
)
(defcustom feedmail-debug-sit-for 0
"Duration of pause after feedmail-debug messages.
After some messages are divulged, it may be helpful to pause before
something else obliterates them. This value controls the duration of
the pause. If the value is nil or 0, the `sit-for' is not done, which
has the effect of not pausing at all. Debug messages can be seen after
the fact in the messages buffer."
:version "24.1"
:group 'feedmail-debug
:type 'integer
)
(defvar feedmail-queue-buffer-file-name nil
"If non-nil, has the value normally expected of `buffer-file-name'.
You are not intended to set this to something in your configuration. Rather,
you might programmatically set it to something via a hook or function
advice or whatever. You might like to do this if you are using a mail
composition program that eventually uses sendmail.el's `mail-send'
function to process the message. If there is a filename associated
with the message buffer, `mail-send' will ask you for confirmation.
There's no trivial way to avoid it. It's unwise to just set the value
of `buffer-file-name' to nil because that will defeat feedmail's file
management features. Instead, arrange for this variable to be set to
the value of `buffer-file-name' before setting that to nil. An easy way
to do that would be with an advice on `mail-send'.
feedmail will pretend that `buffer-file-name', if nil, has the value
assigned of `feedmail-queue-buffer-file-name' and carry out its normal
activities. feedmail does not restore the non-nil value of
`buffer-file-name'. For safe bookkeeping, the user should ensure that
feedmail-queue-buffer-file-name is restored to nil.
Example advice for mail-send:
(advice-add \\='mail-send :around #\\='my-feedmail-mail-send-advice)
(defun my-feedmail-mail-send-advice (orig-fun &rest args)
(let ((feedmail-queue-buffer-file-name buffer-file-name)
(buffer-file-name nil))
(apply orig-fun args)))")
;; defvars to make byte-compiler happy(er)
(defvar feedmail-error-buffer nil)
(defvar feedmail-prepped-text-buffer nil)
(defvar feedmail-raw-text-buffer nil)
(defvar feedmail-address-list nil)
(defvar feedmail-queue-runner-is-active nil
"Non-nil means we're inside the logic of the queue-running loop.
That is, iterating over all messages in the queue to send them. In
that case, the value is the name of the queued message file currently
being processed. This can be used for differentiating customized code
for different scenarios. Users shouldn't set or change this
variable, but may depend on its value as described here.")
(defun feedmail-mail-send-hook-splitter ()
"Facilitate dividing `mail-send-hook' things into queued and immediate cases.
If you have `mail-send-hook' functions that should only be called
for sending/ queueing messages or only be called for the sending
of queued messages, this is for you. Add this function to
`mail-send-hook' with something like this:
(add-hook \\='mail-send-hook \\='feedmail-mail-send-hook-splitter)
Then add the functions you want called to either
`feedmail-mail-send-hook-queued' or `feedmail-mail-send-hook', as
appropriate. The distinction is that `feedmail-mail-send-hook'
will be called when you send mail from a composition
buffer (typically by typing \\`C-c C-c'), whether the message is sent
immediately or placed in the queue or drafts directory.
`feedmail-mail-send-hook-queued' is called when messages are
being sent from the queue directory, typically via a call to
`feedmail-run-the-queue'."
(feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
(run-hooks 'feedmail-mail-send-hook)))
(defcustom feedmail-mail-send-hook nil
"Hook run by `feedmail-mail-send-hook-splitter' for immediate mail.
See documentation of `feedmail-mail-send-hook-splitter' for details."
:type 'hook
:group 'feedmail)
(defcustom feedmail-mail-send-hook-queued nil
"Hook run by `feedmail-mail-send-hook-splitter' for queued mail.
See documentation of `feedmail-mail-send-hook-splitter' for details."
:type 'hook
:group 'feedmail)
(defun feedmail-confirm-addresses-hook-example ()
"An example of a `feedmail-last-chance-hook'.
It shows the simple addresses and gets a confirmation. Use as:
(setq feedmail-last-chance-hook \\='feedmail-confirm-addresses-hook-example)."
(save-window-excursion
(display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
(erase-buffer)
(insert (mapconcat #'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
(error "FQM: Sending...gave up in last chance hook"))))
(defcustom feedmail-last-chance-hook nil
"User's last opportunity to modify the message on its way out.
When this hook runs, the current buffer is already the appropriate
buffer. It has already had all the header prepping from the standard
package. The next step after running the hook will be to save the
message via Fcc: processing. The hook might be interested in these:
\(1) `feedmail-prepped-text-buffer' contains the header and body of the
message, ready to go; (2) `feedmail-address-list' contains a list
of simplified recipients of addresses which are to be given to the
subprocess (the hook may change the list); (3) `feedmail-error-buffer'
is an empty buffer intended to soak up errors for display to the user.
If the hook allows interactive activity, the user should not send more
mail while in the hook since some of the internal buffers will be
reused and things will get confused. It's not necessary to
arrange for the undoing of any changes you make to the buffer."
:group 'feedmail-misc
:type 'hook
)
(defcustom feedmail-queue-express-hook nil
"Chance to modify a message being sent directly to a queue.
Run by feedmail-queue-express-to-queue and feedmail-queue-express-to-draft.
For example, you might want to run vm-mime-encode-composition to take
care of attachments. If you subsequently edit the message buffer, you
can undo the encoding."
:version "24.1"
:group 'feedmail-queue
:type 'hook
)
(defcustom feedmail-before-fcc-hook nil
"User's last opportunity to modify the message before Fcc action.
It has already had all the header prepping from the standard package.
The next step after running the hook will be to save the message via
Fcc: processing. The hook might be interested in these: (1)
`feedmail-prepped-text-buffer' contains the header and body of the
message, ready to go; (2) `feedmail-address-list' contains a list of
simplified recipients of addressees to whom the message was sent (3)
`feedmail-error-buffer' is an empty buffer intended to soak up errors
for display to the user. If the hook allows interactive activity, the
user should not send more mail while in the hook since some of the
internal buffers will be reused and things will get confused."
:group 'feedmail-misc
:type 'hook
)
(defcustom feedmail-queue-runner-mode-setter
(lambda (&optional _) (mail-mode))
"A function to set the proper mode of a message file.
Called when the message is read back out of the queue directory with a single
argument, the optional argument used in the call to
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
Most people want `mail-mode', so the default value is an anonymous
function which is just a wrapper to ignore the supplied argument when
calling it, but here's your chance to have something different.
If you are a VM user, you might like feedmail-vm-mail-mode, though you
really don't need that (and it's not particularly well-tested).
Called with funcall, not `call-interactively'."
:group 'feedmail-queue
:type 'function
)
(defcustom feedmail-queue-alternative-mail-header-separator nil
"Alternative header demarcation for queued messages.
If you sometimes get alternative values for `mail-header-separator' in
queued messages, set the value of this variable to whatever it is.
For example, `rmail-resend' uses a `mail-header-separator' value of empty
string (\"\") when you send/queue a message.
When trying to send a queued message, if the value of this variable is
non-nil, feedmail will first try to send the message using the value
of `mail-header-separator'. If it can't find that, it will temporarily
set `mail-header-separator' to the value of
`feedmail-queue-alternative-mail-header-separator' and try again."
:group 'feedmail-queue
:type '(choice (const nil) string)
)
(defcustom feedmail-queue-runner-message-sender
(lambda (&optional _)
;; `mail-send' is not autoloaded, which is why we need the `require'.
(require 'sendmail) (declare-function mail-send "sendmail")
(mail-send))
"Function to initiate sending a message file.
Called for each message read back out of the queue directory with a
single argument, the optional argument used in the call to
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
Interactively, that argument will be the prefix argument.
\\<mail-mode-map>
Most people want `mail-send' (bound to \\[mail-send] in `mail-mode'), but here's
your chance to have something different. The default value is just a
wrapper function which discards the optional argument and calls
`mail-send'. If you are a VM user, you might like vm-mail-send, though
you really don't need that. Called with funcall, not call-interactively."
:version "24.1" ; changed default
:group 'feedmail-queue
:type 'function
)
(defcustom feedmail-queue-runner-cleaner-upper
(lambda (fqm-file &optional arg)
(delete-file fqm-file)
(if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
"Function that will be called after a message has been sent.
Not called in the case of errors. This function is called with two
arguments: the name of the message queue file for the message just sent,
and the optional argument used in the call to `feedmail-run-the-queue'
or `feedmail-run-the-queue-no-prompts' (prefix arg if interactive).
In any case, the affiliated buffer is killed elsewhere, so don't do that
inside this function. Return value is ignored.
The default action is an anonymous function which gets rid of the file
from the queue directory. With a non-nil second argument, a brief
message is give for each file deleted. You could replace this
function, for example, to archive all of your sent messages someplace
\(though there are better ways to get that particular result)."
:group 'feedmail-queue
:type 'function
)
(defvar feedmail-is-a-resend nil
"Non-nil means the message is a Resend (in the RFC-822-or-later sense).
This affects the composition of certain headers. feedmail sets this
variable as soon as it starts prepping the message text buffer, so any
user-supplied functions can rely on it. Users shouldn't set or change this
variable, but may depend on its value as described here.")
(defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail
"Function used to send the prepped buffer to a subprocess.
The function's three (mandatory) arguments are: (1) the buffer
containing the prepped message; (2) a buffer where errors should be
directed; and (3) a list containing the addresses individually as
strings. Popular choices for this are `feedmail-buffer-to-binmail',
`feedmail-buffer-to-smtpmail', `feedmail-buffer-to-sendmail', and
`feedmail-buffer-to-smtp'. If you use the sendmail form, you probably
want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc to nil'.
If you use the binmail form, check the value of `feedmail-binmail-template'."
:group 'feedmail-misc
:type 'function
)
(defconst feedmail-binmail-gnulinuxish-template
(concat
"(echo From "
(if (boundp 'user-login-name) user-login-name "feedmail")
" ; cat -) | /usr/bin/rmail %s")
"Good candidate for GNU/Linux systems and maybe others.
You may need to modify this if your \"rmail\" is in a different place.
For example, I hear that in some Debian systems, it's /usr/sbin/rmail.
See feedmail-binmail-template documentation."
)
(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s"
(if (file-exists-p "/bin/rmail")
"/bin/rmail %s" "/bin/mail %s"))
"Command template for the subprocess which will get rid of the mail.
It can result in any command understandable by /bin/sh. Might not
work at all in non-UNIX environments. The single `%s', if present,
gets replaced by the space-separated, simplified list of addressees.
Used in `feedmail-buffer-to-binmail' to form the shell command which
will receive the contents of the prepped buffer as stdin. The default
value uses /bin/rmail (if it exists) unless `mail-interactive' has been
set non-nil.
If you'd like your errors to come back as mail instead of immediately
in a buffer, try /bin/rmail instead of /bin/mail. If /bin/rmail
exists, this can be accomplished by keeping the default nil setting of
`mail-interactive'. You might also like to consult local mail experts
for any other interesting command line possibilities. Some versions
of UNIX have an rmail program which behaves differently from
/bin/rmail and complains if feedmail gives it a message on stdin. If
you don't know about such things and if there is no local expert to
consult, stick with /bin/mail or use one of the other buffer eating
functions.
The above description applies to \"classic\" UNIX /bin/mail and /bin/rmail.
On most GNU/Linux systems and perhaps other places, /bin/mail behaves
completely differently and shouldn't be used at all in this template.
Instead of /bin/rmail, there is a /usr/bin/rmail, and it can be used
with a wrapper. The wrapper is necessary because /usr/bin/rmail on such
systems requires that the first line of the message appearing on standard
input have a UNIX-style From_ postmark. If you have such a system, the
wrapping can be accomplished by setting the value of `feedmail-binmail-template'
to `feedmail-binmail-gnulinuxish-template'. You should then send some test
messages to make sure it works as expected."
:version "24.1" ; changed default
:group 'feedmail-misc
:type 'string
)
;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
;; feedmail-buffer-to-smtpmail are the only things provided for values
;; for the variable feedmail-buffer-eating-function. It's pretty easy
;; to write your own, though.
(defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
"Function which actually calls /bin/mail as a subprocess.
Feeds the buffer to it."
(feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
(set-buffer prepped)
(apply
#'call-process-region
(append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
(format feedmail-binmail-template
(mapconcat #'identity addr-listoid " "))))))
(defvar sendmail-program)
(defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
"Function which actually calls sendmail as a subprocess.
Feeds the buffer to it. Probably has some flaws for Resent-* and other
complicated cases. Takes addresses from message headers and
might disappoint you with Bcc: handling. In case of odd results, consult
local gurus."
(require 'sendmail)
(feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
(set-buffer prepped)
(apply #'call-process-region
(append (list (point-min) (point-max) sendmail-program
nil errors-to nil "-oi" "-t")
;; provide envelope "from" to sendmail; results will vary
(if feedmail-sendmail-f-doesnt-sell-me-out
(list "-f" user-mail-address))
;; These mean "report errors by mail" and "deliver in background".
(if (null mail-interactive) '("-oem" "-odb")))))
(declare-function smtpmail-via-smtp "smtpmail"
(recipient smtpmail-text-buffer &optional ask-for-password
send-attempts))
(defvar smtpmail-smtp-server)
;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
;; simplified by WJC after more feedmail development;
;; idea (but not implementation) of copying smtpmail trace buffer to
;; feedmail error buffer from:
;; Mon 14-Oct-1996; Douglas Gray Stephens
;; modified to insert error for displaying
(defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid)
"Function which actually calls `smtpmail-via-smtp' to send buffer as e-mail."
;; I'm not sure smtpmail.el is careful about the following
;; return value, but it also uses it internally, so I will fear
;; no evil.
(feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid)
(require 'smtpmail)
(let ((result (smtpmail-via-smtp addr-listoid prepped)))
(when result
(set-buffer errors-to)
(insert "Send via smtpmail failed: " result)
(let ((case-fold-search t)
;; don't be overconfident about the name of the trace buffer
(tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
(mapcar
(lambda (buffy)
(if (string-match tracer (buffer-name buffy))
(progn
(insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
(insert-buffer-substring buffy)
(insert "\n\n"))))
(buffer-list))))))
(declare-function smtp-via-smtp "ext:smtp" (sender recipients smtp-text-buffer))
(defvar smtp-server)
;; FLIM's smtp.el pointed out to me by Kenichi Handa <handa@gnu.org>
(defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid)
"Function which actually calls smtp-via-smtp to send buffer as e-mail."
(feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid)
(require 'smtp)
(if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
(progn
(set-buffer errors-to)
(insert "Send via smtp failed. Probable SMTP protocol error.\n")
(insert "Look for details below or in the *Messages* buffer.\n\n")
(let ((case-fold-search t)
;; don't be overconfident about the name of the trace buffer
(tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
(mapcar
(lambda (buffy)
(if (string-match tracer (buffer-name buffy))
(progn
(insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
(insert-buffer-substring buffy)
(insert "\n\n"))))
(buffer-list))))))
;; just a place to park a docstring
(defconst feedmail-fiddle-plex-blurb nil
"A fiddle-plex is a concise way of specifying header field fiddling.
It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING. The element
VALUE can also be a list sometimes.
NAME is the name of the header field to be fiddled with. Although case
doesn't matter in looking for headers, case of NAME is preserved when a header
is inserted via fiddling. It shouldn't include the trailing colon.
VALUE is either nil, a simple string, a function returning nil or a string, or,
as described below for ACTION `combine', a list of up to three values.
ACTION describes the nature of the fiddling to be done. Possibilities
for ACTION (default is `supplement'):
`supplement' Leave other like fields as-is, insert this one.
`replace' Delete other like fields, if any, and insert this one.
`create' Insert this one only if no like field exists.
`combine' Combine aggregate values of like fields with this one.
In this case, VALUE has a special form. It is a list
of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
VAL-PRE and VAL-POST are strings or nil. VAL-LIKE may
be either a string or a function (it may also be nil,
but there's not much point to that).
Values of like header fields are aggregated, leading and
trailing whitespace is removed, and embedded
whitespace is left as-is. If there are no like
fields, or the aggregate value is an empty string,
VAL-LIKE is not used. Else, if VAL-LIKE is a function,
it is called with two arguments: NAME and the
aggregate like values. Else, if VAL-LIKE is a string, it is
used as a format string where a single %s will be
replaced by the aggregate values of like fields.
VAL-PRE, the results of using VAL-LIKE, and VAL-POST
are concatenated, and the result, if not nil and not
an empty string, is used as the new value for the
field. Although this description sounds a bit
complicated, the idea is to provide a mechanism for
combining the old value with a new value in a flexible
way. For example, if you wanted to add a new value to
an existing header field by adding a semi-colon and
then starting the new value on a continuation line,
you might specify this:
(nil \"%s;\\n\\t\" \"This is my new value\")
FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is
non-nil, feedmail \"smart filling\" is done on VALUE just before
insertion.")
(declare-function vm-mail "ext:vm" (&optional to subject))
(defun feedmail-vm-mail-mode (&optional _)
"Make something like a buffer that has been created via `vm-mail'.
The optional argument is ignored and is just for argument compatibility with
`feedmail-queue-runner-mode-setter'. This function is suitable for being
applied to a file after you've just read it from disk: for example, a
feedmail FQM message file from a queue. You could use something like
this:
(add-to-list \\='auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))"
(feedmail-say-debug ">in-> feedmail-vm-mail-mode")
(let ((the-buf (current-buffer)))
(vm-mail)
(delete-region (point-min) (point-max))
(insert-buffer-substring the-buf)
(setq buffer-file-name (buffer-file-name the-buf))
(set-buffer-modified-p (buffer-modified-p the-buf))
;; For some versions of emacs, saving the message to a queue
;; triggers running the mode function on the buffer, and that
;; leads (through a series of events I don't really understand)
;; to this function being called while the buffer is still
;; marked modified even though it is in the process of being
;; saved. I guess the function gets called during the renaming
;; that takes place en route to the save.
;;
;; This clearing of the marker probably wastes a buffer copy
;; but it's easy to do and more reliable than figuring out what
;; each variant of emacs does in this strange case.
(with-current-buffer the-buf
(set-buffer-modified-p nil))
(kill-buffer the-buf)
))
;;;###autoload
(defun feedmail-send-it ()
"Send the current mail buffer using the Feedmail package.
This is a suitable value for `send-mail-function'. It can be used
with various lower-level mechanisms to provide features such as queueing."
(feedmail-say-debug ">in-> feedmail-send-it")
(save-excursion
(let ((bfn-jiggle nil))
;; if buffer-file-name is nil, temporarily use the stashed value
(if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
(setq buffer-file-name feedmail-queue-buffer-file-name
bfn-jiggle t))
;; avoid matching trouble over slash vs backslash by getting canonical
(if feedmail-queue-directory
(setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
(if feedmail-queue-draft-directory
(setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
(if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
;; else, queuing is enabled, should we ask about it or just do it?
(if feedmail-ask-before-queue
(funcall (feedmail-queue-send-edit-prompt))
(feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))
;; put this back
(if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
)))
(defun feedmail-message-action-send ()
;; hooks can make this take a while so clear the prompt
(feedmail-say-debug ">in-> feedmail-message-action-send")
(message "FQM: Immediate send...")
(feedmail-send-it-immediately-wrapper))
;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu>
(defun feedmail-queue-express-to-queue ()
"Send message directly to the queue, with a minimum of fuss and bother."
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-express-to-queue")
(run-hooks 'feedmail-queue-express-hook)
(let ((feedmail-enable-queue t)
(feedmail-ask-before-queue nil)
(feedmail-queue-reminder-alist nil)
(feedmail-queue-chatty-sit-for 0))
(feedmail-send-it)
)
)
(defun feedmail-queue-express-to-draft ()
"Send message directly to the draft queue, with a minimum of fuss and bother."
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-express-to-draft")
(let ((feedmail-queue-directory feedmail-queue-draft-directory))
(feedmail-queue-express-to-queue)
)
)
(defun feedmail-message-action-send-strong ()
(feedmail-say-debug ">in-> feedmail-message-action-send-strong")
(let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
(defun feedmail-message-action-edit ()
(feedmail-say-debug ">in-> feedmail-message-action-edit")
(error "FQM: Message not queued; returning to edit"))
(defun feedmail-message-action-draft ()
(feedmail-say-debug ">in-> feedmail-message-action-draft")
(feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
(defun feedmail-message-action-draft-strong ()
(feedmail-say-debug ">in-> feedmail-message-action-draft-strong")
(let ((buffer-file-name nil))
(feedmail-message-action-draft)))
(defun feedmail-message-action-queue ()
(feedmail-say-debug ">in-> feedmail-message-action-queue")
(feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
(defun feedmail-message-action-queue-strong ()
(feedmail-say-debug ">in-> feedmail-message-action-queue-strong")
(let ((buffer-file-name nil))
(feedmail-message-action-queue)))
(defun feedmail-message-action-toggle-spray ()
(feedmail-say-debug ">in-> feedmail-message-action-toggle-spray")
(let ((feedmail-enable-spray (not feedmail-enable-spray)))
(if feedmail-enable-spray
(message "FQM: For this message, spray toggled ON")
(message "FQM: For this message, spray toggled OFF"))
(sit-for 3)
;; recursion, but harmless
(feedmail-send-it)))
(defconst feedmail-p-h-b-n "*FQM Help*")
(defun feedmail-message-action-help ()
(feedmail-say-debug ">in-> feedmail-message-action-help")
(let ((d-string " ")
(fqm-help (get-buffer feedmail-p-h-b-n)))
(if (stringp feedmail-ask-before-queue-default)
(setq d-string feedmail-ask-before-queue-default)
(setq d-string (char-to-string feedmail-ask-before-queue-default)))
(if (and fqm-help (get-buffer-window fqm-help))
(feedmail-scroll-buffer 'up fqm-help)
(feedmail-message-action-help-blat d-string))
;; recursive, but no worries (it goes deeper on user action)
(feedmail-send-it)))
(defun feedmail-message-action-help-blat (d-string)
(feedmail-say-debug ">in-> feedmail-message-action-help-blat")
(with-output-to-temp-buffer feedmail-p-h-b-n
(princ (substitute-command-keys "\
You're dispatching a message and feedmail queuing is enabled.
Typing ? again will normally scroll this help buffer.
Choices:
q QUEUE for later sending (via feedmail-run-the-queue)
Q QUEUE! like \"q\", but always make a new file
i IMMEDIATELY send this (but not the other queued messages)
I IMMEDIATELY! like \"i\", but skip following confirmation prompt
d DRAFT queue in the draft directory
D DRAFT! like \"d\", but always make a new file
e EDIT return to the message edit buffer (don't send or queue)
* SPRAY toggle spray mode (individual message transmissions)
> SCROLL UP scroll message up (toward end of message)
< SCROLL DOWN scroll message down (toward beginning of message)
? HELP show or scroll this help buffer
Synonyms:
s SEND immediately (same as \"i\")
S SEND! immediately (same as \"I\")
r ROUGH draft (same as \"d\")
R ROUGH! draft (same as \"D\")
n NOPE didn't mean it (same as \"e\")
y YUP do the default behavior (same as \"C-m\")
SPC SCROLL UP (same as \">\")
The user-configurable default is currently \""))
(princ d-string)
(princ "\". For other possibilities,
see the variable feedmail-prompt-before-queue-user-alist.
")
(and (stringp feedmail-prompt-before-queue-help-supplement)
(princ feedmail-prompt-before-queue-help-supplement))
(with-current-buffer standard-output
(help-mode))))
(defun feedmail-message-action-scroll-up ()
(feedmail-say-debug ">in-> feedmail-message-action-scroll-up")
(feedmail-scroll-buffer 'up)
;; recursive, but no worries (it goes deeper on user action)
(feedmail-send-it))
(defun feedmail-message-action-scroll-down ()
(feedmail-say-debug ">in-> feedmail-message-action-scroll-down")
(feedmail-scroll-buffer 'down)
;; recursive, but no worries (it goes deeper on user action)
(feedmail-send-it))
;;;###autoload
(defun feedmail-run-the-queue-no-prompts (&optional arg)
"Like `feedmail-run-the-queue', but suppress confirmation prompts."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-run-the-queue-no-prompts")
(let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
;;;###autoload
(defun feedmail-run-the-queue-global-prompt (&optional arg)
"Like `feedmail-run-the-queue', but with a global confirmation prompt.
This is generally most useful if run non-interactively, since you can
bail out with an appropriate answer to the global confirmation prompt."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
(let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
;;;###autoload
(defun feedmail-run-the-queue (&optional arg)
"Visit each message in the feedmail queue directory and send it out.
Return value is a list of three things: number of messages sent, number of
messages skipped, and number of non-message things in the queue (commonly
backup file names and the like)."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-run-the-queue")
;; avoid matching trouble over slash vs backslash by getting canonical
(if feedmail-queue-directory
(setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
(if feedmail-queue-draft-directory
(setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
(let* ((maybe-file)
(qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
(dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
(q-cnt (nth 0 qlist))
(q-oth (nth 1 qlist))
(d-cnt (nth 0 dlist))
(d-oth (nth 1 dlist))
(messages-sent 0)
(messages-skipped 0)
(blobby-buffer)
(already-buffer)
(do-the-run t)
(list-of-possible-fqms))
(if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
(setq do-the-run
(y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
d-cnt d-oth q-cnt q-oth)
5 nil)))
(if (not do-the-run)
(setq messages-skipped q-cnt)
(save-window-excursion
(setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
(if feedmail-queue-run-orderer
(setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
(mapc
(lambda (blobby)
(setq maybe-file (expand-file-name blobby feedmail-queue-directory))
(cond
((file-directory-p maybe-file) nil) ; don't care about subdirs
((feedmail-fqm-p blobby)
(setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
(setq already-buffer
(find-buffer-visiting maybe-file))
(if (and already-buffer (buffer-modified-p already-buffer))
(save-window-excursion
(display-buffer (set-buffer already-buffer))
;; make a guess that the user just forgot to save
(if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
(save-buffer))))
(set-buffer blobby-buffer)
(setq buffer-offer-save nil)
(buffer-disable-undo blobby-buffer)
(insert-file-contents-literally maybe-file)
(goto-char (point-min))
;; if at least two line-endings with CRLF, translate the file
(if (looking-at ".*\r\n.*\r\n")
(while (search-forward "\r\n" nil t)
(replace-match "\n" nil t)))
(funcall feedmail-queue-runner-mode-setter arg)
(condition-case signal-stuff ; don't give up the loop if user skips some
(let ((feedmail-enable-queue nil)
(feedmail-queue-runner-is-active maybe-file))
;; if can't find EOH, this is no message!
(unless (feedmail-find-eoh t)
(feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
(error "FQM: You should never see this message"))
(feedmail-say-debug "Prepping %s" maybe-file)
;; the catch is a way out for users to voluntarily skip sending a message
(catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
(set-buffer blobby-buffer)
(if (buffer-modified-p) ; still modified, means wasn't sent
(progn
(setq messages-skipped (1+ messages-skipped))
(feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function))
(setq messages-sent (1+ messages-sent))
(funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
(if (and already-buffer (not (file-exists-p maybe-file)))
;; we have gotten rid of the file associated with the
;; buffer, so update the buffer's notion of that
(with-current-buffer already-buffer
(setq buffer-file-name nil)))))
;; the handler for the condition-case
(error (setq messages-skipped (1+ messages-skipped))
(ding t)
(message "FQM: Trapped `%s', message left in queue." (car signal-stuff))
(sit-for 3)
(message "FQM: Trap details: \"%s\""
(mapconcat #'identity (cdr signal-stuff) "\" \""))
(sit-for 3)))
(kill-buffer blobby-buffer)
(feedmail-say-chatter
"%d to go, %d sent, %d skipped (%d other files ignored)"
(- q-cnt messages-sent messages-skipped)
messages-sent messages-skipped q-oth)
)))
list-of-possible-fqms)))
(if feedmail-queue-chatty
(progn
(feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
messages-sent messages-skipped q-oth)
(feedmail-queue-reminder 'after-run)
(sit-for feedmail-queue-chatty-sit-for)))
(list messages-sent messages-skipped q-oth)))
;;;###autoload
(defun feedmail-queue-reminder (&optional what-event)
"Perform some kind of reminder activity about queued and draft messages.
Called with an optional symbol argument which says what kind of event
is triggering the reminder activity. The default is `on-demand', which
is what you typically would use if you were putting this in your Emacs start-up
or mail hook code. Other recognized values for WHAT-EVENT (these are passed
internally by feedmail):
after-immediate (a message has just been sent in immediate mode)
after-queue (a message has just been queued)
after-draft (a message has just been placed in the draft directory)
after-run (the queue has just been run, possibly sending messages)
WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If
the associated value is a function, it is called without arguments and is
expected to perform the reminder activity. You can supply your own reminder
functions by redefining `feedmail-queue-reminder-alist'. If you don't want any
reminders, you can set `feedmail-queue-reminder-alist' to nil."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
(let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
(setq entry (assoc key feedmail-queue-reminder-alist))
(setq reminder (cdr entry))
(if (fboundp reminder) (funcall reminder)))
)
(defun feedmail-queue-reminder-brief ()
"Brief display of draft and queued message counts in minibuffer."
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-reminder-brief")
(let (q-cnt d-cnt q-lis d-lis)
(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
(setq q-cnt (car q-lis))
(setq d-cnt (car d-lis))
(if (or (> q-cnt 0) (> d-cnt 0))
(progn
(message "FQM: [D: %d, Q: %d]" d-cnt q-cnt))))
)
(defun feedmail-queue-reminder-medium ()
"Verbose display of draft and queued message counts in minibuffer."
(interactive)
(feedmail-say-debug ">in-> feedmail-queue-reminder-medium")
(let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
(setq q-cnt (car q-lis))
(setq d-cnt (car d-lis))
(setq q-oth (nth 1 q-lis))
(setq d-oth (nth 1 d-lis))
(if (or (> q-cnt 0) (> d-cnt 0))
(progn
(message "FQM: Draft: %dm+%d in \"%s\", Queue: %dm+%d in \"%s\""
d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
)
(defun feedmail-queue-send-edit-prompt ()
"Ask whether to queue, send immediately, or return to editing a message, etc."
(feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt")
(feedmail-queue-send-edit-prompt-inner
feedmail-ask-before-queue-default
feedmail-ask-before-queue-prompt
feedmail-ask-before-queue-reprompt
'feedmail-message-action-help
feedmail-prompt-before-queue-standard-alist
feedmail-prompt-before-queue-user-alist
))
(defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper
standard-alist user-alist)
(feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner")
;; Some implementation ideas here came from the userlock.el code
(or defining-kbd-macro (discard-input))
(save-window-excursion
(let ((answer) (d-char) (d-string " "))
(if (stringp default)
(progn
(setq d-char (string-to-char default)
d-string default))
(setq d-string (char-to-string default))
(setq d-char default)
)
(while (null answer)
(message prompt d-string)
(let ((user-sez
(let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
(read-char-exclusive))))
(if (= user-sez help-char)
(setq answer (cons '^ helper))
(if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
(setq user-sez d-char))
(setq answer (or (assoc user-sez user-alist)
(assoc user-sez standard-alist)))
(if (or (null answer) (null (cdr answer)))
(progn
(beep)
(message reprompt d-string)
(sit-for 3)))
)))
(cdr answer)
)))
(defun feedmail-scroll-buffer (direction &optional buffy)
;; scrolling fun
;; emacs convention is that scroll-up moves text up, window down
(feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction)
(save-selected-window
(let ((fqm-window (display-buffer (if buffy buffy (current-buffer)))))
(select-window fqm-window)
(if (eq direction 'up)
(if (pos-visible-in-window-p (point-max) fqm-window)
;; originally just (goto-char (point-min)), but
;; pos-visible-in-window-p seems oblivious to that
(scroll-down 999999)
(scroll-up))
(if (pos-visible-in-window-p (point-min) fqm-window)
(scroll-up 999999)
(scroll-down))))))
(defun feedmail-look-at-queue-directory (queue-directory)
"Find out some things about a queue directory.
Result is a list containing a count of queued messages in the
directory, a count of other files in the directory, and a high water
mark for prefix sequence numbers. Subdirectories are not included in
the counts."
(feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory)
(let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
;; iterate, counting things we find along the way in the directory
(if (file-directory-p queue-directory)
(mapc
(lambda (blobby)
(cond
((file-directory-p blobby) nil) ; don't care about subdirs
((feedmail-fqm-p blobby)
(setq blobbet (file-name-nondirectory blobby))
(if (string-match "^[0-9][0-9][0-9]-" blobbet)
(let ((water-mark))
(setq water-mark (string-to-number (substring blobbet 0 3)))
(if (> water-mark high-water) (setq high-water water-mark))))
(setq q-cnt (1+ q-cnt)))
(t (setq q-oth (1+ q-oth)))
))
(directory-files queue-directory t)))
(list q-cnt q-oth high-water)))
(defun feedmail-tidy-up-slug (slug)
"Utility for mapping out suspect characters in a potential filename."
(feedmail-say-debug ">in-> feedmail-tidy-up-slug %s" slug)
;; even programmers deserve a break sometimes, so cover nil for them
(if (null slug) (setq slug ""))
;; replace all non-alphanumerics with hyphen for safety
(while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug)))
;; collapse multiple hyphens to one
(while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
;; for tidiness, peel off leading hyphens
(if (string-match "^-*" slug) (setq slug (replace-match "" nil nil slug)))
;; for tidiness, peel off trailing hyphens
(if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
slug
)
(defun feedmail-queue-subject-slug-maker (&optional queue-directory)
"Create a name for storing the message in the queue.
Optional argument QUEUE-DIRECTORY specifies into which directory the
file will be placed. The name is based on the Subject: header (if
there is one). If there is no subject,
`feedmail-queue-default-file-slug' is consulted. Special characters are
mapped to mostly alphanumerics for safety."
(feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory)
(let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
(setq eoh-marker (feedmail-find-eoh))
(goto-char (point-min))
;; get raw subject value (first line, anyhow)
(if (re-search-forward "^Subject:" eoh-marker t)
(progn (setq s-point (point))
(end-of-line)
(setq subject (buffer-substring-no-properties s-point (point)))))
(setq subject (feedmail-tidy-up-slug subject))
(if (zerop (length subject))
(setq subject
(cond
((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
((fboundp feedmail-queue-default-file-slug)
(save-excursion (funcall feedmail-queue-default-file-slug)))
((eq feedmail-queue-default-file-slug 'ask)
(file-name-nondirectory
(read-file-name "FQM: Message filename slug? "
(file-name-as-directory queue-directory) subject nil subject)))
(t "no subject"))
))
;; one more time, with feeling
(feedmail-tidy-up-slug subject)
))
(defun feedmail-create-queue-filename (queue-directory)
(feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory)
(let ((slug "wjc"))
(cond
(feedmail-queue-slug-maker
(save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
(feedmail-ask-for-queue-slug
(setq slug (file-name-nondirectory
(read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
(file-name-as-directory queue-directory) slug nil slug))))
)
(setq slug (feedmail-tidy-up-slug slug))
(setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
(concat
(expand-file-name slug queue-directory)
feedmail-queue-fqm-suffix)
))
(defun feedmail-dump-message-to-queue (queue-directory what-event)
(feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event)
(or (file-accessible-directory-p queue-directory)
;; progn to get nil result no matter what
(progn (make-directory queue-directory t) nil)
(file-accessible-directory-p queue-directory)
(error "FQM: Message not queued; trouble with directory %s" queue-directory))
(let ((filename)
(is-fqm)
(is-in-this-dir)
(previous-buffer-file-name buffer-file-name))
(if buffer-file-name
(progn
(setq is-fqm (feedmail-fqm-p buffer-file-name))
(setq is-in-this-dir (string-equal
(directory-file-name
(expand-file-name queue-directory))
(directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
;; if visiting a queued message, just save
(if (and is-fqm is-in-this-dir)
(setq filename buffer-file-name)
(setq filename (feedmail-create-queue-filename queue-directory)))
;; make binary file on DOS/Windows 95/Windows NT, etc
(let ((coding-system-for-write
(if feedmail-force-binary-write
'no-conversion
coding-system-for-write)))
(write-file filename))
;; convenient for moving from draft to q, for example
(if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
(let (d b s)
(setq b (file-name-nondirectory previous-buffer-file-name))
(setq d (file-name-directory previous-buffer-file-name))
(setq s (substring d (1- (length d))))
(setq d (substring d 0 (1- (length d))))
(setq d (file-name-nondirectory d))
(y-or-n-p (format "FQM: Was previously %s%s%s; delete that? "
d s b))))
(delete-file previous-buffer-file-name))
(if feedmail-nuke-buffer-after-queue
(let ((a-s-file-name buffer-auto-save-file-name))
;; be aggressive in nuking auto-save files
(and (kill-buffer (current-buffer))
delete-auto-save-files
(file-exists-p a-s-file-name)
(delete-file a-s-file-name))))
(feedmail-say-chatter "Queued in %s" filename)
(if feedmail-queue-chatty
(progn
(feedmail-queue-reminder what-event)
(sit-for feedmail-queue-chatty-sit-for)))))
;; from a similar function in mail-utils.el
(defun feedmail-rfc822-time-zone (time)
(declare (obsolete format-time-string "29.1"))
(feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
(format-time-string "%z" time))
(defun feedmail-rfc822-date (arg-time)
(feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
(let ((system-time-locale "C"))
(format-time-string "%a, %e %b %Y %T %z" arg-time)))
(defun feedmail-send-it-immediately-wrapper ()
"Wrapper to catch skip-me-i."
(if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately)))
(error "FQM: Sending...abandoned!")))
(declare-function expand-mail-aliases "mailalias" (beg end &optional exclude))
(defun feedmail-send-it-immediately ()
"Handle immediate sending, including during a queue run."
(feedmail-say-debug ">in-> feedmail-send-it-immediately")
(let ((feedmail-error-buffer
(get-buffer-create " *FQM Outgoing Email Errors*"))
(feedmail-prepped-text-buffer
(get-buffer-create " *FQM Outgoing Email Text*"))
(feedmail-raw-text-buffer (current-buffer))
(feedmail-address-list)
(eoh-marker)
(bcc-holder)
(resent-bcc-holder)
(a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):")
(a-re-rtc "^Resent-\\(To\\|Cc\\):")
(a-re-rb "^Resent-Bcc:")
(a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
(a-re-dtc "^\\(To\\|Cc\\):")
(a-re-db "^Bcc:")
;; To get a temporary changeable copy.
(mail-header-separator mail-header-separator)
)
(unwind-protect
(save-current-buffer
(set-buffer feedmail-error-buffer) (erase-buffer)
(set-buffer feedmail-prepped-text-buffer) (erase-buffer)
;; Jam contents of user-supplied mail buffer into our scratch buffer.
(insert-buffer-substring feedmail-raw-text-buffer)
;; Require one newline at the end.
(goto-char (point-max))
(or (= (preceding-char) ?\n) (insert ?\n))
(let ((case-fold-search nil))
;; Change header-delimiter to be what mailers expect (empty line).
;; leaves match data in place or signals error
(feedmail-say-debug "looking for m-h-s \"%s\""
mail-header-separator)
(setq eoh-marker (feedmail-find-eoh))
(feedmail-say-debug "found m-h-s %s" eoh-marker)
(setq mail-header-separator "")
(replace-match ""))
;; (replace-match "\\1")) ;; might be empty or "\r"
;; mail-aliases nil = mail-abbrevs.el
(feedmail-say-debug "expanding mail aliases")
(if (or feedmail-force-expand-mail-aliases
mail-aliases)
(expand-mail-aliases (point-min) eoh-marker))
;; Make it pretty.
(if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
;; Ignore any blank lines in the header.
(goto-char (point-min))
(while (and (re-search-forward "\n\n\n*" eoh-marker t)
(< (point) eoh-marker))
(replace-match "\n"))
(let ((case-fold-search t) (addr-regexp))
(goto-char (point-min))
;; There are some RFC-822-or-later combinations/cases missed here,
;; but probably good enough and what users expect.
;;
;; Use resent-* stuff only if there is at least one non-empty one.
(setq feedmail-is-a-resend
(re-search-forward
;; Header name, followed by optional whitespace, followed by
;; non-whitespace, followed by anything, followed by
;; newline; the idea is empty Resent-* headers are ignored.
"^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
eoh-marker t))
;; If we say so, gather the Bcc stuff before the main course.
(when (eq feedmail-deduce-bcc-where 'first)
(setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
(setq feedmail-address-list
(feedmail-deduce-address-list
feedmail-prepped-text-buffer (point-min) eoh-marker
addr-regexp feedmail-address-list)))
;; The main course.
(setq addr-regexp
(if (memq feedmail-deduce-bcc-where '(first last))
;; Handled by first or last cases, so don't get
;; Bcc stuff.
(if feedmail-is-a-resend a-re-rtc a-re-dtc)
;; Not handled by first or last cases, so also get
;; Bcc stuff.
(if feedmail-is-a-resend a-re-rtcb a-re-dtcb)))
(setq feedmail-address-list
(feedmail-deduce-address-list
feedmail-prepped-text-buffer (point-min) eoh-marker
addr-regexp feedmail-address-list))
;; If we say so, gather the Bcc stuff after the main course.
(when (eq feedmail-deduce-bcc-where 'last)
(setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db))
(setq feedmail-address-list
(feedmail-deduce-address-list
feedmail-prepped-text-buffer (point-min) eoh-marker
addr-regexp feedmail-address-list)))
(if (not feedmail-address-list)
(error "FQM: Sending...abandoned, no addressees"))
;; Not needed, but meets user expectations.
(setq feedmail-address-list (nreverse feedmail-address-list))
;; Find and handle any Bcc fields.
(setq bcc-holder
(feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
(setq resent-bcc-holder
(feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
(when (and bcc-holder (not feedmail-nuke-bcc))
(goto-char (point-min))
(insert bcc-holder))
(when (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
(goto-char (point-min))
(insert resent-bcc-holder))
(goto-char (point-min))
;; fiddle about, fiddle about, fiddle about....
(feedmail-fiddle-from)
(feedmail-fiddle-sender)
(feedmail-fiddle-x-mailer)
(feedmail-fiddle-message-id
(or feedmail-queue-runner-is-active
(buffer-file-name feedmail-raw-text-buffer)))
(feedmail-fiddle-date
(or feedmail-queue-runner-is-active
(buffer-file-name feedmail-raw-text-buffer)))
(feedmail-fiddle-list-of-fiddle-plexes
feedmail-fiddle-plex-user-list)
;; don't send out a blank headers of various sorts
;; (this loses on continued line with a blank first line)
(goto-char (point-min))
(and feedmail-nuke-empty-headers ; hey, who's an empty-header?
(while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n"
eoh-marker t)
(replace-match ""))))
(feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
(run-hooks 'feedmail-last-chance-hook)
(save-window-excursion
(let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:"))
(also-file)
(confirm (cond
((eq feedmail-confirm-outgoing 'immediate)
(not feedmail-queue-runner-is-active))
((eq feedmail-confirm-outgoing 'queued)
feedmail-queue-runner-is-active)
(t feedmail-confirm-outgoing)))
(fullframe (cond
((eq feedmail-display-full-frame 'immediate)
(not feedmail-queue-runner-is-active))
((eq feedmail-display-full-frame 'queued)
feedmail-queue-runner-is-active)
(t feedmail-display-full-frame))))
(if fullframe
(progn
(switch-to-buffer feedmail-prepped-text-buffer t)
(delete-other-windows)))
(if (or (not confirm)
(feedmail-one-last-look feedmail-prepped-text-buffer))
(let ((user-mail-address
(feedmail-envelope-deducer eoh-marker)))
(feedmail-say-debug "give it to buffer-eater")
(feedmail-give-it-to-buffer-eater)
(feedmail-say-debug "gave it to buffer-eater")
(if (and (not feedmail-queue-runner-is-active)
(setq also-file
(buffer-file-name feedmail-raw-text-buffer)))
(progn
;; If a file but not running the queue,
;; offer to delete it
(setq also-file (expand-file-name also-file))
(when (or feedmail-queue-auto-file-nuke
(y-or-n-p
(format "FQM: Delete message file %s? "
also-file)))
;; If we delete the affiliated file, get rid
;; of the file name association and make sure we
;; don't annoy people with a prompt on exit.
(delete-file also-file)
(with-current-buffer feedmail-raw-text-buffer
(setq buffer-offer-save nil)
(setq buffer-file-name nil)))))
(goto-char (point-min))
;; Re-insert and handle any Fcc fields (and, optionally,
;; any Bcc).
(when fcc
(let ((coding-system-for-write
(if (and (memq system-type '(ms-dos windows-nt))
feedmail-force-binary-write)
'no-conversion
coding-system-for-write)))
(insert fcc)
(unless feedmail-nuke-bcc-in-fcc
(if bcc-holder (insert bcc-holder))
(if resent-bcc-holder
(insert resent-bcc-holder)))
(run-hooks 'feedmail-before-fcc-hook)
(when feedmail-nuke-body-in-fcc
(goto-char eoh-marker)
(if (natnump feedmail-nuke-body-in-fcc)
(forward-line feedmail-nuke-body-in-fcc))
(delete-region (point) (point-max)))
(mail-do-fcc eoh-marker))))
;; User bailed out of one-last-look.
(if feedmail-queue-runner-is-active
(throw 'skip-me-q 'skip-me-q)
(throw 'skip-me-i 'skip-me-i))
)))) ; unwind-protect body (save-excursion)
;; unwind-protect cleanup forms.
(kill-buffer feedmail-prepped-text-buffer)
(set-buffer feedmail-error-buffer)
(if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
(display-buffer feedmail-error-buffer)
;; Read fast ... the meter is running.
(if feedmail-queue-runner-is-active
(progn
(ding t)
(feedmail-say-chatter "Sending...failed")))
(error "FQM: Sending...failed"))
(set-buffer feedmail-raw-text-buffer))
) ; let
(when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
(feedmail-queue-reminder 'after-immediate)
(sit-for feedmail-queue-chatty-sit-for)))
(defun feedmail-fiddle-header (name value &optional action folding)
"Internal feedmail function for jamming fields into message header.
NAME, VALUE, ACTION, and FOLDING are the four elements of a
fiddle-plex, as described in the documentation for the variable
`feedmail-fiddle-plex-blurb'."
(feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s"
name value action folding)
(let ((case-fold-search t)
(header-colon (concat (regexp-quote name) ":"))
header-regexp eoh-marker has-like ag-like val-like that-point)
(setq header-regexp (concat "^" header-colon))
(setq eoh-marker (feedmail-find-eoh))
(goto-char (point-min))
(setq has-like (re-search-forward header-regexp eoh-marker t))
(if (not action) (setq action 'supplement))
(cond
((eq action 'supplement)
;; trim leading/trailing whitespace
(if (string-match "\\`[ \t\n]+" value)
(setq value (substring value (match-end 0))))
(if (string-match "[ \t\n]+\\'" value)
(setq value (substring value 0 (match-beginning 0))))
(if (> (length value) 0)
(progn
(if feedmail-fiddle-headers-upwardly
(goto-char (point-min))
(goto-char eoh-marker))
(setq that-point (point))
(insert name ": " value "\n")
(if folding (feedmail-fill-this-one that-point (point))))))
((eq action 'replace)
(if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
(feedmail-fiddle-header name value 'supplement folding))
((eq action 'create)
(if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))
((eq action 'combine)
(setq val-like (nth 1 value))
(setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
;; get rid of initial header name from first instance (front of string)
(if (string-match (concat header-regexp "[ \t\n]+") ag-like)
(setq ag-like (replace-match "" t t ag-like)))
;; get rid of embedded header names from subsequent instances
(while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
(setq ag-like (replace-match "\n\t" t t ag-like)))
;; trim leading/trailing whitespace
(if (string-match "\\`[ \t\n]+" ag-like)
(setq ag-like (substring ag-like (match-end 0))))
(if (string-match "[ \t\n]+\\'" ag-like)
(setq ag-like (substring ag-like 0 (match-beginning 0))))
;; if ag-like is not nil and not an empty string, transform it via a function
;; call or format operation
(if (> (length ag-like) 0)
(setq ag-like
(cond
((and (symbolp val-like) (fboundp val-like))
(funcall val-like name ag-like))
((stringp val-like)
(format val-like ag-like))
(t nil))))
(feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
))
(defun feedmail-give-it-to-buffer-eater ()
(feedmail-say-debug ">in-> feedmail-give-it-to-buffer-eater")
(save-excursion
(if feedmail-enable-spray
(mapcar
(lambda (address)
(let ((feedmail-spray-this-address address)
(spray-buffer
(get-buffer-create " *FQM Outgoing Email Spray*")))
(with-current-buffer spray-buffer
(erase-buffer)
;; not life's most efficient methodology, but spraying isn't
;; an every-5-minutes event either
(insert-buffer-substring feedmail-prepped-text-buffer)
;; There's a good case to me made that each separate
;; transmission of a message in the spray should
;; have a distinct Message-Id:. There is also a less
;; compelling argument in the other direction.
;; I think they technically should have distinct
;; Message-Id:s, but I doubt that anyone cares,
;; practically. If someone complains about it, I'll
;; add it.
(feedmail-fiddle-list-of-spray-fiddle-plexes
feedmail-spray-address-fiddle-plex-list)
;; this (let ) is just in case some buffer eater
;; is cheating and using the global variable name instead
;; of its argument to find the buffer
(let ((feedmail-prepped-text-buffer spray-buffer))
(funcall feedmail-buffer-eating-function
feedmail-prepped-text-buffer
feedmail-error-buffer
(list feedmail-spray-this-address))))
(kill-buffer spray-buffer)
))
feedmail-address-list)
(feedmail-say-debug "calling buffer-eater %s"
feedmail-buffer-eating-function)
(funcall feedmail-buffer-eating-function
feedmail-prepped-text-buffer
feedmail-error-buffer
feedmail-address-list))))
(defun feedmail-envelope-deducer (eoh-marker)
"If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'.
Else, look for Sender: or From: (or Resent-*) and
return that value."
(feedmail-say-debug ">in-> feedmail-envelope-deducer %s" eoh-marker)
(if (not feedmail-deduce-envelope-from)
user-mail-address
(let ((from-list))
(setq from-list
(feedmail-deduce-address-list
(current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-Sender:" "^Sender:")
from-list))
(if (not from-list)
(setq from-list
(feedmail-deduce-address-list
(current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-From:" "^From:")
from-list)))
(if (and from-list (car from-list)) (car from-list) user-mail-address))))
(defun feedmail-fiddle-from ()
"Fiddle From:."
(feedmail-say-debug ">in-> feedmail-fiddle-from")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil feedmail-from-line) nil)
;; t is the same as using the default computation, so compute it and recurse
;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
;; improvement using user-mail-address suggested by
;; gray@austin.apc.slb.com (Douglas Gray Stephens)
((eq t feedmail-from-line)
(let ((feedmail-from-line
(cond
((eq mail-from-style nil) user-mail-address)
((eq mail-from-style 'parens) (concat user-mail-address " (" (user-full-name) ")"))
((eq mail-from-style 'angles) (concat "\"" (user-full-name) "\" <" user-mail-address ">"))
)))
(feedmail-fiddle-from)))
;; if it's a string, simply make a fiddle-plex out of it and recurse
((stringp feedmail-from-line)
(let ((feedmail-from-line (list "ignored" feedmail-from-line 'create)))
(feedmail-fiddle-from)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp feedmail-from-line) (fboundp feedmail-from-line))
(let ((feedmail-from-line (funcall feedmail-from-line)))
(feedmail-fiddle-from)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp feedmail-from-line)
(feedmail-fiddle-header
(if feedmail-is-a-resend "Resent-From" "From")
(nth 1 feedmail-from-line) ; value
(nth 2 feedmail-from-line) ; action
(nth 3 feedmail-from-line))))) ; folding
(defun feedmail-fiddle-sender ()
"Fiddle Sender:."
(feedmail-say-debug ">in-> feedmail-fiddle-sender")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil feedmail-sender-line) nil)
;; t is not allowed, but handled it just to avoid bugs later
((eq t feedmail-sender-line) nil)
;; if it's a string, simply make a fiddle-plex out of it and recurse
((stringp feedmail-sender-line)
(let ((feedmail-sender-line (list "ignored" feedmail-sender-line 'create)))
(feedmail-fiddle-sender)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp feedmail-sender-line) (fboundp feedmail-sender-line))
(let ((feedmail-sender-line (funcall feedmail-sender-line)))
(feedmail-fiddle-sender)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp feedmail-sender-line)
(feedmail-fiddle-header
(if feedmail-is-a-resend "Resent-Sender" "Sender")
(nth 1 feedmail-sender-line) ; value
(nth 2 feedmail-sender-line) ; action
(nth 3 feedmail-sender-line))))) ; folding
(defun feedmail-default-date-generator (maybe-file)
"Default function for generating Date: header contents."
(feedmail-say-debug ">in-> feedmail-default-date-generator")
(let ((attr (and maybe-file (file-attributes maybe-file))))
(when attr
(feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (file-attribute-access-time attr))))
(feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (file-attribute-modification-time attr))))
(feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (file-attribute-status-change-time attr)))))
(feedmail-rfc822-date (and attr (not feedmail-queue-use-send-time-for-date)
(file-attribute-modification-time attr)))))
(defun feedmail-fiddle-date (maybe-file)
"Fiddle Date:. See documentation of `feedmail-date-generator'."
(feedmail-say-debug ">in-> feedmail-fiddle-date")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil feedmail-date-generator) nil)
;; t is the same as using the function feedmail-default-date-generator, so let it and recurse
((eq t feedmail-date-generator)
(let ((feedmail-date-generator (feedmail-default-date-generator maybe-file)))
(feedmail-fiddle-date maybe-file)))
;; if it's a string, simply make a fiddle-plex out of it and recurse
((stringp feedmail-date-generator)
(let ((feedmail-date-generator (list "ignored" feedmail-date-generator 'create)))
(feedmail-fiddle-date maybe-file)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp feedmail-date-generator) (fboundp feedmail-date-generator))
(let ((feedmail-date-generator (funcall feedmail-date-generator maybe-file)))
(feedmail-fiddle-date maybe-file)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp feedmail-date-generator)
(feedmail-fiddle-header
(if feedmail-is-a-resend "Resent-Date" "Date")
(nth 1 feedmail-date-generator) ; value
(nth 2 feedmail-date-generator) ; action
(nth 3 feedmail-date-generator))))) ; folding
(defun feedmail-default-message-id-generator (maybe-file)
"Default function for generating Message-Id: header contents.
Based on a date and a sort of random number for tie breaking. Unless
`feedmail-message-id-suffix' is defined, uses `user-mail-address', so be
sure it's set. If both are nil, creates a quasi-random suffix that is
probably not appropriate for you."
(feedmail-say-debug ">in-> feedmail-default-message-id-generator %s"
maybe-file)
(let ((date-time)
(system-time-locale "C")
(end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
(if (not end-stuff) (setq end-stuff (format "%d.example.com" (random))))
(if (string-match "^\\(.*\\)@" end-stuff)
(setq end-stuff
(concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
(setq end-stuff (concat "@" end-stuff)))
(if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
(setq date-time (file-attribute-modification-time
(file-attributes maybe-file))))
(format "<%d-%s%s>"
(mod (random) 10000)
(format-time-string "%a%d%b%Y%H%M%S%z" date-time)
end-stuff))
)
(defun feedmail-fiddle-message-id (maybe-file)
"Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'."
(feedmail-say-debug ">in-> feedmail-fiddle-message-id %s" maybe-file)
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil feedmail-message-id-generator) nil)
;; t is the same as using the function feedmail-default-message-id-generator, so let it and recurse
((eq t feedmail-message-id-generator)
(let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file)))
(feedmail-fiddle-message-id maybe-file)))
;; if it's a string, simply make a fiddle-plex out of it and recurse
((stringp feedmail-message-id-generator)
(let ((feedmail-message-id-generator (list "ignored" feedmail-message-id-generator 'create)))
(feedmail-fiddle-message-id maybe-file)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp feedmail-message-id-generator) (fboundp feedmail-message-id-generator))
(let ((feedmail-message-id-generator (funcall feedmail-message-id-generator maybe-file)))
(feedmail-fiddle-message-id maybe-file)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp feedmail-message-id-generator)
(feedmail-fiddle-header
(if feedmail-is-a-resend "Resent-Message-Id" "Message-Id")
(nth 1 feedmail-message-id-generator) ; value
(nth 2 feedmail-message-id-generator) ; action
(nth 3 feedmail-message-id-generator))))) ; folding
(defun feedmail-default-x-mailer-generator ()
"Default function for generating X-Mailer: header contents."
(concat
(let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs "))
emacs-version " (via feedmail " feedmail-patch-level
(if feedmail-queue-runner-is-active " Q" " I")
(if feedmail-enable-spray "S" "")
(if feedmail-x-mailer-line-user-appendage ") " ")")
feedmail-x-mailer-line-user-appendage))
(defun feedmail-fiddle-x-mailer ()
"Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'."
(feedmail-say-debug ">in-> feedmail-fiddle-x-mailer")
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil feedmail-x-mailer-line) nil)
;; t is the same as using the function feedmail-default-x-mailer-generator, so let it and recurse
((eq t feedmail-x-mailer-line)
(let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
(feedmail-fiddle-x-mailer)))
;; if it's a string, simply make a fiddle-plex out of it and recurse
((stringp feedmail-x-mailer-line)
(let ((feedmail-x-mailer-line (list "ignored" (list feedmail-x-mailer-line ";\n\t%s") 'combine)))
(feedmail-fiddle-x-mailer)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp feedmail-x-mailer-line) (fboundp feedmail-x-mailer-line))
(let ((feedmail-x-mailer-line (funcall feedmail-x-mailer-line)))
(feedmail-fiddle-x-mailer)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp feedmail-x-mailer-line)
(feedmail-fiddle-header
(if feedmail-is-a-resend "X-Resent-Mailer" "X-Mailer")
(nth 1 feedmail-x-mailer-line) ; value
(nth 2 feedmail-x-mailer-line) ; action
(nth 3 feedmail-x-mailer-line))))) ; folding
(defun feedmail-fiddle-spray-address (addy-plex)
"Fiddle header for single spray address. Uses `feedmail-spray-this-address'."
(feedmail-say-debug ">in-> feedmail-fiddle-spray-address %s" addy-plex)
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
((eq nil addy-plex) nil)
;; t means the same as using "To:" and unembellished addy
((eq t addy-plex)
(let ((addy-plex (list "To" feedmail-spray-this-address)))
(feedmail-fiddle-spray-address addy-plex)))
;; if it's a string, simply make a fiddle-plex out of it and recurse, assuming
;; the string names a header field (e.g., "To")
((stringp addy-plex)
(let ((addy-plex (list addy-plex feedmail-spray-this-address)))
(feedmail-fiddle-spray-address addy-plex)))
;; if it's a function, call it and recurse with the resulting value
((and (symbolp addy-plex) (fboundp addy-plex))
(let ((addy-plex (funcall addy-plex)))
(feedmail-fiddle-spray-address addy-plex)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp addy-plex)
(feedmail-fiddle-header
(nth 0 addy-plex) ; name
(nth 1 addy-plex) ; value
(nth 2 addy-plex) ; action
(nth 3 addy-plex))))) ; folding
(defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
"Fiddling based on a list of fiddle-plexes for spraying."
(feedmail-say-debug ">in-> feedmail-fiddle-list-of-spray-fiddle-plexes")
;; default is to fall off the end of the list and do nothing
(let ((lofp list-of-fiddle-plexes) fp)
(if (listp lofp)
(while lofp
(setq fp (car lofp))
(setq lofp (cdr lofp))
(feedmail-fiddle-spray-address fp))
(feedmail-fiddle-spray-address lofp))))
(defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
"Fiddling based on a list of fiddle-plexes.
Values t, nil, and string are pointless."
(feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes")
;; default is to fall off the end of the list and do nothing
(let ((lofp list-of-fiddle-plexes) fp)
(while lofp
(setq fp (car lofp))
(setq lofp (cdr lofp))
(cond
;; if it's a function, call it and recurse with the resulting value
((and (symbolp fp) (fboundp fp))
(let ((lofp (list (funcall fp)))) (feedmail-fiddle-list-of-fiddle-plexes lofp)))
;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
((listp fp)
(feedmail-fiddle-header
(nth 0 fp)
(nth 1 fp) ; value
(nth 2 fp) ; action
(nth 3 fp))))))) ; folding
(defun feedmail-accume-n-nuke-header (header-end header-regexp)
"Delete headers matching a regexp and their continuation lines.
There may be multiple such lines, and each may have arbitrarily
many continuation lines. Return an accumulation of the deleted
headers, including the intervening newlines."
(feedmail-say-debug ">in-> feedmail-accume-n-nuke-header %s %s"
header-end header-regexp)
(let ((case-fold-search t) (dropout))
(save-excursion
(goto-char (point-min))
;; iterate over all matching lines
(while (re-search-forward header-regexp header-end t)
(forward-line 1)
(setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
(delete-region (match-beginning 0) (point))
;; get rid of any continuation lines
(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
(forward-line 1)
(setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
(replace-match ""))))
(identity dropout)))
(defun feedmail-fill-to-cc-function (header-end)
"Smart filling of address headers (don't be fooled by the name).
The filling tries to avoid splitting lines except at commas. This
avoids, in particular, splitting within parenthesized comments in
addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:,
Resent-To:, Resent-Cc:, and Resent-Bcc:."
(feedmail-say-debug ">in-> feedmail-fill-to-cc-function")
(let ((case-fold-search t)
this-line
this-line-end)
(save-excursion
(goto-char (point-min))
;; iterate over all To:/Cc:, etc, lines
(while
(re-search-forward
"^\\(From:\\|Reply-To:\\|To:\\|Cc:\\|Bcc:\\|Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)"
header-end t)
(setq this-line (match-beginning 0))
;; replace 0 or more leading spaces with a single space
(and (looking-at "[ \t]*") (replace-match " "))
(forward-line 1)
;; get any continuation lines
(while (and (looking-at "[ \t]+") (< (point) header-end))
(forward-line 1))
(setq this-line-end (point-marker))
(save-excursion (feedmail-fill-this-one this-line this-line-end))
))))
(defun feedmail-fill-this-one (this-line this-line-end)
"In-place smart filling of the region bounded by the two arguments."
(feedmail-say-debug ">in-> feedmail-fill-this-one")
(let ((fill-prefix "\t")
(fill-column feedmail-fill-to-cc-fill-column))
;; The general idea is to break only on commas. Collapse
;; multiple whitespace to a single blank; change
;; all the blanks to something unprintable; change the
;; commas to blanks; fill the region; change it back.
(goto-char this-line)
(while (re-search-forward "\\s-+" (1- this-line-end) t)
(replace-match " "))
(subst-char-in-region this-line this-line-end ? 2 t) ; blank->C-b
(subst-char-in-region this-line this-line-end ?, ? t) ; comma->blank
(fill-region-as-paragraph this-line this-line-end)
(subst-char-in-region this-line this-line-end ? ?, t) ; comma<-blank
(subst-char-in-region this-line this-line-end 2 ? t) ; blank<-C-b
;; look out for missing commas before continuation lines
(goto-char this-line)
(while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
(replace-match "\\1,\n\t"))
))
(defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
"Get address list with all comments and other excitement trimmed.
Addresses are collected only from headers whose names match the fourth
argument. Returns a list of strings. Duplicate addresses will have
been weeded out."
(feedmail-say-debug ">in-> feedmail-deduce-address-list %s %s" addr-regexp address-list)
(let ((simple-address)
(address-blob)
(this-line)
(this-line-end))
(with-current-buffer (get-buffer-create " *FQM scratch*")
(erase-buffer)
(insert-buffer-substring message-buffer header-start header-end)
(goto-char (point-min))
(let ((case-fold-search t))
(while (re-search-forward addr-regexp (point-max) t)
(replace-match "")
(setq this-line (match-beginning 0))
(forward-line 1)
;; get any continuation lines
(while (and (looking-at "^[ \t]+") (< (point) (point-max)))
(forward-line 1))
(setq this-line-end (point-marker))
;; only keep if we don't have it already
(setq address-blob
(mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
(while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
(setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
(setq address-blob (replace-match "" t t address-blob))
(if (not (member simple-address address-list))
(push simple-address address-list)))
))
(kill-buffer nil))
(identity address-list)))
(defun feedmail-one-last-look (buffer)
"Offer the user one last chance to give it up."
(feedmail-say-debug ">in-> feedmail-one-last-look")
(save-excursion
;; FIXME: switch-to-buffer may fail or pop up a new frame
;; (in minibuffer-only frames, for example) and save-window-excursion
;; won't delete the newly created frame upon exit!
(save-window-excursion
(switch-to-buffer buffer)
(if (numberp feedmail-confirm-outgoing-timeout)
(y-or-n-p-with-timeout
"FQM: Send this email? "
(abs feedmail-confirm-outgoing-timeout)
(> feedmail-confirm-outgoing-timeout 0))
(y-or-n-p "FQM: Send this email? "))
)))
(defun feedmail-fqm-p (might-be)
"Internal; does filename end with FQM suffix?"
(feedmail-say-debug ">in-> feedmail-fqm-p %s" might-be)
(string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
(defun feedmail-say-debug (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
"Internal; emits debug messages in standard format."
(when feedmail-debug
(funcall 'message (concat "FQM DB: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
(and feedmail-debug-sit-for (not (= 0 feedmail-debug-sit-for))
(sit-for feedmail-debug-sit-for))))
(defun feedmail-say-chatter (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
"Internal; emits queue chatter messages in standard format."
(when feedmail-queue-chatty
(funcall 'message (concat "FQM: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
(and feedmail-queue-chatty-sit-for (not (= 0 feedmail-queue-chatty-sit-for))
(sit-for feedmail-queue-chatty-sit-for))))
(defun feedmail-find-eoh (&optional noerror)
"Internal; find the end of message header fields, return mark just before it."
;; all this funny business with line endings is to account for CRLF
;; weirdness that I don't think I'll ever figure out
(feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror)
(let ((mhs mail-header-separator)
(alt-mhs feedmail-queue-alternative-mail-header-separator)
r-mhs r-alt-mhs)
(setq r-mhs (concat "^" (regexp-quote mhs) "$"))
(setq r-alt-mhs (concat "^" (regexp-quote (or alt-mhs "")) "$"))
(save-excursion
(goto-char (point-min))
(if (or (re-search-forward r-mhs nil t)
(and alt-mhs (re-search-forward r-alt-mhs nil t)))
(progn
(beginning-of-line)
(point-marker))
(if noerror
nil
(error "FQM: Can't find message-header-separator or alternate"))))))
(provide 'feedmail)
;;; feedmail.el ends here
|