unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
blob bee7e90f72c1f0a0e1012299ce0ebe00105f045b 437020 bytes (raw)
name: lisp/simple.el 	 # note: path name is non-authoritative(*)

    1
    2
    3
    4
    5
    6
    7
    8
    9
   10
   11
   12
   13
   14
   15
   16
   17
   18
   19
   20
   21
   22
   23
   24
   25
   26
   27
   28
   29
   30
   31
   32
   33
   34
   35
   36
   37
   38
   39
   40
   41
   42
   43
   44
   45
   46
   47
   48
   49
   50
   51
   52
   53
   54
   55
   56
   57
   58
   59
   60
   61
   62
   63
   64
   65
   66
   67
   68
   69
   70
   71
   72
   73
   74
   75
   76
   77
   78
   79
   80
   81
   82
   83
   84
   85
   86
   87
   88
   89
   90
   91
   92
   93
   94
   95
   96
   97
   98
   99
  100
  101
  102
  103
  104
  105
  106
  107
  108
  109
  110
  111
  112
  113
  114
  115
  116
  117
  118
  119
  120
  121
  122
  123
  124
  125
  126
  127
  128
  129
  130
  131
  132
  133
  134
  135
  136
  137
  138
  139
  140
  141
  142
  143
  144
  145
  146
  147
  148
  149
  150
  151
  152
  153
  154
  155
  156
  157
  158
  159
  160
  161
  162
  163
  164
  165
  166
  167
  168
  169
  170
  171
  172
  173
  174
  175
  176
  177
  178
  179
  180
  181
  182
  183
  184
  185
  186
  187
  188
  189
  190
  191
  192
  193
  194
  195
  196
  197
  198
  199
  200
  201
  202
  203
  204
  205
  206
  207
  208
  209
  210
  211
  212
  213
  214
  215
  216
  217
  218
  219
  220
  221
  222
  223
  224
  225
  226
  227
  228
  229
  230
  231
  232
  233
  234
  235
  236
  237
  238
  239
  240
  241
  242
  243
  244
  245
  246
  247
  248
  249
  250
  251
  252
  253
  254
  255
  256
  257
  258
  259
  260
  261
  262
  263
  264
  265
  266
  267
  268
  269
  270
  271
  272
  273
  274
  275
  276
  277
  278
  279
  280
  281
  282
  283
  284
  285
  286
  287
  288
  289
  290
  291
  292
  293
  294
  295
  296
  297
  298
  299
  300
  301
  302
  303
  304
  305
  306
  307
  308
  309
  310
  311
  312
  313
  314
  315
  316
  317
  318
  319
  320
  321
  322
  323
  324
  325
  326
  327
  328
  329
  330
  331
  332
  333
  334
  335
  336
  337
  338
  339
  340
  341
  342
  343
  344
  345
  346
  347
  348
  349
  350
  351
  352
  353
  354
  355
  356
  357
  358
  359
  360
  361
  362
  363
  364
  365
  366
  367
  368
  369
  370
  371
  372
  373
  374
  375
  376
  377
  378
  379
  380
  381
  382
  383
  384
  385
  386
  387
  388
  389
  390
  391
  392
  393
  394
  395
  396
  397
  398
  399
  400
  401
  402
  403
  404
  405
  406
  407
  408
  409
  410
  411
  412
  413
  414
  415
  416
  417
  418
  419
  420
  421
  422
  423
  424
  425
  426
  427
  428
  429
  430
  431
  432
  433
  434
  435
  436
  437
  438
  439
  440
  441
  442
  443
  444
  445
  446
  447
  448
  449
  450
  451
  452
  453
  454
  455
  456
  457
  458
  459
  460
  461
  462
  463
  464
  465
  466
  467
  468
  469
  470
  471
  472
  473
  474
  475
  476
  477
  478
  479
  480
  481
  482
  483
  484
  485
  486
  487
  488
  489
  490
  491
  492
  493
  494
  495
  496
  497
  498
  499
  500
  501
  502
  503
  504
  505
  506
  507
  508
  509
  510
  511
  512
  513
  514
  515
  516
  517
  518
  519
  520
  521
  522
  523
  524
  525
  526
  527
  528
  529
  530
  531
  532
  533
  534
  535
  536
  537
  538
  539
  540
  541
  542
  543
  544
  545
  546
  547
  548
  549
  550
  551
  552
  553
  554
  555
  556
  557
  558
  559
  560
  561
  562
  563
  564
  565
  566
  567
  568
  569
  570
  571
  572
  573
  574
  575
  576
  577
  578
  579
  580
  581
  582
  583
  584
  585
  586
  587
  588
  589
  590
  591
  592
  593
  594
  595
  596
  597
  598
  599
  600
  601
  602
  603
  604
  605
  606
  607
  608
  609
  610
  611
  612
  613
  614
  615
  616
  617
  618
  619
  620
  621
  622
  623
  624
  625
  626
  627
  628
  629
  630
  631
  632
  633
  634
  635
  636
  637
  638
  639
  640
  641
  642
  643
  644
  645
  646
  647
  648
  649
  650
  651
  652
  653
  654
  655
  656
  657
  658
  659
  660
  661
  662
  663
  664
  665
  666
  667
  668
  669
  670
  671
  672
  673
  674
  675
  676
  677
  678
  679
  680
  681
  682
  683
  684
  685
  686
  687
  688
  689
  690
  691
  692
  693
  694
  695
  696
  697
  698
  699
  700
  701
  702
  703
  704
  705
  706
  707
  708
  709
  710
  711
  712
  713
  714
  715
  716
  717
  718
  719
  720
  721
  722
  723
  724
  725
  726
  727
  728
  729
  730
  731
  732
  733
  734
  735
  736
  737
  738
  739
  740
  741
  742
  743
  744
  745
  746
  747
  748
  749
  750
  751
  752
  753
  754
  755
  756
  757
  758
  759
  760
  761
  762
  763
  764
  765
  766
  767
  768
  769
  770
  771
  772
  773
  774
  775
  776
  777
  778
  779
  780
  781
  782
  783
  784
  785
  786
  787
  788
  789
  790
  791
  792
  793
  794
  795
  796
  797
  798
  799
  800
  801
  802
  803
  804
  805
  806
  807
  808
  809
  810
  811
  812
  813
  814
  815
  816
  817
  818
  819
  820
  821
  822
  823
  824
  825
  826
  827
  828
  829
  830
  831
  832
  833
  834
  835
  836
  837
  838
  839
  840
  841
  842
  843
  844
  845
  846
  847
  848
  849
  850
  851
  852
  853
  854
  855
  856
  857
  858
  859
  860
  861
  862
  863
  864
  865
  866
  867
  868
  869
  870
  871
  872
  873
  874
  875
  876
  877
  878
  879
  880
  881
  882
  883
  884
  885
  886
  887
  888
  889
  890
  891
  892
  893
  894
  895
  896
  897
  898
  899
  900
  901
  902
  903
  904
  905
  906
  907
  908
  909
  910
  911
  912
  913
  914
  915
  916
  917
  918
  919
  920
  921
  922
  923
  924
  925
  926
  927
  928
  929
  930
  931
  932
  933
  934
  935
  936
  937
  938
  939
  940
  941
  942
  943
  944
  945
  946
  947
  948
  949
  950
  951
  952
  953
  954
  955
  956
  957
  958
  959
  960
  961
  962
  963
  964
  965
  966
  967
  968
  969
  970
  971
  972
  973
  974
  975
  976
  977
  978
  979
  980
  981
  982
  983
  984
  985
  986
  987
  988
  989
  990
  991
  992
  993
  994
  995
  996
  997
  998
  999
 1000
 1001
 1002
 1003
 1004
 1005
 1006
 1007
 1008
 1009
 1010
 1011
 1012
 1013
 1014
 1015
 1016
 1017
 1018
 1019
 1020
 1021
 1022
 1023
 1024
 1025
 1026
 1027
 1028
 1029
 1030
 1031
 1032
 1033
 1034
 1035
 1036
 1037
 1038
 1039
 1040
 1041
 1042
 1043
 1044
 1045
 1046
 1047
 1048
 1049
 1050
 1051
 1052
 1053
 1054
 1055
 1056
 1057
 1058
 1059
 1060
 1061
 1062
 1063
 1064
 1065
 1066
 1067
 1068
 1069
 1070
 1071
 1072
 1073
 1074
 1075
 1076
 1077
 1078
 1079
 1080
 1081
 1082
 1083
 1084
 1085
 1086
 1087
 1088
 1089
 1090
 1091
 1092
 1093
 1094
 1095
 1096
 1097
 1098
 1099
 1100
 1101
 1102
 1103
 1104
 1105
 1106
 1107
 1108
 1109
 1110
 1111
 1112
 1113
 1114
 1115
 1116
 1117
 1118
 1119
 1120
 1121
 1122
 1123
 1124
 1125
 1126
 1127
 1128
 1129
 1130
 1131
 1132
 1133
 1134
 1135
 1136
 1137
 1138
 1139
 1140
 1141
 1142
 1143
 1144
 1145
 1146
 1147
 1148
 1149
 1150
 1151
 1152
 1153
 1154
 1155
 1156
 1157
 1158
 1159
 1160
 1161
 1162
 1163
 1164
 1165
 1166
 1167
 1168
 1169
 1170
 1171
 1172
 1173
 1174
 1175
 1176
 1177
 1178
 1179
 1180
 1181
 1182
 1183
 1184
 1185
 1186
 1187
 1188
 1189
 1190
 1191
 1192
 1193
 1194
 1195
 1196
 1197
 1198
 1199
 1200
 1201
 1202
 1203
 1204
 1205
 1206
 1207
 1208
 1209
 1210
 1211
 1212
 1213
 1214
 1215
 1216
 1217
 1218
 1219
 1220
 1221
 1222
 1223
 1224
 1225
 1226
 1227
 1228
 1229
 1230
 1231
 1232
 1233
 1234
 1235
 1236
 1237
 1238
 1239
 1240
 1241
 1242
 1243
 1244
 1245
 1246
 1247
 1248
 1249
 1250
 1251
 1252
 1253
 1254
 1255
 1256
 1257
 1258
 1259
 1260
 1261
 1262
 1263
 1264
 1265
 1266
 1267
 1268
 1269
 1270
 1271
 1272
 1273
 1274
 1275
 1276
 1277
 1278
 1279
 1280
 1281
 1282
 1283
 1284
 1285
 1286
 1287
 1288
 1289
 1290
 1291
 1292
 1293
 1294
 1295
 1296
 1297
 1298
 1299
 1300
 1301
 1302
 1303
 1304
 1305
 1306
 1307
 1308
 1309
 1310
 1311
 1312
 1313
 1314
 1315
 1316
 1317
 1318
 1319
 1320
 1321
 1322
 1323
 1324
 1325
 1326
 1327
 1328
 1329
 1330
 1331
 1332
 1333
 1334
 1335
 1336
 1337
 1338
 1339
 1340
 1341
 1342
 1343
 1344
 1345
 1346
 1347
 1348
 1349
 1350
 1351
 1352
 1353
 1354
 1355
 1356
 1357
 1358
 1359
 1360
 1361
 1362
 1363
 1364
 1365
 1366
 1367
 1368
 1369
 1370
 1371
 1372
 1373
 1374
 1375
 1376
 1377
 1378
 1379
 1380
 1381
 1382
 1383
 1384
 1385
 1386
 1387
 1388
 1389
 1390
 1391
 1392
 1393
 1394
 1395
 1396
 1397
 1398
 1399
 1400
 1401
 1402
 1403
 1404
 1405
 1406
 1407
 1408
 1409
 1410
 1411
 1412
 1413
 1414
 1415
 1416
 1417
 1418
 1419
 1420
 1421
 1422
 1423
 1424
 1425
 1426
 1427
 1428
 1429
 1430
 1431
 1432
 1433
 1434
 1435
 1436
 1437
 1438
 1439
 1440
 1441
 1442
 1443
 1444
 1445
 1446
 1447
 1448
 1449
 1450
 1451
 1452
 1453
 1454
 1455
 1456
 1457
 1458
 1459
 1460
 1461
 1462
 1463
 1464
 1465
 1466
 1467
 1468
 1469
 1470
 1471
 1472
 1473
 1474
 1475
 1476
 1477
 1478
 1479
 1480
 1481
 1482
 1483
 1484
 1485
 1486
 1487
 1488
 1489
 1490
 1491
 1492
 1493
 1494
 1495
 1496
 1497
 1498
 1499
 1500
 1501
 1502
 1503
 1504
 1505
 1506
 1507
 1508
 1509
 1510
 1511
 1512
 1513
 1514
 1515
 1516
 1517
 1518
 1519
 1520
 1521
 1522
 1523
 1524
 1525
 1526
 1527
 1528
 1529
 1530
 1531
 1532
 1533
 1534
 1535
 1536
 1537
 1538
 1539
 1540
 1541
 1542
 1543
 1544
 1545
 1546
 1547
 1548
 1549
 1550
 1551
 1552
 1553
 1554
 1555
 1556
 1557
 1558
 1559
 1560
 1561
 1562
 1563
 1564
 1565
 1566
 1567
 1568
 1569
 1570
 1571
 1572
 1573
 1574
 1575
 1576
 1577
 1578
 1579
 1580
 1581
 1582
 1583
 1584
 1585
 1586
 1587
 1588
 1589
 1590
 1591
 1592
 1593
 1594
 1595
 1596
 1597
 1598
 1599
 1600
 1601
 1602
 1603
 1604
 1605
 1606
 1607
 1608
 1609
 1610
 1611
 1612
 1613
 1614
 1615
 1616
 1617
 1618
 1619
 1620
 1621
 1622
 1623
 1624
 1625
 1626
 1627
 1628
 1629
 1630
 1631
 1632
 1633
 1634
 1635
 1636
 1637
 1638
 1639
 1640
 1641
 1642
 1643
 1644
 1645
 1646
 1647
 1648
 1649
 1650
 1651
 1652
 1653
 1654
 1655
 1656
 1657
 1658
 1659
 1660
 1661
 1662
 1663
 1664
 1665
 1666
 1667
 1668
 1669
 1670
 1671
 1672
 1673
 1674
 1675
 1676
 1677
 1678
 1679
 1680
 1681
 1682
 1683
 1684
 1685
 1686
 1687
 1688
 1689
 1690
 1691
 1692
 1693
 1694
 1695
 1696
 1697
 1698
 1699
 1700
 1701
 1702
 1703
 1704
 1705
 1706
 1707
 1708
 1709
 1710
 1711
 1712
 1713
 1714
 1715
 1716
 1717
 1718
 1719
 1720
 1721
 1722
 1723
 1724
 1725
 1726
 1727
 1728
 1729
 1730
 1731
 1732
 1733
 1734
 1735
 1736
 1737
 1738
 1739
 1740
 1741
 1742
 1743
 1744
 1745
 1746
 1747
 1748
 1749
 1750
 1751
 1752
 1753
 1754
 1755
 1756
 1757
 1758
 1759
 1760
 1761
 1762
 1763
 1764
 1765
 1766
 1767
 1768
 1769
 1770
 1771
 1772
 1773
 1774
 1775
 1776
 1777
 1778
 1779
 1780
 1781
 1782
 1783
 1784
 1785
 1786
 1787
 1788
 1789
 1790
 1791
 1792
 1793
 1794
 1795
 1796
 1797
 1798
 1799
 1800
 1801
 1802
 1803
 1804
 1805
 1806
 1807
 1808
 1809
 1810
 1811
 1812
 1813
 1814
 1815
 1816
 1817
 1818
 1819
 1820
 1821
 1822
 1823
 1824
 1825
 1826
 1827
 1828
 1829
 1830
 1831
 1832
 1833
 1834
 1835
 1836
 1837
 1838
 1839
 1840
 1841
 1842
 1843
 1844
 1845
 1846
 1847
 1848
 1849
 1850
 1851
 1852
 1853
 1854
 1855
 1856
 1857
 1858
 1859
 1860
 1861
 1862
 1863
 1864
 1865
 1866
 1867
 1868
 1869
 1870
 1871
 1872
 1873
 1874
 1875
 1876
 1877
 1878
 1879
 1880
 1881
 1882
 1883
 1884
 1885
 1886
 1887
 1888
 1889
 1890
 1891
 1892
 1893
 1894
 1895
 1896
 1897
 1898
 1899
 1900
 1901
 1902
 1903
 1904
 1905
 1906
 1907
 1908
 1909
 1910
 1911
 1912
 1913
 1914
 1915
 1916
 1917
 1918
 1919
 1920
 1921
 1922
 1923
 1924
 1925
 1926
 1927
 1928
 1929
 1930
 1931
 1932
 1933
 1934
 1935
 1936
 1937
 1938
 1939
 1940
 1941
 1942
 1943
 1944
 1945
 1946
 1947
 1948
 1949
 1950
 1951
 1952
 1953
 1954
 1955
 1956
 1957
 1958
 1959
 1960
 1961
 1962
 1963
 1964
 1965
 1966
 1967
 1968
 1969
 1970
 1971
 1972
 1973
 1974
 1975
 1976
 1977
 1978
 1979
 1980
 1981
 1982
 1983
 1984
 1985
 1986
 1987
 1988
 1989
 1990
 1991
 1992
 1993
 1994
 1995
 1996
 1997
 1998
 1999
 2000
 2001
 2002
 2003
 2004
 2005
 2006
 2007
 2008
 2009
 2010
 2011
 2012
 2013
 2014
 2015
 2016
 2017
 2018
 2019
 2020
 2021
 2022
 2023
 2024
 2025
 2026
 2027
 2028
 2029
 2030
 2031
 2032
 2033
 2034
 2035
 2036
 2037
 2038
 2039
 2040
 2041
 2042
 2043
 2044
 2045
 2046
 2047
 2048
 2049
 2050
 2051
 2052
 2053
 2054
 2055
 2056
 2057
 2058
 2059
 2060
 2061
 2062
 2063
 2064
 2065
 2066
 2067
 2068
 2069
 2070
 2071
 2072
 2073
 2074
 2075
 2076
 2077
 2078
 2079
 2080
 2081
 2082
 2083
 2084
 2085
 2086
 2087
 2088
 2089
 2090
 2091
 2092
 2093
 2094
 2095
 2096
 2097
 2098
 2099
 2100
 2101
 2102
 2103
 2104
 2105
 2106
 2107
 2108
 2109
 2110
 2111
 2112
 2113
 2114
 2115
 2116
 2117
 2118
 2119
 2120
 2121
 2122
 2123
 2124
 2125
 2126
 2127
 2128
 2129
 2130
 2131
 2132
 2133
 2134
 2135
 2136
 2137
 2138
 2139
 2140
 2141
 2142
 2143
 2144
 2145
 2146
 2147
 2148
 2149
 2150
 2151
 2152
 2153
 2154
 2155
 2156
 2157
 2158
 2159
 2160
 2161
 2162
 2163
 2164
 2165
 2166
 2167
 2168
 2169
 2170
 2171
 2172
 2173
 2174
 2175
 2176
 2177
 2178
 2179
 2180
 2181
 2182
 2183
 2184
 2185
 2186
 2187
 2188
 2189
 2190
 2191
 2192
 2193
 2194
 2195
 2196
 2197
 2198
 2199
 2200
 2201
 2202
 2203
 2204
 2205
 2206
 2207
 2208
 2209
 2210
 2211
 2212
 2213
 2214
 2215
 2216
 2217
 2218
 2219
 2220
 2221
 2222
 2223
 2224
 2225
 2226
 2227
 2228
 2229
 2230
 2231
 2232
 2233
 2234
 2235
 2236
 2237
 2238
 2239
 2240
 2241
 2242
 2243
 2244
 2245
 2246
 2247
 2248
 2249
 2250
 2251
 2252
 2253
 2254
 2255
 2256
 2257
 2258
 2259
 2260
 2261
 2262
 2263
 2264
 2265
 2266
 2267
 2268
 2269
 2270
 2271
 2272
 2273
 2274
 2275
 2276
 2277
 2278
 2279
 2280
 2281
 2282
 2283
 2284
 2285
 2286
 2287
 2288
 2289
 2290
 2291
 2292
 2293
 2294
 2295
 2296
 2297
 2298
 2299
 2300
 2301
 2302
 2303
 2304
 2305
 2306
 2307
 2308
 2309
 2310
 2311
 2312
 2313
 2314
 2315
 2316
 2317
 2318
 2319
 2320
 2321
 2322
 2323
 2324
 2325
 2326
 2327
 2328
 2329
 2330
 2331
 2332
 2333
 2334
 2335
 2336
 2337
 2338
 2339
 2340
 2341
 2342
 2343
 2344
 2345
 2346
 2347
 2348
 2349
 2350
 2351
 2352
 2353
 2354
 2355
 2356
 2357
 2358
 2359
 2360
 2361
 2362
 2363
 2364
 2365
 2366
 2367
 2368
 2369
 2370
 2371
 2372
 2373
 2374
 2375
 2376
 2377
 2378
 2379
 2380
 2381
 2382
 2383
 2384
 2385
 2386
 2387
 2388
 2389
 2390
 2391
 2392
 2393
 2394
 2395
 2396
 2397
 2398
 2399
 2400
 2401
 2402
 2403
 2404
 2405
 2406
 2407
 2408
 2409
 2410
 2411
 2412
 2413
 2414
 2415
 2416
 2417
 2418
 2419
 2420
 2421
 2422
 2423
 2424
 2425
 2426
 2427
 2428
 2429
 2430
 2431
 2432
 2433
 2434
 2435
 2436
 2437
 2438
 2439
 2440
 2441
 2442
 2443
 2444
 2445
 2446
 2447
 2448
 2449
 2450
 2451
 2452
 2453
 2454
 2455
 2456
 2457
 2458
 2459
 2460
 2461
 2462
 2463
 2464
 2465
 2466
 2467
 2468
 2469
 2470
 2471
 2472
 2473
 2474
 2475
 2476
 2477
 2478
 2479
 2480
 2481
 2482
 2483
 2484
 2485
 2486
 2487
 2488
 2489
 2490
 2491
 2492
 2493
 2494
 2495
 2496
 2497
 2498
 2499
 2500
 2501
 2502
 2503
 2504
 2505
 2506
 2507
 2508
 2509
 2510
 2511
 2512
 2513
 2514
 2515
 2516
 2517
 2518
 2519
 2520
 2521
 2522
 2523
 2524
 2525
 2526
 2527
 2528
 2529
 2530
 2531
 2532
 2533
 2534
 2535
 2536
 2537
 2538
 2539
 2540
 2541
 2542
 2543
 2544
 2545
 2546
 2547
 2548
 2549
 2550
 2551
 2552
 2553
 2554
 2555
 2556
 2557
 2558
 2559
 2560
 2561
 2562
 2563
 2564
 2565
 2566
 2567
 2568
 2569
 2570
 2571
 2572
 2573
 2574
 2575
 2576
 2577
 2578
 2579
 2580
 2581
 2582
 2583
 2584
 2585
 2586
 2587
 2588
 2589
 2590
 2591
 2592
 2593
 2594
 2595
 2596
 2597
 2598
 2599
 2600
 2601
 2602
 2603
 2604
 2605
 2606
 2607
 2608
 2609
 2610
 2611
 2612
 2613
 2614
 2615
 2616
 2617
 2618
 2619
 2620
 2621
 2622
 2623
 2624
 2625
 2626
 2627
 2628
 2629
 2630
 2631
 2632
 2633
 2634
 2635
 2636
 2637
 2638
 2639
 2640
 2641
 2642
 2643
 2644
 2645
 2646
 2647
 2648
 2649
 2650
 2651
 2652
 2653
 2654
 2655
 2656
 2657
 2658
 2659
 2660
 2661
 2662
 2663
 2664
 2665
 2666
 2667
 2668
 2669
 2670
 2671
 2672
 2673
 2674
 2675
 2676
 2677
 2678
 2679
 2680
 2681
 2682
 2683
 2684
 2685
 2686
 2687
 2688
 2689
 2690
 2691
 2692
 2693
 2694
 2695
 2696
 2697
 2698
 2699
 2700
 2701
 2702
 2703
 2704
 2705
 2706
 2707
 2708
 2709
 2710
 2711
 2712
 2713
 2714
 2715
 2716
 2717
 2718
 2719
 2720
 2721
 2722
 2723
 2724
 2725
 2726
 2727
 2728
 2729
 2730
 2731
 2732
 2733
 2734
 2735
 2736
 2737
 2738
 2739
 2740
 2741
 2742
 2743
 2744
 2745
 2746
 2747
 2748
 2749
 2750
 2751
 2752
 2753
 2754
 2755
 2756
 2757
 2758
 2759
 2760
 2761
 2762
 2763
 2764
 2765
 2766
 2767
 2768
 2769
 2770
 2771
 2772
 2773
 2774
 2775
 2776
 2777
 2778
 2779
 2780
 2781
 2782
 2783
 2784
 2785
 2786
 2787
 2788
 2789
 2790
 2791
 2792
 2793
 2794
 2795
 2796
 2797
 2798
 2799
 2800
 2801
 2802
 2803
 2804
 2805
 2806
 2807
 2808
 2809
 2810
 2811
 2812
 2813
 2814
 2815
 2816
 2817
 2818
 2819
 2820
 2821
 2822
 2823
 2824
 2825
 2826
 2827
 2828
 2829
 2830
 2831
 2832
 2833
 2834
 2835
 2836
 2837
 2838
 2839
 2840
 2841
 2842
 2843
 2844
 2845
 2846
 2847
 2848
 2849
 2850
 2851
 2852
 2853
 2854
 2855
 2856
 2857
 2858
 2859
 2860
 2861
 2862
 2863
 2864
 2865
 2866
 2867
 2868
 2869
 2870
 2871
 2872
 2873
 2874
 2875
 2876
 2877
 2878
 2879
 2880
 2881
 2882
 2883
 2884
 2885
 2886
 2887
 2888
 2889
 2890
 2891
 2892
 2893
 2894
 2895
 2896
 2897
 2898
 2899
 2900
 2901
 2902
 2903
 2904
 2905
 2906
 2907
 2908
 2909
 2910
 2911
 2912
 2913
 2914
 2915
 2916
 2917
 2918
 2919
 2920
 2921
 2922
 2923
 2924
 2925
 2926
 2927
 2928
 2929
 2930
 2931
 2932
 2933
 2934
 2935
 2936
 2937
 2938
 2939
 2940
 2941
 2942
 2943
 2944
 2945
 2946
 2947
 2948
 2949
 2950
 2951
 2952
 2953
 2954
 2955
 2956
 2957
 2958
 2959
 2960
 2961
 2962
 2963
 2964
 2965
 2966
 2967
 2968
 2969
 2970
 2971
 2972
 2973
 2974
 2975
 2976
 2977
 2978
 2979
 2980
 2981
 2982
 2983
 2984
 2985
 2986
 2987
 2988
 2989
 2990
 2991
 2992
 2993
 2994
 2995
 2996
 2997
 2998
 2999
 3000
 3001
 3002
 3003
 3004
 3005
 3006
 3007
 3008
 3009
 3010
 3011
 3012
 3013
 3014
 3015
 3016
 3017
 3018
 3019
 3020
 3021
 3022
 3023
 3024
 3025
 3026
 3027
 3028
 3029
 3030
 3031
 3032
 3033
 3034
 3035
 3036
 3037
 3038
 3039
 3040
 3041
 3042
 3043
 3044
 3045
 3046
 3047
 3048
 3049
 3050
 3051
 3052
 3053
 3054
 3055
 3056
 3057
 3058
 3059
 3060
 3061
 3062
 3063
 3064
 3065
 3066
 3067
 3068
 3069
 3070
 3071
 3072
 3073
 3074
 3075
 3076
 3077
 3078
 3079
 3080
 3081
 3082
 3083
 3084
 3085
 3086
 3087
 3088
 3089
 3090
 3091
 3092
 3093
 3094
 3095
 3096
 3097
 3098
 3099
 3100
 3101
 3102
 3103
 3104
 3105
 3106
 3107
 3108
 3109
 3110
 3111
 3112
 3113
 3114
 3115
 3116
 3117
 3118
 3119
 3120
 3121
 3122
 3123
 3124
 3125
 3126
 3127
 3128
 3129
 3130
 3131
 3132
 3133
 3134
 3135
 3136
 3137
 3138
 3139
 3140
 3141
 3142
 3143
 3144
 3145
 3146
 3147
 3148
 3149
 3150
 3151
 3152
 3153
 3154
 3155
 3156
 3157
 3158
 3159
 3160
 3161
 3162
 3163
 3164
 3165
 3166
 3167
 3168
 3169
 3170
 3171
 3172
 3173
 3174
 3175
 3176
 3177
 3178
 3179
 3180
 3181
 3182
 3183
 3184
 3185
 3186
 3187
 3188
 3189
 3190
 3191
 3192
 3193
 3194
 3195
 3196
 3197
 3198
 3199
 3200
 3201
 3202
 3203
 3204
 3205
 3206
 3207
 3208
 3209
 3210
 3211
 3212
 3213
 3214
 3215
 3216
 3217
 3218
 3219
 3220
 3221
 3222
 3223
 3224
 3225
 3226
 3227
 3228
 3229
 3230
 3231
 3232
 3233
 3234
 3235
 3236
 3237
 3238
 3239
 3240
 3241
 3242
 3243
 3244
 3245
 3246
 3247
 3248
 3249
 3250
 3251
 3252
 3253
 3254
 3255
 3256
 3257
 3258
 3259
 3260
 3261
 3262
 3263
 3264
 3265
 3266
 3267
 3268
 3269
 3270
 3271
 3272
 3273
 3274
 3275
 3276
 3277
 3278
 3279
 3280
 3281
 3282
 3283
 3284
 3285
 3286
 3287
 3288
 3289
 3290
 3291
 3292
 3293
 3294
 3295
 3296
 3297
 3298
 3299
 3300
 3301
 3302
 3303
 3304
 3305
 3306
 3307
 3308
 3309
 3310
 3311
 3312
 3313
 3314
 3315
 3316
 3317
 3318
 3319
 3320
 3321
 3322
 3323
 3324
 3325
 3326
 3327
 3328
 3329
 3330
 3331
 3332
 3333
 3334
 3335
 3336
 3337
 3338
 3339
 3340
 3341
 3342
 3343
 3344
 3345
 3346
 3347
 3348
 3349
 3350
 3351
 3352
 3353
 3354
 3355
 3356
 3357
 3358
 3359
 3360
 3361
 3362
 3363
 3364
 3365
 3366
 3367
 3368
 3369
 3370
 3371
 3372
 3373
 3374
 3375
 3376
 3377
 3378
 3379
 3380
 3381
 3382
 3383
 3384
 3385
 3386
 3387
 3388
 3389
 3390
 3391
 3392
 3393
 3394
 3395
 3396
 3397
 3398
 3399
 3400
 3401
 3402
 3403
 3404
 3405
 3406
 3407
 3408
 3409
 3410
 3411
 3412
 3413
 3414
 3415
 3416
 3417
 3418
 3419
 3420
 3421
 3422
 3423
 3424
 3425
 3426
 3427
 3428
 3429
 3430
 3431
 3432
 3433
 3434
 3435
 3436
 3437
 3438
 3439
 3440
 3441
 3442
 3443
 3444
 3445
 3446
 3447
 3448
 3449
 3450
 3451
 3452
 3453
 3454
 3455
 3456
 3457
 3458
 3459
 3460
 3461
 3462
 3463
 3464
 3465
 3466
 3467
 3468
 3469
 3470
 3471
 3472
 3473
 3474
 3475
 3476
 3477
 3478
 3479
 3480
 3481
 3482
 3483
 3484
 3485
 3486
 3487
 3488
 3489
 3490
 3491
 3492
 3493
 3494
 3495
 3496
 3497
 3498
 3499
 3500
 3501
 3502
 3503
 3504
 3505
 3506
 3507
 3508
 3509
 3510
 3511
 3512
 3513
 3514
 3515
 3516
 3517
 3518
 3519
 3520
 3521
 3522
 3523
 3524
 3525
 3526
 3527
 3528
 3529
 3530
 3531
 3532
 3533
 3534
 3535
 3536
 3537
 3538
 3539
 3540
 3541
 3542
 3543
 3544
 3545
 3546
 3547
 3548
 3549
 3550
 3551
 3552
 3553
 3554
 3555
 3556
 3557
 3558
 3559
 3560
 3561
 3562
 3563
 3564
 3565
 3566
 3567
 3568
 3569
 3570
 3571
 3572
 3573
 3574
 3575
 3576
 3577
 3578
 3579
 3580
 3581
 3582
 3583
 3584
 3585
 3586
 3587
 3588
 3589
 3590
 3591
 3592
 3593
 3594
 3595
 3596
 3597
 3598
 3599
 3600
 3601
 3602
 3603
 3604
 3605
 3606
 3607
 3608
 3609
 3610
 3611
 3612
 3613
 3614
 3615
 3616
 3617
 3618
 3619
 3620
 3621
 3622
 3623
 3624
 3625
 3626
 3627
 3628
 3629
 3630
 3631
 3632
 3633
 3634
 3635
 3636
 3637
 3638
 3639
 3640
 3641
 3642
 3643
 3644
 3645
 3646
 3647
 3648
 3649
 3650
 3651
 3652
 3653
 3654
 3655
 3656
 3657
 3658
 3659
 3660
 3661
 3662
 3663
 3664
 3665
 3666
 3667
 3668
 3669
 3670
 3671
 3672
 3673
 3674
 3675
 3676
 3677
 3678
 3679
 3680
 3681
 3682
 3683
 3684
 3685
 3686
 3687
 3688
 3689
 3690
 3691
 3692
 3693
 3694
 3695
 3696
 3697
 3698
 3699
 3700
 3701
 3702
 3703
 3704
 3705
 3706
 3707
 3708
 3709
 3710
 3711
 3712
 3713
 3714
 3715
 3716
 3717
 3718
 3719
 3720
 3721
 3722
 3723
 3724
 3725
 3726
 3727
 3728
 3729
 3730
 3731
 3732
 3733
 3734
 3735
 3736
 3737
 3738
 3739
 3740
 3741
 3742
 3743
 3744
 3745
 3746
 3747
 3748
 3749
 3750
 3751
 3752
 3753
 3754
 3755
 3756
 3757
 3758
 3759
 3760
 3761
 3762
 3763
 3764
 3765
 3766
 3767
 3768
 3769
 3770
 3771
 3772
 3773
 3774
 3775
 3776
 3777
 3778
 3779
 3780
 3781
 3782
 3783
 3784
 3785
 3786
 3787
 3788
 3789
 3790
 3791
 3792
 3793
 3794
 3795
 3796
 3797
 3798
 3799
 3800
 3801
 3802
 3803
 3804
 3805
 3806
 3807
 3808
 3809
 3810
 3811
 3812
 3813
 3814
 3815
 3816
 3817
 3818
 3819
 3820
 3821
 3822
 3823
 3824
 3825
 3826
 3827
 3828
 3829
 3830
 3831
 3832
 3833
 3834
 3835
 3836
 3837
 3838
 3839
 3840
 3841
 3842
 3843
 3844
 3845
 3846
 3847
 3848
 3849
 3850
 3851
 3852
 3853
 3854
 3855
 3856
 3857
 3858
 3859
 3860
 3861
 3862
 3863
 3864
 3865
 3866
 3867
 3868
 3869
 3870
 3871
 3872
 3873
 3874
 3875
 3876
 3877
 3878
 3879
 3880
 3881
 3882
 3883
 3884
 3885
 3886
 3887
 3888
 3889
 3890
 3891
 3892
 3893
 3894
 3895
 3896
 3897
 3898
 3899
 3900
 3901
 3902
 3903
 3904
 3905
 3906
 3907
 3908
 3909
 3910
 3911
 3912
 3913
 3914
 3915
 3916
 3917
 3918
 3919
 3920
 3921
 3922
 3923
 3924
 3925
 3926
 3927
 3928
 3929
 3930
 3931
 3932
 3933
 3934
 3935
 3936
 3937
 3938
 3939
 3940
 3941
 3942
 3943
 3944
 3945
 3946
 3947
 3948
 3949
 3950
 3951
 3952
 3953
 3954
 3955
 3956
 3957
 3958
 3959
 3960
 3961
 3962
 3963
 3964
 3965
 3966
 3967
 3968
 3969
 3970
 3971
 3972
 3973
 3974
 3975
 3976
 3977
 3978
 3979
 3980
 3981
 3982
 3983
 3984
 3985
 3986
 3987
 3988
 3989
 3990
 3991
 3992
 3993
 3994
 3995
 3996
 3997
 3998
 3999
 4000
 4001
 4002
 4003
 4004
 4005
 4006
 4007
 4008
 4009
 4010
 4011
 4012
 4013
 4014
 4015
 4016
 4017
 4018
 4019
 4020
 4021
 4022
 4023
 4024
 4025
 4026
 4027
 4028
 4029
 4030
 4031
 4032
 4033
 4034
 4035
 4036
 4037
 4038
 4039
 4040
 4041
 4042
 4043
 4044
 4045
 4046
 4047
 4048
 4049
 4050
 4051
 4052
 4053
 4054
 4055
 4056
 4057
 4058
 4059
 4060
 4061
 4062
 4063
 4064
 4065
 4066
 4067
 4068
 4069
 4070
 4071
 4072
 4073
 4074
 4075
 4076
 4077
 4078
 4079
 4080
 4081
 4082
 4083
 4084
 4085
 4086
 4087
 4088
 4089
 4090
 4091
 4092
 4093
 4094
 4095
 4096
 4097
 4098
 4099
 4100
 4101
 4102
 4103
 4104
 4105
 4106
 4107
 4108
 4109
 4110
 4111
 4112
 4113
 4114
 4115
 4116
 4117
 4118
 4119
 4120
 4121
 4122
 4123
 4124
 4125
 4126
 4127
 4128
 4129
 4130
 4131
 4132
 4133
 4134
 4135
 4136
 4137
 4138
 4139
 4140
 4141
 4142
 4143
 4144
 4145
 4146
 4147
 4148
 4149
 4150
 4151
 4152
 4153
 4154
 4155
 4156
 4157
 4158
 4159
 4160
 4161
 4162
 4163
 4164
 4165
 4166
 4167
 4168
 4169
 4170
 4171
 4172
 4173
 4174
 4175
 4176
 4177
 4178
 4179
 4180
 4181
 4182
 4183
 4184
 4185
 4186
 4187
 4188
 4189
 4190
 4191
 4192
 4193
 4194
 4195
 4196
 4197
 4198
 4199
 4200
 4201
 4202
 4203
 4204
 4205
 4206
 4207
 4208
 4209
 4210
 4211
 4212
 4213
 4214
 4215
 4216
 4217
 4218
 4219
 4220
 4221
 4222
 4223
 4224
 4225
 4226
 4227
 4228
 4229
 4230
 4231
 4232
 4233
 4234
 4235
 4236
 4237
 4238
 4239
 4240
 4241
 4242
 4243
 4244
 4245
 4246
 4247
 4248
 4249
 4250
 4251
 4252
 4253
 4254
 4255
 4256
 4257
 4258
 4259
 4260
 4261
 4262
 4263
 4264
 4265
 4266
 4267
 4268
 4269
 4270
 4271
 4272
 4273
 4274
 4275
 4276
 4277
 4278
 4279
 4280
 4281
 4282
 4283
 4284
 4285
 4286
 4287
 4288
 4289
 4290
 4291
 4292
 4293
 4294
 4295
 4296
 4297
 4298
 4299
 4300
 4301
 4302
 4303
 4304
 4305
 4306
 4307
 4308
 4309
 4310
 4311
 4312
 4313
 4314
 4315
 4316
 4317
 4318
 4319
 4320
 4321
 4322
 4323
 4324
 4325
 4326
 4327
 4328
 4329
 4330
 4331
 4332
 4333
 4334
 4335
 4336
 4337
 4338
 4339
 4340
 4341
 4342
 4343
 4344
 4345
 4346
 4347
 4348
 4349
 4350
 4351
 4352
 4353
 4354
 4355
 4356
 4357
 4358
 4359
 4360
 4361
 4362
 4363
 4364
 4365
 4366
 4367
 4368
 4369
 4370
 4371
 4372
 4373
 4374
 4375
 4376
 4377
 4378
 4379
 4380
 4381
 4382
 4383
 4384
 4385
 4386
 4387
 4388
 4389
 4390
 4391
 4392
 4393
 4394
 4395
 4396
 4397
 4398
 4399
 4400
 4401
 4402
 4403
 4404
 4405
 4406
 4407
 4408
 4409
 4410
 4411
 4412
 4413
 4414
 4415
 4416
 4417
 4418
 4419
 4420
 4421
 4422
 4423
 4424
 4425
 4426
 4427
 4428
 4429
 4430
 4431
 4432
 4433
 4434
 4435
 4436
 4437
 4438
 4439
 4440
 4441
 4442
 4443
 4444
 4445
 4446
 4447
 4448
 4449
 4450
 4451
 4452
 4453
 4454
 4455
 4456
 4457
 4458
 4459
 4460
 4461
 4462
 4463
 4464
 4465
 4466
 4467
 4468
 4469
 4470
 4471
 4472
 4473
 4474
 4475
 4476
 4477
 4478
 4479
 4480
 4481
 4482
 4483
 4484
 4485
 4486
 4487
 4488
 4489
 4490
 4491
 4492
 4493
 4494
 4495
 4496
 4497
 4498
 4499
 4500
 4501
 4502
 4503
 4504
 4505
 4506
 4507
 4508
 4509
 4510
 4511
 4512
 4513
 4514
 4515
 4516
 4517
 4518
 4519
 4520
 4521
 4522
 4523
 4524
 4525
 4526
 4527
 4528
 4529
 4530
 4531
 4532
 4533
 4534
 4535
 4536
 4537
 4538
 4539
 4540
 4541
 4542
 4543
 4544
 4545
 4546
 4547
 4548
 4549
 4550
 4551
 4552
 4553
 4554
 4555
 4556
 4557
 4558
 4559
 4560
 4561
 4562
 4563
 4564
 4565
 4566
 4567
 4568
 4569
 4570
 4571
 4572
 4573
 4574
 4575
 4576
 4577
 4578
 4579
 4580
 4581
 4582
 4583
 4584
 4585
 4586
 4587
 4588
 4589
 4590
 4591
 4592
 4593
 4594
 4595
 4596
 4597
 4598
 4599
 4600
 4601
 4602
 4603
 4604
 4605
 4606
 4607
 4608
 4609
 4610
 4611
 4612
 4613
 4614
 4615
 4616
 4617
 4618
 4619
 4620
 4621
 4622
 4623
 4624
 4625
 4626
 4627
 4628
 4629
 4630
 4631
 4632
 4633
 4634
 4635
 4636
 4637
 4638
 4639
 4640
 4641
 4642
 4643
 4644
 4645
 4646
 4647
 4648
 4649
 4650
 4651
 4652
 4653
 4654
 4655
 4656
 4657
 4658
 4659
 4660
 4661
 4662
 4663
 4664
 4665
 4666
 4667
 4668
 4669
 4670
 4671
 4672
 4673
 4674
 4675
 4676
 4677
 4678
 4679
 4680
 4681
 4682
 4683
 4684
 4685
 4686
 4687
 4688
 4689
 4690
 4691
 4692
 4693
 4694
 4695
 4696
 4697
 4698
 4699
 4700
 4701
 4702
 4703
 4704
 4705
 4706
 4707
 4708
 4709
 4710
 4711
 4712
 4713
 4714
 4715
 4716
 4717
 4718
 4719
 4720
 4721
 4722
 4723
 4724
 4725
 4726
 4727
 4728
 4729
 4730
 4731
 4732
 4733
 4734
 4735
 4736
 4737
 4738
 4739
 4740
 4741
 4742
 4743
 4744
 4745
 4746
 4747
 4748
 4749
 4750
 4751
 4752
 4753
 4754
 4755
 4756
 4757
 4758
 4759
 4760
 4761
 4762
 4763
 4764
 4765
 4766
 4767
 4768
 4769
 4770
 4771
 4772
 4773
 4774
 4775
 4776
 4777
 4778
 4779
 4780
 4781
 4782
 4783
 4784
 4785
 4786
 4787
 4788
 4789
 4790
 4791
 4792
 4793
 4794
 4795
 4796
 4797
 4798
 4799
 4800
 4801
 4802
 4803
 4804
 4805
 4806
 4807
 4808
 4809
 4810
 4811
 4812
 4813
 4814
 4815
 4816
 4817
 4818
 4819
 4820
 4821
 4822
 4823
 4824
 4825
 4826
 4827
 4828
 4829
 4830
 4831
 4832
 4833
 4834
 4835
 4836
 4837
 4838
 4839
 4840
 4841
 4842
 4843
 4844
 4845
 4846
 4847
 4848
 4849
 4850
 4851
 4852
 4853
 4854
 4855
 4856
 4857
 4858
 4859
 4860
 4861
 4862
 4863
 4864
 4865
 4866
 4867
 4868
 4869
 4870
 4871
 4872
 4873
 4874
 4875
 4876
 4877
 4878
 4879
 4880
 4881
 4882
 4883
 4884
 4885
 4886
 4887
 4888
 4889
 4890
 4891
 4892
 4893
 4894
 4895
 4896
 4897
 4898
 4899
 4900
 4901
 4902
 4903
 4904
 4905
 4906
 4907
 4908
 4909
 4910
 4911
 4912
 4913
 4914
 4915
 4916
 4917
 4918
 4919
 4920
 4921
 4922
 4923
 4924
 4925
 4926
 4927
 4928
 4929
 4930
 4931
 4932
 4933
 4934
 4935
 4936
 4937
 4938
 4939
 4940
 4941
 4942
 4943
 4944
 4945
 4946
 4947
 4948
 4949
 4950
 4951
 4952
 4953
 4954
 4955
 4956
 4957
 4958
 4959
 4960
 4961
 4962
 4963
 4964
 4965
 4966
 4967
 4968
 4969
 4970
 4971
 4972
 4973
 4974
 4975
 4976
 4977
 4978
 4979
 4980
 4981
 4982
 4983
 4984
 4985
 4986
 4987
 4988
 4989
 4990
 4991
 4992
 4993
 4994
 4995
 4996
 4997
 4998
 4999
 5000
 5001
 5002
 5003
 5004
 5005
 5006
 5007
 5008
 5009
 5010
 5011
 5012
 5013
 5014
 5015
 5016
 5017
 5018
 5019
 5020
 5021
 5022
 5023
 5024
 5025
 5026
 5027
 5028
 5029
 5030
 5031
 5032
 5033
 5034
 5035
 5036
 5037
 5038
 5039
 5040
 5041
 5042
 5043
 5044
 5045
 5046
 5047
 5048
 5049
 5050
 5051
 5052
 5053
 5054
 5055
 5056
 5057
 5058
 5059
 5060
 5061
 5062
 5063
 5064
 5065
 5066
 5067
 5068
 5069
 5070
 5071
 5072
 5073
 5074
 5075
 5076
 5077
 5078
 5079
 5080
 5081
 5082
 5083
 5084
 5085
 5086
 5087
 5088
 5089
 5090
 5091
 5092
 5093
 5094
 5095
 5096
 5097
 5098
 5099
 5100
 5101
 5102
 5103
 5104
 5105
 5106
 5107
 5108
 5109
 5110
 5111
 5112
 5113
 5114
 5115
 5116
 5117
 5118
 5119
 5120
 5121
 5122
 5123
 5124
 5125
 5126
 5127
 5128
 5129
 5130
 5131
 5132
 5133
 5134
 5135
 5136
 5137
 5138
 5139
 5140
 5141
 5142
 5143
 5144
 5145
 5146
 5147
 5148
 5149
 5150
 5151
 5152
 5153
 5154
 5155
 5156
 5157
 5158
 5159
 5160
 5161
 5162
 5163
 5164
 5165
 5166
 5167
 5168
 5169
 5170
 5171
 5172
 5173
 5174
 5175
 5176
 5177
 5178
 5179
 5180
 5181
 5182
 5183
 5184
 5185
 5186
 5187
 5188
 5189
 5190
 5191
 5192
 5193
 5194
 5195
 5196
 5197
 5198
 5199
 5200
 5201
 5202
 5203
 5204
 5205
 5206
 5207
 5208
 5209
 5210
 5211
 5212
 5213
 5214
 5215
 5216
 5217
 5218
 5219
 5220
 5221
 5222
 5223
 5224
 5225
 5226
 5227
 5228
 5229
 5230
 5231
 5232
 5233
 5234
 5235
 5236
 5237
 5238
 5239
 5240
 5241
 5242
 5243
 5244
 5245
 5246
 5247
 5248
 5249
 5250
 5251
 5252
 5253
 5254
 5255
 5256
 5257
 5258
 5259
 5260
 5261
 5262
 5263
 5264
 5265
 5266
 5267
 5268
 5269
 5270
 5271
 5272
 5273
 5274
 5275
 5276
 5277
 5278
 5279
 5280
 5281
 5282
 5283
 5284
 5285
 5286
 5287
 5288
 5289
 5290
 5291
 5292
 5293
 5294
 5295
 5296
 5297
 5298
 5299
 5300
 5301
 5302
 5303
 5304
 5305
 5306
 5307
 5308
 5309
 5310
 5311
 5312
 5313
 5314
 5315
 5316
 5317
 5318
 5319
 5320
 5321
 5322
 5323
 5324
 5325
 5326
 5327
 5328
 5329
 5330
 5331
 5332
 5333
 5334
 5335
 5336
 5337
 5338
 5339
 5340
 5341
 5342
 5343
 5344
 5345
 5346
 5347
 5348
 5349
 5350
 5351
 5352
 5353
 5354
 5355
 5356
 5357
 5358
 5359
 5360
 5361
 5362
 5363
 5364
 5365
 5366
 5367
 5368
 5369
 5370
 5371
 5372
 5373
 5374
 5375
 5376
 5377
 5378
 5379
 5380
 5381
 5382
 5383
 5384
 5385
 5386
 5387
 5388
 5389
 5390
 5391
 5392
 5393
 5394
 5395
 5396
 5397
 5398
 5399
 5400
 5401
 5402
 5403
 5404
 5405
 5406
 5407
 5408
 5409
 5410
 5411
 5412
 5413
 5414
 5415
 5416
 5417
 5418
 5419
 5420
 5421
 5422
 5423
 5424
 5425
 5426
 5427
 5428
 5429
 5430
 5431
 5432
 5433
 5434
 5435
 5436
 5437
 5438
 5439
 5440
 5441
 5442
 5443
 5444
 5445
 5446
 5447
 5448
 5449
 5450
 5451
 5452
 5453
 5454
 5455
 5456
 5457
 5458
 5459
 5460
 5461
 5462
 5463
 5464
 5465
 5466
 5467
 5468
 5469
 5470
 5471
 5472
 5473
 5474
 5475
 5476
 5477
 5478
 5479
 5480
 5481
 5482
 5483
 5484
 5485
 5486
 5487
 5488
 5489
 5490
 5491
 5492
 5493
 5494
 5495
 5496
 5497
 5498
 5499
 5500
 5501
 5502
 5503
 5504
 5505
 5506
 5507
 5508
 5509
 5510
 5511
 5512
 5513
 5514
 5515
 5516
 5517
 5518
 5519
 5520
 5521
 5522
 5523
 5524
 5525
 5526
 5527
 5528
 5529
 5530
 5531
 5532
 5533
 5534
 5535
 5536
 5537
 5538
 5539
 5540
 5541
 5542
 5543
 5544
 5545
 5546
 5547
 5548
 5549
 5550
 5551
 5552
 5553
 5554
 5555
 5556
 5557
 5558
 5559
 5560
 5561
 5562
 5563
 5564
 5565
 5566
 5567
 5568
 5569
 5570
 5571
 5572
 5573
 5574
 5575
 5576
 5577
 5578
 5579
 5580
 5581
 5582
 5583
 5584
 5585
 5586
 5587
 5588
 5589
 5590
 5591
 5592
 5593
 5594
 5595
 5596
 5597
 5598
 5599
 5600
 5601
 5602
 5603
 5604
 5605
 5606
 5607
 5608
 5609
 5610
 5611
 5612
 5613
 5614
 5615
 5616
 5617
 5618
 5619
 5620
 5621
 5622
 5623
 5624
 5625
 5626
 5627
 5628
 5629
 5630
 5631
 5632
 5633
 5634
 5635
 5636
 5637
 5638
 5639
 5640
 5641
 5642
 5643
 5644
 5645
 5646
 5647
 5648
 5649
 5650
 5651
 5652
 5653
 5654
 5655
 5656
 5657
 5658
 5659
 5660
 5661
 5662
 5663
 5664
 5665
 5666
 5667
 5668
 5669
 5670
 5671
 5672
 5673
 5674
 5675
 5676
 5677
 5678
 5679
 5680
 5681
 5682
 5683
 5684
 5685
 5686
 5687
 5688
 5689
 5690
 5691
 5692
 5693
 5694
 5695
 5696
 5697
 5698
 5699
 5700
 5701
 5702
 5703
 5704
 5705
 5706
 5707
 5708
 5709
 5710
 5711
 5712
 5713
 5714
 5715
 5716
 5717
 5718
 5719
 5720
 5721
 5722
 5723
 5724
 5725
 5726
 5727
 5728
 5729
 5730
 5731
 5732
 5733
 5734
 5735
 5736
 5737
 5738
 5739
 5740
 5741
 5742
 5743
 5744
 5745
 5746
 5747
 5748
 5749
 5750
 5751
 5752
 5753
 5754
 5755
 5756
 5757
 5758
 5759
 5760
 5761
 5762
 5763
 5764
 5765
 5766
 5767
 5768
 5769
 5770
 5771
 5772
 5773
 5774
 5775
 5776
 5777
 5778
 5779
 5780
 5781
 5782
 5783
 5784
 5785
 5786
 5787
 5788
 5789
 5790
 5791
 5792
 5793
 5794
 5795
 5796
 5797
 5798
 5799
 5800
 5801
 5802
 5803
 5804
 5805
 5806
 5807
 5808
 5809
 5810
 5811
 5812
 5813
 5814
 5815
 5816
 5817
 5818
 5819
 5820
 5821
 5822
 5823
 5824
 5825
 5826
 5827
 5828
 5829
 5830
 5831
 5832
 5833
 5834
 5835
 5836
 5837
 5838
 5839
 5840
 5841
 5842
 5843
 5844
 5845
 5846
 5847
 5848
 5849
 5850
 5851
 5852
 5853
 5854
 5855
 5856
 5857
 5858
 5859
 5860
 5861
 5862
 5863
 5864
 5865
 5866
 5867
 5868
 5869
 5870
 5871
 5872
 5873
 5874
 5875
 5876
 5877
 5878
 5879
 5880
 5881
 5882
 5883
 5884
 5885
 5886
 5887
 5888
 5889
 5890
 5891
 5892
 5893
 5894
 5895
 5896
 5897
 5898
 5899
 5900
 5901
 5902
 5903
 5904
 5905
 5906
 5907
 5908
 5909
 5910
 5911
 5912
 5913
 5914
 5915
 5916
 5917
 5918
 5919
 5920
 5921
 5922
 5923
 5924
 5925
 5926
 5927
 5928
 5929
 5930
 5931
 5932
 5933
 5934
 5935
 5936
 5937
 5938
 5939
 5940
 5941
 5942
 5943
 5944
 5945
 5946
 5947
 5948
 5949
 5950
 5951
 5952
 5953
 5954
 5955
 5956
 5957
 5958
 5959
 5960
 5961
 5962
 5963
 5964
 5965
 5966
 5967
 5968
 5969
 5970
 5971
 5972
 5973
 5974
 5975
 5976
 5977
 5978
 5979
 5980
 5981
 5982
 5983
 5984
 5985
 5986
 5987
 5988
 5989
 5990
 5991
 5992
 5993
 5994
 5995
 5996
 5997
 5998
 5999
 6000
 6001
 6002
 6003
 6004
 6005
 6006
 6007
 6008
 6009
 6010
 6011
 6012
 6013
 6014
 6015
 6016
 6017
 6018
 6019
 6020
 6021
 6022
 6023
 6024
 6025
 6026
 6027
 6028
 6029
 6030
 6031
 6032
 6033
 6034
 6035
 6036
 6037
 6038
 6039
 6040
 6041
 6042
 6043
 6044
 6045
 6046
 6047
 6048
 6049
 6050
 6051
 6052
 6053
 6054
 6055
 6056
 6057
 6058
 6059
 6060
 6061
 6062
 6063
 6064
 6065
 6066
 6067
 6068
 6069
 6070
 6071
 6072
 6073
 6074
 6075
 6076
 6077
 6078
 6079
 6080
 6081
 6082
 6083
 6084
 6085
 6086
 6087
 6088
 6089
 6090
 6091
 6092
 6093
 6094
 6095
 6096
 6097
 6098
 6099
 6100
 6101
 6102
 6103
 6104
 6105
 6106
 6107
 6108
 6109
 6110
 6111
 6112
 6113
 6114
 6115
 6116
 6117
 6118
 6119
 6120
 6121
 6122
 6123
 6124
 6125
 6126
 6127
 6128
 6129
 6130
 6131
 6132
 6133
 6134
 6135
 6136
 6137
 6138
 6139
 6140
 6141
 6142
 6143
 6144
 6145
 6146
 6147
 6148
 6149
 6150
 6151
 6152
 6153
 6154
 6155
 6156
 6157
 6158
 6159
 6160
 6161
 6162
 6163
 6164
 6165
 6166
 6167
 6168
 6169
 6170
 6171
 6172
 6173
 6174
 6175
 6176
 6177
 6178
 6179
 6180
 6181
 6182
 6183
 6184
 6185
 6186
 6187
 6188
 6189
 6190
 6191
 6192
 6193
 6194
 6195
 6196
 6197
 6198
 6199
 6200
 6201
 6202
 6203
 6204
 6205
 6206
 6207
 6208
 6209
 6210
 6211
 6212
 6213
 6214
 6215
 6216
 6217
 6218
 6219
 6220
 6221
 6222
 6223
 6224
 6225
 6226
 6227
 6228
 6229
 6230
 6231
 6232
 6233
 6234
 6235
 6236
 6237
 6238
 6239
 6240
 6241
 6242
 6243
 6244
 6245
 6246
 6247
 6248
 6249
 6250
 6251
 6252
 6253
 6254
 6255
 6256
 6257
 6258
 6259
 6260
 6261
 6262
 6263
 6264
 6265
 6266
 6267
 6268
 6269
 6270
 6271
 6272
 6273
 6274
 6275
 6276
 6277
 6278
 6279
 6280
 6281
 6282
 6283
 6284
 6285
 6286
 6287
 6288
 6289
 6290
 6291
 6292
 6293
 6294
 6295
 6296
 6297
 6298
 6299
 6300
 6301
 6302
 6303
 6304
 6305
 6306
 6307
 6308
 6309
 6310
 6311
 6312
 6313
 6314
 6315
 6316
 6317
 6318
 6319
 6320
 6321
 6322
 6323
 6324
 6325
 6326
 6327
 6328
 6329
 6330
 6331
 6332
 6333
 6334
 6335
 6336
 6337
 6338
 6339
 6340
 6341
 6342
 6343
 6344
 6345
 6346
 6347
 6348
 6349
 6350
 6351
 6352
 6353
 6354
 6355
 6356
 6357
 6358
 6359
 6360
 6361
 6362
 6363
 6364
 6365
 6366
 6367
 6368
 6369
 6370
 6371
 6372
 6373
 6374
 6375
 6376
 6377
 6378
 6379
 6380
 6381
 6382
 6383
 6384
 6385
 6386
 6387
 6388
 6389
 6390
 6391
 6392
 6393
 6394
 6395
 6396
 6397
 6398
 6399
 6400
 6401
 6402
 6403
 6404
 6405
 6406
 6407
 6408
 6409
 6410
 6411
 6412
 6413
 6414
 6415
 6416
 6417
 6418
 6419
 6420
 6421
 6422
 6423
 6424
 6425
 6426
 6427
 6428
 6429
 6430
 6431
 6432
 6433
 6434
 6435
 6436
 6437
 6438
 6439
 6440
 6441
 6442
 6443
 6444
 6445
 6446
 6447
 6448
 6449
 6450
 6451
 6452
 6453
 6454
 6455
 6456
 6457
 6458
 6459
 6460
 6461
 6462
 6463
 6464
 6465
 6466
 6467
 6468
 6469
 6470
 6471
 6472
 6473
 6474
 6475
 6476
 6477
 6478
 6479
 6480
 6481
 6482
 6483
 6484
 6485
 6486
 6487
 6488
 6489
 6490
 6491
 6492
 6493
 6494
 6495
 6496
 6497
 6498
 6499
 6500
 6501
 6502
 6503
 6504
 6505
 6506
 6507
 6508
 6509
 6510
 6511
 6512
 6513
 6514
 6515
 6516
 6517
 6518
 6519
 6520
 6521
 6522
 6523
 6524
 6525
 6526
 6527
 6528
 6529
 6530
 6531
 6532
 6533
 6534
 6535
 6536
 6537
 6538
 6539
 6540
 6541
 6542
 6543
 6544
 6545
 6546
 6547
 6548
 6549
 6550
 6551
 6552
 6553
 6554
 6555
 6556
 6557
 6558
 6559
 6560
 6561
 6562
 6563
 6564
 6565
 6566
 6567
 6568
 6569
 6570
 6571
 6572
 6573
 6574
 6575
 6576
 6577
 6578
 6579
 6580
 6581
 6582
 6583
 6584
 6585
 6586
 6587
 6588
 6589
 6590
 6591
 6592
 6593
 6594
 6595
 6596
 6597
 6598
 6599
 6600
 6601
 6602
 6603
 6604
 6605
 6606
 6607
 6608
 6609
 6610
 6611
 6612
 6613
 6614
 6615
 6616
 6617
 6618
 6619
 6620
 6621
 6622
 6623
 6624
 6625
 6626
 6627
 6628
 6629
 6630
 6631
 6632
 6633
 6634
 6635
 6636
 6637
 6638
 6639
 6640
 6641
 6642
 6643
 6644
 6645
 6646
 6647
 6648
 6649
 6650
 6651
 6652
 6653
 6654
 6655
 6656
 6657
 6658
 6659
 6660
 6661
 6662
 6663
 6664
 6665
 6666
 6667
 6668
 6669
 6670
 6671
 6672
 6673
 6674
 6675
 6676
 6677
 6678
 6679
 6680
 6681
 6682
 6683
 6684
 6685
 6686
 6687
 6688
 6689
 6690
 6691
 6692
 6693
 6694
 6695
 6696
 6697
 6698
 6699
 6700
 6701
 6702
 6703
 6704
 6705
 6706
 6707
 6708
 6709
 6710
 6711
 6712
 6713
 6714
 6715
 6716
 6717
 6718
 6719
 6720
 6721
 6722
 6723
 6724
 6725
 6726
 6727
 6728
 6729
 6730
 6731
 6732
 6733
 6734
 6735
 6736
 6737
 6738
 6739
 6740
 6741
 6742
 6743
 6744
 6745
 6746
 6747
 6748
 6749
 6750
 6751
 6752
 6753
 6754
 6755
 6756
 6757
 6758
 6759
 6760
 6761
 6762
 6763
 6764
 6765
 6766
 6767
 6768
 6769
 6770
 6771
 6772
 6773
 6774
 6775
 6776
 6777
 6778
 6779
 6780
 6781
 6782
 6783
 6784
 6785
 6786
 6787
 6788
 6789
 6790
 6791
 6792
 6793
 6794
 6795
 6796
 6797
 6798
 6799
 6800
 6801
 6802
 6803
 6804
 6805
 6806
 6807
 6808
 6809
 6810
 6811
 6812
 6813
 6814
 6815
 6816
 6817
 6818
 6819
 6820
 6821
 6822
 6823
 6824
 6825
 6826
 6827
 6828
 6829
 6830
 6831
 6832
 6833
 6834
 6835
 6836
 6837
 6838
 6839
 6840
 6841
 6842
 6843
 6844
 6845
 6846
 6847
 6848
 6849
 6850
 6851
 6852
 6853
 6854
 6855
 6856
 6857
 6858
 6859
 6860
 6861
 6862
 6863
 6864
 6865
 6866
 6867
 6868
 6869
 6870
 6871
 6872
 6873
 6874
 6875
 6876
 6877
 6878
 6879
 6880
 6881
 6882
 6883
 6884
 6885
 6886
 6887
 6888
 6889
 6890
 6891
 6892
 6893
 6894
 6895
 6896
 6897
 6898
 6899
 6900
 6901
 6902
 6903
 6904
 6905
 6906
 6907
 6908
 6909
 6910
 6911
 6912
 6913
 6914
 6915
 6916
 6917
 6918
 6919
 6920
 6921
 6922
 6923
 6924
 6925
 6926
 6927
 6928
 6929
 6930
 6931
 6932
 6933
 6934
 6935
 6936
 6937
 6938
 6939
 6940
 6941
 6942
 6943
 6944
 6945
 6946
 6947
 6948
 6949
 6950
 6951
 6952
 6953
 6954
 6955
 6956
 6957
 6958
 6959
 6960
 6961
 6962
 6963
 6964
 6965
 6966
 6967
 6968
 6969
 6970
 6971
 6972
 6973
 6974
 6975
 6976
 6977
 6978
 6979
 6980
 6981
 6982
 6983
 6984
 6985
 6986
 6987
 6988
 6989
 6990
 6991
 6992
 6993
 6994
 6995
 6996
 6997
 6998
 6999
 7000
 7001
 7002
 7003
 7004
 7005
 7006
 7007
 7008
 7009
 7010
 7011
 7012
 7013
 7014
 7015
 7016
 7017
 7018
 7019
 7020
 7021
 7022
 7023
 7024
 7025
 7026
 7027
 7028
 7029
 7030
 7031
 7032
 7033
 7034
 7035
 7036
 7037
 7038
 7039
 7040
 7041
 7042
 7043
 7044
 7045
 7046
 7047
 7048
 7049
 7050
 7051
 7052
 7053
 7054
 7055
 7056
 7057
 7058
 7059
 7060
 7061
 7062
 7063
 7064
 7065
 7066
 7067
 7068
 7069
 7070
 7071
 7072
 7073
 7074
 7075
 7076
 7077
 7078
 7079
 7080
 7081
 7082
 7083
 7084
 7085
 7086
 7087
 7088
 7089
 7090
 7091
 7092
 7093
 7094
 7095
 7096
 7097
 7098
 7099
 7100
 7101
 7102
 7103
 7104
 7105
 7106
 7107
 7108
 7109
 7110
 7111
 7112
 7113
 7114
 7115
 7116
 7117
 7118
 7119
 7120
 7121
 7122
 7123
 7124
 7125
 7126
 7127
 7128
 7129
 7130
 7131
 7132
 7133
 7134
 7135
 7136
 7137
 7138
 7139
 7140
 7141
 7142
 7143
 7144
 7145
 7146
 7147
 7148
 7149
 7150
 7151
 7152
 7153
 7154
 7155
 7156
 7157
 7158
 7159
 7160
 7161
 7162
 7163
 7164
 7165
 7166
 7167
 7168
 7169
 7170
 7171
 7172
 7173
 7174
 7175
 7176
 7177
 7178
 7179
 7180
 7181
 7182
 7183
 7184
 7185
 7186
 7187
 7188
 7189
 7190
 7191
 7192
 7193
 7194
 7195
 7196
 7197
 7198
 7199
 7200
 7201
 7202
 7203
 7204
 7205
 7206
 7207
 7208
 7209
 7210
 7211
 7212
 7213
 7214
 7215
 7216
 7217
 7218
 7219
 7220
 7221
 7222
 7223
 7224
 7225
 7226
 7227
 7228
 7229
 7230
 7231
 7232
 7233
 7234
 7235
 7236
 7237
 7238
 7239
 7240
 7241
 7242
 7243
 7244
 7245
 7246
 7247
 7248
 7249
 7250
 7251
 7252
 7253
 7254
 7255
 7256
 7257
 7258
 7259
 7260
 7261
 7262
 7263
 7264
 7265
 7266
 7267
 7268
 7269
 7270
 7271
 7272
 7273
 7274
 7275
 7276
 7277
 7278
 7279
 7280
 7281
 7282
 7283
 7284
 7285
 7286
 7287
 7288
 7289
 7290
 7291
 7292
 7293
 7294
 7295
 7296
 7297
 7298
 7299
 7300
 7301
 7302
 7303
 7304
 7305
 7306
 7307
 7308
 7309
 7310
 7311
 7312
 7313
 7314
 7315
 7316
 7317
 7318
 7319
 7320
 7321
 7322
 7323
 7324
 7325
 7326
 7327
 7328
 7329
 7330
 7331
 7332
 7333
 7334
 7335
 7336
 7337
 7338
 7339
 7340
 7341
 7342
 7343
 7344
 7345
 7346
 7347
 7348
 7349
 7350
 7351
 7352
 7353
 7354
 7355
 7356
 7357
 7358
 7359
 7360
 7361
 7362
 7363
 7364
 7365
 7366
 7367
 7368
 7369
 7370
 7371
 7372
 7373
 7374
 7375
 7376
 7377
 7378
 7379
 7380
 7381
 7382
 7383
 7384
 7385
 7386
 7387
 7388
 7389
 7390
 7391
 7392
 7393
 7394
 7395
 7396
 7397
 7398
 7399
 7400
 7401
 7402
 7403
 7404
 7405
 7406
 7407
 7408
 7409
 7410
 7411
 7412
 7413
 7414
 7415
 7416
 7417
 7418
 7419
 7420
 7421
 7422
 7423
 7424
 7425
 7426
 7427
 7428
 7429
 7430
 7431
 7432
 7433
 7434
 7435
 7436
 7437
 7438
 7439
 7440
 7441
 7442
 7443
 7444
 7445
 7446
 7447
 7448
 7449
 7450
 7451
 7452
 7453
 7454
 7455
 7456
 7457
 7458
 7459
 7460
 7461
 7462
 7463
 7464
 7465
 7466
 7467
 7468
 7469
 7470
 7471
 7472
 7473
 7474
 7475
 7476
 7477
 7478
 7479
 7480
 7481
 7482
 7483
 7484
 7485
 7486
 7487
 7488
 7489
 7490
 7491
 7492
 7493
 7494
 7495
 7496
 7497
 7498
 7499
 7500
 7501
 7502
 7503
 7504
 7505
 7506
 7507
 7508
 7509
 7510
 7511
 7512
 7513
 7514
 7515
 7516
 7517
 7518
 7519
 7520
 7521
 7522
 7523
 7524
 7525
 7526
 7527
 7528
 7529
 7530
 7531
 7532
 7533
 7534
 7535
 7536
 7537
 7538
 7539
 7540
 7541
 7542
 7543
 7544
 7545
 7546
 7547
 7548
 7549
 7550
 7551
 7552
 7553
 7554
 7555
 7556
 7557
 7558
 7559
 7560
 7561
 7562
 7563
 7564
 7565
 7566
 7567
 7568
 7569
 7570
 7571
 7572
 7573
 7574
 7575
 7576
 7577
 7578
 7579
 7580
 7581
 7582
 7583
 7584
 7585
 7586
 7587
 7588
 7589
 7590
 7591
 7592
 7593
 7594
 7595
 7596
 7597
 7598
 7599
 7600
 7601
 7602
 7603
 7604
 7605
 7606
 7607
 7608
 7609
 7610
 7611
 7612
 7613
 7614
 7615
 7616
 7617
 7618
 7619
 7620
 7621
 7622
 7623
 7624
 7625
 7626
 7627
 7628
 7629
 7630
 7631
 7632
 7633
 7634
 7635
 7636
 7637
 7638
 7639
 7640
 7641
 7642
 7643
 7644
 7645
 7646
 7647
 7648
 7649
 7650
 7651
 7652
 7653
 7654
 7655
 7656
 7657
 7658
 7659
 7660
 7661
 7662
 7663
 7664
 7665
 7666
 7667
 7668
 7669
 7670
 7671
 7672
 7673
 7674
 7675
 7676
 7677
 7678
 7679
 7680
 7681
 7682
 7683
 7684
 7685
 7686
 7687
 7688
 7689
 7690
 7691
 7692
 7693
 7694
 7695
 7696
 7697
 7698
 7699
 7700
 7701
 7702
 7703
 7704
 7705
 7706
 7707
 7708
 7709
 7710
 7711
 7712
 7713
 7714
 7715
 7716
 7717
 7718
 7719
 7720
 7721
 7722
 7723
 7724
 7725
 7726
 7727
 7728
 7729
 7730
 7731
 7732
 7733
 7734
 7735
 7736
 7737
 7738
 7739
 7740
 7741
 7742
 7743
 7744
 7745
 7746
 7747
 7748
 7749
 7750
 7751
 7752
 7753
 7754
 7755
 7756
 7757
 7758
 7759
 7760
 7761
 7762
 7763
 7764
 7765
 7766
 7767
 7768
 7769
 7770
 7771
 7772
 7773
 7774
 7775
 7776
 7777
 7778
 7779
 7780
 7781
 7782
 7783
 7784
 7785
 7786
 7787
 7788
 7789
 7790
 7791
 7792
 7793
 7794
 7795
 7796
 7797
 7798
 7799
 7800
 7801
 7802
 7803
 7804
 7805
 7806
 7807
 7808
 7809
 7810
 7811
 7812
 7813
 7814
 7815
 7816
 7817
 7818
 7819
 7820
 7821
 7822
 7823
 7824
 7825
 7826
 7827
 7828
 7829
 7830
 7831
 7832
 7833
 7834
 7835
 7836
 7837
 7838
 7839
 7840
 7841
 7842
 7843
 7844
 7845
 7846
 7847
 7848
 7849
 7850
 7851
 7852
 7853
 7854
 7855
 7856
 7857
 7858
 7859
 7860
 7861
 7862
 7863
 7864
 7865
 7866
 7867
 7868
 7869
 7870
 7871
 7872
 7873
 7874
 7875
 7876
 7877
 7878
 7879
 7880
 7881
 7882
 7883
 7884
 7885
 7886
 7887
 7888
 7889
 7890
 7891
 7892
 7893
 7894
 7895
 7896
 7897
 7898
 7899
 7900
 7901
 7902
 7903
 7904
 7905
 7906
 7907
 7908
 7909
 7910
 7911
 7912
 7913
 7914
 7915
 7916
 7917
 7918
 7919
 7920
 7921
 7922
 7923
 7924
 7925
 7926
 7927
 7928
 7929
 7930
 7931
 7932
 7933
 7934
 7935
 7936
 7937
 7938
 7939
 7940
 7941
 7942
 7943
 7944
 7945
 7946
 7947
 7948
 7949
 7950
 7951
 7952
 7953
 7954
 7955
 7956
 7957
 7958
 7959
 7960
 7961
 7962
 7963
 7964
 7965
 7966
 7967
 7968
 7969
 7970
 7971
 7972
 7973
 7974
 7975
 7976
 7977
 7978
 7979
 7980
 7981
 7982
 7983
 7984
 7985
 7986
 7987
 7988
 7989
 7990
 7991
 7992
 7993
 7994
 7995
 7996
 7997
 7998
 7999
 8000
 8001
 8002
 8003
 8004
 8005
 8006
 8007
 8008
 8009
 8010
 8011
 8012
 8013
 8014
 8015
 8016
 8017
 8018
 8019
 8020
 8021
 8022
 8023
 8024
 8025
 8026
 8027
 8028
 8029
 8030
 8031
 8032
 8033
 8034
 8035
 8036
 8037
 8038
 8039
 8040
 8041
 8042
 8043
 8044
 8045
 8046
 8047
 8048
 8049
 8050
 8051
 8052
 8053
 8054
 8055
 8056
 8057
 8058
 8059
 8060
 8061
 8062
 8063
 8064
 8065
 8066
 8067
 8068
 8069
 8070
 8071
 8072
 8073
 8074
 8075
 8076
 8077
 8078
 8079
 8080
 8081
 8082
 8083
 8084
 8085
 8086
 8087
 8088
 8089
 8090
 8091
 8092
 8093
 8094
 8095
 8096
 8097
 8098
 8099
 8100
 8101
 8102
 8103
 8104
 8105
 8106
 8107
 8108
 8109
 8110
 8111
 8112
 8113
 8114
 8115
 8116
 8117
 8118
 8119
 8120
 8121
 8122
 8123
 8124
 8125
 8126
 8127
 8128
 8129
 8130
 8131
 8132
 8133
 8134
 8135
 8136
 8137
 8138
 8139
 8140
 8141
 8142
 8143
 8144
 8145
 8146
 8147
 8148
 8149
 8150
 8151
 8152
 8153
 8154
 8155
 8156
 8157
 8158
 8159
 8160
 8161
 8162
 8163
 8164
 8165
 8166
 8167
 8168
 8169
 8170
 8171
 8172
 8173
 8174
 8175
 8176
 8177
 8178
 8179
 8180
 8181
 8182
 8183
 8184
 8185
 8186
 8187
 8188
 8189
 8190
 8191
 8192
 8193
 8194
 8195
 8196
 8197
 8198
 8199
 8200
 8201
 8202
 8203
 8204
 8205
 8206
 8207
 8208
 8209
 8210
 8211
 8212
 8213
 8214
 8215
 8216
 8217
 8218
 8219
 8220
 8221
 8222
 8223
 8224
 8225
 8226
 8227
 8228
 8229
 8230
 8231
 8232
 8233
 8234
 8235
 8236
 8237
 8238
 8239
 8240
 8241
 8242
 8243
 8244
 8245
 8246
 8247
 8248
 8249
 8250
 8251
 8252
 8253
 8254
 8255
 8256
 8257
 8258
 8259
 8260
 8261
 8262
 8263
 8264
 8265
 8266
 8267
 8268
 8269
 8270
 8271
 8272
 8273
 8274
 8275
 8276
 8277
 8278
 8279
 8280
 8281
 8282
 8283
 8284
 8285
 8286
 8287
 8288
 8289
 8290
 8291
 8292
 8293
 8294
 8295
 8296
 8297
 8298
 8299
 8300
 8301
 8302
 8303
 8304
 8305
 8306
 8307
 8308
 8309
 8310
 8311
 8312
 8313
 8314
 8315
 8316
 8317
 8318
 8319
 8320
 8321
 8322
 8323
 8324
 8325
 8326
 8327
 8328
 8329
 8330
 8331
 8332
 8333
 8334
 8335
 8336
 8337
 8338
 8339
 8340
 8341
 8342
 8343
 8344
 8345
 8346
 8347
 8348
 8349
 8350
 8351
 8352
 8353
 8354
 8355
 8356
 8357
 8358
 8359
 8360
 8361
 8362
 8363
 8364
 8365
 8366
 8367
 8368
 8369
 8370
 8371
 8372
 8373
 8374
 8375
 8376
 8377
 8378
 8379
 8380
 8381
 8382
 8383
 8384
 8385
 8386
 8387
 8388
 8389
 8390
 8391
 8392
 8393
 8394
 8395
 8396
 8397
 8398
 8399
 8400
 8401
 8402
 8403
 8404
 8405
 8406
 8407
 8408
 8409
 8410
 8411
 8412
 8413
 8414
 8415
 8416
 8417
 8418
 8419
 8420
 8421
 8422
 8423
 8424
 8425
 8426
 8427
 8428
 8429
 8430
 8431
 8432
 8433
 8434
 8435
 8436
 8437
 8438
 8439
 8440
 8441
 8442
 8443
 8444
 8445
 8446
 8447
 8448
 8449
 8450
 8451
 8452
 8453
 8454
 8455
 8456
 8457
 8458
 8459
 8460
 8461
 8462
 8463
 8464
 8465
 8466
 8467
 8468
 8469
 8470
 8471
 8472
 8473
 8474
 8475
 8476
 8477
 8478
 8479
 8480
 8481
 8482
 8483
 8484
 8485
 8486
 8487
 8488
 8489
 8490
 8491
 8492
 8493
 8494
 8495
 8496
 8497
 8498
 8499
 8500
 8501
 8502
 8503
 8504
 8505
 8506
 8507
 8508
 8509
 8510
 8511
 8512
 8513
 8514
 8515
 8516
 8517
 8518
 8519
 8520
 8521
 8522
 8523
 8524
 8525
 8526
 8527
 8528
 8529
 8530
 8531
 8532
 8533
 8534
 8535
 8536
 8537
 8538
 8539
 8540
 8541
 8542
 8543
 8544
 8545
 8546
 8547
 8548
 8549
 8550
 8551
 8552
 8553
 8554
 8555
 8556
 8557
 8558
 8559
 8560
 8561
 8562
 8563
 8564
 8565
 8566
 8567
 8568
 8569
 8570
 8571
 8572
 8573
 8574
 8575
 8576
 8577
 8578
 8579
 8580
 8581
 8582
 8583
 8584
 8585
 8586
 8587
 8588
 8589
 8590
 8591
 8592
 8593
 8594
 8595
 8596
 8597
 8598
 8599
 8600
 8601
 8602
 8603
 8604
 8605
 8606
 8607
 8608
 8609
 8610
 8611
 8612
 8613
 8614
 8615
 8616
 8617
 8618
 8619
 8620
 8621
 8622
 8623
 8624
 8625
 8626
 8627
 8628
 8629
 8630
 8631
 8632
 8633
 8634
 8635
 8636
 8637
 8638
 8639
 8640
 8641
 8642
 8643
 8644
 8645
 8646
 8647
 8648
 8649
 8650
 8651
 8652
 8653
 8654
 8655
 8656
 8657
 8658
 8659
 8660
 8661
 8662
 8663
 8664
 8665
 8666
 8667
 8668
 8669
 8670
 8671
 8672
 8673
 8674
 8675
 8676
 8677
 8678
 8679
 8680
 8681
 8682
 8683
 8684
 8685
 8686
 8687
 8688
 8689
 8690
 8691
 8692
 8693
 8694
 8695
 8696
 8697
 8698
 8699
 8700
 8701
 8702
 8703
 8704
 8705
 8706
 8707
 8708
 8709
 8710
 8711
 8712
 8713
 8714
 8715
 8716
 8717
 8718
 8719
 8720
 8721
 8722
 8723
 8724
 8725
 8726
 8727
 8728
 8729
 8730
 8731
 8732
 8733
 8734
 8735
 8736
 8737
 8738
 8739
 8740
 8741
 8742
 8743
 8744
 8745
 8746
 8747
 8748
 8749
 8750
 8751
 8752
 8753
 8754
 8755
 8756
 8757
 8758
 8759
 8760
 8761
 8762
 8763
 8764
 8765
 8766
 8767
 8768
 8769
 8770
 8771
 8772
 8773
 8774
 8775
 8776
 8777
 8778
 8779
 8780
 8781
 8782
 8783
 8784
 8785
 8786
 8787
 8788
 8789
 8790
 8791
 8792
 8793
 8794
 8795
 8796
 8797
 8798
 8799
 8800
 8801
 8802
 8803
 8804
 8805
 8806
 8807
 8808
 8809
 8810
 8811
 8812
 8813
 8814
 8815
 8816
 8817
 8818
 8819
 8820
 8821
 8822
 8823
 8824
 8825
 8826
 8827
 8828
 8829
 8830
 8831
 8832
 8833
 8834
 8835
 8836
 8837
 8838
 8839
 8840
 8841
 8842
 8843
 8844
 8845
 8846
 8847
 8848
 8849
 8850
 8851
 8852
 8853
 8854
 8855
 8856
 8857
 8858
 8859
 8860
 8861
 8862
 8863
 8864
 8865
 8866
 8867
 8868
 8869
 8870
 8871
 8872
 8873
 8874
 8875
 8876
 8877
 8878
 8879
 8880
 8881
 8882
 8883
 8884
 8885
 8886
 8887
 8888
 8889
 8890
 8891
 8892
 8893
 8894
 8895
 8896
 8897
 8898
 8899
 8900
 8901
 8902
 8903
 8904
 8905
 8906
 8907
 8908
 8909
 8910
 8911
 8912
 8913
 8914
 8915
 8916
 8917
 8918
 8919
 8920
 8921
 8922
 8923
 8924
 8925
 8926
 8927
 8928
 8929
 8930
 8931
 8932
 8933
 8934
 8935
 8936
 8937
 8938
 8939
 8940
 8941
 8942
 8943
 8944
 8945
 8946
 8947
 8948
 8949
 8950
 8951
 8952
 8953
 8954
 8955
 8956
 8957
 8958
 8959
 8960
 8961
 8962
 8963
 8964
 8965
 8966
 8967
 8968
 8969
 8970
 8971
 8972
 8973
 8974
 8975
 8976
 8977
 8978
 8979
 8980
 8981
 8982
 8983
 8984
 8985
 8986
 8987
 8988
 8989
 8990
 8991
 8992
 8993
 8994
 8995
 8996
 8997
 8998
 8999
 9000
 9001
 9002
 9003
 9004
 9005
 9006
 9007
 9008
 9009
 9010
 9011
 9012
 9013
 9014
 9015
 9016
 9017
 9018
 9019
 9020
 9021
 9022
 9023
 9024
 9025
 9026
 9027
 9028
 9029
 9030
 9031
 9032
 9033
 9034
 9035
 9036
 9037
 9038
 9039
 9040
 9041
 9042
 9043
 9044
 9045
 9046
 9047
 9048
 9049
 9050
 9051
 9052
 9053
 9054
 9055
 9056
 9057
 9058
 9059
 9060
 9061
 9062
 9063
 9064
 9065
 9066
 9067
 9068
 9069
 9070
 9071
 9072
 9073
 9074
 9075
 9076
 9077
 9078
 9079
 9080
 9081
 9082
 9083
 9084
 9085
 9086
 9087
 9088
 9089
 9090
 9091
 9092
 9093
 9094
 9095
 9096
 9097
 9098
 9099
 9100
 9101
 9102
 9103
 9104
 9105
 9106
 9107
 9108
 9109
 9110
 9111
 9112
 9113
 9114
 9115
 9116
 9117
 9118
 9119
 9120
 9121
 9122
 9123
 9124
 9125
 9126
 9127
 9128
 9129
 9130
 9131
 9132
 9133
 9134
 9135
 9136
 9137
 9138
 9139
 9140
 9141
 9142
 9143
 9144
 9145
 9146
 9147
 9148
 9149
 9150
 9151
 9152
 9153
 9154
 9155
 9156
 9157
 9158
 9159
 9160
 9161
 9162
 9163
 9164
 9165
 9166
 9167
 9168
 9169
 9170
 9171
 9172
 9173
 9174
 9175
 9176
 9177
 9178
 9179
 9180
 9181
 9182
 9183
 9184
 9185
 9186
 9187
 9188
 9189
 9190
 9191
 9192
 9193
 9194
 9195
 9196
 9197
 9198
 9199
 9200
 9201
 9202
 9203
 9204
 9205
 9206
 9207
 9208
 9209
 9210
 9211
 9212
 9213
 9214
 9215
 9216
 9217
 9218
 9219
 9220
 9221
 9222
 9223
 9224
 9225
 9226
 9227
 9228
 9229
 9230
 9231
 9232
 9233
 9234
 9235
 9236
 9237
 9238
 9239
 9240
 9241
 9242
 9243
 9244
 9245
 9246
 9247
 9248
 9249
 9250
 9251
 9252
 9253
 9254
 9255
 9256
 9257
 9258
 9259
 9260
 9261
 9262
 9263
 9264
 9265
 9266
 9267
 9268
 9269
 9270
 9271
 9272
 9273
 9274
 9275
 9276
 9277
 9278
 9279
 9280
 9281
 9282
 9283
 9284
 9285
 9286
 9287
 9288
 9289
 9290
 9291
 9292
 9293
 9294
 9295
 9296
 9297
 9298
 9299
 9300
 9301
 9302
 9303
 9304
 9305
 9306
 9307
 9308
 9309
 9310
 9311
 9312
 9313
 9314
 9315
 9316
 9317
 9318
 9319
 9320
 9321
 9322
 9323
 9324
 9325
 9326
 9327
 9328
 9329
 9330
 9331
 9332
 9333
 9334
 9335
 9336
 9337
 9338
 9339
 9340
 9341
 9342
 9343
 9344
 9345
 9346
 9347
 9348
 9349
 9350
 9351
 9352
 9353
 9354
 9355
 9356
 9357
 9358
 9359
 9360
 9361
 9362
 9363
 9364
 9365
 9366
 9367
 9368
 9369
 9370
 9371
 9372
 9373
 9374
 9375
 9376
 9377
 9378
 9379
 9380
 9381
 9382
 9383
 9384
 9385
 9386
 9387
 9388
 9389
 9390
 9391
 9392
 9393
 9394
 9395
 9396
 9397
 9398
 9399
 9400
 9401
 9402
 9403
 9404
 9405
 9406
 9407
 9408
 9409
 9410
 9411
 9412
 9413
 9414
 9415
 9416
 9417
 9418
 9419
 9420
 9421
 9422
 9423
 9424
 9425
 9426
 9427
 9428
 9429
 9430
 9431
 9432
 9433
 9434
 9435
 9436
 9437
 9438
 9439
 9440
 9441
 9442
 9443
 9444
 9445
 9446
 9447
 9448
 9449
 9450
 9451
 9452
 9453
 9454
 9455
 9456
 9457
 9458
 9459
 9460
 9461
 9462
 9463
 9464
 9465
 9466
 9467
 9468
 9469
 9470
 9471
 9472
 9473
 9474
 9475
 9476
 9477
 9478
 9479
 9480
 9481
 9482
 9483
 9484
 9485
 9486
 9487
 9488
 9489
 9490
 9491
 9492
 9493
 9494
 9495
 9496
 9497
 9498
 9499
 9500
 9501
 9502
 9503
 9504
 9505
 9506
 9507
 9508
 9509
 9510
 9511
 9512
 9513
 9514
 9515
 9516
 9517
 9518
 9519
 9520
 9521
 9522
 9523
 9524
 9525
 9526
 9527
 9528
 9529
 9530
 9531
 9532
 9533
 9534
 9535
 9536
 9537
 9538
 9539
 9540
 9541
 9542
 9543
 9544
 9545
 9546
 9547
 9548
 9549
 9550
 9551
 9552
 9553
 9554
 9555
 9556
 9557
 9558
 9559
 9560
 9561
 9562
 9563
 9564
 9565
 9566
 9567
 9568
 9569
 9570
 9571
 9572
 9573
 9574
 9575
 9576
 9577
 9578
 9579
 9580
 9581
 9582
 9583
 9584
 9585
 9586
 9587
 9588
 9589
 9590
 9591
 9592
 9593
 9594
 9595
 9596
 9597
 9598
 9599
 9600
 9601
 9602
 9603
 9604
 9605
 9606
 9607
 9608
 9609
 9610
 9611
 9612
 9613
 9614
 9615
 9616
 9617
 9618
 9619
 9620
 9621
 9622
 9623
 9624
 9625
 9626
 9627
 9628
 9629
 9630
 9631
 9632
 9633
 9634
 9635
 9636
 9637
 9638
 9639
 9640
 9641
 9642
 9643
 9644
 9645
 9646
 9647
 9648
 9649
 9650
 9651
 9652
 9653
 9654
 9655
 9656
 9657
 9658
 9659
 9660
 9661
 9662
 9663
 9664
 9665
 9666
 9667
 9668
 9669
 9670
 9671
 9672
 9673
 9674
 9675
 9676
 9677
 9678
 9679
 9680
 9681
 9682
 9683
 9684
 9685
 9686
 9687
 9688
 9689
 9690
 9691
 9692
 9693
 9694
 9695
 9696
 9697
 9698
 9699
 9700
 9701
 9702
 9703
 9704
 9705
 9706
 9707
 9708
 9709
 9710
 9711
 9712
 9713
 9714
 9715
 9716
 9717
 9718
 9719
 9720
 9721
 9722
 9723
 9724
 9725
 9726
 9727
 9728
 9729
 9730
 9731
 9732
 9733
 9734
 9735
 9736
 9737
 9738
 9739
 9740
 9741
 9742
 9743
 9744
 9745
 9746
 9747
 9748
 9749
 9750
 9751
 9752
 9753
 9754
 9755
 9756
 9757
 9758
 9759
 9760
 9761
 9762
 9763
 9764
 9765
 9766
 9767
 9768
 9769
 9770
 9771
 9772
 9773
 9774
 9775
 9776
 9777
 9778
 9779
 9780
 9781
 9782
 9783
 9784
 9785
 9786
 9787
 9788
 9789
 9790
 9791
 9792
 9793
 9794
 9795
 9796
 9797
 9798
 9799
 9800
 9801
 9802
 9803
 9804
 9805
 9806
 9807
 9808
 9809
 9810
 9811
 9812
 9813
 9814
 9815
 9816
 9817
 9818
 9819
 9820
 9821
 9822
 9823
 9824
 9825
 9826
 9827
 9828
 9829
 9830
 9831
 9832
 9833
 9834
 9835
 9836
 9837
 9838
 9839
 9840
 9841
 9842
 9843
 9844
 9845
 9846
 9847
 9848
 9849
 9850
 9851
 9852
 9853
 9854
 9855
 9856
 9857
 9858
 9859
 9860
 9861
 9862
 9863
 9864
 9865
 9866
 9867
 9868
 9869
 9870
 9871
 9872
 9873
 9874
 9875
 9876
 9877
 9878
 9879
 9880
 9881
 9882
 9883
 9884
 9885
 9886
 9887
 9888
 9889
 9890
 9891
 9892
 9893
 9894
 9895
 9896
 9897
 9898
 9899
 9900
 9901
 9902
 9903
 9904
 9905
 9906
 9907
 9908
 9909
 9910
 9911
 9912
 9913
 9914
 9915
 9916
 9917
 9918
 9919
 9920
 9921
 9922
 9923
 9924
 9925
 9926
 9927
 9928
 9929
 9930
 9931
 9932
 9933
 9934
 9935
 9936
 9937
 9938
 9939
 9940
 9941
 9942
 9943
 9944
 9945
 9946
 9947
 9948
 9949
 9950
 9951
 9952
 9953
 9954
 9955
 9956
 9957
 9958
 9959
 9960
 9961
 9962
 9963
 9964
 9965
 9966
 9967
 9968
 9969
 9970
 9971
 9972
 9973
 9974
 9975
 9976
 9977
 9978
 9979
 9980
 9981
 9982
 9983
 9984
 9985
 9986
 9987
 9988
 9989
 9990
 9991
 9992
 9993
 9994
 9995
 9996
 9997
 9998
 9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038
10039
10040
10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
10071
10072
10073
10074
10075
10076
10077
10078
10079
10080
10081
10082
10083
10084
10085
10086
10087
10088
10089
10090
10091
10092
10093
10094
10095
10096
10097
10098
10099
10100
10101
10102
10103
10104
10105
10106
10107
10108
10109
10110
10111
10112
10113
10114
10115
10116
10117
10118
10119
10120
10121
10122
10123
10124
10125
10126
10127
10128
10129
10130
10131
10132
10133
10134
10135
10136
10137
10138
10139
10140
10141
10142
10143
10144
10145
10146
10147
10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
10160
10161
10162
10163
10164
10165
10166
10167
10168
10169
10170
10171
10172
10173
10174
10175
10176
10177
10178
10179
10180
10181
10182
10183
10184
10185
10186
10187
10188
10189
10190
10191
10192
10193
10194
10195
10196
10197
10198
10199
10200
10201
10202
10203
10204
10205
10206
10207
10208
10209
10210
10211
10212
10213
10214
10215
10216
10217
10218
10219
10220
10221
10222
10223
10224
10225
10226
10227
10228
10229
10230
10231
10232
10233
10234
10235
10236
10237
10238
10239
10240
10241
10242
10243
10244
10245
10246
10247
10248
10249
10250
10251
10252
10253
10254
10255
10256
10257
10258
10259
10260
10261
10262
10263
10264
10265
10266
10267
10268
10269
10270
10271
10272
10273
10274
10275
10276
10277
10278
10279
10280
10281
10282
10283
10284
10285
10286
10287
10288
10289
10290
10291
10292
10293
10294
10295
10296
10297
10298
10299
10300
10301
10302
10303
10304
10305
10306
10307
10308
10309
10310
10311
10312
10313
10314
10315
10316
10317
10318
10319
10320
10321
10322
10323
10324
10325
10326
10327
10328
10329
10330
10331
10332
10333
10334
10335
10336
10337
10338
10339
10340
10341
10342
10343
10344
10345
10346
10347
10348
10349
10350
10351
10352
10353
10354
10355
10356
10357
10358
10359
10360
10361
10362
10363
10364
10365
10366
10367
10368
10369
10370
10371
10372
10373
10374
10375
10376
10377
10378
10379
10380
10381
10382
10383
10384
10385
10386
10387
10388
10389
10390
10391
10392
10393
10394
10395
10396
10397
10398
10399
10400
10401
10402
10403
10404
10405
10406
10407
10408
10409
10410
10411
10412
10413
10414
10415
10416
10417
10418
10419
10420
10421
10422
10423
10424
10425
10426
10427
 
;;; simple.el --- basic editing commands for Emacs  -*- lexical-binding: t -*-

;; Copyright (C) 1985-1987, 1993-2022 Free Software Foundation, Inc.

;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A grab-bag of basic Emacs commands not specifically related to some
;; major mode or to file-handling.

;;; Code:

(eval-when-compile (require 'cl-lib))

(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())

;;; From compile.el
(defvar compilation-current-error)
(defvar compilation-context-lines)

(defcustom idle-update-delay 0.5
  "Idle time delay before updating various things on the screen.
Various Emacs features that update auxiliary information when point moves
wait this many seconds after Emacs becomes idle before doing an update."
  :type 'number
  :group 'display
  :version "22.1")

(defvar amalgamating-undo-limit 20
  "The maximum number of changes to possibly amalgamate when undoing changes.
The `undo' command will normally consider \"similar\" changes
(like inserting characters) to be part of the same change.  This
is called \"amalgamating\" the changes.  This variable says what
the maximum number of changes considered is when amalgamating.  A
value of 1 means that nothing is amalgamated.")

(defgroup killing nil
  "Killing and yanking commands."
  :group 'editing)

(defgroup paren-matching nil
  "Highlight (un)matching of parens and expressions."
  :group 'matching)
\f
;;; next-error support framework

(defgroup next-error nil
  "`next-error' support framework."
  :group 'compilation
  :version "22.1")

(defface next-error
  '((t (:inherit region)))
  "Face used to highlight next error locus."
  :group 'next-error
  :version "22.1")

(defcustom next-error-highlight 0.5
  "Highlighting of locations in the selected buffer.
If a number, highlight the locus in `next-error' face for the given time
in seconds, or until the next command is executed.
If t, highlight the locus until the next command is executed, or until
some other locus replaces it.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it.
See `next-error-highlight-no-select' to customize highlighting
of the locus in non-selected buffers."
  :type '(choice (number :tag "Highlight for specified time")
                 (const :tag "Semipermanent highlighting" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" fringe-arrow))
  :group 'next-error
  :version "22.1")

(defcustom next-error-highlight-no-select 0.5
  "Highlighting of locations in non-selected source buffers.
Usually non-selected buffers are displayed by `next-error-no-select'.
If number, highlight the locus in `next-error' face for given time in seconds.
If t, highlight the locus indefinitely until some other locus replaces it.
If nil, don't highlight the locus in the source buffer.
If `fringe-arrow', indicate the locus by the fringe arrow
indefinitely until some other locus replaces it.
See `next-error-highlight' to customize highlighting of the locus
in the selected buffer."
  :type '(choice (number :tag "Highlight for specified time")
                 (const :tag "Semipermanent highlighting" t)
                 (const :tag "No highlighting" nil)
                 (const :tag "Fringe arrow" fringe-arrow))
  :group 'next-error
  :version "22.1")

(defcustom next-error-recenter nil
  "Display the line in the visited source file recentered as specified.
If non-nil, the value is passed directly to `recenter'."
  :type '(choice (integer :tag "Line to recenter to")
                 (const :tag "Center of window" (4))
                 (const :tag "No recentering" nil))
  :group 'next-error
  :version "23.1")

(defcustom next-error-message-highlight nil
  "If non-nil, highlight the current error message in the `next-error' buffer.
If the value is `keep', highlighting is permanent, so all visited error
messages are highlighted; this helps to see what messages were visited."
  :type '(choice (const :tag "Highlight the current error" t)
                 (const :tag "Highlight all visited errors" keep)
                 (const :tag "No highlighting" nil))
  :group 'next-error
  :version "28.1")

(defface next-error-message
  '((t (:inherit highlight :extend t)))
  "Face used to highlight the current error message in the `next-error' buffer."
  :group 'next-error
  :version "28.1")

(defvar-local next-error--message-highlight-overlay
  nil
  "Overlay highlighting the current error message in the `next-error' buffer.")

(defvar global-minor-modes nil
  "A list of the currently enabled global minor modes.
This is a list of symbols.")

(defcustom next-error-hook nil
  "List of hook functions run by `next-error' after visiting source file."
  :type 'hook
  :group 'next-error)

(defcustom next-error-verbose t
  "If non-nil, `next-error' always outputs the current error buffer.
If nil, the message is output only when the error buffer
changes."
  :group 'next-error
  :type 'boolean
  :safe #'booleanp
  :version "27.1")

(defvar next-error-highlight-timer nil)

(defvar next-error-overlay-arrow-position nil)
(put 'next-error-overlay-arrow-position 'overlay-arrow-string (purecopy "=>"))
(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)

(defvar next-error-last-buffer nil
  "The most recent `next-error' buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")

(defvar-local next-error-buffer nil
  "The buffer-local value of the most recent `next-error' buffer.")
;; next-error-buffer is made buffer-local to keep the reference
;; to the parent buffer used to navigate to the current buffer, so the
;; next call of next-buffer will use the same parent buffer to
;; continue navigation from it.

(defvar-local next-error-function nil
  "Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")

(defvar-local next-error-move-function nil
  "Function to use to move to an error locus.
It takes two arguments, a buffer position in the error buffer
and a buffer position in the error locus buffer.
The buffer for the error locus should already be current.
nil means use `goto-char' using the second argument position.")

(defsubst next-error-buffer-p (buffer
			       &optional avoid-current
			       extra-test-inclusive
			       extra-test-exclusive)
  "Return non-nil if BUFFER is a `next-error' capable buffer.
If AVOID-CURRENT is non-nil, and BUFFER is the current buffer,
return nil.

The function EXTRA-TEST-INCLUSIVE, if non-nil, is called if
BUFFER would not normally qualify.  If it returns non-nil, BUFFER
is considered `next-error' capable, anyway, and the function
returns non-nil.

The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called if the
buffer would normally qualify.  If it returns nil, BUFFER is
rejected, and the function returns nil."
  (and (buffer-name buffer)		;First make sure it's live.
       (not (and avoid-current (eq buffer (current-buffer))))
       (with-current-buffer buffer
	 (if next-error-function   ; This is the normal test.
	     ;; Optionally reject some buffers.
	     (if extra-test-exclusive
		 (funcall extra-test-exclusive)
	       t)
	   ;; Optionally accept some other buffers.
	   (and extra-test-inclusive
		(funcall extra-test-inclusive))))))

(defcustom next-error-find-buffer-function #'ignore
  "Function called to find a `next-error' capable buffer.
This function takes the same three arguments as the function
`next-error-find-buffer', and should return the buffer to be
used by the subsequent invocation of the command `next-error'
and `previous-error'.
If the function returns nil, `next-error-find-buffer' will
try to use the buffer it used previously, and failing that
all other buffers."
  :type '(choice (const :tag "No default" ignore)
                 (const :tag "Single next-error capable buffer on selected frame"
                        next-error-buffer-on-selected-frame)
                 (const :tag "Current buffer if next-error capable and outside navigation"
                        next-error-buffer-unnavigated-current)
                 (function :tag "Other function"))
  :group 'next-error
  :version "28.1")

(defun next-error-buffer-on-selected-frame (&optional _avoid-current
                                                      extra-test-inclusive
                                                      extra-test-exclusive)
  "Return a single visible `next-error' buffer on the selected frame."
  (let ((window-buffers
         (delete-dups
          (delq nil (mapcar (lambda (w)
                              (if (next-error-buffer-p
				   (window-buffer w)
                                   t
                                   extra-test-inclusive extra-test-exclusive)
                                  (window-buffer w)))
                            (window-list))))))
    (if (eq (length window-buffers) 1)
        (car window-buffers))))

(defun next-error-buffer-unnavigated-current (&optional avoid-current
                                                        extra-test-inclusive
                                                        extra-test-exclusive)
  "Try the current buffer when outside navigation.
But return nil if we navigated to the current buffer by the means
of `next-error' command.  Otherwise, return it if it's `next-error'
capable."
  ;; Check that next-error-buffer has no buffer-local value
  ;; (i.e. we never navigated to the current buffer from another),
  ;; and the current buffer is a `next-error' capable buffer.
  (if (and (not (local-variable-p 'next-error-buffer))
           (next-error-buffer-p (current-buffer) avoid-current
                                extra-test-inclusive extra-test-exclusive))
      (current-buffer)))

(defun next-error-find-buffer (&optional avoid-current
					 extra-test-inclusive
					 extra-test-exclusive)
  "Return a `next-error' capable buffer.

If AVOID-CURRENT is non-nil, treat the current buffer
as an absolute last resort only.

The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
that normally would not qualify.  If it returns t, the buffer
in question is treated as usable.

The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
that would normally be considered usable.  If it returns nil,
that buffer is rejected."
  (or
   ;; 1. If a customizable function returns a buffer, use it.
   (funcall next-error-find-buffer-function avoid-current
                                            extra-test-inclusive
                                            extra-test-exclusive)
   ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
   (if (and next-error-last-buffer
            (next-error-buffer-p next-error-last-buffer avoid-current
                                 extra-test-inclusive extra-test-exclusive))
       next-error-last-buffer)
   ;; 3. If the current buffer is acceptable, choose it.
   (if (next-error-buffer-p (current-buffer) avoid-current
			    extra-test-inclusive extra-test-exclusive)
       (current-buffer))
   ;; 4. Look for any acceptable buffer.
   (let ((buffers (buffer-list)))
     (while (and buffers
                 (not (next-error-buffer-p
		       (car buffers) avoid-current
		       extra-test-inclusive extra-test-exclusive)))
       (setq buffers (cdr buffers)))
     (car buffers))
   ;; 5. Use the current buffer as a last resort if it qualifies,
   ;; even despite AVOID-CURRENT.
   (and avoid-current
	(next-error-buffer-p (current-buffer) nil
			     extra-test-inclusive extra-test-exclusive)
	(progn
	  (message "This is the only buffer with error message locations")
	  (current-buffer)))
   ;; 6. Give up.
   (error "No buffers contain error message locations")))

(defun next-error (&optional arg reset)
  "Visit next `next-error' message and corresponding source code.

If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.

A prefix ARG specifies how many error messages to move;
negative means move back to previous error messages.
Just \\[universal-argument] as a prefix means reparse the error message buffer
and start at the first error.

The RESET argument specifies that we should restart from the beginning.

\\[next-error] normally uses the most recently started
compilation, grep, or occur buffer.  It can also operate on any
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
`next-error-function' is bound to an appropriate function.
To specify use of a particular buffer for error messages, type
\\[next-error] in that buffer.  You can also use the command
`next-error-select-buffer' to select the buffer to use for the subsequent
invocation of `next-error'.

Once \\[next-error] has chosen the buffer for error messages, it
runs `next-error-hook' with `run-hooks', and stays with that buffer
until you use it in some other buffer that uses Compilation mode
or Compilation Minor mode.

To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
  (interactive "P")
  (if (consp arg) (setq reset t arg nil))
  (let ((buffer (next-error-find-buffer)))
    (when buffer
      ;; We know here that next-error-function is a valid symbol we can funcall
      (with-current-buffer buffer
        (funcall next-error-function (prefix-numeric-value arg) reset)
        (let ((prev next-error-last-buffer))
          (next-error-found buffer (current-buffer))
          (when (or next-error-verbose
                    (not (eq prev next-error-last-buffer)))
            (message "%s locus from %s"
                     (cond (reset                             "First")
                           ((eq (prefix-numeric-value arg) 0) "Current")
                           ((< (prefix-numeric-value arg) 0)  "Previous")
                           (t                                 "Next"))
                     next-error-last-buffer)))))))

(defun next-error-internal ()
  "Visit the source code corresponding to the `next-error' message at point."
  (let ((buffer (current-buffer)))
    ;; We know here that next-error-function is a valid symbol we can funcall
    (funcall next-error-function 0 nil)
    (let ((prev next-error-last-buffer))
      (next-error-found buffer (current-buffer))
      (when (or next-error-verbose
                (not (eq prev next-error-last-buffer)))
        (message "Current locus from %s" next-error-last-buffer)))))

(defun next-error-quit-window (from-buffer to-buffer)
  "Quit window of FROM-BUFFER when the prefix arg is 0.
Intended to be used in `next-error-found-function'."
  (when (and (eq current-prefix-arg 0) from-buffer
             (not (eq from-buffer to-buffer)))
    (let ((window (get-buffer-window from-buffer)))
      (when (window-live-p window)
        (quit-restore-window window)))))

(defcustom next-error-found-function #'ignore
  "Function called when a next locus is found and displayed.
Function is called with two arguments: a FROM-BUFFER buffer
from which `next-error' navigated, and a target buffer TO-BUFFER."
  :type '(choice (const :tag "No default" ignore)
                 (const :tag "Quit previous window with M-0"
                        next-error-quit-window)
                 (function :tag "Other function"))
  :group 'next-error
  :version "27.1")

(defun next-error-found (&optional from-buffer to-buffer)
  "Function to call when the next locus is found and displayed.
FROM-BUFFER is a buffer from which `next-error' navigated,
and TO-BUFFER is a target buffer."
  (setq next-error-last-buffer (or from-buffer (current-buffer)))
  (when to-buffer
    (with-current-buffer to-buffer
      (setq next-error-buffer from-buffer)))
  (when next-error-recenter
    (recenter next-error-recenter))
  (funcall next-error-found-function from-buffer to-buffer)
  (next-error-message-highlight from-buffer)
  (run-hooks 'next-error-hook))

(defun next-error-select-buffer (buffer)
  "Select a `next-error' capable BUFFER and set it as the last used.
This means that the selected buffer becomes the source of locations
for the subsequent invocation of `next-error' or `previous-error'.
Interactively, this command allows selection only among buffers
where `next-error-function' is bound to an appropriate function."
  (interactive
   (list (get-buffer
          (read-buffer "Select next-error buffer: " nil nil
                       (lambda (b) (next-error-buffer-p (cdr b)))))))
  (setq next-error-last-buffer buffer))

(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)

(defun previous-error (&optional n)
  "Visit previous `next-error' message and corresponding source code.

Prefix arg N says how many error messages to move backwards (or
forwards, if negative).

This operates on the output from the \\[compile] and \\[grep] commands.

See `next-error' for the details."
  (interactive "p")
  (next-error (- (or n 1))))

(defun first-error (&optional n)
  "Restart at the first error.
Visit corresponding source code.
With prefix arg N, visit the source code of the Nth error.
This operates on the output from the \\[compile] command, for instance."
  (interactive "p")
  (next-error n t))

(defun next-error-no-select (&optional n)
  "Move point to the next error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move forwards (or
backwards, if negative).
Finds and highlights the source line like \\[next-error], but does not
select the source buffer."
  (interactive "p")
  (save-selected-window
    (let ((next-error-highlight next-error-highlight-no-select)
          (display-buffer-overriding-action
           '(nil (inhibit-same-window . t))))
      (next-error n))))

(defun previous-error-no-select (&optional n)
  "Move point to the previous error in the `next-error' buffer and highlight match.
Prefix arg N says how many error messages to move backwards (or
forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
  (interactive "p")
  (next-error-no-select (- (or n 1))))

;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

(define-minor-mode next-error-follow-minor-mode
  "Minor mode for compilation, occur and diff modes.

When turned on, cursor motion in the compilation, grep, occur or diff
buffer causes automatic display of the corresponding source code location."
  :group 'next-error :init-value nil :lighter " Fol"
  (if (not next-error-follow-minor-mode)
      (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
    (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
    (make-local-variable 'next-error-follow-last-line)))

;; Used as a `post-command-hook' by `next-error-follow-mode'
;; for the *Compilation* *grep* and *Occur* buffers.
(defun next-error-follow-mode-post-command-hook ()
  (unless (equal next-error-follow-last-line (line-number-at-pos))
    (setq next-error-follow-last-line (line-number-at-pos))
    (condition-case nil
	(let ((compilation-context-lines nil))
	  (setq compilation-current-error (point))
	  (next-error-no-select 0))
      (error t))))

(defun next-error-message-highlight (error-buffer)
  "Highlight the current error message in the ‘next-error’ buffer."
  (when next-error-message-highlight
    (with-current-buffer error-buffer
      (when (and next-error--message-highlight-overlay
                 (not (eq next-error-message-highlight 'keep)))
        (delete-overlay next-error--message-highlight-overlay))
      (let ((ol (make-overlay (line-beginning-position) (1+ (line-end-position)))))
        ;; do not override region highlighting
        (overlay-put ol 'priority -50)
        (overlay-put ol 'face 'next-error-message)
        (overlay-put ol 'window (get-buffer-window))
        (setf next-error--message-highlight-overlay ol)))))

(defun recenter-current-error (&optional arg)
  "Recenter the current displayed error in the `next-error' buffer."
  (interactive "P")
  (save-selected-window
    (let ((next-error-highlight next-error-highlight-no-select)
          (display-buffer-overriding-action
           '(nil (inhibit-same-window . t))))
      (next-error 0)
      (set-buffer (window-buffer))
      (recenter-top-bottom arg))))
\f
;;;

(defun fundamental-mode ()
  "Major mode not specialized for anything in particular.
Other major modes are defined by comparison with this one."
  (interactive)
  (kill-all-local-variables)
  (run-mode-hooks))

(define-derived-mode clean-mode fundamental-mode "Clean"
  "A mode that removes all overlays and text properties."
  (kill-all-local-variables t)
  (let ((inhibit-read-only t))
    (dolist (overlay (overlays-in (point-min) (point-max)))
      (delete-overlay overlay))
    (set-text-properties (point-min) (point-max) nil)
    (setq-local yank-excluded-properties t)))

;; Special major modes to view specially formatted data rather than files.

(defvar-keymap special-mode-map
  :suppress t
  "q" #'quit-window
  "SPC" #'scroll-up-command
  "S-SPC" #'scroll-down-command
  "DEL" #'scroll-down-command
  "?" #'describe-mode
  "h" #'describe-mode
  ">" #'end-of-buffer
  "<" #'beginning-of-buffer
  "g" #'revert-buffer)

(put 'special-mode 'mode-class 'special)
(define-derived-mode special-mode nil "Special"
  "Parent major mode from which special major modes should inherit.

A special major mode is intended to view specially formatted data
rather than files.  These modes usually use read-only buffers."
  (setq buffer-read-only t))

;; Making and deleting lines.

(defvar self-insert-uses-region-functions nil
  "Special hook to tell if `self-insert-command' will use the region.
It must be called via `run-hook-with-args-until-success' with no arguments.

If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper') and will
usually delete the region.  If all the functions on this hook return
nil, it is an indication that `self-insert-command' needs the region
untouched by `delete-selection-mode' and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' that acts on the region should
add a function to this hook so that `delete-selection-mode' could
refrain from deleting the region before the `post-self-insert-hook'
functions are called.
This hook is run by `delete-selection-uses-region-p', which see.")

(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  "Propertized string representing a hard newline character.")

(defun newline (&optional arg interactive)
   "Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.

If `electric-indent-mode' is enabled, this indents the final new line
that it adds, and reindents the preceding line.  To just insert
a newline, use \\[electric-indent-just-newline].

If `auto-fill-mode' is enabled, this may cause automatic line
breaking of the preceding line.  A non-nil ARG inhibits this.

If `use-hard-newlines' is enabled, the newline is marked with the
text-property `hard'.

A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
  (interactive "*P\np")
  (barf-if-buffer-read-only)
  (when (and arg
             (< (prefix-numeric-value arg) 0))
    (error "Repetition argument has to be non-negative"))
  ;; Call self-insert so that auto-fill, abbrev expansion etc. happen.
  ;; Set last-command-event to tell self-insert what to insert.
  (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
         (beforepos (point))
         (last-command-event ?\n)
         ;; Don't auto-fill if we have a prefix argument.
         (auto-fill-function (if arg nil auto-fill-function))
         (arg (prefix-numeric-value arg))
         (procsym (make-symbol "newline-postproc")) ;(bug#46326)
         (postproc
          ;; Do the rest in post-self-insert-hook, because we want to do it
          ;; *before* other functions on that hook.
          (lambda ()
            (remove-hook 'post-self-insert-hook procsym t)
            ;; Mark the newline(s) `hard'.
            (if use-hard-newlines
                (set-hard-newline-properties
                 (- (point) arg) (point)))
            ;; If the newline leaves the previous line blank, and we
            ;; have a left margin, delete that from the blank line.
            (save-excursion
              (goto-char beforepos)
              (beginning-of-line)
              (and (looking-at "[ \t]+$")
                   (> (current-left-margin) 0)
                   (delete-region (point)
                                  (line-end-position))))
            ;; Indent the line after the newline, except in one case:
            ;; when we added the newline at the beginning of a line that
            ;; starts a page.
            (or was-page-start
                (move-to-left-margin nil t)))))
    (fset procsym postproc)
    (if (not interactive)
	;; FIXME: For non-interactive uses, many calls actually
	;; just want (insert "\n"), so maybe we should do just
	;; that, so as to avoid the risk of filling or running
	;; abbrevs unexpectedly.
	(let ((post-self-insert-hook (list postproc)))
	  (self-insert-command arg))
      (unwind-protect
	  (progn
	    (add-hook 'post-self-insert-hook procsym nil t)
	    (self-insert-command arg))
	;; We first used let-binding to protect the hook, but that
	;; was naive since add-hook affects the symbol-default
	;; value of the variable, whereas the let-binding might
	;; protect only the buffer-local value.
	(remove-hook 'post-self-insert-hook procsym t))))
  nil)

(defun set-hard-newline-properties (from to)
  (let ((sticky (get-text-property from 'rear-nonsticky)))
    (put-text-property from to 'hard 't)
    ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
    (if (and (listp sticky) (not (memq 'hard sticky)))
	(put-text-property from (point) 'rear-nonsticky
			   (cons 'hard sticky)))))

(defun open-line (n)
  "Insert a newline and leave point before it.
If there is a fill prefix and/or a `left-margin', insert them on
the new line if the line would have been blank.
With arg N, insert N newlines."
  (interactive "*p")
  (let* ((do-fill-prefix (and fill-prefix (bolp)))
	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
	 (loc (point-marker))
         ;; Don't expand an abbrev before point.
	 (abbrev-mode nil))
    (newline n)
    (goto-char loc)
    (while (> n 0)
      (cond ((bolp)
	     (if do-left-margin (indent-to (current-left-margin)))
	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
      (forward-line 1)
      (setq n (1- n)))
    (goto-char loc)
    ;; Necessary in case a margin or prefix was inserted.
    (end-of-line)))

(defun split-line (&optional arg)
  "Split current line, moving portion beyond point vertically down.
If the current line starts with `fill-prefix', insert it on the new
line as well.  With prefix ARG, don't insert `fill-prefix' on new line.

When called from Lisp code, ARG may be a prefix string to copy."
  (interactive "*P")
  (skip-chars-forward " \t")
  (let* ((col (current-column))
	 (pos (point))
	 ;; What prefix should we check for (nil means don't).
	 (prefix (cond ((stringp arg) arg)
		       (arg nil)
		       (t fill-prefix)))
	 ;; Does this line start with it?
	 (have-prfx (and prefix
			 (save-excursion
			   (beginning-of-line)
			   (looking-at (regexp-quote prefix))))))
    (newline 1)
    (if have-prfx (insert-and-inherit prefix))
    (indent-to col 0)
    (goto-char pos)))

(defface separator-line
  '((((type graphic) (background dark))
     :height 0.1 :background "#505050")
    (((type graphic) (background light))
     :height 0.1 :background "#a0a0a0")
    (t
     :foreground "ForestGreen" :underline t))
  "Face for separator lines."
  :version "29.1"
  :group 'text)

(defun make-separator-line (&optional length)
  "Make a string appropriate for usage as a visual separator line.
This uses the `separator-line' face.

If LENGTH is nil, use the window width."
  (if (or (display-graphic-p)
          (display-supports-face-attributes-p '(:underline t)))
      (if length
          (concat (propertize (make-string length ?\s) 'face 'separator-line)
                  "\n")
        (propertize "\n" 'face '(:inherit separator-line :extend t)))
    ;; In terminals (that don't support underline), use a line of dashes.
    (concat (propertize (make-string (or length (1- (window-width))) ?-)
                        'face 'separator-line)
            "\n")))

(defun delete-indentation (&optional arg beg end)
  "Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this
line.
With prefix ARG, join the current line to the following line.
When BEG and END are non-nil, join all lines in the region they
define.  Interactively, BEG and END are, respectively, the start
and end of the region if it is active, else nil.  (The region is
ignored if prefix ARG is given.)"
  (interactive
   (progn (barf-if-buffer-read-only)
          (cons current-prefix-arg
                (and (use-region-p)
                     (list (region-beginning) (region-end))))))
  ;; Consistently deactivate mark even when no text is changed.
  (setq deactivate-mark t)
  (if (and beg (not arg))
      ;; Region is active.  Go to END, but only if region spans
      ;; multiple lines.
      (and (goto-char beg)
           (> end (line-end-position))
           (goto-char end))
    ;; Region is inactive.  Set a loop sentinel
    ;; (subtracting 1 in order to compare less than BOB).
    (setq beg (1- (line-beginning-position (and arg 2))))
    (when arg (forward-line)))
  (let ((prefix (and (> (length fill-prefix) 0)
                     (regexp-quote fill-prefix))))
    (while (and (> (line-beginning-position) beg)
                (forward-line 0)
                (= (preceding-char) ?\n))
      (delete-char -1)
      ;; If the appended line started with the fill prefix,
      ;; delete the prefix.
      (if (and prefix (looking-at prefix))
          (replace-match "" t t))
      (fixup-whitespace))))

(defalias 'join-line #'delete-indentation) ; easier to find

(defun delete-blank-lines ()
  "On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
On nonblank line, delete any immediately following blank lines."
  (interactive "*")
  (let (thisblank singleblank)
    (save-excursion
      (beginning-of-line)
      (setq thisblank (looking-at "[ \t]*$"))
      ;; Set singleblank if there is just one blank line here.
      (setq singleblank
	    (and thisblank
		 (not (looking-at "[ \t]*\n[ \t]*$"))
		 (or (bobp)
		     (progn (forward-line -1)
			    (not (looking-at "[ \t]*$")))))))
    ;; Delete preceding blank lines, and this one too if it's the only one.
    (if thisblank
	(progn
	  (beginning-of-line)
	  (if singleblank (forward-line 1))
	  (delete-region (point)
			 (if (re-search-backward "[^ \t\n]" nil t)
			     (progn (forward-line 1) (point))
			   (point-min)))))
    ;; Delete following blank lines, unless the current line is blank
    ;; and there are no following blank lines.
    (if (not (and thisblank singleblank))
	(save-excursion
	  (end-of-line)
	  (forward-line 1)
	  (delete-region (point)
			 (if (re-search-forward "[^ \t\n]" nil t)
			     (progn (beginning-of-line) (point))
			   (point-max)))))
    ;; Handle the special case where point is followed by newline and eob.
    ;; Delete the line, leaving point at eob.
    (if (looking-at "^[ \t]*\n\\'")
	(delete-region (point) (point-max)))))

(defcustom delete-trailing-lines t
  "If non-nil, \\[delete-trailing-whitespace] deletes trailing lines.
Trailing lines are deleted only if `delete-trailing-whitespace'
is called on the entire buffer (rather than an active region)."
  :type 'boolean
  :group 'editing
  :version "24.3")

(defun region-modifiable-p (start end)
  "Return non-nil if the region contains no read-only text."
  (and (not (get-text-property start 'read-only))
       (eq end (next-single-property-change start 'read-only nil end))))

(defun delete-trailing-whitespace (&optional start end)
  "Delete trailing whitespace between START and END.
If called interactively, START and END are the start/end of the
region if the mark is active, or of the buffer's accessible
portion if the mark is inactive.

This command deletes whitespace characters after the last
non-whitespace character in each line between START and END.  It
does not consider formfeed characters to be whitespace.

If this command acts on the entire buffer (i.e. if called
interactively with the mark inactive, or called from Lisp with
END nil), it also deletes all trailing lines at the end of the
buffer if the variable `delete-trailing-lines' is non-nil."
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (if (use-region-p)
                     (list (region-beginning) (region-end))
                   (list nil nil))))
  (save-match-data
    (save-excursion
      (let ((end-marker (and end (copy-marker end))))
        (goto-char (or start (point-min)))
        (with-syntax-table (make-syntax-table (syntax-table))
          ;; Don't delete formfeeds, even if they are considered whitespace.
          (modify-syntax-entry ?\f "_")
          (while (re-search-forward "\\s-$" end-marker t)
            (skip-syntax-backward "-" (line-beginning-position))
            (let ((b (point)) (e (match-end 0)))
              (if (region-modifiable-p b e)
                  (delete-region b e)
                (goto-char e)))))
        (if end
            (set-marker end-marker nil)
          ;; Delete trailing empty lines.
          (and delete-trailing-lines
               ;; Really the end of buffer.
               (= (goto-char (point-max)) (1+ (buffer-size)))
               (<= (skip-chars-backward "\n") -2)
               (region-modifiable-p (1+ (point)) (point-max))
               (delete-region (1+ (point)) (point-max)))))))
  ;; Return nil for the benefit of `write-file-functions'.
  nil)

(defun newline-and-indent (&optional arg)
  "Insert a newline, then indent according to major mode.
Indentation is done using the value of `indent-line-function'.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'.

With ARG, perform this action that many times.

Also see `open-line' (bound to \\[open-line]) for a command that
just inserts a newline without doing any indentation."
  (interactive "*p")
  (delete-horizontal-space t)
  (unless arg
    (setq arg 1))
  (let ((electric-indent-mode nil))
    (dotimes (_ arg)
      (newline nil t)
      (indent-according-to-mode))))

(defun reindent-then-newline-and-indent ()
  "Reindent current line, insert newline, then indent the new line.
Indentation of both lines is done according to the current major mode,
which means calling the current value of `indent-line-function'.
In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
  (interactive "*")
  (let ((pos (point))
        (electric-indent-mode nil))
    ;; Be careful to insert the newline before indenting the line.
    ;; Otherwise, the indentation might be wrong.
    (newline)
    (save-excursion
      (goto-char pos)
      ;; We are at EOL before the call to indent-according-to-mode, and
      ;; after it we usually are as well, but not always.  We tried to
      ;; address it with `save-excursion' but that uses a normal marker
      ;; whereas we need `move after insertion', so we do the save/restore
      ;; by hand.
      (setq pos (copy-marker pos t))
      (indent-according-to-mode)
      (goto-char pos)
      ;; Remove the trailing white-space after indentation because
      ;; indentation may introduce the whitespace.
      (delete-horizontal-space t))
    (indent-according-to-mode)))

(defcustom read-quoted-char-radix 8
  "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16."
 :type '(choice (const 8) (const 10) (const 16))
 :group 'editing-basics)

(defun read-quoted-char (&optional prompt)
  "Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
we read any number of octal digits and return the
specified character code.  Any nondigit terminates the sequence.
If the terminator is RET, it is discarded;
any other terminator is used itself as input.

The optional argument PROMPT specifies a string to use to prompt the user.
The variable `read-quoted-char-radix' controls which radix to use
for numeric input."
  (let ((message-log-max nil)
	(help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
				       help-event-list)))
	done (first t) (code 0) char translated)
    (while (not done)
      (let ((inhibit-quit first)
	    ;; Don't let C-h or other help chars get the help
	    ;; message--only help function keys.  See bug#16617.
	    (help-char nil)
	    (help-event-list help-events)
	    (help-form
	     "Type the special character you want to use,
or the octal character code.
RET terminates the character code and is discarded;
any other non-digit terminates the character code and is then used as input."))
	(setq char (read-event (and prompt (format "%s-" prompt)) t))
	(if inhibit-quit (setq quit-flag nil)))
      ;; Translate TAB key into control-I ASCII character, and so on.
      ;; Note: `read-char' does it using the `ascii-character' property.
      ;; We tried using read-key instead, but that disables the keystroke
      ;; echo produced by 'C-q', see bug#24635.
      (let ((translation (lookup-key local-function-key-map (vector char))))
	(setq translated (if (arrayp translation)
			     (aref translation 0)
			   char)))
      (if (integerp translated)
	  (setq translated (char-resolve-modifiers translated)))
      (cond ((null translated))
	    ((not (integerp translated))
	     (setq unread-command-events (list char)
		   done t))
	    ((/= (logand translated ?\M-\^@) 0)
	     ;; Turn a meta-character into a character with the 0200 bit set.
	     (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
		   done t))
	    ((and (<= ?0 translated)
                  (< translated (+ ?0 (min 10 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (<= ?a (downcase translated))
		  (< (downcase translated)
                     (+ ?a -10 (min 36 read-quoted-char-radix))))
	     (setq code (+ (* code read-quoted-char-radix)
			   (+ 10 (- (downcase translated) ?a))))
	     (and prompt (setq prompt (message "%s %c" prompt translated))))
	    ((and (not first) (eq translated ?\C-m))
	     (setq done t))
	    ((not first)
	     (setq unread-command-events (list char)
		   done t))
	    (t (setq code translated
		     done t)))
      (setq first nil))
    code))

(defun quoted-insert (arg)
  "Read next input character and insert it.
This is useful for inserting control characters.
With argument, insert ARG copies of the character.

If the first character you type after this command is an octal digit,
you should type a sequence of octal digits that specify a character code.
Any nondigit terminates the sequence.  If the terminator is a RET,
it is discarded; any other terminator is used itself as input.
The variable `read-quoted-char-radix' specifies the radix for this feature;
set it to 10 or 16 to use decimal or hex instead of octal.

In overwrite mode, this function inserts the character anyway, and
does not handle octal digits specially.  This means that if you use
overwrite as your normal editing mode, you can use this function to
insert characters when necessary.

In binary overwrite mode, this function does overwrite, and octal
digits are interpreted as a character code.  This is intended to be
useful for editing binary files."
  (interactive "*p")
  (let* ((char
	  ;; Avoid "obsolete" warnings for translation-table-for-input.
	  (with-no-warnings
	    (let (translation-table-for-input input-method-function)
	      (if (or (not overwrite-mode)
		      (eq overwrite-mode 'overwrite-mode-binary))
		  (read-quoted-char)
		(read-char))))))
    ;; This used to assume character codes 0240 - 0377 stand for
    ;; characters in some single-byte character set, and converted them
    ;; to Emacs characters.  But in 23.1 this feature is deprecated
    ;; in favor of inserting the corresponding Unicode characters.
    ;; (if (and enable-multibyte-characters
    ;;          (>= char ?\240)
    ;;          (<= char ?\377))
    ;;     (setq char (unibyte-char-to-multibyte char)))
    (unless (characterp char)
      (user-error "%s is not a valid character"
		  (key-description (vector char))))
    (if (> arg 0)
	(if (eq overwrite-mode 'overwrite-mode-binary)
	    (delete-char arg)))
    (while (> arg 0)
      (insert-and-inherit char)
      (setq arg (1- arg)))))

(defun forward-to-indentation (&optional arg)
  "Move forward ARG lines and position at first nonblank character."
  (interactive "^p")
  (forward-line (or arg 1))
  (skip-chars-forward " \t"))

(defun backward-to-indentation (&optional arg)
  "Move backward ARG lines and position at first nonblank character."
  (interactive "^p")
  (forward-line (- (or arg 1)))
  (skip-chars-forward " \t"))

(defun back-to-indentation ()
  "Move point to the first non-whitespace character on this line."
  (interactive "^")
  (beginning-of-line 1)
  (skip-syntax-forward " " (line-end-position))
  ;; Move back over chars that have whitespace syntax but have the p flag.
  (backward-prefix-chars))

(defun fixup-whitespace ()
  "Fixup white space between objects around point.
Leave one space or none, according to the context."
  (interactive "*")
  (save-excursion
    (delete-horizontal-space)
    (if (or (looking-at "^\\|$\\|\\s)")
	    (save-excursion (forward-char -1)
			    (looking-at "$\\|\\s(\\|\\s'")))
	nil
      (insert ?\s))))

(defun delete-horizontal-space (&optional backward-only)
  "Delete all spaces and tabs around point.
If BACKWARD-ONLY is non-nil, delete them only before point."
  (interactive "*P")
  (delete-space--internal " \t" backward-only))

(defun delete-all-space (&optional backward-only)
  "Delete all spaces, tabs, and newlines around point.
If BACKWARD-ONLY is non-nil, delete them only before point."
  (interactive "*P")
  (delete-space--internal " \t\r\n" backward-only))

(defun delete-space--internal (chars backward-only)
  "Delete CHARS around point.
If BACKWARD-ONLY is non-nil, delete them only before point."
  (let ((orig-pos (point)))
    (delete-region
     (if backward-only
         orig-pos
       (progn
         (skip-chars-forward chars)
         (constrain-to-field nil orig-pos t)))
     (progn
       (skip-chars-backward chars)
       (constrain-to-field nil orig-pos)))))

(defun just-one-space (&optional n)
  "Delete all spaces and tabs around point, leaving one space (or N spaces).
If N is negative, delete newlines as well, leaving -N spaces.
See also `cycle-spacing'."
  (interactive "*p")
  (let ((orig-pos        (point))
        (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
        (num             (abs (or n 1))))
    (skip-chars-backward skip-characters)
    (constrain-to-field nil orig-pos)
    (let* ((num   (- num (skip-chars-forward " " (+ num (point)))))
           (mid   (point))
           (end   (progn
                    (skip-chars-forward skip-characters)
                    (constrain-to-field nil orig-pos t))))
      (delete-region mid end)
      (insert (make-string num ?\s)))))

(defvar cycle-spacing--context nil
  "Stored context used in consecutive calls to `cycle-spacing' command.
The value is a property list with the following elements:
- `:orig-pos'    The original position of point when starting the
                 sequence.
- `:whitespace-string' All whitespace characters around point
                       including newlines.
- `:n'            The prefix arg given to the initial invocation
                  which is reused for all actions in this cycle.
- `:last-action'  The last action performed in the cycle.")

(defcustom cycle-spacing-actions
  '( just-one-space
     delete-all-space
     restore)
  "List of actions cycled through by `cycle-spacing'.
Supported values are:
- `just-one-space'      Delete all but N (prefix arg) spaces.
                        See that command's docstring for details.
- `delete-space-after'  Delete spaces after point keeping only N.
- `delete-space-before' Delete spaces before point keeping only N.
- `delete-all-space'    Delete all spaces around point.
- `restore'             Restore the original spacing.

All actions make use of the prefix arg given to `cycle-spacing'
in the initial invocation, i.e., `just-one-space' keeps this
amount of spaces deleting surplus ones.  `just-one-space' and all
other actions have the contract that a positive prefix arg (or
zero) only deletes tabs and spaces whereas a negative prefix arg
also deletes newlines.

The `delete-space-before' and `delete-space-after' actions handle
the prefix arg \\[negative-argument] without a number provided
specially: all spaces before/after point are deleted (as if N was
0) including newlines (as if N was negative).

In addition to the predefined actions listed above, any function
which accepts one argument is allowed.  It receives the raw
prefix arg of this cycle.

In addition, an action may take the form (ACTION ARG) where
ACTION is one of the predefined actions (except for `restore')
and ARG is either
- an integer with the meaning that ACTION should always use this
  fixed integer instead of the actual prefix arg or
- the symbol `inverted-arg' with the meaning that ACTION should
  be performed with the inverted actual prefix arg.
- the symbol `-' with the meaning that ACTION should include
  newlines but it's up to the ACTION to decide how to interpret
  it as a number, e.g., `delete-space-before' and
  `delete-space-after' treat it like 0 whereas `just-one-space'
  treats it like -1 as is usual."
  :group 'editing-basics
  :type (let ((actions
               '((const :tag "Just N (prefix arg) spaces" just-one-space)
                 (const :tag "Delete spaces after point" delete-space-after)
                 (const :tag "Delete spaces before point" delete-space-before)
                 (const :tag "Delete all spaces around point" delete-all-space)
                 (function :tag "Function receiving a numeric arg"))))
          `(repeat
            (choice
             ,@actions
             (list :tag "Action with modified arg"
                   (choice ,@actions)
                   (choice (const :tag "Inverted prefix arg" inverted-arg)
                           (integer :tag "Fixed numeric arg")
                           (const :tag "Negative arg" -)))
             (const :tag "Restore the original spacing" restore))))
  :version "29.1")

(defun cycle-spacing (&optional n)
  "Manipulate whitespace around point in a smart way.
Repeated calls perform the actions in `cycle-spacing-actions' one
after the other, wrapping around after the last one.

All actions are amendable using a prefix arg N.  In general, a
zero or positive prefix arg allows only for deletion of tabs and
spaces whereas a negative prefix arg also allows for deleting
newlines.

The prefix arg given at the first invocation starting a cycle is
provided to all following actions, i.e.,
    \\[negative-argument] \\[cycle-spacing] \\[cycle-spacing] \\[cycle-spacing]
is equivalent to
    \\[negative-argument] \\[cycle-spacing] \\[negative-argument] \\[cycle-spacing] \\[negative-argument] \\[cycle-spacing].

A new sequence can be started by providing a different prefix arg
than provided at the initial invocation (except for 1), or by
doing any other command before the next \\[cycle-spacing]."
  (interactive "*P")
  ;; Initialize `cycle-spacing--context' if needed.
  (when (or (not (equal last-command this-command))
            (not cycle-spacing--context)
            ;; With M-5 M-SPC M-SPC... we pass the prefix arg 5 to
            ;; each action and only start a new cycle when a different
            ;; prefix arg is given and which is not the default value
            ;; 1.
            (and n (not (equal (plist-get cycle-spacing--context :n)
                               n))))
    (let ((orig-pos (point))
          (skip-characters " \t\n\r"))
      (save-excursion
        (skip-chars-backward skip-characters)
        (constrain-to-field nil orig-pos)
        (let ((start (point))
              (end   (progn
                       (skip-chars-forward skip-characters)
                       (constrain-to-field nil orig-pos t))))
          (setq cycle-spacing--context  ;; Save for later.
                (list :orig-pos orig-pos
                      :whitespace-string (buffer-substring start end)
                      :n n
                      :last-action nil))))))

  ;; Cycle through the actions in `cycle-spacing-actions'.
  (when cycle-spacing--context
    (cl-labels ((next-action ()
                  (let* ((l cycle-spacing-actions)
                         (elt (plist-get cycle-spacing--context
                                         :last-action)))
                    (if (null elt)
                        (car cycle-spacing-actions)
                      (catch 'found
                        (while l
                          (cond
                           ((null (cdr l))
                            (throw 'found
                                   (when (eq elt (car l))
                                     (car cycle-spacing-actions))))
                           ((and (eq elt (car l))
                                 (cdr l))
                            (throw 'found (cadr l)))
                           (t (setq l (cdr l)))))))))
                (skip-chars (chars max-dist direction)
                  (if (eq direction 'forward)
                      (skip-chars-forward
                       chars
                       (and max-dist (+ (point) max-dist)))
                    (skip-chars-backward
                     chars
                     (and max-dist (- (point) max-dist)))))
                (delete-space (n include-newlines direction)
                  (let ((orig-point (point))
                        (chars (if include-newlines
                                   " \t\r\n"
                                 " \t")))
                    (when (or (zerop n)
                              (= n (abs (skip-chars chars n direction))))
                      (let ((start (point))
                            (end (progn
                                   (skip-chars chars nil direction)
                                   (point))))
                        (unless (= start end)
                          (delete-region start end))
                        (goto-char (if (eq direction 'forward)
                                       orig-point
                                     (+ n end)))))))
                (restore ()
                  (delete-all-space)
                  (insert (plist-get cycle-spacing--context
                                     :whitespace-string))
                  (goto-char (plist-get cycle-spacing--context
                                        :orig-pos))))
      (let ((action (next-action)))
        (atomic-change-group
          (restore)
          (unless (eq action 'restore)
            ;; action can be some-action or (some-action <arg>) where
            ;; arg is either an integer, the arg to be always used for
            ;; this action or - to use the inverted context n for this
            ;; action.
            (let* ((actual-action (if (listp action)
                                      (car action)
                                    action))
                   (arg (when (listp action)
                          (nth 1 action)))
                   (context-n (plist-get cycle-spacing--context :n))
                   (actual-n (cond
                              ((integerp arg) arg)
                              ((eq 'inverted-arg arg)
                               (* -1 (prefix-numeric-value context-n)))
                              ((eq '- arg) '-)
                              (t context-n)))
                   (numeric-n (prefix-numeric-value actual-n))
                   (include-newlines (or (eq actual-n '-)
                                         (and (integerp actual-n)
                                              (< actual-n 0)))))
              (cond
               ((eq actual-action 'just-one-space)
                (just-one-space numeric-n))
               ((eq actual-action 'delete-space-after)
                (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
                              include-newlines 'forward))
               ((eq actual-action 'delete-space-before)
                (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
                              include-newlines 'backward))
               ((eq actual-action 'delete-all-space)
                (if include-newlines
                    (delete-all-space)
                  (delete-horizontal-space)))
               ((functionp actual-action)
                (funcall actual-action actual-n))
               (t
                (error "Don't know how to handle action %S" action)))))
          (setf (plist-get cycle-spacing--context :last-action)
                action))))))
\f
(defun beginning-of-buffer (&optional arg)
  "Move point to the beginning of the buffer.
With numeric arg N, put point N/10 of the way from the beginning.
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.

Push mark at previous position, unless either a \\[universal-argument] prefix
is supplied, or Transient Mark mode is enabled and the mark is active."
  (declare (interactive-only "use `(goto-char (point-min))' instead."))
  (interactive "^P")
  (or (consp arg)
      (region-active-p)
      (push-mark))
  (let ((size (- (point-max) (point-min))))
    (goto-char (if (and arg (not (consp arg)))
		   (+ (point-min) 1
		      (/ (* size (prefix-numeric-value arg)) 10))
		 (point-min))))
  (if (and arg (not (consp arg))) (forward-line 1)))

(defun end-of-buffer (&optional arg)
  "Move point to the end of the buffer.
With numeric arg N, put point N/10 of the way from the end.
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.

Push mark at previous position, unless either a \\[universal-argument] prefix
is supplied, or Transient Mark mode is enabled and the mark is active."
  (declare (interactive-only "use `(goto-char (point-max))' instead."))
  (interactive "^P")
  (or (consp arg) (region-active-p) (push-mark))
  (let ((size (- (point-max) (point-min))))
    (goto-char (if (and arg (not (consp arg)))
		   (- (point-max)
		      (/ (* size (prefix-numeric-value arg)) 10))
		 (point-max))))
  ;; If we went to a place in the middle of the buffer,
  ;; adjust it to the beginning of a line.
  (cond ((and arg (not (consp arg))) (forward-line 1))
	((and (eq (current-buffer) (window-buffer))
              (> (point) (window-end nil t)))
	 ;; If the end of the buffer is not already on the screen,
	 ;; then scroll specially to put it near, but not at, the bottom.
	 (overlay-recenter (point))
	 ;; FIXME: Arguably if `scroll-conservatively' is set, then
         ;; we should pass -1 to `recenter'.
	 (recenter (if (and scroll-minibuffer-conservatively
	                    (window-minibuffer-p))
	               -1 -3)))))

(defcustom delete-active-region t
  "Whether single-char deletion commands delete an active region.
This has an effect only if Transient Mark mode is enabled, and
affects `delete-forward-char' and `delete-backward-char', though
not `delete-char'.

If the value is the symbol `kill', the active region is killed
instead of deleted."
  :type '(choice (const :tag "Delete active region" t)
                 (const :tag "Kill active region" kill)
                 (const :tag "Do ordinary deletion" nil))
  :group 'killing
  :version "24.1")

(setq region-extract-function
  (lambda (method)
    (when (region-beginning)
      (cond
       ((eq method 'bounds)
        (list (cons (region-beginning) (region-end))))
       ((eq method 'delete-only)
        (delete-region (region-beginning) (region-end)))
       (t
        (filter-buffer-substring (region-beginning) (region-end) method))))))

(defvar region-insert-function
  (lambda (lines)
    (let ((first t))
      (while lines
        (or first
            (insert ?\n))
        (insert-for-yank (car lines))
        (setq lines (cdr lines)
              first nil))))
  "Function to insert the region's content.
Called with one argument LINES.
Insert the region as a list of lines.")

(defun delete-backward-char (n &optional killflag)
  "Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
To disable this, set option `delete-active-region' to nil.

Optional second arg KILLFLAG, if non-nil, means to kill (save in
kill ring) instead of delete.  If called interactively, a numeric
prefix argument specifies N, and KILLFLAG is also set if a prefix
argument is used.

When killing, the killed text is filtered by
`filter-buffer-substring' before it is saved in the kill ring, so
the actual saved text might be different from what was killed.

In Overwrite mode, single character backward deletion may replace
tabs with spaces so as to back over columns, unless point is at
the end of the line."
  (declare (interactive-only delete-char))
  (interactive "p\nP")
  (unless (integerp n)
    (signal 'wrong-type-argument (list 'integerp n)))
  (cond ((and (use-region-p)
	      delete-active-region
	      (= n 1))
	 ;; If a region is active, kill or delete it.
	 (if (eq delete-active-region 'kill)
	     (kill-region (region-beginning) (region-end) 'region)
           (funcall region-extract-function 'delete-only)))
	;; In Overwrite mode, maybe untabify while deleting
	((null (or (null overwrite-mode)
		   (<= n 0)
		   (memq (char-before) '(?\t ?\n))
		   (eobp)
		   (eq (char-after) ?\n)))
	 (let ((ocol (current-column)))
           (delete-char (- n) killflag)
	   (save-excursion
	     (insert-char ?\s (- ocol (current-column)) nil))))
	;; Otherwise, do simple deletion.
	(t (delete-char (- n) killflag))))

(defun delete-forward-char (n &optional killflag)
  "Delete the following N characters (previous if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
delete the text in the region and deactivate the mark instead.
To disable this, set variable `delete-active-region' to nil.

If N is positive, characters composed into a single grapheme cluster
count as a single character and are deleted together.  Thus,
\"\\[universal-argument] 2 \\[delete-forward-char]\" when two grapheme clusters follow point will
delete the characters composed into both of the grapheme clusters.

Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete.  If called interactively, a numeric
prefix argument specifies N, and KILLFLAG is also set if a prefix
argument is used.

When killing, the killed text is filtered by
`filter-buffer-substring' before it is saved in the kill ring, so
the actual saved text might be different from what was killed."
  (declare (interactive-only delete-char))
  (interactive "p\nP")
  (unless (integerp n)
    (signal 'wrong-type-argument (list 'integerp n)))
  (cond ((and (use-region-p)
	      delete-active-region
	      (= n 1))
	 ;; If a region is active, kill or delete it.
	 (if (eq delete-active-region 'kill)
	     (kill-region (region-beginning) (region-end) 'region)
	   (funcall region-extract-function 'delete-only)))

	;; For forward deletion, treat composed characters as a single
	;; character to delete.
        ((>= n 1)
         (let ((pos (point))
               start cmp)
           (setq start pos)
           (while (> n 0)
             ;; 'find-composition' will return (FROM TO ....) or nil.
             (setq cmp (find-composition pos))
             (if cmp
                 (setq pos (cadr cmp))
               (setq pos (1+ pos)))
             (setq n (1- n)))
           (delete-char (- pos start) killflag)))

	;; Otherwise, do simple deletion.
	(t (delete-char n killflag))))

(defun mark-whole-buffer ()
  "Put point at beginning and mark at end of buffer.
Also push mark at point before pushing mark at end of buffer.
If narrowing is in effect, uses only the accessible part of the buffer.
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
  (declare (interactive-only t))
  (interactive)
  (push-mark)
  (push-mark (point-max) nil t)
  ;; This is really `point-min' in most cases, but if we're in the
  ;; minibuffer, this is at the end of the prompt.
  (goto-char (minibuffer-prompt-end)))
\f
;; Counting lines, one way or another.

(defcustom goto-line-history-local nil
  "If this option is nil, `goto-line-history' is shared between all buffers.
If it is non-nil, each buffer has its own value of this history list.

Note that on changing from non-nil to nil, the former contents of
`goto-line-history' for each buffer are discarded on use of
`goto-line' in that buffer."
  :group 'editing
  :type 'boolean
  :safe #'booleanp
  :version "28.1")

(defvar goto-line-history nil
  "History of values entered with `goto-line'.")

(defun goto-line-read-args (&optional relative)
  "Read arguments for `goto-line' related commands."
  (if (and current-prefix-arg (not (consp current-prefix-arg)))
      (list (prefix-numeric-value current-prefix-arg))
    ;; Look for a default, a number in the buffer at point.
    (let* ((number (number-at-point))
           (default (and (natnump number) number))
           ;; Decide if we're switching buffers.
           (buffer
            (if (consp current-prefix-arg)
                (other-buffer (current-buffer) t)))
           (buffer-prompt
            (if buffer
                (concat " in " (buffer-name buffer))
              "")))
      ;; Has the buffer locality of `goto-line-history' changed?
      (cond ((and goto-line-history-local (not (local-variable-p 'goto-line-history)))
             (make-local-variable 'goto-line-history))
            ((and (not goto-line-history-local) (local-variable-p 'goto-line-history))
             (kill-local-variable 'goto-line-history)))
      ;; Read the argument, offering that number (if any) as default.
      (list (read-number (format "Goto%s line%s: "
                                 (if (buffer-narrowed-p)
                                     (if relative " relative" " absolute")
                                   "")
                                 buffer-prompt)
                         (list default (if (or relative (not (buffer-narrowed-p)))
                                           (line-number-at-pos)
                                         (save-restriction
                                           (widen)
                                           (line-number-at-pos))))
                         'goto-line-history)
            buffer))))

(defun goto-line (line &optional buffer relative)
  "Go to LINE, counting from line 1 at beginning of buffer.
If called interactively, a numeric prefix argument specifies
LINE; without a numeric prefix argument, read LINE from the
minibuffer.

If optional argument BUFFER is non-nil, switch to that buffer and
move to line LINE there.  If called interactively with \\[universal-argument]
as argument, BUFFER is the most recently selected other buffer.

If optional argument RELATIVE is non-nil, counting starts at the beginning
of the accessible portion of the (potentially narrowed) buffer.

If the variable `widen-automatically' is non-nil, cancel narrowing and
leave all lines accessible.  If `widen-automatically' is nil, just move
point to the edge of visible portion and don't change the buffer bounds.

Prior to moving point, this function sets the mark (without
activating it), unless Transient Mark mode is enabled and the
mark is already active.

This function is usually the wrong thing to use in a Lisp program.
What you probably want instead is something like:
  (goto-char (point-min))
  (forward-line (1- N))
If at all possible, an even better solution is to use char counts
rather than line counts."
  (declare (interactive-only forward-line))
  (interactive (goto-line-read-args))
  ;; Switch to the desired buffer, one way or another.
  (if buffer
      (let ((window (get-buffer-window buffer)))
	(if window (select-window window)
	  (switch-to-buffer-other-window buffer))))
  ;; Leave mark at previous position
  (or (region-active-p) (push-mark))
  ;; Move to the specified line number in that buffer.
  (let ((pos (save-restriction
               (unless relative (widen))
               (goto-char (point-min))
               (if (eq selective-display t)
                   (re-search-forward "[\n\C-m]" nil 'end (1- line))
                 (forward-line (1- line)))
               (point))))
    (when (and (not relative)
               (buffer-narrowed-p)
               widen-automatically
               ;; Position is outside narrowed part of buffer
               (or (> (point-min) pos) (> pos (point-max))))
      (widen))
    (goto-char pos)))

(defun goto-line-relative (line &optional buffer)
  "Go to LINE, counting from line at (point-min).
The line number is relative to the accessible portion of the narrowed
buffer.  The argument BUFFER is the same as in the function `goto-line'."
  (declare (interactive-only forward-line))
  (interactive (goto-line-read-args t))
  (with-suppressed-warnings ((interactive-only goto-line))
    (goto-line line buffer t)))

(defun count-words-region (start end &optional arg)
  "Count the number of words in the region.
If called interactively, print a message reporting the number of
lines, words, and characters in the region (whether or not the
region is active); with prefix ARG, report for the entire buffer
rather than the region.

If called from Lisp, return the number of words between positions
START and END."
  (interactive (if current-prefix-arg
		   (list nil nil current-prefix-arg)
		 (list (region-beginning) (region-end) nil)))
  (cond ((not (called-interactively-p 'any))
	 (count-words start end))
	(arg
	 (message "%s" (count-words--buffer-format)))
	(t
	 (message "%s" (count-words--format "Region" start end)))))

(defun count-words (start end &optional totals)
  "Count words between START and END.
If called interactively, START and END are normally the start and
end of the buffer; but if the region is active, START and END are
the start and end of the region.  Print a message reporting the
number of lines, sentences, words, and chars.  With prefix
argument, also include the data for the entire (un-narrowed)
buffer.

If called from Lisp, return the number of words between START and
END, without printing any message.  TOTALS is ignored when called
from Lisp."
  (interactive (list nil nil current-prefix-arg))
  ;; When called from Lisp, return the data.
  (if (not (called-interactively-p 'any))
      (let ((words 0)
            ;; Count across field boundaries. (Bug#41761)
            (inhibit-field-text-motion t))
	(save-excursion
	  (save-restriction
	    (narrow-to-region start end)
	    (goto-char (point-min))
	    (while (forward-word-strictly 1)
	      (setq words (1+ words)))))
	words)
    ;; When called interactively, message the data.
    (let ((totals (if (and totals
                           (or (use-region-p)
                               (buffer-narrowed-p)))
                      (save-restriction
                        (widen)
                        (count-words--format "; buffer in total"
                                             (point-min) (point-max)))
                    "")))
      (if (use-region-p)
	  (message "%s%s" (count-words--format
                           "Region" (region-beginning) (region-end))
                   totals)
        (message "%s%s" (count-words--buffer-format) totals)))))

(defun count-words--buffer-format ()
  (count-words--format
   (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
   (point-min) (point-max)))

(defun count-words--format (str start end)
  (let ((lines (count-lines start end))
	(sentences (count-sentences start end))
	(words (count-words start end))
	(chars (- end start)))
    (format "%s has %d line%s, %d sentence%s, %d word%s, and %d character%s"
	     str
	     lines (if (= lines 1) "" "s")
	     sentences (if (= sentences 1) "" "s")
	     words (if (= words 1) "" "s")
	     chars (if (= chars 1) "" "s"))))

(defun count-sentences (start end)
  (let ((sentences 0)
        (inhibit-field-text-motion t))
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (goto-char (point-min))
	(while (ignore-errors (forward-sentence))
	  (setq sentences (1+ sentences)))
        ;; Remove last possibly empty sentence
        (when (/= (skip-chars-backward " \t\n") 0)
          (setq sentences (1- sentences)))
	sentences))))

(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1")

(defun what-line ()
  "Print the current buffer line number and narrowed line number of point."
  (interactive)
  (let ((start (point-min))
	(n (line-number-at-pos)))
    (if (= start 1)
	(message "Line %d" n)
      (save-excursion
	(save-restriction
	  (widen)
	  (message "line %d (narrowed line %d)"
		   (+ n (line-number-at-pos start) -1) n))))))

(defun count-lines (start end &optional ignore-invisible-lines)
  "Return number of lines between START and END.
This is usually the number of newlines between them, but can be
one more if START is not equal to END and the greater of them is
not at the start of a line.

When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
included in the count."
  (save-excursion
    (save-restriction
      (narrow-to-region start end)
      (cond ((and (not ignore-invisible-lines)
                  (eq selective-display t))
             (goto-char (point-min))
	     (save-match-data
	       (let ((done 0))
		 (while (re-search-forward "\n\\|\r[^\n]" nil t 40)
		   (setq done (+ 40 done)))
		 (while (re-search-forward "\n\\|\r[^\n]" nil t 1)
		   (setq done (+ 1 done)))
		 (goto-char (point-max))
		 (if (and (/= start end)
			  (not (bolp)))
		     (1+ done)
		   done))))
	    (ignore-invisible-lines
             (goto-char (point-min))
	     (save-match-data
	       (- (buffer-size)
                  (forward-line (buffer-size))
		  (let ((invisible-count 0)
		        prop)
		    (goto-char (point-min))
		    (while (re-search-forward "\n\\|\r[^\n]" nil t)
		      (setq prop (get-char-property (1- (point)) 'invisible))
		      (if (if (eq buffer-invisibility-spec t)
			      prop
			    (or (memq prop buffer-invisibility-spec)
			        (assq prop buffer-invisibility-spec)))
			  (setq invisible-count (1+ invisible-count))))
		    invisible-count))))
	    (t
             (goto-char (point-max))
             (if (bolp)
                 (1- (line-number-at-pos))
               (line-number-at-pos)))))))

(defcustom what-cursor-show-names nil
  "Whether to show character names in `what-cursor-position'."
  :type 'boolean
  :version "27.1"
  :group 'editing-basics)

(defun what-cursor-position (&optional detail)
  "Print info on cursor position (on screen and within buffer).
Also describe the character after point, and give its character
code in octal, decimal and hex.  If `what-cursor-show-names' is
non-nil, additionally show the name of the character.

For a non-ASCII multibyte character, also give its encoding in the
buffer's selected coding system if the coding system encodes the
character safely.  If the character is encoded into one byte, that
code is shown in hex.  If the character is encoded into more than one
byte, just \"...\" is shown.

In addition, with prefix argument, show details about that character
in *Help* buffer.  See also the command `describe-char'."
  (interactive "P")
  (let* ((char (following-char))
         (char-name (and what-cursor-show-names
                         (or (get-char-code-property char 'name)
                             (get-char-code-property char 'old-name))))
         (char-name-fmt (if char-name
                            (format ", %s" char-name)
                          ""))
	 (bidi-fixer
	  ;; If the character is one of LRE, LRO, RLE, RLO, it will
	  ;; start a directional embedding, which could completely
	  ;; disrupt the rest of the line (e.g., RLO will display the
	  ;; rest of the line right-to-left).  So we put an invisible
	  ;; PDF character after these characters, to end the
	  ;; embedding, which eliminates any effects on the rest of
	  ;; the line.  For RLE and RLO we also append an invisible
	  ;; LRM, to avoid reordering the following numerical
	  ;; characters.  For LRI/RLI/FSI we append a PDI.
	  (cond ((memq char '(?\x202a ?\x202d))
		 (propertize (string ?\x202c) 'invisible t))
		((memq char '(?\x202b ?\x202e))
		 (propertize (string ?\x202c ?\x200e) 'invisible t))
		((memq char '(?\x2066 ?\x2067 ?\x2068))
		 (propertize (string ?\x2069) 'invisible t))
		;; Strong right-to-left characters cause reordering of
		;; the following numerical characters which show the
		;; codepoint, so append LRM to countermand that.
		((memq (get-char-code-property char 'bidi-class) '(R AL))
		 (propertize (string ?\x200e) 'invisible t))
		(t
		 "")))
	 (beg (point-min))
	 (end (point-max))
         (pos (point))
	 (total (buffer-size))
	 (percent (round (* 100.0 (1- pos)) (max 1 total)))
	 (hscroll (if (= (window-hscroll) 0)
		      ""
		    (format " Hscroll=%d" (window-hscroll))))
	 (col (current-column)))
    (if (= pos end)
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
		     pos total percent beg end col hscroll)
	  (message "point=%d of %d (EOB) column=%d%s"
		   pos total col hscroll))
      (let ((coding buffer-file-coding-system)
	    encoded encoding-msg display-prop under-display)
	(if (or (not coding)
		(eq (coding-system-type coding) t))
	    (setq coding (or (default-value 'buffer-file-coding-system)
                             ;; A nil value of `buffer-file-coding-system'
                             ;; means "no conversion" which means each byte
                             ;; is a char and vice versa.
                             'binary)))
	(if (eq (char-charset char) 'eight-bit)
	    (setq encoding-msg
		  (format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt))
	  ;; Check if the character is displayed with some `display'
	  ;; text property.  In that case, set under-display to the
	  ;; buffer substring covered by that property.
	  (setq display-prop (get-char-property pos 'display))
	  (if display-prop
	      (let ((to (or (next-single-char-property-change pos 'display)
			    (point-max))))
		(if (< to (+ pos 4))
		    (setq under-display "")
		  (setq under-display "..."
			to (+ pos 4)))
		(setq under-display
		      (concat (buffer-substring-no-properties pos to)
			      under-display)))
	    (setq encoded (and (>= char 128) (encode-coding-char char coding))))
	  (setq encoding-msg
		(if display-prop
		    (if (not (stringp display-prop))
			(format "(%d, #o%o, #x%x%s, part of display \"%s\")"
				char char char char-name-fmt under-display)
		      (format "(%d, #o%o, #x%x%s, part of display \"%s\"->\"%s\")"
			      char char char char-name-fmt under-display display-prop))
		  (if encoded
		      (format "(%d, #o%o, #x%x%s, file %s)"
			      char char char char-name-fmt
			      (if (> (length encoded) 1)
				  "..."
				(encoded-string-description encoded coding)))
		    (format "(%d, #o%o, #x%x%s)" char char char char-name-fmt)))))
	(if detail
	    ;; We show the detailed information about CHAR.
	    (describe-char (point)))
	(if (or (/= beg 1) (/= end (1+ total)))
	    (message "Char: %s%s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
		     (if (< char 256)
			 (single-key-description char)
		       (buffer-substring-no-properties (point) (1+ (point))))
		     bidi-fixer
		     encoding-msg pos total percent beg end col hscroll)
	  (message "Char: %s%s %s point=%d of %d (%d%%) column=%d%s"
		   (if enable-multibyte-characters
		       (if (< char 128)
			   (single-key-description char)
			 (buffer-substring-no-properties (point) (1+ (point))))
		     (single-key-description char))
		   bidi-fixer encoding-msg pos total percent col hscroll))))))
\f
;; Initialize read-expression-map.  It is defined at C level.
(defvar read-expression-map
  (let ((m (make-sparse-keymap)))
    (define-key m "\M-\t" 'completion-at-point)
    ;; Might as well bind TAB to completion, since inserting a TAB char is
    ;; much too rarely useful.
    (define-key m "\t" 'completion-at-point)
    (define-key m "\r" 'read--expression-try-read)
    (define-key m "\n" 'read--expression-try-read)
    (define-key m "\M-g\M-c" 'read-expression-switch-to-completions)
    (set-keymap-parent m minibuffer-local-map)
    m))

(defun read-minibuffer (prompt &optional initial-contents)
  "Return a Lisp object read using the minibuffer, unevaluated.
Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
is a string to insert in the minibuffer before reading.
\(INITIAL-CONTENTS can also be a cons of a string and an integer.
Such arguments are used as in `read-from-minibuffer'.)"
  ;; Used for interactive spec `x'.
  (read-from-minibuffer prompt initial-contents minibuffer-local-map
                        t 'minibuffer-history))

(defun eval-minibuffer (prompt &optional initial-contents)
  "Return value of Lisp expression read using the minibuffer.
Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
is a string to insert in the minibuffer before reading.
\(INITIAL-CONTENTS can also be a cons of a string and an integer.
Such arguments are used as in `read-from-minibuffer'.)"
  ;; Used for interactive spec `X'.
  (eval (read--expression prompt initial-contents)))

(defvar minibuffer-completing-symbol nil
  "Non-nil means completing a Lisp symbol in the minibuffer.")
(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1" 'get)

(defvar minibuffer-default nil
  "The current default value or list of default values in the minibuffer.
The functions `read-from-minibuffer' and `completing-read' bind
this variable locally.")

(defcustom eval-expression-print-level 4
  "Value for `print-level' while printing value in `eval-expression'.
A value of nil means no limit."
  :group 'lisp
  :type '(choice (const :tag "No Limit" nil) integer)
  :version "21.1")

(defcustom eval-expression-print-length 12
  "Value for `print-length' while printing value in `eval-expression'.
A value of nil means no limit."
  :group 'lisp
  :type '(choice (const :tag "No Limit" nil) integer)
  :version "21.1")

(defcustom eval-expression-debug-on-error t
  "If non-nil set `debug-on-error' to t in `eval-expression'.
If nil, don't change the value of `debug-on-error'."
  :group 'lisp
  :type 'boolean
  :version "21.1")

(defcustom eval-expression-print-maximum-character 127
  "The largest integer that will be displayed as a character.
This affects printing by `eval-expression' (via
`eval-expression-print-format')."
  :group 'lisp
  :type `(choice (const :tag "ASCII characters" 127)
                 (const :tag "All characters" ,(max-char))
                 (integer :tag "Max codepoint to display as character"))
  :version "26.1")

(defun eval-expression-print-format (value)
  "If VALUE is an integer, return a specially formatted string.
This string will typically look like \" (#o1, #x1, ?\\C-a)\".
If VALUE is not an integer, return nil.
This function is used by commands like `eval-expression' that
display the result of expression evaluation."
  (when (integerp value)
    (let ((char-string
           (and (characterp value)
                (<= value eval-expression-print-maximum-character)
                (char-displayable-p value)
                (prin1-char value))))
      (if char-string
          (format " (#o%o, #x%x, %s)" value value char-string)
        (format " (#o%o, #x%x)" value value)))))

(defvar eval-expression-minibuffer-setup-hook nil
  "Hook run by `eval-expression' when entering the minibuffer.")

(defun read--expression (prompt &optional initial-contents)
  "Read an Emacs Lisp expression from the minibuffer.

PROMPT and optional argument INITIAL-CONTENTS do the same as in
function `read-from-minibuffer'."
  (let ((minibuffer-completing-symbol t))
    (minibuffer-with-setup-hook
        (lambda ()
          ;; FIXME: instead of just applying the syntax table, maybe
          ;; use a special major mode tailored to reading Lisp
          ;; expressions from the minibuffer? (`emacs-lisp-mode'
          ;; doesn't preserve the necessary keybindings.)
          (set-syntax-table emacs-lisp-mode-syntax-table)
          (add-hook 'completion-at-point-functions
                    #'elisp-completion-at-point nil t)
          (run-hooks 'eval-expression-minibuffer-setup-hook))
      (read-from-minibuffer prompt initial-contents
                            read-expression-map t
                            'read-expression-history))))

(defun read--expression-try-read ()
  "Try to read an Emacs Lisp expression in the minibuffer.

Exit the minibuffer if successful, else report the error to the
user and move point to the location of the error.  If point is
not already at the location of the error, push a mark before
moving point."
  (interactive)
  (unless (> (minibuffer-depth) 0)
    (error "Minibuffer must be active"))
  (if (let* ((contents (minibuffer-contents))
             (error-point nil))
        (with-temp-buffer
          (condition-case err
              (progn
                (insert contents)
                (goto-char (point-min))
                ;; `read' will signal errors like "End of file during
                ;; parsing" and "Invalid read syntax".
                (read (current-buffer))
                ;; Since `read' does not signal the "Trailing garbage
                ;; following expression" error, we check for trailing
                ;; garbage ourselves.
                (or (progn
                      ;; This check is similar to what `string_to_object'
                      ;; does in minibuf.c.
                      (skip-chars-forward " \t\n")
                      (= (point) (point-max)))
                    (error "Trailing garbage following expression")))
            (error
             (setq error-point (+ (length (minibuffer-prompt)) (point)))
             (with-current-buffer (window-buffer (minibuffer-window))
               (unless (= (point) error-point)
                 (push-mark))
               (goto-char error-point)
               (minibuffer-message (error-message-string err)))
             nil))))
      (exit-minibuffer)))

(defun eval-expression-get-print-arguments (prefix-argument)
  "Get arguments for commands that print an expression result.
Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) based
on PREFIX-ARGUMENT.  This function determines the interpretation
of the prefix argument for `eval-expression' and
`eval-last-sexp'."
  (let ((num (prefix-numeric-value prefix-argument)))
    (list (not (memq prefix-argument '(- nil)))
          (= num 0)
          (cond ((not (memq prefix-argument '(0 -1 - nil))) nil)
                ((= num -1) most-positive-fixnum)
                (t eval-expression-print-maximum-character)))))

;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-buffer.
(defun eval-expression (exp &optional insert-value no-truncate char-print-limit)
  "Evaluate EXP and print value in the echo area.
When called interactively, read an Emacs Lisp expression and
evaluate it.  Value is also consed on to front of the variable
`values'.  Optional argument INSERT-VALUE non-nil (interactively,
with a non `-' prefix argument) means insert the result into the
current buffer instead of printing it in the echo area.

Normally, this function truncates long output according to the
value of the variables `eval-expression-print-length' and
`eval-expression-print-level'.  When NO-TRUNCATE is
non-nil (interactively, with a prefix argument of zero), however,
there is no such truncation.

If the resulting value is an integer, and CHAR-PRINT-LIMIT is
non-nil (interactively, unless given a non-zero prefix argument)
it will be printed in several additional formats (octal,
hexadecimal, and character).  The character format is used only
if the value is below CHAR-PRINT-LIMIT (interactively, if the
prefix argument is -1 or the value doesn't exceed
`eval-expression-print-maximum-character').

Runs the hook `eval-expression-minibuffer-setup-hook' on entering the
minibuffer.

If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
  (interactive
   (cons (read--expression "Eval: ")
         (eval-expression-get-print-arguments current-prefix-arg)))

  (let (result)
    (if (null eval-expression-debug-on-error)
        (setq result
              (values--store-value
               (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
      (let ((old-value (make-symbol "t")) new-value)
        ;; Bind debug-on-error to something unique so that we can
        ;; detect when evalled code changes it.
        (let ((debug-on-error old-value))
          (setq result
	        (values--store-value
                 (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
	  (setq new-value debug-on-error))
        ;; If evalled code has changed the value of debug-on-error,
        ;; propagate that change to the global binding.
        (unless (eq old-value new-value)
	  (setq debug-on-error new-value))))

    (let ((print-length (unless no-truncate eval-expression-print-length))
          (print-level  (unless no-truncate eval-expression-print-level))
          (eval-expression-print-maximum-character char-print-limit)
          (deactivate-mark))
      (let ((out (if insert-value (current-buffer) t)))
        (prog1
            (prin1 result out)
          (let ((str (and char-print-limit
                          (eval-expression-print-format result))))
            (when str (princ str out))))))))

(defun edit-and-eval-command (prompt command)
  "Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression.  Let user edit that expression in
the minibuffer, then read and evaluate the result."
  (let ((command
	 (let ((print-level nil)
	       (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
	   (unwind-protect
	       (read-from-minibuffer prompt
				     (prin1-to-string command)
				     read-expression-map t
				     'command-history)
	     ;; If command was added to command-history as a string,
	     ;; get rid of that.  We want only evaluable expressions there.
             (when (stringp (car command-history))
               (pop command-history))))))

    (add-to-history 'command-history command)
    (eval command)))

(defun repeat-complex-command (arg)
  "Edit and re-evaluate last complex command, or ARGth from last.
A complex command is one that used the minibuffer.
The command is placed in the minibuffer as a Lisp form for editing.
The result is executed, repeating the command as changed.
If the command has been changed or is not the most recent previous
command it is added to the front of the command history.
You can use the minibuffer history commands \
\\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
to get different commands to edit and resubmit."
  (interactive "p")
  (let ((elt (nth (1- arg) command-history))
	newcmd)
    (if elt
	(progn
	  (setq newcmd
		(let ((print-level nil)
		      (minibuffer-history-position arg)
		      (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
		  (unwind-protect
		      (read-from-minibuffer
		       "Redo: " (prin1-to-string elt) read-expression-map t
		       (cons 'command-history arg))

		    ;; If command was added to command-history as a
		    ;; string, get rid of that.  We want only
		    ;; evaluable expressions there.
                    (when (stringp (car command-history))
                      (pop command-history)))))

          (add-to-history 'command-history newcmd)
          (apply #'funcall-interactively
		 (car newcmd)
		 (mapcar (lambda (e) (eval e t)) (cdr newcmd))))
      (if command-history
	  (error "Argument %d is beyond length of command history" arg)
	(error "There are no previous complex commands to repeat")))))


(defvar extended-command-history nil)
(defvar execute-extended-command--last-typed nil)

(defcustom read-extended-command-predicate nil
  "Predicate to use to determine which commands to include when completing.
If it's nil, include all the commands.
If it's a function, it will be called with two parameters: the
symbol of the command and a buffer.  The predicate should return
non-nil if the command should be present when doing `M-x TAB'
in that buffer."
  :version "28.1"
  :group 'completion
  :type '(choice (const :tag "Don't exclude any commands" nil)
                 (const :tag "Exclude commands irrelevant to current buffer's mode"
                        command-completion-default-include-p)
                 (function :tag "Other function")))

(defun read-extended-command ()
  "Read command name to invoke in `execute-extended-command'.
This function uses the `read-extended-command-predicate' user option."
  (let ((buffer (current-buffer)))
    (minibuffer-with-setup-hook
        (lambda ()
          (add-hook 'post-self-insert-hook
                    (lambda ()
                      (setq execute-extended-command--last-typed
                            (minibuffer-contents)))
                    nil 'local)
          (setq-local minibuffer-default-add-function
	              (lambda ()
	                ;; Get a command name at point in the original buffer
	                ;; to propose it after M-n.
	                (let ((def
                               (with-current-buffer
			           (window-buffer (minibuffer-selected-window))
			         (and (commandp (function-called-at-point))
				      (format
                                       "%S" (function-called-at-point)))))
		              (all (sort (minibuffer-default-add-completions)
                                         #'string<)))
		          (if def
		              (cons def (delete def all))
		            all)))))
      ;; Read a string, completing from and restricting to the set of
      ;; all defined commands.  Don't provide any initial input.
      ;; Save the command read on the extended-command history list.
      (completing-read
       (concat (cond
	        ((eq current-prefix-arg '-) "- ")
	        ((and (consp current-prefix-arg)
		      (eq (car current-prefix-arg) 4))
		 "C-u ")
	        ((and (consp current-prefix-arg)
		      (integerp (car current-prefix-arg)))
	         (format "%d " (car current-prefix-arg)))
	        ((integerp current-prefix-arg)
	         (format "%d " current-prefix-arg)))
	       ;; This isn't strictly correct if `execute-extended-command'
	       ;; is bound to anything else (e.g. [menu]).
	       ;; It could use (key-description (this-single-command-keys)),
	       ;; but actually a prompt other than "M-x" would be confusing,
	       ;; because "M-x" is a well-known prompt to read a command
	       ;; and it serves as a shorthand for "Extended command: ".
               (if (memq 'shift (event-modifiers last-command-event))
	           "M-X "
	         "M-x "))
       (lambda (string pred action)
         (if (and suggest-key-bindings (eq action 'metadata))
	     '(metadata
	       (affixation-function . read-extended-command--affixation)
	       (category . command))
           (let ((pred
                  (if (memq action '(nil t))
                      ;; Exclude from completions obsolete commands
                      ;; lacking a `current-name', or where `when' is
                      ;; not the current major version.
                      (lambda (sym)
                        (let ((obsolete (get sym 'byte-obsolete-info)))
                          (and (funcall pred sym)
                               (or (equal string (symbol-name sym))
                                   (not obsolete)
                                   (and
                                    ;; Has a current-name.
                                    (functionp (car obsolete))
                                    ;; when >= emacs-major-version
                                    (condition-case nil
                                        (>= (car (version-to-list
                                                  (caddr obsolete)))
                                            emacs-major-version)
                                      ;; If the obsoletion version isn't
                                      ;; valid, include the command.
                                      (error t)))))))
                    pred)))
             (complete-with-action action obarray string pred))))
       (lambda (sym)
         (and (commandp sym)
              (cond ((null read-extended-command-predicate))
                    ((functionp read-extended-command-predicate)
                     ;; Don't let bugs break M-x completion; interpret
                     ;; them as the absence of a predicate.
                     (condition-case-unless-debug err
                         (funcall read-extended-command-predicate sym buffer)
                       (error (message "read-extended-command-predicate: %s: %s"
                                       sym (error-message-string err))))))))
       t nil 'extended-command-history))))

(defun command-completion-using-modes-p (symbol buffer)
  "Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
  ;; Check the modes.
  (let ((modes (command-modes symbol)))
    ;; Common fast case: Just a single mode.
    (if (null (cdr modes))
        (or (provided-mode-derived-p
             (buffer-local-value 'major-mode buffer) (car modes))
            (memq (car modes)
                  (buffer-local-value 'local-minor-modes buffer))
            (memq (car modes) global-minor-modes))
      ;; Uncommon case: Multiple modes.
      (command-completion-with-modes-p modes buffer))))

(defun command-completion-default-include-p (symbol buffer)
  "Say whether SYMBOL should be offered as a completion.
If there's a `completion-predicate' for SYMBOL, the result from
calling that predicate is called.  If there isn't one, this
predicate is true if the command SYMBOL is applicable to the
major mode in BUFFER, or any of the active minor modes in
BUFFER."
  (if (get symbol 'completion-predicate)
      ;; An explicit completion predicate takes precedence.
      (funcall (get symbol 'completion-predicate) symbol buffer)
    (or (null (command-modes symbol))
        (command-completion-using-modes-p symbol buffer))))

(defun command-completion-with-modes-p (modes buffer)
  "Say whether MODES are in action in BUFFER.
This is the case if either the major mode is derived from one of MODES,
or (if one of MODES is a minor mode), if it is switched on in BUFFER."
  (or (apply #'provided-mode-derived-p
             (buffer-local-value 'major-mode buffer)
             modes)
      ;; It's a minor mode.
      (seq-intersection modes
                        (buffer-local-value 'local-minor-modes buffer)
                        #'eq)
      (seq-intersection modes global-minor-modes #'eq)))

(defun command-completion-button-p (category buffer)
  "Return non-nil if there's a button of CATEGORY at point in BUFFER."
  (with-current-buffer buffer
    (and (get-text-property (point) 'button)
         (eq (get-text-property (point) 'category) category))))

(defun read-extended-command--affixation (command-names)
  (with-selected-window (or (minibuffer-selected-window) (selected-window))
    (mapcar
     (lambda (command-name)
       (let* ((fun (and (stringp command-name) (intern-soft command-name)))
              (binding (where-is-internal fun overriding-local-map t))
              (obsolete (get fun 'byte-obsolete-info))
              (alias (symbol-function fun))
              (suffix (cond ((symbolp alias)
                             (format " (%s)" alias))
                            (obsolete
                             (format " (%s)" (car obsolete)))
                            ((and binding (not (stringp binding)))
                             (format " (%s)" (key-description binding)))
                            (t ""))))
         (put-text-property 0 (length suffix)
                            'face 'completions-annotations suffix)
         (list command-name "" suffix)))
     command-names)))

(defcustom suggest-key-bindings t
  "Non-nil means show the equivalent keybinding when \
\\[execute-extended-command] has one.
The value can be a length of time to show the message for.
If the value is non-nil and not a number, we wait 2 seconds.

Also see `extended-command-suggest-shorter'.

Equivalent key-bindings are also shown in the completion list of
\\[execute-extended-command] for all commands that have them."
  :group 'keyboard
  :type '(choice (const :tag "off" nil)
                 (natnum :tag "time" 2)
                 (other :tag "on")))

(defcustom extended-command-suggest-shorter t
  "If non-nil, show a shorter \\[execute-extended-command] invocation \
when there is one.

Also see `suggest-key-bindings'."
  :group 'keyboard
  :type 'boolean
  :version "26.1")

(defun execute-extended-command--shorter-1 (name length)
  (cond
   ((zerop length) (list ""))
   ((equal name "") nil)
   (t
    (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
                   (execute-extended-command--shorter-1
                    (substring name 1) (1- length)))
           (when (string-match "\\`\\(-\\)?[^-]*" name)
             (execute-extended-command--shorter-1
              (substring name (match-end 0)) length))))))

(defun execute-extended-command--shorter (name typed)
  (let ((candidates '())
        (max (length typed))
        (len 1)
        binding)
    (while (and (not binding)
                (progn
                  (unless candidates
                    (setq len (1+ len))
                    (setq candidates (execute-extended-command--shorter-1
                                      name len)))
                  ;; Don't show the help message if the binding isn't
                  ;; significantly shorter than the M-x command the user typed.
                  (< len (- max 5))))
      (input-pending-p)    ;Dummy call to trigger input-processing, bug#23002.
      (let ((candidate (pop candidates)))
        (when (equal name
                       (car-safe (completion-try-completion
                                  candidate obarray 'commandp len)))
          (setq binding candidate))))
    binding))

(defvar execute-extended-command--binding-timer nil)

(defun execute-extended-command (prefixarg &optional command-name typed)
  ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
  ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
  "Read a command name, then read the arguments and call the command.
To pass a prefix argument to the command you are
invoking, give a prefix argument to `execute-extended-command'."
  (declare (interactive-only command-execute))
  ;; FIXME: Remember the actual text typed by the user before completion,
  ;; so that we don't later on suggest the same shortening.
  (interactive
   (let ((execute-extended-command--last-typed nil))
     (list current-prefix-arg
           (read-extended-command)
           execute-extended-command--last-typed)))
  ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
  (unless command-name
    (let ((current-prefix-arg prefixarg) ; for prompt
          (execute-extended-command--last-typed nil))
      (setq command-name (read-extended-command))
      (setq typed execute-extended-command--last-typed)))
  (let* ((function (and (stringp command-name) (intern-soft command-name)))
         (binding (and suggest-key-bindings
		       (not executing-kbd-macro)
		       (where-is-internal function overriding-local-map t)))
         (delay-before-suggest 0)
         (find-shorter nil))
    (unless (commandp function)
      (error "`%s' is not a valid command name" command-name))
    ;; Some features, such as novice.el, rely on this-command-keys
    ;; including M-x COMMAND-NAME RET.
    (set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
    (setq this-command function)
    ;; Normally `real-this-command' should never be changed, but here we really
    ;; want to pretend that M-x <cmd> RET is nothing more than a "key
    ;; binding" for <cmd>, so the command the user really wanted to run is
    ;; `function' and not `execute-extended-command'.  The difference is
    ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
    (setq real-this-command function)
    (let ((prefix-arg prefixarg))
      (command-execute function 'record))
    ;; Ensure that we never have two of the suggest-binding timers in
    ;; flight.
    (when execute-extended-command--binding-timer
      (cancel-timer execute-extended-command--binding-timer))
    ;; If this command displayed something in the echo area, then
    ;; postpone the display of our suggestion message a bit.
    (when (and suggest-key-bindings
               (or binding
                   (and extended-command-suggest-shorter typed)))
      (setq delay-before-suggest
            (cond
             ((zerop (length (current-message))) 0)
             ((numberp suggest-key-bindings) suggest-key-bindings)
             (t 2)))
      (when (and extended-command-suggest-shorter
                 (not binding)
                 (not executing-kbd-macro)
                 (symbolp function)
                 (> (length (symbol-name function)) 2))
        ;; There's no binding for CMD.  Let's try and find the shortest
        ;; string to use in M-x.
        (setq find-shorter t))
      (when (or binding find-shorter)
        (setq execute-extended-command--binding-timer
              (run-at-time
               delay-before-suggest nil
               (lambda ()
                 ;; If the user has typed any other commands in the
                 ;; meantime, then don't display anything.
                 (when (eq function real-last-command)
                   ;; Find shorter string.
                   (when find-shorter
                     (while-no-input
                       ;; FIXME: Can be slow.  Cache it maybe?
                       (setq binding (execute-extended-command--shorter
                                      (symbol-name function) typed))))
                   (when binding
                     (with-temp-message
                         (format-message "You can run the command `%s' with %s"
                                         function
                                         (if (stringp binding)
                                             (concat "M-x " binding " RET")
                                           (key-description binding)))
                       (sit-for (if (numberp suggest-key-bindings)
                                    suggest-key-bindings
                                  2))))))))))))

(defun execute-extended-command-for-buffer (prefixarg &optional
                                                      command-name typed)
  "Query user for a command relevant for the current mode, and then execute it.
This is like `execute-extended-command', but it limits the
completions to commands that are particularly relevant to the
current buffer.  This includes commands that have been marked as
being specially designed for the current major mode (and enabled
minor modes), as well as commands bound in the active local key
maps."
  (declare (interactive-only command-execute))
  (interactive
   (let* ((execute-extended-command--last-typed nil)
          (keymaps
           ;; The major mode's keymap and any active minor modes.
           (nconc
            (and (current-local-map) (list (current-local-map)))
            (mapcar
             #'cdr
             (seq-filter
              (lambda (elem)
                (symbol-value (car elem)))
              minor-mode-map-alist))))
          (read-extended-command-predicate
           (lambda (symbol buffer)
             (or (command-completion-using-modes-p symbol buffer)
                 (where-is-internal symbol keymaps)))))
     (list current-prefix-arg
           (read-extended-command)
           execute-extended-command--last-typed)))
  (with-suppressed-warnings ((interactive-only execute-extended-command))
    (execute-extended-command prefixarg command-name typed)))

(cl-defgeneric function-documentation (function)
  "Extract the raw docstring info from FUNCTION.
FUNCTION is expected to be a function value rather than, say, a mere symbol.
This is intended to be specialized via `cl-defmethod' but not called directly:
if you need a function's documentation use `documentation' which will call this
function as needed."
  (let ((docstring-p (lambda (doc)
                       ;; A docstring can be either a string or a reference
                       ;; into either the `etc/DOC' or a `.elc' file.
                       (or (stringp doc)
                           (fixnump doc) (fixnump (cdr-safe doc))))))
    (pcase function
      ((pred byte-code-function-p)
       (when (> (length function) 4)
         (let ((doc (aref function 4)))
           (when (funcall docstring-p doc) doc))))
      ((or (pred stringp) (pred vectorp)) "Keyboard macro.")
      (`(keymap . ,_)
       "Prefix command (definition is a keymap associating keystrokes with commands).")
      ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
           `(autoload ,_file . ,body))
       (let ((doc (car body)))
	 (when (and (funcall docstring-p doc)
	            ;; Handle a doc reference--but these never come last
	            ;; in the function body, so reject them if they are last.
	            (or (cdr body) (eq 'autoload (car-safe function))))
           doc)))
      (_ (signal 'invalid-function (list function))))))

(cl-defmethod function-documentation ((function accessor))
  (oclosure--accessor-docstring function)) ;; FIXME: η-reduce!

;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
(cl-defgeneric oclosure-interactive-form (_function)
  "Return the interactive form of FUNCTION or nil if none.
This is called by `interactive-form' when invoked on OClosures.
It should return either nil or a two-element list of the form (interactive FORM)
where FORM is like the first arg of the `interactive' special form.
Add your methods to this generic function, but always call `interactive-form'
instead."
  ;; (interactive-form function)
  nil)

(defun command-execute (cmd &optional record-flag keys special)
  ;; BEWARE: Called directly from the C code.
  "Execute CMD as an editor command.
CMD must be a symbol that satisfies the `commandp' predicate.

Optional second arg RECORD-FLAG non-nil means unconditionally put
this command in the variable `command-history'.  Otherwise, that
is done only if an arg is read using the minibuffer.

The argument KEYS specifies the value to use instead of the
return value of the `this-command-keys' function when reading the
arguments; if it is nil, `this-command-keys' is used.

The argument SPECIAL, if non-nil, means that this command is
executing a special event, so ignore the prefix argument and
don't clear it."
  (setq debug-on-next-call nil)
  (let ((prefixarg (unless special
                     ;; FIXME: This should probably be done around
                     ;; pre-command-hook rather than here!
                     (prog1 prefix-arg
                       (setq current-prefix-arg prefix-arg)
                       (setq prefix-arg nil)
                       (when current-prefix-arg
                         (prefix-command-update)))))
        query)
    (if (and (symbolp cmd)
             (get cmd 'disabled)
             (or (and (setq query (and (consp (get cmd 'disabled))
                                       (eq (car (get cmd 'disabled)) 'query)))
                      (not (command-execute--query cmd)))
                 (and (not query) disabled-command-function)))
        (when (not query)
          ;; FIXME: Weird calling convention!
          (run-hooks 'disabled-command-function))
      (let ((final cmd))
        (while
            (progn
              (setq final (indirect-function final))
              (if (autoloadp final)
                  (setq final (autoload-do-load final cmd)))))
        (cond
         ((arrayp final)
          ;; If requested, place the macro in the command history.  For
          ;; other sorts of commands, call-interactively takes care of this.
          (when record-flag
            (add-to-history
             'command-history `(execute-kbd-macro ,final ,prefixarg) nil t))
          (execute-kbd-macro final prefixarg))
         (t
          ;; Pass `cmd' rather than `final', for the backtrace's sake.
          (prog1 (call-interactively cmd record-flag keys)
            (when (and (symbolp cmd)
                       (get cmd 'byte-obsolete-info)
                       (not (get cmd 'command-execute-obsolete-warned)))
              (put cmd 'command-execute-obsolete-warned t)
              (message "%s" (macroexp--obsolete-warning
                             cmd (get cmd 'byte-obsolete-info) "command"))))))))))

(defun command-execute--query (command)
  "Query the user whether to run COMMAND."
  (let ((query (get command 'disabled)))
    (funcall (if (nth 1 query) #'yes-or-no-p #'y-or-n-p)
             (nth 2 query))))

;;;###autoload
(defun command-query (command query &optional verbose)
  "Make executing COMMAND issue QUERY to the user.
This will, by default, use `y-or-n-p', but if VERBOSE,
`yes-or-no-p' is used instead."
  (put command 'disabled
       (list 'query (not (not verbose)) query)))

\f
(defvar minibuffer-history nil
  "Default minibuffer history list.
This is used for all minibuffer input
except when an alternate history list is specified.

Maximum length of the history list is determined by the value
of `history-length', which see.")
(defvar minibuffer-history-sexp-flag nil
  "Control whether history list elements are expressions or strings.
If the value of this variable equals current minibuffer depth,
they are expressions; otherwise they are strings.
\(That convention is designed to do the right thing for
recursive uses of the minibuffer.)")
(setq minibuffer-history-variable 'minibuffer-history)
(setq minibuffer-history-position nil)  ;; Defvar is in C code.
(defvar minibuffer-history-search-history nil)

(defvar minibuffer-text-before-history nil
  "Text that was in this minibuffer before any history commands.
This is nil if there have not yet been any history commands
in this use of the minibuffer.")

(add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)

(defun minibuffer-history-initialize ()
  (setq minibuffer-text-before-history nil))

(defun minibuffer-avoid-prompt (_new _old)
  "A point-motion hook for the minibuffer, that moves point out of the prompt."
  (declare (obsolete cursor-intangible-mode "25.1"))
  (constrain-to-field nil (point-max)))

(defcustom minibuffer-history-case-insensitive-variables nil
  "Minibuffer history variables for which matching should ignore case.
If a history variable is a member of this list, then the
\\[previous-matching-history-element] and \\[next-matching-history-element]\
 commands ignore case when searching it,
regardless of `case-fold-search'."
  :type '(repeat variable)
  :group 'minibuffer)

(defun previous-matching-history-element (regexp n)
  "Find the previous history element that matches REGEXP.
\(Previous history elements refer to earlier actions.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match.
Normally, history elements are matched case-insensitively if
`case-fold-search' is non-nil, but an uppercase letter in REGEXP
makes the search case-sensitive.
See also `minibuffer-history-case-insensitive-variables'."
  (interactive
   (let* ((enable-recursive-minibuffers t)
	  (regexp (read-from-minibuffer
                   (format-prompt "Previous element matching regexp"
                                  (and minibuffer-history-search-history
                                       (car minibuffer-history-search-history)))
		   nil minibuffer-local-map nil
		   'minibuffer-history-search-history
		   (car minibuffer-history-search-history))))
     ;; Use the last regexp specified, by default, if input is empty.
     (list (if (string= regexp "")
	       (if minibuffer-history-search-history
		   (car minibuffer-history-search-history)
		 (user-error "No previous history search regexp"))
	     regexp)
	   (prefix-numeric-value current-prefix-arg))))
  (unless (zerop n)
    (if (and (zerop minibuffer-history-position)
	     (null minibuffer-text-before-history))
	(setq minibuffer-text-before-history
	      (minibuffer-contents-no-properties)))
    (let ((history (minibuffer-history-value))
	  (case-fold-search
	   (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
	       ;; On some systems, ignore case for file names.
	       (if (memq minibuffer-history-variable
			 minibuffer-history-case-insensitive-variables)
		   t
		 ;; Respect the user's setting for case-fold-search:
		 case-fold-search)
	     nil))
	  prevpos
	  match-string
	  match-offset
	  (pos minibuffer-history-position))
      (while (/= n 0)
	(setq prevpos pos)
	(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
	(when (= pos prevpos)
	  (user-error (if (= pos 1)
                          "No later matching history item"
                        "No earlier matching history item")))
	(setq match-string
	      (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
		  (let ((print-level nil))
		    (prin1-to-string (nth (1- pos) history)))
		(nth (1- pos) history)))
	(setq match-offset
	      (if (< n 0)
		  (and (string-match regexp match-string)
		       (match-end 0))
		(and (string-match (concat ".*\\(" regexp "\\)") match-string)
		     (match-beginning 1))))
	(when match-offset
	  (setq n (+ n (if (< n 0) 1 -1)))))
      (setq minibuffer-history-position pos)
      (goto-char (point-max))
      (delete-minibuffer-contents)
      (insert match-string)
      (goto-char (+ (minibuffer-prompt-end) match-offset))))
  (if (memq (car (car command-history)) '(previous-matching-history-element
					  next-matching-history-element))
      (setq command-history (cdr command-history))))

(defun next-matching-history-element (regexp n)
  "Find the next history element that matches REGEXP.
\(The next history element refers to a more recent action.)
With prefix argument N, search for Nth next match.
If N is negative, find the previous or Nth previous match.
Normally, history elements are matched case-insensitively if
`case-fold-search' is non-nil, but an uppercase letter in REGEXP
makes the search case-sensitive."
  (interactive
   (let* ((enable-recursive-minibuffers t)
	  (regexp (read-from-minibuffer "Next element matching (regexp): "
					nil
					minibuffer-local-map
					nil
					'minibuffer-history-search-history
 					(car minibuffer-history-search-history))))
     ;; Use the last regexp specified, by default, if input is empty.
     (list (if (string= regexp "")
	       (if minibuffer-history-search-history
		   (car minibuffer-history-search-history)
		 (user-error "No previous history search regexp"))
	     regexp)
	   (prefix-numeric-value current-prefix-arg))))
  (previous-matching-history-element regexp (- n)))

(defvar minibuffer-temporary-goal-position nil)

(defvar minibuffer-default-add-function 'minibuffer-default-add-completions
  "Function run by `goto-history-element' before consuming default values.
This is useful to dynamically add more elements to the list of default values
when `goto-history-element' reaches the end of this list.
Before calling this function `goto-history-element' sets the variable
`minibuffer-default-add-done' to t, so it will call this function only
once.  In special cases, when this function needs to be called more
than once, it can set `minibuffer-default-add-done' to nil explicitly,
overriding the setting of this variable to t in `goto-history-element'.")

(defvar-local minibuffer-default-add-done nil
  "When nil, add more elements to the end of the list of default values.
The value nil causes `goto-history-element' to add more elements to
the list of defaults when it reaches the end of this list.  It does
this by calling a function defined by `minibuffer-default-add-function'.")

(defun minibuffer-default-add-completions ()
  "Return a list of all completions without the default value.
This function is used to add all elements of the completion table to
the end of the list of defaults just after the default value."
  (let ((def minibuffer-default)
	(all (all-completions ""
			      minibuffer-completion-table
			      minibuffer-completion-predicate)))
    (if (listp def)
	(append def all)
      (cons def (delete def all)))))

(defun minibuffer-history-value ()
  "Return the value of the minibuffer input history list.
If `minibuffer-history-variable' points to a buffer-local variable and
the minibuffer is active, return the buffer-local value for the buffer
that was current when the minibuffer was activated."
  (buffer-local-value minibuffer-history-variable
                      (window-buffer (minibuffer-selected-window))))

(defun goto-history-element (nabs)
  "Puts element of the minibuffer history in the minibuffer.
The argument NABS specifies the absolute history position in
descending order, where 0 means the current element and a
positive number N means the Nth previous element.  NABS being a
negative number -N means the Nth entry of \"future history.\""
  (interactive "p")
  (when (and (not minibuffer-default-add-done)
	     (functionp minibuffer-default-add-function)
	     (< nabs (- (if (listp minibuffer-default)
			    (length minibuffer-default)
			  1))))
    (setq minibuffer-default-add-done t
	  minibuffer-default (funcall minibuffer-default-add-function)))
  (let ((minimum (if minibuffer-default
		     (- (if (listp minibuffer-default)
			    (length minibuffer-default)
			  1))
		   0))
	elt minibuffer-returned-to-present)
    (if (and (zerop minibuffer-history-position)
	     (null minibuffer-text-before-history))
	(setq minibuffer-text-before-history
	      (minibuffer-contents-no-properties)))
    (if (< nabs minimum)
	(user-error (if minibuffer-default
                        "End of defaults; no next item"
                      "End of history; no default available")))
    (if (> nabs (if (listp (minibuffer-history-value))
                    (length (minibuffer-history-value))
                  0))
	(user-error "Beginning of history; no preceding item"))
    (unless (memq last-command '(next-history-element
				 previous-history-element))
      (let ((prompt-end (minibuffer-prompt-end)))
        (setq-local minibuffer-temporary-goal-position
                    (cond ((<= (point) prompt-end) prompt-end)
                          ((eobp) nil)
                          (t (point))))))
    (goto-char (point-max))
    (delete-minibuffer-contents)
    (setq minibuffer-history-position nabs)
    (cond ((< nabs 0)
	   (setq elt (if (listp minibuffer-default)
			 (nth (1- (abs nabs)) minibuffer-default)
		       minibuffer-default)))
	  ((= nabs 0)
	   (setq elt (or minibuffer-text-before-history ""))
	   (setq minibuffer-returned-to-present t)
	   (setq minibuffer-text-before-history nil))
	  (t (setq elt (nth (1- minibuffer-history-position)
			    (minibuffer-history-value)))))
    (insert
     (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth))
	      (not minibuffer-returned-to-present))
	 (let ((print-level nil))
	   (prin1-to-string elt))
       elt))
    (goto-char (or minibuffer-temporary-goal-position (point-max)))))

(defun next-history-element (n)
  "Puts next element of the minibuffer history in the minibuffer.
With argument N, it uses the Nth following element.  The position
in the history can go beyond the current position and invoke \"future
history.\""
  (interactive "p")
  (or (zerop n)
      (goto-history-element (- minibuffer-history-position n))))

(defun previous-history-element (n)
  "Puts previous element of the minibuffer history in the minibuffer.
With argument N, it uses the Nth previous element."
  (interactive "p")
  (or (zerop n)
      (goto-history-element (+ minibuffer-history-position n))))

(defun next-line-or-history-element (&optional arg)
  "Move cursor vertically down ARG lines, or to the next history element.
When point moves over the bottom line of multi-line minibuffer, puts ARGth
next element of the minibuffer history in the minibuffer."
  (interactive "^p")
  (or arg (setq arg 1))
  (let* ((old-point (point))
         ;; Don't add newlines if they have the mode enabled globally.
         (next-line-add-newlines nil)
	 ;; Remember the original goal column of possibly multi-line input
	 ;; excluding the length of the prompt on the first line.
	 (prompt-end (minibuffer-prompt-end))
	 (old-column (unless (and (eolp) (> (point) prompt-end))
		       (if (= (line-number-at-pos) 1)
			   (max (- (current-column)
				   (save-excursion
				     (goto-char (1- prompt-end))
				     (current-column)))
				0)
			 (current-column)))))
    (condition-case nil
	(with-no-warnings
	  (next-line arg))
      (end-of-buffer
       ;; Restore old position since `line-move-visual' moves point to
       ;; the end of the line when it fails to go to the next line.
       (goto-char old-point)
       (next-history-element arg)
       ;; Reset `temporary-goal-column' because a correct value is not
       ;; calculated when `next-line' above fails by bumping against
       ;; the bottom of the minibuffer (bug#22544).
       (setq temporary-goal-column 0)
       ;; Restore the original goal column on the last line
       ;; of possibly multi-line input.
       (goto-char (point-max))
       (when old-column
	 (if (= (line-number-at-pos) 1)
	     (move-to-column (+ old-column
				(save-excursion
				  (goto-char (1- (minibuffer-prompt-end)))
				  (current-column))))
	   (move-to-column old-column)))))))

(defun previous-line-or-history-element (&optional arg)
  "Move cursor vertically up ARG lines, or to the previous history element.
When point moves over the top line of multi-line minibuffer, puts ARGth
previous element of the minibuffer history in the minibuffer."
  (interactive "^p")
  (or arg (setq arg 1))
  (let* ((old-point (point))
	 ;; Remember the original goal column of possibly multi-line input
	 ;; excluding the length of the prompt on the first line.
	 (prompt-end (minibuffer-prompt-end))
	 (old-column (unless (and (eolp) (> (point) prompt-end))
		       (if (= (line-number-at-pos) 1)
			   (max (- (current-column)
				   (save-excursion
				     (goto-char (1- prompt-end))
				     (current-column)))
				1)
			 (current-column)))))
    (condition-case nil
	(with-no-warnings
	  (previous-line arg)
          ;; Avoid moving point to the prompt
          (when (< (point) (minibuffer-prompt-end))
            ;; If there is minibuffer contents on the same line
            (if (<= (minibuffer-prompt-end)
                    (save-excursion
                      (if (or truncate-lines (not line-move-visual))
                          (end-of-line)
                        (end-of-visual-line))
                      (point)))
                ;; Move to the beginning of minibuffer contents
                (goto-char (minibuffer-prompt-end))
              ;; Otherwise, go to the previous history element
              (signal 'beginning-of-buffer nil))))
      (beginning-of-buffer
       ;; Restore old position since `line-move-visual' moves point to
       ;; the beginning of the line when it fails to go to the previous line.
       (goto-char old-point)
       (previous-history-element arg)
       ;; Reset `temporary-goal-column' because a correct value is not
       ;; calculated when `previous-line' above fails by bumping against
       ;; the top of the minibuffer (bug#22544).
       (setq temporary-goal-column 0)
       ;; Restore the original goal column on the first line
       ;; of possibly multi-line input.
       (goto-char (minibuffer-prompt-end))
       (if old-column
	   (if (= (line-number-at-pos) 1)
	       (move-to-column (+ old-column
				  (save-excursion
				    (goto-char (1- (minibuffer-prompt-end)))
				    (current-column))))
	     (move-to-column old-column))
	 (if (not line-move-visual) ; Handle logical lines (bug#42862)
	     (end-of-line)
	   ;; Put the cursor at the end of the visual line instead of the
	   ;; logical line, so the next `previous-line-or-history-element'
	   ;; would move to the previous history element, not to a possible upper
	   ;; visual line from the end of logical line in `line-move-visual' mode.
	   (end-of-visual-line)
	   ;; Since `end-of-visual-line' puts the cursor at the beginning
	   ;; of the next visual line, move it one char back to the end
	   ;; of the first visual line (bug#22544).
	   (unless (eolp) (backward-char 1))))))))

(defun next-complete-history-element (n)
  "Get next history element that completes the minibuffer before the point.
The contents of the minibuffer after the point are deleted and replaced
by the new completion."
  (interactive "p")
  (let ((point-at-start (point)))
    (next-matching-history-element
     (concat
      "^" (regexp-quote (buffer-substring (minibuffer-prompt-end) (point))))
     n)
    ;; next-matching-history-element always puts us at (point-min).
    ;; Move to the position we were at before changing the buffer contents.
    ;; This is still sensible, because the text before point has not changed.
    (goto-char point-at-start)))

(defun previous-complete-history-element (n)
  "\
Get previous history element that completes the minibuffer before the point.
The contents of the minibuffer after the point are deleted and replaced
by the new completion."
  (interactive "p")
  (next-complete-history-element (- n)))

;; For compatibility with the old subr of the same name.
(defun minibuffer-prompt-width ()
  "Return the display width of the minibuffer prompt.
Return 0 if current buffer is not a minibuffer."
  ;; Return the width of everything before the field at the end of
  ;; the buffer; this should be 0 for normal buffers.
  (1- (minibuffer-prompt-end)))
\f
;; isearch minibuffer history
(add-hook 'minibuffer-setup-hook 'minibuffer-history-isearch-setup)

(defvar minibuffer-history-isearch-message-overlay)
(make-variable-buffer-local 'minibuffer-history-isearch-message-overlay)

(defun minibuffer-history-isearch-setup ()
  "Set up a minibuffer for using isearch to search the minibuffer history.
Intended to be added to `minibuffer-setup-hook'."
  (setq-local isearch-search-fun-function
              #'minibuffer-history-isearch-search)
  (setq-local isearch-message-function
              #'minibuffer-history-isearch-message)
  (setq-local isearch-wrap-function
              #'minibuffer-history-isearch-wrap)
  (setq-local isearch-push-state-function
              #'minibuffer-history-isearch-push-state)
  (setq-local isearch-lazy-count nil)
  (add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))

(defun minibuffer-history-isearch-end ()
  "Clean up the minibuffer after terminating isearch in the minibuffer."
  (if minibuffer-history-isearch-message-overlay
      (delete-overlay minibuffer-history-isearch-message-overlay)))

(defun minibuffer-history-isearch-search ()
  "Return the proper search function, for isearch in minibuffer history."
  (lambda (string bound noerror)
    (let ((search-fun
	   ;; Use standard functions to search within minibuffer text
	   (isearch-search-fun-default))
	  found)
      ;; Avoid lazy-highlighting matches in the minibuffer prompt when
      ;; searching forward.  Lazy-highlight calls this lambda with the
      ;; bound arg, so skip the minibuffer prompt.
      (if (and bound isearch-forward (< (point) (minibuffer-prompt-end)))
	  (goto-char (minibuffer-prompt-end)))
      (or
       ;; 1. First try searching in the initial minibuffer text
       (funcall search-fun string
		(if isearch-forward bound (minibuffer-prompt-end))
		noerror)
       ;; 2. If the above search fails, start putting next/prev history
       ;; elements in the minibuffer successively, and search the string
       ;; in them.  Do this only when bound is nil (i.e. not while
       ;; lazy-highlighting search strings in the current minibuffer text).
       (unless bound
	 (condition-case nil
	     (progn
	       (while (not found)
		 (cond (isearch-forward
			(next-history-element 1)
			(goto-char (minibuffer-prompt-end)))
		       (t
			(previous-history-element 1)
			(goto-char (point-max))))
		 (setq isearch-barrier (point) isearch-opoint (point))
		 ;; After putting the next/prev history element, search
		 ;; the string in them again, until next-history-element
		 ;; or previous-history-element raises an error at the
		 ;; beginning/end of history.
		 (setq found (funcall search-fun string
				      (unless isearch-forward
					;; For backward search, don't search
					;; in the minibuffer prompt
					(minibuffer-prompt-end))
				      noerror)))
	       ;; Return point of the new search result
	       (point))
	   ;; Return nil when next(prev)-history-element fails
	   (error nil)))))))

(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis)
  "Display the minibuffer history search prompt.
If there are no search errors, this function displays an overlay with
the isearch prompt which replaces the original minibuffer prompt.
Otherwise, it displays the standard isearch message returned from
the function `isearch-message'."
  (if (not (and (minibufferp) isearch-success (not isearch-error)))
      ;; Use standard function `isearch-message' when not in the minibuffer,
      ;; or search fails, or has an error (like incomplete regexp).
      ;; This function overwrites minibuffer text with isearch message,
      ;; so it's possible to see what is wrong in the search string.
      (isearch-message c-q-hack ellipsis)
    ;; Otherwise, put the overlay with the standard isearch prompt over
    ;; the initial minibuffer prompt.
    (if (overlayp minibuffer-history-isearch-message-overlay)
	(move-overlay minibuffer-history-isearch-message-overlay
		      (point-min) (minibuffer-prompt-end))
      (setq minibuffer-history-isearch-message-overlay
	    (make-overlay (point-min) (minibuffer-prompt-end)))
      (overlay-put minibuffer-history-isearch-message-overlay 'evaporate t))
    (overlay-put minibuffer-history-isearch-message-overlay
		 'display (isearch-message-prefix c-q-hack ellipsis))
    ;; And clear any previous isearch message.
    (message "")))

(defun minibuffer-history-isearch-wrap ()
  "Wrap the minibuffer history search when search fails.
Move point to the first history element for a forward search,
or to the last history element for a backward search."
  ;; When `minibuffer-history-isearch-search' fails on reaching the
  ;; beginning/end of the history, wrap the search to the first/last
  ;; minibuffer history element.
  (if isearch-forward
      (goto-history-element (length (minibuffer-history-value)))
    (goto-history-element 0))
  (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))

(defun minibuffer-history-isearch-push-state ()
  "Save a function restoring the state of minibuffer history search.
Save `minibuffer-history-position' to the additional state parameter
in the search status stack."
  (let ((pos minibuffer-history-position))
    (lambda (cmd)
      (minibuffer-history-isearch-pop-state cmd pos))))

(defun minibuffer-history-isearch-pop-state (_cmd hist-pos)
  "Restore the minibuffer history search state.
Go to the history element by the absolute history position HIST-POS."
  (goto-history-element hist-pos))

\f
(add-hook 'minibuffer-setup-hook 'minibuffer-error-initialize)

(defun minibuffer-error-initialize ()
  "Set up minibuffer error processing."
  (setq-local command-error-function 'minibuffer-error-function))

(defun minibuffer-error-function (data context caller)
  "Display error messages in the active minibuffer.
The same as `command-error-default-function' but display error messages
at the end of the minibuffer using `minibuffer-message' to not obscure
the minibuffer contents."
  (if (memq 'minibuffer-quit (get (car data) 'error-conditions))
      (ding t)
    (discard-input)
    (ding))
  (let ((string (error-message-string data)))
    ;; If we know from where the error was signaled, show it in
    ;; *Messages*.
    (let ((inhibit-message t))
      (message "%s%s" (if caller (format "%s: " caller) "") string))
    ;; Display an error message at the end of the minibuffer.
    (minibuffer-message (apply #'propertize (format " [%s%s]" context string)
                               minibuffer-prompt-properties))))

\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(define-obsolete-function-alias 'advertised-undo 'undo "23.2")

(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
  "Table mapping redo records to the corresponding undo one.
A redo record for an undo in region maps to `undo-in-region'.
A redo record for ordinary undo maps to the following (earlier) undo.
A redo record that undoes to the beginning of the undo list maps to t.
In the rare case where there are (erroneously) consecutive nil's in
`buffer-undo-list', `undo' maps the previous valid undo record to
`empty', if the previous record is a redo record, `undo' doesn't change
its mapping.

To be clear, a redo record is just an undo record, the only difference
is that it is created by an undo command (instead of an ordinary buffer
edit).  Since a record used to undo ordinary change is called undo
record, a record used to undo an undo is called redo record.

`undo' uses this table to make sure the previous command is `undo'.
`undo-redo' uses this table to set the correct `pending-undo-list'.

When you undo, `pending-undo-list' shrinks and `buffer-undo-list'
grows, and Emacs maps the tip of `buffer-undo-list' to the tip of
`pending-undo-list' in this table.

For example, consider this undo list where each node represents an
undo record: if we undo from 4, `pending-undo-list' will be at 3,
`buffer-undo-list' at 5, and 5 will map to 3.

    |
    3  5
    | /
    |/
    4")

(defvar undo-in-region nil
  "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")

(defcustom undo-no-redo nil
  "If t, `undo' doesn't go through redo entries."
  :type 'boolean
  :group 'undo)

(defvar pending-undo-list nil
  "Within a run of consecutive undo commands, list remaining to be undone.
If t, we undid all the way to the end of it.")

(defun undo--last-change-was-undo-p (undo-list)
  (while (and (consp undo-list) (eq (car undo-list) nil))
    (setq undo-list (cdr undo-list)))
  (gethash undo-list undo-equiv-table))

(defun undo (&optional arg)
  "Undo some previous changes.
Repeat this command to undo more changes.
A numeric ARG serves as a repeat count.

In Transient Mark mode when the mark is active, undo changes only within
the current region.  Similarly, when not in Transient Mark mode, just \\[universal-argument]
as an argument limits undo to changes within the current region."
  (interactive "*P")
  ;; Make last-command indicate for the next command that this was an undo.
  ;; That way, another undo will undo more.
  ;; If we get to the end of the undo history and get an error,
  ;; another undo command will find the undo history empty
  ;; and will get another error.  To begin undoing the undos,
  ;; you must type some other command.
  (let* ((modified (buffer-modified-p))
	 ;; For an indirect buffer, look in the base buffer for the
	 ;; auto-save data.
	 (base-buffer (or (buffer-base-buffer) (current-buffer)))
	 (recent-save (with-current-buffer base-buffer
			(recent-auto-save-p)))
         ;; Allow certain commands to inhibit an immediately following
         ;; undo-in-region.
         (inhibit-region (and (symbolp last-command)
                              (get last-command 'undo-inhibit-region)))
	 message)
    ;; If we get an error in undo-start,
    ;; the next command should not be a "consecutive undo".
    ;; So set `this-command' to something other than `undo'.
    (setq this-command 'undo-start)
    ;; Here we decide whether to break the undo chain.  If the
    ;; previous command is `undo', we don't call `undo-start', i.e.,
    ;; don't break the undo chain.
    (unless (and (eq last-command 'undo)
		 (or (eq pending-undo-list t)
		     ;; If something (a timer or filter?) changed the buffer
		     ;; since the previous command, don't continue the undo seq.
		     (undo--last-change-was-undo-p buffer-undo-list)))
      (setq undo-in-region
	    (and (or (region-active-p) (and arg (not (numberp arg))))
                 (not inhibit-region)))
      (if undo-in-region
	  (undo-start (region-beginning) (region-end))
	(undo-start))
      ;; get rid of initial undo boundary
      (undo-more 1))
    ;; If we got this far, the next command should be a consecutive undo.
    (setq this-command 'undo)
    ;; Check to see whether we're hitting a redo record, and if
    ;; so, ask the user whether she wants to skip the redo/undo pair.
    (let ((equiv (gethash pending-undo-list undo-equiv-table)))
      (or (eq (selected-window) (minibuffer-window))
	  (setq message (format "%s%s"
                                (if (or undo-no-redo (not equiv))
                                    "Undo" "Redo")
                                (if undo-in-region " in region" ""))))
      (when (and (consp equiv) undo-no-redo)
	;; The equiv entry might point to another redo record if we have done
	;; undo-redo-undo-redo-... so skip to the very last equiv.
	(while (let ((next (gethash equiv undo-equiv-table)))
		 (if next (setq equiv next))))
	(setq pending-undo-list (if (consp equiv) equiv t))))
    (undo-more
     (if (numberp arg)
	 (prefix-numeric-value arg)
       1))
    ;; Record the fact that the just-generated undo records come from an
    ;; undo operation--that is, they are redo records.
    ;; In the ordinary case (not within a region), map the redo
    ;; record to the following undos.
    ;; I don't know how to do that in the undo-in-region case.
    (let ((list buffer-undo-list))
      ;; Strip any leading undo boundaries there might be, like we do
      ;; above when checking.
      (while (eq (car list) nil)
	(setq list (cdr list)))
      (puthash list
               (cond
                (undo-in-region 'undo-in-region)
                ;; Prevent identity mapping.  This can happen if
                ;; consecutive nils are erroneously in undo list.  It
                ;; has to map to _something_ so that the next `undo'
                ;; command recognizes that the previous command is
                ;; `undo' and doesn't break the undo chain.
                ((eq list pending-undo-list)
                 (or (gethash list undo-equiv-table)
                     'empty))
                (t pending-undo-list))
	       undo-equiv-table))
    ;; Don't specify a position in the undo record for the undo command.
    ;; Instead, undoing this should move point to where the change is.
    (let ((tail buffer-undo-list)
	  (prev nil))
      (while (car tail)
	(when (integerp (car tail))
	  (let ((pos (car tail)))
	    (if prev
		(setcdr prev (cdr tail))
	      (setq buffer-undo-list (cdr tail)))
	    (setq tail (cdr tail))
	    (while (car tail)
	      (if (eq pos (car tail))
		  (if prev
		      (setcdr prev (cdr tail))
		    (setq buffer-undo-list (cdr tail)))
		(setq prev tail))
	      (setq tail (cdr tail)))
	    (setq tail nil)))
	(setq prev tail tail (cdr tail))))
    ;; Record what the current undo list says,
    ;; so the next command can tell if the buffer was modified in between.
    (and modified (not (buffer-modified-p))
	 (with-current-buffer base-buffer
	   (delete-auto-save-file-if-necessary recent-save)))
    ;; Display a message announcing success.
    (if message
	(message "%s" message))))

(defun buffer-disable-undo (&optional buffer)
  "Make BUFFER stop keeping undo information.
No argument or nil as argument means do this for the current buffer."
  (interactive)
  (with-current-buffer (if buffer (get-buffer buffer) (current-buffer))
    (setq buffer-undo-list t)))

(defun undo-only (&optional arg)
  "Undo some previous changes.
Repeat this command to undo more changes.
A numeric ARG serves as a repeat count.
Contrary to `undo', this will not redo a previous undo."
  (interactive "*p")
  (let ((undo-no-redo t)) (undo arg)))

(defun undo-redo (&optional arg)
  "Undo the last ARG undos, i.e., redo the last ARG changes.
Interactively, ARG is the prefix numeric argument and defaults to 1."
  (interactive "*p")
  (cond
   ((not (undo--last-change-was-undo-p buffer-undo-list))
    (user-error "No undone changes to redo"))
   (t
    (let* ((ul buffer-undo-list)
           (new-ul
            (let ((undo-in-progress t))
              (while (and (consp ul) (eq (car ul) nil))
                (setq ul (cdr ul)))
              (primitive-undo (or arg 1) ul)))
           (new-pul (undo--last-change-was-undo-p new-ul)))
      (message "Redo%s" (if undo-in-region " in region" ""))
      (setq this-command 'undo)
      (setq pending-undo-list new-pul)
      (setq buffer-undo-list new-ul)))))

(defvar undo-in-progress nil
  "Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")

(defun undo-more (n)
  "Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
  (or (listp pending-undo-list)
      (user-error (concat "No further undo information"
                          (and undo-in-region " for region"))))
  (let ((undo-in-progress t))
    ;; Note: The following, while pulling elements off
    ;; `pending-undo-list' will call primitive change functions which
    ;; will push more elements onto `buffer-undo-list'.
    (setq pending-undo-list (primitive-undo n pending-undo-list))
    (if (null pending-undo-list)
	(setq pending-undo-list t))))

(defun primitive-undo (n list)
  "Undo N records from the front of the list LIST.
Return what remains of the list."

  ;; This is a good feature, but would make undo-start
  ;; unable to do what is expected.
  ;;(when (null (car (list)))
  ;;  ;; If the head of the list is a boundary, it is the boundary
  ;;  ;; preceding this command.  Get rid of it and don't count it.
  ;;  (setq list (cdr list))))

  (let ((arg n)
        ;; In a writable buffer, enable undoing read-only text that is
        ;; so because of text properties.
        (inhibit-read-only t)
        ;; Don't let `intangible' properties interfere with undo.
        (inhibit-point-motion-hooks t)
        ;; We use oldlist only to check for EQ.  ++kfs
        (oldlist buffer-undo-list)
        (did-apply nil)
        (next nil))
    (while (> arg 0)
      (while (setq next (pop list))     ;Exit inner loop at undo boundary.
        ;; Handle an integer by setting point to that value.
        (pcase next
          ((pred integerp) (goto-char next))
          ;; Element (t . TIME) records previous modtime.
          ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
          ;; UNKNOWN_MODTIME_NSECS.
          (`(t . ,time)
           ;; If this records an obsolete save
           ;; (not matching the actual disk file)
           ;; then don't mark unmodified.
           (when (or (equal time (visited-file-modtime))
                     (and (consp time)
                          (equal (list (car time) (cdr time))
                                 (visited-file-modtime))))
             (unlock-buffer)
             (set-buffer-modified-p nil)))
          ;; Element (nil PROP VAL BEG . END) is property change.
          (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
           (when (or (> (point-min) beg) (< (point-max) end))
             (error "Changes to be undone are outside visible portion of buffer"))
           (put-text-property beg end prop val))
          ;; Element (BEG . END) means range was inserted.
          (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
           ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
           ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
           (when (or (> (point-min) beg) (< (point-max) end))
             (error "Changes to be undone are outside visible portion of buffer"))
           ;; Set point first thing, so that undoing this undo
           ;; does not send point back to where it is now.
           (goto-char beg)
           (delete-region beg end))
          ;; Element (apply FUN . ARGS) means call FUN to undo.
          (`(apply . ,fun-args)
           (let ((currbuff (current-buffer)))
             (if (integerp (car fun-args))
                 ;; Long format: (apply DELTA START END FUN . ARGS).
                 (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
                              (start-mark (copy-marker start nil))
                              (end-mark (copy-marker end t)))
                   (when (or (> (point-min) start) (< (point-max) end))
                     (error "Changes to be undone are outside visible portion of buffer"))
                   (apply fun args) ;; Use `save-current-buffer'?
                   ;; Check that the function did what the entry
                   ;; said it would do.
                   (unless (and (= start start-mark)
                                (= (+ delta end) end-mark))
                     (error "Changes to be undone by function different from announced"))
                   (set-marker start-mark nil)
                   (set-marker end-mark nil))
               (apply fun-args))
             (unless (eq currbuff (current-buffer))
               (error "Undo function switched buffer"))
             (setq did-apply t)))
          ;; Element (STRING . POS) means STRING was deleted.
          (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
           (let ((valid-marker-adjustments nil)
                 (apos (abs pos)))
             (when (or (< apos (point-min)) (> apos (point-max)))
               (error "Changes to be undone are outside visible portion of buffer"))
             ;; Check that marker adjustments which were recorded
             ;; with the (STRING . POS) record are still valid, ie
             ;; the markers haven't moved.  We check their validity
             ;; before reinserting the string so as we don't need to
             ;; mind marker insertion-type.
             (while (and (markerp (car-safe (car list)))
                         (integerp (cdr-safe (car list))))
               (let* ((marker-adj (pop list))
                      (m (car marker-adj)))
                 (and (eq (marker-buffer m) (current-buffer))
                      (= apos m)
                      (push marker-adj valid-marker-adjustments))))
             ;; Insert string and adjust point
             (if (< pos 0)
                 (progn
                   (goto-char (- pos))
                   (insert string))
               (goto-char pos)
               (insert string)
               (goto-char pos))
             ;; Adjust the valid marker adjustments
             (dolist (adj valid-marker-adjustments)
               ;; Insert might have invalidated some of the markers
               ;; via modification hooks.  Update only the currently
               ;; valid ones (bug#25599).
               (if (marker-buffer (car adj))
                   (set-marker (car adj)
                               (- (car adj) (cdr adj)))))))
          ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
          (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
           (warn "Encountered %S entry in undo list with no matching (TEXT . POS) entry"
                 next)
           ;; Even though these elements are not expected in the undo
           ;; list, adjust them to be conservative for the 24.4
           ;; release.  (Bug#16818)
           (when (marker-buffer marker)
             (set-marker marker
                         (- marker offset)
                         (marker-buffer marker))))
          (_ (error "Unrecognized entry in undo list %S" next))))
      (setq arg (1- arg)))
    ;; Make sure an apply entry produces at least one undo entry,
    ;; so the test in `undo' for continuing an undo series
    ;; will work right.
    (if (and did-apply
             (eq oldlist buffer-undo-list))
        (setq buffer-undo-list
              (cons (list 'apply 'cdr nil) buffer-undo-list))))
  list)

;; Deep copy of a list
(defun undo-copy-list (list)
  "Make a copy of undo list LIST."
  (mapcar 'undo-copy-list-1 list))

(defun undo-copy-list-1 (elt)
  (if (consp elt)
      (cons (car elt) (undo-copy-list-1 (cdr elt)))
    elt))

(defun undo-start (&optional beg end)
  "Set `pending-undo-list' to the front of the undo list.
The next call to `undo-more' will undo the most recently made change.
If BEG and END are specified, then undo only elements
that apply to text between BEG and END are used; other undo elements
are ignored.  If BEG and END are nil, all undo elements are used."
  (if (eq buffer-undo-list t)
      (user-error "No undo information in this buffer"))
  (setq pending-undo-list
	(if (and beg end (not (= beg end)))
	    (undo-make-selective-list (min beg end) (max beg end))
	  buffer-undo-list)))

;; The positions given in elements of the undo list are the positions
;; as of the time that element was recorded to undo history.  In
;; general, subsequent buffer edits render those positions invalid in
;; the current buffer, unless adjusted according to the intervening
;; undo elements.
;;
;; Undo in region is a use case that requires adjustments to undo
;; elements.  It must adjust positions of elements in the region based
;; on newer elements not in the region so as they may be correctly
;; applied in the current buffer.  undo-make-selective-list
;; accomplishes this with its undo-deltas list of adjustments.  An
;; example undo history from oldest to newest:
;;
;; buf pos:
;; 123456789 buffer-undo-list undo-deltas
;; --------- ---------------- -----------
;; aaa       (1 . 4)          (1 . -3)
;; aaba      (3 . 4)          N/A (in region)
;; ccaaba    (1 . 3)          (1 . -2)
;; ccaabaddd (7 . 10)         (7 . -3)
;; ccaabdd   ("ad" . 6)       (6 . 2)
;; ccaabaddd (6 . 8)          (6 . -2)
;;  |   |<-- region: "caab", from 2 to 6
;;
;; When the user starts a run of undos in region,
;; undo-make-selective-list is called to create the full list of in
;; region elements.  Each element is adjusted forward chronologically
;; through undo-deltas to determine if it is in the region.
;;
;; In the above example, the insertion of "b" is (3 . 4) in the
;; buffer-undo-list.  The undo-delta (1 . -2) causes (3 . 4) to become
;; (5 . 6).  The next three undo-deltas cause no adjustment, so (5
;; . 6) is assessed as in the region and placed in the selective list.
;; Notably, the end of region itself adjusts from "2 to 6" to "2 to 5"
;; due to the selected element.  The "b" insertion is the only element
;; fully in the region, so in this example undo-make-selective-list
;; returns (nil (5 . 6)).
;;
;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge
;; case.  It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)).
;; Normally an undo-delta of (6 . 2) would cause positions after 6 to
;; adjust by 2.  However, they shouldn't adjust to less than 6, so (7
;; . 10) adjusts to (6 . 8) due to the first undo delta.
;;
;; More interesting is how to adjust the "ddd" insertion due to the
;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad".
;; If the reinsertion was a manual retyping of "ad", then the total
;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10).  However, if
;; the reinsertion was due to undo, one might expect the first "d"
;; character would again be a part of the "ddd" text, meaning its
;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10).
;;
;; undo-make-selective-list assumes in this situation that "ad" was a
;; new edit, even if it was inserted because of an undo.
;; Consequently, if the user undos in region "8 to 10" of the
;; "ccaabaddd" buffer, they could be surprised that it becomes
;; "ccaabad", as though the first "d" became detached from the
;; original "ddd" insertion.  This quirk is a FIXME.

(defun undo-make-selective-list (start end)
  "Return a list of undo elements for the region START to END.
The elements come from `buffer-undo-list', but we keep only the
elements inside this region, and discard those outside this
region.  The elements' positions are adjusted so as the returned
list can be applied to the current buffer."
  (let ((ulist buffer-undo-list)
        ;; A list of position adjusted undo elements in the region.
        (selective-list (list nil))
        ;; A list of undo-deltas for out of region undo elements.
        undo-deltas
        undo-elt)
    (while ulist
      (when undo-no-redo
        (while (consp (gethash ulist undo-equiv-table))
          (setq ulist (gethash ulist undo-equiv-table))))
      (setq undo-elt (car ulist))
      (cond
       ((null undo-elt)
        ;; Don't put two nils together in the list
        (when (car selective-list)
          (push nil selective-list)))
       ((and (consp undo-elt) (eq (car undo-elt) t))
        ;; This is a "was unmodified" element.  Keep it
        ;; if we have kept everything thus far.
        (when (not undo-deltas)
          (push undo-elt selective-list)))
       ;; Skip over marker adjustments, instead relying
       ;; on finding them after (TEXT . POS) elements
       ((markerp (car-safe undo-elt))
        nil)
       (t
        (let ((adjusted-undo-elt (undo-adjust-elt undo-elt
                                                  undo-deltas)))
          (if (undo-elt-in-region adjusted-undo-elt start end)
              (progn
                (setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
                (push adjusted-undo-elt selective-list)
                ;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was
                ;; kept.  primitive-undo may discard them later.
                (when (and (stringp (car-safe adjusted-undo-elt))
                           (integerp (cdr-safe adjusted-undo-elt)))
                  (let ((list-i (cdr ulist)))
                    (while (markerp (car-safe (car list-i)))
                      (push (pop list-i) selective-list)))))
            (let ((delta (undo-delta undo-elt)))
              (when (/= 0 (cdr delta))
                (push delta undo-deltas)))))))
      (pop ulist))
    (nreverse selective-list)))

(defun undo-elt-in-region (undo-elt start end)
  "Determine whether UNDO-ELT falls inside the region START ... END.
If it crosses the edge, we return nil.

Generally this function is not useful for determining
whether (MARKER . ADJUSTMENT) undo elements are in the region,
because markers can be arbitrarily relocated.  Instead, pass the
marker adjustment's corresponding (TEXT . POS) element."
  (cond ((integerp undo-elt)
	 (and (>= undo-elt start)
	      (<= undo-elt end)))
	((eq undo-elt nil)
	 t)
	((atom undo-elt)
	 nil)
	((stringp (car undo-elt))
	 ;; (TEXT . POSITION)
	 (and (>= (abs (cdr undo-elt)) start)
	      (<= (abs (cdr undo-elt)) end)))
	((and (consp undo-elt) (markerp (car undo-elt)))
	 ;; (MARKER . ADJUSTMENT)
         (<= start (car undo-elt) end))
	((null (car undo-elt))
	 ;; (nil PROPERTY VALUE BEG . END)
	 (let ((tail (nthcdr 3 undo-elt)))
	   (and (>= (car tail) start)
		(<= (cdr tail) end))))
	((integerp (car undo-elt))
	 ;; (BEGIN . END)
	 (and (>= (car undo-elt) start)
	      (<= (cdr undo-elt) end)))))

(defun undo-elt-crosses-region (undo-elt start end)
  "Test whether UNDO-ELT crosses one edge of that region START ... END.
This assumes we have already decided that UNDO-ELT
is not *inside* the region START...END."
  (declare (obsolete nil "25.1"))
  (cond ((atom undo-elt) nil)
	((null (car undo-elt))
	 ;; (nil PROPERTY VALUE BEG . END)
	 (let ((tail (nthcdr 3 undo-elt)))
	   (and (< (car tail) end)
		(> (cdr tail) start))))
	((integerp (car undo-elt))
	 ;; (BEGIN . END)
	 (and (< (car undo-elt) end)
	      (> (cdr undo-elt) start)))))

(defun undo-adjust-elt (elt deltas)
  "Return adjustment of undo element ELT by the undo DELTAS list."
  (pcase elt
    ;; POSITION
    ((pred integerp)
     (undo-adjust-pos elt deltas))
    ;; (BEG . END)
    (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
     (undo-adjust-beg-end beg end deltas))
    ;; (TEXT . POSITION)
    (`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
     (cons text (* (if (< pos 0) -1 1)
                   (undo-adjust-pos (abs pos) deltas))))
    ;; (nil PROPERTY VALUE BEG . END)
    (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
     `(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas)))
    ;; (apply DELTA START END FUN . ARGS)
    ;; FIXME
    ;; All others return same elt
    (_ elt)))

;; (BEG . END) can adjust to the same positions, commonly when an
;; insertion was undone and they are out of region, for example:
;;
;; buf pos:
;; 123456789 buffer-undo-list undo-deltas
;; --------- ---------------- -----------
;; [...]
;; abbaa     (2 . 4)          (2 . -2)
;; aaa       ("bb" . 2)       (2 . 2)
;; [...]
;;
;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent
;; undo.  Further adjustments to such an element should be the same as
;; for (TEXT . POSITION) elements.  The options are:
;;
;;   1: POSITION adjusts using <= (use-< nil), resulting in behavior
;;      analogous to marker insertion-type t.
;;
;;   2: POSITION adjusts using <, resulting in behavior analogous to
;;      marker insertion-type nil.
;;
;; There was no strong reason to prefer one or the other, except that
;; the first is more consistent with prior undo in region behavior.
(defun undo-adjust-beg-end (beg end deltas)
  "Return cons of adjustments to BEG and END by the undo DELTAS list."
  (let ((adj-beg (undo-adjust-pos beg deltas)))
    ;; Note: option 2 above would be like (cons (min ...) adj-end)
    (cons adj-beg
          (max adj-beg (undo-adjust-pos end deltas t)))))

(defun undo-adjust-pos (pos deltas &optional use-<)
  "Return adjustment of POS by the undo DELTAS list, comparing
with < or <= based on USE-<."
  (dolist (d deltas pos)
    (when (if use-<
              (< (car d) pos)
            (<= (car d) pos))
      (setq pos
            ;; Don't allow pos to become less than the undo-delta
            ;; position.  This edge case is described in the overview
            ;; comments.
            (max (car d) (- pos (cdr d)))))))

;; Return the first affected buffer position and the delta for an undo element
;; delta is defined as the change in subsequent buffer positions if we *did*
;; the undo.
(defun undo-delta (undo-elt)
  (if (consp undo-elt)
      (cond ((stringp (car undo-elt))
	     ;; (TEXT . POSITION)
	     (cons (abs (cdr undo-elt)) (length (car undo-elt))))
	    ((integerp (car undo-elt))
	     ;; (BEGIN . END)
	     (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
	    (t
	     '(0 . 0)))
    '(0 . 0)))

;;; Default undo-boundary addition
;;
;; This section adds a new undo-boundary at either after a command is
;; called or in some cases on a timer called after a change is made in
;; any buffer.
(defvar-local undo-auto--last-boundary-cause nil
  "Describe the cause of the last `undo-boundary'.

If `explicit', the last boundary was caused by an explicit call to
`undo-boundary', that is one not called by the code in this
section.

If it is equal to `timer', then the last boundary was inserted
by `undo-auto--boundary-timer'.

If it is equal to `command', then the last boundary was inserted
automatically after a command, that is by the code defined in
this section.

If it is equal to a list, then the last boundary was inserted by
an amalgamating command.  The car of the list is the number of
times an amalgamating command has been called, and the cdr are the
buffers that were changed during the last command.")

(defvar undo-auto-current-boundary-timer nil
  "Current timer which will run `undo-auto--boundary-timer' or nil.

If set to non-nil, this will effectively disable the timer.")

(defvar undo-auto--this-command-amalgamating nil
  "Non-nil if `this-command' should be amalgamated.
This variable is set to nil by `undo-auto--boundaries' and is set
by `undo-auto-amalgamate'." )

(defun undo-auto--needs-boundary-p ()
  "Return non-nil if `buffer-undo-list' needs a boundary at the start."
  (car-safe buffer-undo-list))

(defun undo-auto--last-boundary-amalgamating-number ()
  "Return the number of amalgamating last commands or nil.
Amalgamating commands are, by default, either
`self-insert-command' and `delete-char', but can be any command
that calls `undo-auto-amalgamate'."
  (car-safe undo-auto--last-boundary-cause))

(defun undo-auto--ensure-boundary (cause)
  "Add an `undo-boundary' to the current buffer if needed.
REASON describes the reason that the boundary is being added; see
`undo-auto--last-boundary-cause' for more information."
  (when (and
         (undo-auto--needs-boundary-p))
    (let ((last-amalgamating
           (undo-auto--last-boundary-amalgamating-number)))
      (undo-boundary)
      (setq undo-auto--last-boundary-cause
            (if (eq 'amalgamate cause)
                (cons
                 (if last-amalgamating (1+ last-amalgamating) 0)
                 undo-auto--undoably-changed-buffers)
              cause)))))

(defun undo-auto--boundaries (cause)
  "Check recently changed buffers and add a boundary if necessary.
REASON describes the reason that the boundary is being added; see
`undo-last-boundary' for more information."
  ;; (Bug #23785) All commands should ensure that there is an undo
  ;; boundary whether they have changed the current buffer or not.
  (when (eq cause 'command)
    (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)))
  (dolist (b undo-auto--undoably-changed-buffers)
          (when (buffer-live-p b)
            (with-current-buffer b
              (undo-auto--ensure-boundary cause))))
  (setq undo-auto--undoably-changed-buffers nil))

(defun undo-auto--boundary-timer ()
  "Timer function run by `undo-auto-current-boundary-timer'."
  (setq undo-auto-current-boundary-timer nil)
  (undo-auto--boundaries 'timer))

(defun undo-auto--boundary-ensure-timer ()
  "Ensure that the `undo-auto-current-boundary-timer' is set."
  (unless undo-auto-current-boundary-timer
    (setq undo-auto-current-boundary-timer
          (run-at-time 10 nil #'undo-auto--boundary-timer))))

(defvar undo-auto--undoably-changed-buffers nil
  "List of buffers that have changed recently.

This list is maintained by `undo-auto--undoable-change' and
`undo-auto--boundaries' and can be affected by changes to their
default values.")

(defun undo-auto--add-boundary ()
  "Add an `undo-boundary' in appropriate buffers."
  (undo-auto--boundaries
   (let ((amal undo-auto--this-command-amalgamating))
     (setq undo-auto--this-command-amalgamating nil)
     (if amal
         'amalgamate
       'command))))

(defun undo-auto-amalgamate ()
  "Amalgamate undo if necessary.
This function can be called before an amalgamating command.  It
removes the previous `undo-boundary' if a series of such calls
have been made.  By default `self-insert-command' and
`delete-char' are the only amalgamating commands, although this
function could be called by any command wishing to have this
behavior."
  (let ((last-amalgamating-count
         (undo-auto--last-boundary-amalgamating-number)))
    (setq undo-auto--this-command-amalgamating t)
    (when last-amalgamating-count
      (if (and (< last-amalgamating-count amalgamating-undo-limit)
               (eq this-command last-command))
          ;; Amalgamate all buffers that have changed.
          ;; This may be needed for example if some *-change-functions
          ;; reflected these changes in some other buffer.
          (dolist (b (cdr undo-auto--last-boundary-cause))
            (when (buffer-live-p b)
              (with-current-buffer
                  b
                (when (and (consp buffer-undo-list)
                           ;; `car-safe' doesn't work because
                           ;; `buffer-undo-list' need not be a list!
                           (null (car buffer-undo-list)))
                  ;; The head of `buffer-undo-list' is nil.
                  (setq buffer-undo-list
                        (cdr buffer-undo-list))))))
        (setq undo-auto--last-boundary-cause 0)))))

(defun undo-auto--undoable-change ()
  "Called after every undoable buffer change."
  (unless (memq (current-buffer) undo-auto--undoably-changed-buffers)
    (let ((bufs undo-auto--undoably-changed-buffers))
      ;; Drop dead buffers from the list, to avoid memory leak in
      ;; (while t (with-temp-buffer (setq buffer-undo-list nil) (insert "a")))
      (while bufs
        (let ((next (cdr bufs)))
          (if (or (buffer-live-p (car bufs)) (null next))
              (setq bufs next)
            (setcar bufs (car next))
            (setcdr bufs (cdr next))))))
    (push (current-buffer) undo-auto--undoably-changed-buffers))
  (undo-auto--boundary-ensure-timer))
;; End auto-boundary section

(defun undo-amalgamate-change-group (handle)
  "Amalgamate changes in change-group since HANDLE.
Remove all undo boundaries between the state of HANDLE and now.
HANDLE is as returned by `prepare-change-group'."
  (dolist (elt handle)
    (with-current-buffer (car elt)
      (setq elt (cdr elt))
      (when (consp buffer-undo-list)
        (let ((old-car (car-safe elt))
              (old-cdr (cdr-safe elt)))
          (unwind-protect
              (progn
                ;; Temporarily truncate the undo log at ELT.
                (when (consp elt)
                  (setcar elt t) (setcdr elt nil))
                (when
                    (or (null elt)        ;The undo-log was empty.
                        ;; `elt' is still in the log: normal case.
                        (eq elt (last buffer-undo-list))
                        ;; `elt' is not in the log any more, but that's because
                        ;; the log is "all new", so we should remove all
                        ;; boundaries from it.
                        (not (eq (last buffer-undo-list) (last old-cdr))))
                  (cl-callf (lambda (x) (delq nil x))
                      (if (car buffer-undo-list)
                          buffer-undo-list
                        ;; Preserve the undo-boundaries at either ends of the
                        ;; change-groups.
                        (cdr buffer-undo-list)))))
            ;; Reset the modified cons cell ELT to its original content.
            (when (consp elt)
              (setcar elt old-car)
              (setcdr elt old-cdr))))))))


(defcustom undo-ask-before-discard nil
  "If non-nil ask about discarding undo info for the current command.
Normally, Emacs discards the undo info for the current command if
it exceeds `undo-outer-limit'.  But if you set this option
non-nil, it asks in the echo area whether to discard the info.
If you answer no, there is a slight risk that Emacs might crash, so
do it only if you really want to undo the command.

This option is mainly intended for debugging.  You have to be
careful if you use it for other purposes.  Garbage collection is
inhibited while the question is asked, meaning that Emacs might
leak memory.  So you should make sure that you do not wait
excessively long before answering the question."
  :type 'boolean
  :group 'undo
  :version "22.1")

(defvar-local undo-extra-outer-limit nil
  "If non-nil, an extra level of size that's ok in an undo item.
We don't ask the user about truncating the undo list until the
current item gets bigger than this amount.

This variable matters only if `undo-ask-before-discard' is non-nil.")

;; When the first undo batch in an undo list is longer than
;; undo-outer-limit, this function gets called to warn the user that
;; the undo info for the current command was discarded.  Garbage
;; collection is inhibited around the call, so it had better not do a
;; lot of consing.
(setq undo-outer-limit-function 'undo-outer-limit-truncate)
(defun undo-outer-limit-truncate (size)
  (if undo-ask-before-discard
      (when (or (null undo-extra-outer-limit)
		(> size undo-extra-outer-limit))
	;; Don't ask the question again unless it gets even bigger.
	;; This applies, in particular, if the user quits from the question.
	;; Such a quit quits out of GC, but something else will call GC
	;; again momentarily.  It will call this function again,
	;; but we don't want to ask the question again.
	(setq undo-extra-outer-limit (+ size 50000))
	(if (let (use-dialog-box track-mouse executing-kbd-macro )
	      (yes-or-no-p (format-message
                            "Buffer `%s' undo info is %d bytes long; discard it? "
                            (buffer-name) size)))
	    (progn (setq buffer-undo-list nil)
		   (setq undo-extra-outer-limit nil)
		   t)
	  nil))
    (display-warning '(undo discard-info)
		     (concat
		      (format-message
                       "Buffer `%s' undo info was %d bytes long.\n"
                       (buffer-name) size)
		      "The undo info was discarded because it exceeded \
`undo-outer-limit'.

This is normal if you executed a command that made a huge change
to the buffer.  In that case, to prevent similar problems in the
future, set `undo-outer-limit' to a value that is large enough to
cover the maximum size of normal changes you expect a single
command to make, but not so large that it might exceed the
maximum memory allotted to Emacs.

If you did not execute any such command, the situation is
probably due to a bug and you should report it.

You can disable the popping up of this buffer by adding the entry
\(undo discard-info) to the user option `warning-suppress-types',
which is defined in the `warnings' library.\n")
		     :warning)
    (setq buffer-undo-list nil)
    t))
\f
;;;; Shell commands

(defconst shell-command-buffer-name "*Shell Command Output*"
  "Name of the output buffer for shell commands.")

(defconst shell-command-buffer-name-async "*Async Shell Command*"
  "Name of the output buffer for asynchronous shell commands.")

(defvar shell-command-history nil
  "History list for some commands that read shell commands.

Maximum length of the history list is determined by the value
of `history-length', which see.")

(defvar shell-command-switch (purecopy "-c")
  "Switch used to have the shell execute its command line argument.")

(defvar shell-command-default-error-buffer nil
  "Buffer name for `shell-command' and `shell-command-on-region' error output.
This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively.  A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")

(declare-function mailcap-file-default-commands "mailcap" (files))
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))

(defun minibuffer-default-add-shell-commands ()
  "Return a list of all commands associated with the current file.
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
  (interactive)
  (let* ((filename (if (listp minibuffer-default)
		       (car minibuffer-default)
		     minibuffer-default))
	 (commands (and filename (require 'mailcap nil t)
			(mailcap-file-default-commands (list filename)))))
    (setq commands (mapcar (lambda (command)
			     (concat command " " filename))
			   commands))
    (if (listp minibuffer-default)
	(append minibuffer-default commands)
      (cons minibuffer-default commands))))

(declare-function shell-completion-vars "shell" ())

(defvar minibuffer-local-shell-command-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-map)
    (define-key map "\t"       #'completion-at-point)
    (define-key map [M-up]     #'minibuffer-previous-completion)
    (define-key map [M-down]   #'minibuffer-next-completion)
    (define-key map [?\M-\r]   #'minibuffer-choose-completion)
    map)
  "Keymap used for completing shell commands in minibuffer.")

(defun read-shell-command (prompt &optional initial-contents hist &rest args)
  "Read a shell command from the minibuffer.
The arguments are the same as the ones of `read-from-minibuffer',
except READ and KEYMAP are missing and HIST defaults
to `shell-command-history'."
  (require 'shell)
  (minibuffer-with-setup-hook
      (lambda ()
        (shell-completion-vars)
        (setq-local minibuffer-default-add-function
                    #'minibuffer-default-add-shell-commands))
    (apply #'read-from-minibuffer prompt initial-contents
	   minibuffer-local-shell-command-map
	   nil
	   (or hist 'shell-command-history)
	   args)))

(defcustom async-shell-command-buffer 'confirm-new-buffer
  "What to do when the output buffer is used by another shell command.
This option specifies how to resolve the conflict where a new command
wants to direct its output to the buffer whose name is stored
in `shell-command-buffer-name-async', but that buffer is already
taken by another running shell command.

The value `confirm-kill-process' is used to ask for confirmation before
killing the already running process and running a new process
in the same buffer, `confirm-new-buffer' for confirmation before running
the command in a new buffer with a name other than the default buffer name,
`new-buffer' for doing the same without confirmation,
`confirm-rename-buffer' for confirmation before renaming the existing
output buffer and running a new command in the default buffer,
`rename-buffer' for doing the same without confirmation."
  :type '(choice (const :tag "Confirm killing of running command"
			confirm-kill-process)
		 (const :tag "Confirm creation of a new buffer"
			confirm-new-buffer)
		 (const :tag "Create a new buffer"
			new-buffer)
		 (const :tag "Confirm renaming of existing buffer"
			confirm-rename-buffer)
		 (const :tag "Rename the existing buffer"
			rename-buffer))
  :group 'shell
  :version "24.3")

(defcustom async-shell-command-display-buffer t
  "Whether to display the command buffer immediately.
If t, display the buffer immediately; if nil, wait until there
is output."
  :type '(choice (const :tag "Display buffer immediately"
			t)
		 (const :tag "Display buffer on output"
			nil))
  :group 'shell
  :version "26.1")

(defcustom async-shell-command-width nil
  "Number of display columns available for asynchronous shell command output.
If nil, use the shell default number (usually 80 columns).
If a positive integer, tell the shell to use that number of columns for
command output."
  :type '(choice (const :tag "Use system limit" nil)
                 (integer :tag "Fixed width" :value 80))
  :group 'shell
  :version "27.1")

(defcustom shell-command-prompt-show-cwd nil
  "If non-nil, show current directory when prompting for a shell command.
This affects `shell-command' and `async-shell-command'."
  :type 'boolean
  :group 'shell
  :version "27.1")

(defcustom shell-command-dont-erase-buffer nil
  "Whether to erase the output buffer before executing shell command.

A nil value erases the output buffer before execution of the
shell command, except when the output buffer is the current one.

The value `erase' ensures the output buffer is erased before
execution of the shell command even if it is the current buffer.

Other non-nil values prevent the output buffer from being erased; they
also reposition point in the shell output buffer after execution of the
shell command, except when the output buffer is the current buffer.

The value `beg-last-out' sets point at the beginning of the last
output, `end-last-out' sets point at the end of the last output,
and `save-point' restores the buffer position as it was before the
shell command."
  :type '(choice
          (const :tag "Erase output buffer if not the current one" nil)
          (const :tag "Always erase output buffer" erase)
          (const :tag "Set point to beginning of last output" beg-last-out)
          (const :tag "Set point to end of last output" end-last-out)
          (const :tag "Save point" save-point))
  :group 'shell
  :version "27.1")

(defvar shell-command-saved-pos nil
  "Record of point positions in output buffers after command completion.
The value is an alist whose elements are of the form (BUFFER . POS),
where BUFFER is the output buffer, and POS is the point position
in BUFFER once the command finishes.
This variable is used when `shell-command-dont-erase-buffer' is non-nil.")

(defun shell-command-save-pos-or-erase (&optional output-to-current-buffer)
  "Store a buffer position or erase the buffer.
Optional argument OUTPUT-TO-CURRENT-BUFFER, if non-nil, means that the output
of the shell command goes to the caller current buffer.

See `shell-command-dont-erase-buffer'."
  (let ((sym shell-command-dont-erase-buffer)
        pos)
    (setq buffer-read-only nil)
    ;; Setting buffer-read-only to nil doesn't suffice
    ;; if some text has a non-nil read-only property,
    ;; which comint sometimes adds for prompts.
    (setq pos
          (cond ((eq sym 'save-point)
                 (if (not output-to-current-buffer)
                     (point)))
                ((eq sym 'beg-last-out)
                 (if (not output-to-current-buffer)
                     (point-max)))
                ((or (eq sym 'erase)
                     (and (null sym) (not output-to-current-buffer)))
                 (let ((inhibit-read-only t))
                   (erase-buffer) nil))))
    (when pos
      (goto-char (point-max))
      (push (cons (current-buffer) pos)
            shell-command-saved-pos))))

(defun shell-command-set-point-after-cmd (&optional buffer)
  "Set point in BUFFER after command complete.
BUFFER is the output buffer of the command; if nil, then defaults
to the current BUFFER.
Set point to the `cdr' of the element in `shell-command-saved-pos'
whose `car' is BUFFER."
  (when shell-command-dont-erase-buffer
    (let* ((sym  shell-command-dont-erase-buffer)
           (buf  (or buffer (current-buffer)))
           (pos  (alist-get buf shell-command-saved-pos)))
      (setq shell-command-saved-pos
            (assq-delete-all buf shell-command-saved-pos))
      (when (buffer-live-p buf)
        (let ((win   (car (get-buffer-window-list buf)))
              (pmax  (with-current-buffer buf (point-max))))

          ;; The first time we run a command in a freshly created buffer
          ;; we have not saved positions yet; advance to `point-max', so that
          ;; successive commands know where to start.
          (unless (and pos (memq sym '(save-point beg-last-out end-last-out)))
            (setq pos pmax))
          ;; Set point in the window displaying buf, if any; otherwise
          ;; display buf temporary in selected frame and set the point.
          (if win
              (set-window-point win pos)
            (when pos
              (with-current-buffer buf (goto-char pos)))
            (save-window-excursion
              (let ((win (display-buffer
                          buf
                          '(nil (inhibit-switch-frame . t)))))
                (set-window-point win pos)))))))))

(defun async-shell-command (command &optional output-buffer error-buffer)
  "Execute string COMMAND asynchronously in background.

Like `shell-command', but adds `&' at the end of COMMAND
to execute it asynchronously.

The output appears in the buffer whose name is stored in the
variable `shell-command-buffer-name-async'.  That buffer is in
shell mode.

You can configure `async-shell-command-buffer' to specify what to do
when the buffer specified by `shell-command-buffer-name-async' is
already taken by another running shell command.

To run COMMAND without displaying the output in a window you can
configure `display-buffer-alist' to use the action
`display-buffer-no-window' for the buffer given by
`shell-command-buffer-name-async'.

In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of
a shell (with its need to quote arguments)."
  (interactive
   (list
    (read-shell-command (if shell-command-prompt-show-cwd
                            (format-message "Async shell command in `%s': "
                                            (abbreviate-file-name
                                             default-directory))
                          "Async shell command: ")
                        nil nil
			(let ((filename
			       (cond
				(buffer-file-name)
				((eq major-mode 'dired-mode)
				 (dired-get-filename nil t)))))
			  (and filename (file-relative-name filename))))
    current-prefix-arg
    shell-command-default-error-buffer))
  (unless (string-match "&[ \t]*\\'" command)
    (setq command (concat command " &")))
  (shell-command command output-buffer error-buffer))

(declare-function comint-output-filter "comint" (process string))
(declare-function comint-term-environment "comint" ())

(defun shell-command (command &optional output-buffer error-buffer)
  "Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.

Interactively, prompt for COMMAND in the minibuffer.
If `shell-command-prompt-show-cwd' is non-nil, show the current
directory in the prompt.

If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer whose name is specified
by `shell-command-buffer-name-async'.  That buffer is in shell
mode.  You can also use `async-shell-command' that automatically
adds `&'.

Otherwise, COMMAND is executed synchronously.  The output appears in
the buffer named by `shell-command-buffer-name'.  If the output is
short enough to display in the echo area (which is determined by the
variables `resize-mini-windows' and `max-mini-window-height'), it is
shown there, but it is nonetheless available in buffer named by
`shell-command-buffer-name' even though that buffer is not
automatically displayed.

To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument] \
before this command.

Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.

The optional second argument OUTPUT-BUFFER, if non-nil,
says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer
and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevents the buffer from being
erased.  If OUTPUT-BUFFER is not a buffer and not nil (which happens
interactively when the prefix argument is given), insert the
output in current buffer after point leaving mark after it.  This
cannot be done asynchronously.

If OUTPUT-BUFFER is a buffer or buffer name different from the
current buffer, instead of outputting at point in that buffer,
the output will be appended at the end of that buffer.

The user option `shell-command-dont-erase-buffer', which see, controls
whether the output buffer is erased and where to put point after
the shell command.

If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
the output can be displayed in the echo area or in its buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
Otherwise, the buffer containing the output is displayed.

If there is output and an error, and you did not specify \"insert it
in the current buffer\", a message about the error goes at the end
of the output.

If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER.

In Elisp, you will often be better served by calling `call-process' or
`start-process' directly, since they offer more control and do not
impose the use of a shell (with its need to quote arguments)."

  (interactive
   (list
    (read-shell-command (if shell-command-prompt-show-cwd
                            (format-message "Shell command in `%s': "
                                            (abbreviate-file-name
                                             default-directory))
                          "Shell command: ")
                        nil nil
			(let ((filename
			       (cond
				(buffer-file-name)
				((eq major-mode 'dired-mode)
				 (dired-get-filename nil t)))))
			  (and filename (file-relative-name filename))))
    current-prefix-arg
    shell-command-default-error-buffer))
  ;; Look for a handler in case default-directory is a remote file name.
  (let ((handler
	 (find-file-name-handler (directory-file-name default-directory)
				 'shell-command)))
    (if handler
	(funcall handler 'shell-command command output-buffer error-buffer)
      (if (and output-buffer
               (not (string-match "[ \t]*&[ \t]*\\'" command))
               (or (eq output-buffer (current-buffer))
                   (and (stringp output-buffer) (eq (get-buffer output-buffer) (current-buffer)))
	           (not (or (bufferp output-buffer) (stringp output-buffer))))) ; Bug#39067
	  ;; Synchronous command with output in current buffer.
	  (let ((error-file
                 (and error-buffer
                      (make-temp-file
                       (expand-file-name "scor"
                                         (or small-temporary-file-directory
                                             temporary-file-directory))))))
	    (barf-if-buffer-read-only)
	    (push-mark nil t)
            (shell-command-save-pos-or-erase 'output-to-current-buffer)
	    ;; We do not use -f for csh; we will not support broken use of
	    ;; .cshrcs.  Even the BSD csh manual says to use
	    ;; "if ($?prompt) exit" before things that are not useful
	    ;; non-interactively.  Besides, if someone wants their other
	    ;; aliases for shell commands then they can still have them.
            (call-process-shell-command command nil (if error-file
                                                        (list t error-file)
                                                      t))
	    (when (and error-file (file-exists-p error-file))
              (when (< 0 (file-attribute-size (file-attributes error-file)))
                (with-current-buffer (get-buffer-create error-buffer)
                  (let ((pos-from-end (- (point-max) (point))))
                    (or (bobp)
                        (insert "\f\n"))
                    ;; Do no formatting while reading error file,
                    ;; because that can run a shell command, and we
                    ;; don't want that to cause an infinite recursion.
                    (format-insert-file error-file nil)
                    ;; Put point after the inserted errors.
                    (goto-char (- (point-max) pos-from-end)))
                  (display-buffer (current-buffer))))
	      (delete-file error-file))
	    ;; This is like exchange-point-and-mark, but doesn't
	    ;; activate the mark.  It is cleaner to avoid activation,
	    ;; even though the command loop would deactivate the mark
	    ;; because we inserted text.
	    (goto-char (prog1 (mark t)
			 (set-marker (mark-marker) (point)
				     (current-buffer)))))
	;; Output goes in a separate buffer.
	;; Preserve the match data in case called from a program.
        ;; FIXME: It'd be ridiculous for an Elisp function to call
        ;; shell-command and assume that it won't mess the match-data!
	(save-match-data
	  (if (string-match "[ \t]*&[ \t]*\\'" command)
	      ;; Command ending with ampersand means asynchronous.
              (let* ((buffer (get-buffer-create
                              (or output-buffer shell-command-buffer-name-async)))
                     (bname (buffer-name buffer))
                     (proc (get-buffer-process buffer))
                     (directory default-directory))
		;; Remove the ampersand.
		(setq command (substring command 0 (match-beginning 0)))
		;; Ask the user what to do with already running process.
		(when proc
		  (cond
		   ((eq async-shell-command-buffer 'confirm-kill-process)
		    ;; If will kill a process, query first.
                    (shell-command--same-buffer-confirm "Kill it")
		    (kill-process proc))
		   ((eq async-shell-command-buffer 'confirm-new-buffer)
		    ;; If will create a new buffer, query first.
                    (shell-command--same-buffer-confirm "Use a new buffer")
                    (setq buffer (generate-new-buffer bname)))
		   ((eq async-shell-command-buffer 'new-buffer)
		    ;; It will create a new buffer.
                    (setq buffer (generate-new-buffer bname)))
		   ((eq async-shell-command-buffer 'confirm-rename-buffer)
		    ;; If will rename the buffer, query first.
                    (shell-command--same-buffer-confirm "Rename it")
		    (with-current-buffer buffer
		      (rename-uniquely))
                    (setq buffer (get-buffer-create bname)))
		   ((eq async-shell-command-buffer 'rename-buffer)
		    ;; It will rename the buffer.
		    (with-current-buffer buffer
		      (rename-uniquely))
                    (setq buffer (get-buffer-create bname)))))
		(with-current-buffer buffer
                  (shell-command-save-pos-or-erase)
		  (setq default-directory directory)
                  (require 'shell)
                  (let ((process-environment
                         (append
                          (and (natnump async-shell-command-width)
                               (list
                                (format "COLUMNS=%d"
                                        async-shell-command-width)))
                          (comint-term-environment)
                          process-environment)))
		    (setq proc
			  (start-process-shell-command "Shell" buffer command)))
		  (setq mode-line-process '(":%s"))
                  (shell-mode)
                  (setq-local revert-buffer-function
                              (lambda (&rest _)
                                (async-shell-command command buffer)))
                  (set-process-sentinel proc #'shell-command-sentinel)
		  ;; Use the comint filter for proper handling of
		  ;; carriage motion (see comint-inhibit-carriage-motion).
                  (set-process-filter proc #'comint-output-filter)
                  (if async-shell-command-display-buffer
                      ;; Display buffer immediately.
                      (display-buffer buffer '(nil (allow-no-window . t)))
                    ;; Defer displaying buffer until first process output.
                    ;; Use disposable named advice so that the buffer is
                    ;; displayed at most once per process lifetime.
                    (let ((nonce (make-symbol "nonce")))
                      (add-function :before (process-filter proc)
                                    (lambda (proc _string)
                                      (let ((buf (process-buffer proc)))
                                        (when (buffer-live-p buf)
                                          (remove-function (process-filter proc)
                                                           nonce)
                                          (display-buffer buf))))
                                    `((name . ,nonce)))))))
	    ;; Otherwise, command is executed synchronously.
	    (shell-command-on-region (point) (point) command
				     output-buffer nil error-buffer)))))))

(defun shell-command--same-buffer-confirm (action)
  (let ((help-form
         (format
          "There's a command already running in the default buffer,
so we can't start a new one in the same one.

Answering \"yes\" will %s.

Answering \"no\" will exit without doing anything, and won't
start the new command.

Also see the `async-shell-command-buffer' variable."
          (downcase action))))
    (unless (yes-or-no-p
             (format "A command is running in the default buffer.  %s? "
                     action))
      (user-error "Shell command in progress"))))

(defun max-mini-window-lines (&optional frame)
  "Compute maximum number of lines for echo area in FRAME.
As defined by `max-mini-window-height'.  FRAME defaults to the
selected frame.  Result may be a floating-point number,
i.e. include a fractional number of lines."
  (cond ((floatp max-mini-window-height) (* (frame-height frame)
					    max-mini-window-height))
	((integerp max-mini-window-height) max-mini-window-height)
	(t 1)))

(defun display-message-or-buffer (message &optional buffer-name action frame)
  "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
MESSAGE may be either a string or a buffer.

A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long
for maximum height of the echo area, as defined by `max-mini-window-lines'
if `resize-mini-windows' is non-nil.

Returns either the string shown in the echo area, or when a pop-up
buffer is used, the window used to display it.

If MESSAGE is a string, then the optional argument BUFFER-NAME is the
name of the buffer used to display it in the case where a pop-up buffer
is used, defaulting to `*Message*'.  In the case where MESSAGE is a
string and it is displayed in the echo area, it is not specified whether
the contents are inserted into the buffer anyway.

Optional arguments ACTION and FRAME are as for `display-buffer',
and are used only if a pop-up buffer is displayed."
  (cond ((and (stringp message) (not (string-search "\n" message)))
	 ;; Trivial case where we can use the echo area
	 (message "%s" message))
	((and (stringp message)
	      (= (string-search "\n" message) (1- (length message))))
	 ;; Trivial case where we can just remove single trailing newline
	 (message "%s" (substring message 0 (1- (length message)))))
	(t
	 ;; General case
	 (with-current-buffer
	     (if (bufferp message)
		 message
	       (get-buffer-create (or buffer-name "*Message*")))

	   (unless (bufferp message)
	     (erase-buffer)
	     (insert message))

	   (let ((lines
		  (if (= (buffer-size) 0)
		      0
		    (count-screen-lines nil nil nil (minibuffer-window)))))
	     (cond ((= lines 0))
		   ((and (or (<= lines 1)
			     (<= lines
				 (if resize-mini-windows (max-mini-window-lines)
				   1)))
			 ;; Don't use the echo area if the output buffer is
			 ;; already displayed in the selected frame.
			 (not (get-buffer-window (current-buffer))))
		    ;; Echo area
		    (goto-char (point-max))
		    (when (bolp)
		      (backward-char 1))
		    (message "%s" (buffer-substring (point-min) (point))))
		   (t
		    ;; Buffer
		    (goto-char (point-min))
		    (display-buffer (current-buffer) action frame))))))))


;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself, and to set the point in the buffer when
;; `shell-command-dont-erase-buffer' is non-nil.
(defun shell-command-sentinel (process signal)
  (when (memq (process-status process) '(exit signal))
    (shell-command-set-point-after-cmd (process-buffer process))
    (message "%s: %s."
             (car (cdr (cdr (process-command process))))
             (substring signal 0 -1))))

(defun shell-command-on-region (start end command
				      &optional output-buffer replace
				      error-buffer display-error-buffer
				      region-noncontiguous-p)
  "Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer specified
by `shell-command-buffer-name'; prefix arg means replace the region
with it.  Return the exit code of COMMAND.

To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
before this command.  By default, the input (from the current buffer)
is encoded using coding-system specified by `process-coding-system-alist',
falling back to `default-process-coding-system' if no match for COMMAND
is found in `process-coding-system-alist'.

Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.

If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
Otherwise it is displayed in the buffer named by `shell-command-buffer-name'.
The output is available in that buffer in both cases.

If there is output and an error, a message about the error
appears at the end of the output.

Optional fourth arg OUTPUT-BUFFER specifies where to put the
command's output.  If the value is a buffer or buffer name,
erase that buffer and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevent to erase the buffer.
If the value is nil, use the buffer specified by `shell-command-buffer-name'.
Any other non-nil value means to insert the output in the
current buffer after START.

Optional fifth arg REPLACE, if non-nil, means to insert the
output in place of text from START to END, putting point and mark
around it.  If REPLACE is the symbol `no-mark', don't set the mark.

Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
or buffer name to which to direct the command's standard error
output.  If nil, error output is mingled with regular output.
When called interactively, `shell-command-default-error-buffer'
is used for ERROR-BUFFER.

Optional seventh arg DISPLAY-ERROR-BUFFER, if non-nil, means to
display the error buffer if there were any errors.  When called
interactively, this is t.

Non-nil REGION-NONCONTIGUOUS-P means that the region is composed of
noncontiguous pieces.  The most common example of this is a
rectangular region, where the pieces are separated by newline
characters."
  (interactive (let (string)
		 (unless (mark)
		   (user-error "The mark is not set now, so there is no region"))
		 ;; Do this before calling region-beginning
		 ;; and region-end, in case subprocess output
		 ;; relocates them while we are in the minibuffer.
		 (setq string (read-shell-command "Shell command on region: "))
		 ;; call-interactively recognizes region-beginning and
		 ;; region-end specially, leaving them in the history.
		 (list (region-beginning) (region-end)
		       string
		       current-prefix-arg
		       current-prefix-arg
		       shell-command-default-error-buffer
		       t
		       (region-noncontiguous-p))))
  (let ((error-file
	 (if error-buffer
	     (make-temp-file
	      (expand-file-name "scor"
				(or small-temporary-file-directory
				    temporary-file-directory)))
	   nil))
	exit-status)
    ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
    (if region-noncontiguous-p
        (let ((input (concat (funcall region-extract-function (when replace 'delete)) "\n"))
              output)
          (with-temp-buffer
            (insert input)
            (call-process-region (point-min) (point-max)
                                 shell-file-name t t
                                 nil shell-command-switch
                                 command)
            (setq output (split-string (buffer-substring
                                        (point-min)
                                        ;; Trim the trailing newline.
                                        (if (eq (char-before (point-max)) ?\n)
                                            (1- (point-max))
                                          (point-max)))
                                       "\n")))
          (cond
           (replace
            (goto-char start)
            (funcall region-insert-function output))
           (t
            (let ((buffer (get-buffer-create
                           (or output-buffer shell-command-buffer-name))))
              (with-current-buffer buffer
                (erase-buffer)
                (funcall region-insert-function output))
              (display-message-or-buffer buffer)))))
      (if (or replace
              (and output-buffer
                   (not (or (bufferp output-buffer) (stringp output-buffer)))))
          ;; Replace specified region with output from command.
          (let ((swap (and replace (< start end))))
            ;; Don't muck with mark unless REPLACE says we should.
            (goto-char start)
            (when (and replace
                       (not (eq replace 'no-mark)))
              (push-mark (point) 'nomsg))
            (setq exit-status
                  (call-shell-region start end command replace
                                       (if error-file
                                           (list t error-file)
                                         t)))
            ;; It is rude to delete a buffer that the command is not using.
            ;; (let ((shell-buffer (get-buffer shell-command-buffer-name)))
            ;;   (and shell-buffer (not (eq shell-buffer (current-buffer)))
            ;; 	 (kill-buffer shell-buffer)))
            ;; Don't muck with mark unless REPLACE says we should.
            (when (and replace swap
                       (not (eq replace 'no-mark)))
              (exchange-point-and-mark)))
        ;; No prefix argument: put the output in a temp buffer,
        ;; replacing its entire contents.
        (let ((buffer (get-buffer-create
                       (or output-buffer shell-command-buffer-name))))
          (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111)
          (unwind-protect
              (if (and (eq buffer (current-buffer))
                       (or (memq shell-command-dont-erase-buffer '(nil erase))
                           (and (not (eq buffer (get-buffer
                                                 shell-command-buffer-name)))
                                (not (region-active-p)))))
                  ;; If the input is the same buffer as the output,
                  ;; delete everything but the specified region,
                  ;; then replace that region with the output.
                  (progn (setq buffer-read-only nil)
                         (delete-region (max start end) (point-max))
                         (delete-region (point-min) (min start end))
                         (setq exit-status
                               (call-process-region (point-min) (point-max)
                                                    shell-file-name t
                                                    (if error-file
                                                        (list t error-file)
                                                      t)
                                                    nil shell-command-switch
                                                    command)))
                ;; Clear the output buffer, then run the command with
                ;; output there.
                (let ((directory default-directory))
                  (with-current-buffer buffer
                    (if (not output-buffer)
                        (setq default-directory directory))
                    (shell-command-save-pos-or-erase)))
                (setq exit-status
                      (call-shell-region start end command nil
                                           (if error-file
                                               (list buffer error-file)
                                             buffer))))
            ;; Report the output.
            (with-current-buffer buffer
              (setq-local revert-buffer-function
                          (lambda (&rest _)
                            (shell-command command)))
              (setq mode-line-process
                    (cond ((null exit-status)
                           " - Error")
                          ((stringp exit-status)
                           (format " - Signal [%s]" exit-status))
                          ((not (equal 0 exit-status))
                           (format " - Exit [%d]" exit-status)))))
            (if (with-current-buffer buffer (> (point-max) (point-min)))
                ;; There's some output, display it
                (progn
                  (display-message-or-buffer buffer)
                  (shell-command-set-point-after-cmd buffer))
            ;; No output; error?
              (let ((output
                     (if (and error-file
                              (< 0 (file-attribute-size
				    (file-attributes error-file))))
                         (format "some error output%s"
                                 (if shell-command-default-error-buffer
                                     (format " to the \"%s\" buffer"
                                             shell-command-default-error-buffer)
                                   ""))
                       "no output")))
                (cond ((null exit-status)
                       (message "(Shell command failed with error)"))
                      ((equal 0 exit-status)
                       (message "(Shell command succeeded with %s)"
                                output))
                      ((stringp exit-status)
                       (message "(Shell command killed by signal %s)"
                                exit-status))
                      (t
                       (message "(Shell command failed with code %d and %s)"
                                exit-status output))))
              ;; Don't kill: there might be useful info in the undo-log.
              ;; (kill-buffer buffer)
              )))))

    (when (and error-file (file-exists-p error-file))
      (if (< 0 (file-attribute-size (file-attributes error-file)))
	  (with-current-buffer (get-buffer-create error-buffer)
            (goto-char (point-max))
            ;; Insert a separator if there's already text here.
	    (unless (bobp)
	      (insert "\f\n"))
	    ;; Do no formatting while reading error file,
	    ;; because that can run a shell command, and we
	    ;; don't want that to cause an infinite recursion.
	    (format-insert-file error-file nil)
	    (and display-error-buffer
		 (display-buffer (current-buffer)))))
      (delete-file error-file))
    exit-status))

(defun shell-command-to-string (command)
  "Execute shell command COMMAND and return its output as a string."
  (with-output-to-string
    (with-current-buffer standard-output
      (shell-command command t))))

(defun process-file (program &optional infile buffer display &rest args)
  "Process files synchronously in a separate process that runs PROGRAM.
Similar to `call-process', but may invoke a file name handler based on
`default-directory'.  The current working directory of the
subprocess is `default-directory'.

If PROGRAM is a remote file name, it should be processed
by `file-local-name' before passing it to this function.

Handle file names in INFILE and BUFFER normally; this differs
from `call-process', which does not support file name handlers
for INFILE and BUFFER.  However, pass ARGS to the process
verbatim without file name handling, as `call-process' does.

Some file name handlers might not support all variants.  For
example, they might treat DISPLAY as nil regardless of the actual
value passed."
  (let ((fh (find-file-name-handler default-directory 'process-file))
        lc stderr-file)
    (unwind-protect
        (if fh (apply fh 'process-file program infile buffer display args)
          (when infile (setq lc (file-local-copy infile)))
          (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
                              (make-temp-file "emacs")))
          (prog1
              (apply 'call-process program
                     (or lc infile)
                     (if stderr-file (list (car buffer) stderr-file) buffer)
                     display args)
            (when stderr-file (copy-file stderr-file (cadr buffer) t))))
      (when stderr-file (delete-file stderr-file))
      (when lc (delete-file lc)))))

(defvar process-file-side-effects t
  "Whether a call of `process-file' changes remote files.

By default, this variable is always set to t, meaning that a
call of `process-file' could potentially change any file on a
remote host.  When set to nil, a file name handler could optimize
its behavior with respect to remote file attribute caching.

You should only ever change this variable with a let-binding;
never with `setq'.")

(defcustom process-file-return-signal-string nil
  "Whether to return a string describing the signal interrupting a process.
When a process returns an exit code greater than 128, it is
interpreted as a signal.  `process-file' requires to return a
string describing this signal.
Since there are processes violating this rule, returning exit
codes greater than 128 which are not bound to a signal,
`process-file' returns the exit code as natural number also in
this case.  Setting this user option to non-nil forces
`process-file' to interpret such exit codes as signals, and to
return a corresponding string."
  :version "28.1"
  :type 'boolean)

(defun start-file-process (name buffer program &rest program-args)
  "Start a program in a subprocess.  Return the process object for it.

Similar to `start-process', but may invoke a file name handler based on
`default-directory'.  See Info node `(elisp)Magic File Names'.

This handler ought to run PROGRAM, perhaps on the local host,
perhaps on a remote host that corresponds to `default-directory'.
In the latter case, the local part of `default-directory', the one
produced from it by `file-local-name', becomes the working directory
of the process on the remote host.

PROGRAM and PROGRAM-ARGS might be file names.  They are not
objects of file name handler invocation, so they need to be obtained
by calling `file-local-name', in case they are remote file names.

File name handlers might not support pty association, if PROGRAM is nil."
  (let ((fh (find-file-name-handler default-directory 'start-file-process)))
    (if fh (apply fh 'start-file-process name buffer program program-args)
      (apply 'start-process name buffer program program-args))))
\f
;;;; Process menu

(defvar tabulated-list-format)
(defvar tabulated-list-entries)
(defvar tabulated-list-sort-key)
(declare-function tabulated-list-init-header  "tabulated-list" ())
(declare-function tabulated-list-print "tabulated-list"
                  (&optional remember-pos update))

(defvar process-menu-query-only nil)

(defvar process-menu-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [?d] 'process-menu-delete-process)
    map))

(define-derived-mode process-menu-mode tabulated-list-mode "Process Menu"
  "Major mode for listing the processes called by Emacs."
  (setq tabulated-list-format [("Process" 15 t)
			       ("PID"      7 t)
			       ("Status"   7 t)
                               ;; 25 is the length of the long standard buffer
                               ;; name "*Async Shell Command*<10>" (bug#30016)
			       ("Buffer"  25 t)
			       ("TTY"     12 t)
			       ("Thread"  12 t)
			       ("Command"  0 t)])
  (make-local-variable 'process-menu-query-only)
  (setq tabulated-list-sort-key (cons "Process" nil))
  (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t))

(defun process-menu-delete-process ()
  "Kill process at point in a `list-processes' buffer."
  (interactive)
  (let ((pos (point)))
    (delete-process (tabulated-list-get-id))
    (revert-buffer)
    (goto-char (min pos (point-max)))
    (if (eobp)
        (forward-line -1)
      (beginning-of-line))))

(declare-function thread-name "thread.c")

(defun list-processes--refresh ()
  "Recompute the list of processes for the Process List buffer.
Also, delete any process that is exited or signaled."
  (setq tabulated-list-entries nil)
  (dolist (p (process-list))
    (cond ((memq (process-status p) '(exit signal closed))
	   (delete-process p))
	  ((or (not process-menu-query-only)
	       (process-query-on-exit-flag p))
	   (let* ((buf (process-buffer p))
		  (type (process-type p))
		  (pid  (if (process-id p) (format "%d" (process-id p)) "--"))
		  (name (process-name p))
		  (status (symbol-name (process-status p)))
		  (buf-label (if (buffer-live-p buf)
				 `(,(buffer-name buf)
				   face link
				   help-echo ,(format-message
					       "Visit buffer `%s'"
					       (buffer-name buf))
				   follow-link t
				   process-buffer ,buf
				   action process-menu-visit-buffer)
			       "--"))
		  (tty (or (process-tty-name p) "--"))
		  (thread
                   (cond
                    ((or
                      (null (process-thread p))
                      (not (fboundp 'thread-name))) "--")
                    ((eq (process-thread p) main-thread) "Main")
		    ((thread-name (process-thread p)))
		    (t "--")))
		  (cmd
		   (if (memq type '(network serial pipe))
		       (let ((contact (process-contact p t t)))
			 (if (eq type 'network)
			     (format "(%s %s)"
				     (if (plist-get contact :type)
					 "datagram"
				       "network")
				     (if (plist-get contact :server)
					 (format
                                          "server on %s"
					  (if (plist-get contact :host)
                                              (format "%s:%s"
						      (plist-get contact :host)
                                                      (plist-get
                                                       contact :service))
					    (plist-get contact :local)))
				       (format "connection to %s:%s"
					       (plist-get contact :host)
					       (plist-get contact :service))))
			   (format "(serial port %s%s)"
				   (or (plist-get contact :port) "?")
				   (let ((speed (plist-get contact :speed)))
				     (if speed
					 (format " at %s b/s" speed)
				       "")))))
		     (mapconcat 'identity (process-command p) " "))))
	     (push (list p (vector name pid status buf-label tty thread cmd))
		   tabulated-list-entries)))))
  (tabulated-list-init-header))

(defun process-menu-visit-buffer (button)
  (display-buffer (button-get button 'process-buffer)))

(defun list-processes (&optional query-only buffer)
  "Display a list of all processes that are Emacs sub-processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Process List*\".
The return value is always nil.

This function lists only processes that were launched by Emacs.  To
see other processes running on the system, use `list-system-processes'."
  (interactive)
  (or (fboundp 'process-list)
      (error "Asynchronous subprocesses are not supported on this system"))
  (unless (bufferp buffer)
    (setq buffer (get-buffer-create "*Process List*")))
  (with-current-buffer buffer
    (process-menu-mode)
    (setq process-menu-query-only query-only)
    (list-processes--refresh)
    (tabulated-list-print))
  (display-buffer buffer)
  nil)
\f
;;;; Prefix commands

(setq prefix-command--needs-update nil)
(setq prefix-command--last-echo nil)

(defun internal-echo-keystrokes-prefix ()
  ;; BEWARE: Called directly from C code.
  ;; If the return value is non-nil, it means we are in the middle of
  ;; a command with prefix, such as a command invoked with prefix-arg.
  (if (not prefix-command--needs-update)
      prefix-command--last-echo
    (setq prefix-command--last-echo
          (let ((strs nil))
            (run-hook-wrapped 'prefix-command-echo-keystrokes-functions
                              (lambda (fun) (push (funcall fun) strs) nil))
            (setq strs (delq nil strs))
            (when strs (mapconcat #'identity strs " "))))))

(defvar prefix-command-echo-keystrokes-functions nil
  "Abnormal hook that constructs the description of the current prefix state.
Each function is called with no argument, should return a string or nil.")

(defun prefix-command-update ()
  "Update state of prefix commands.
Call it whenever you change the \"prefix command state\"."
  (setq prefix-command--needs-update t))

(defvar prefix-command-preserve-state-hook nil
  "Normal hook run when a command needs to preserve the prefix.")

(defun prefix-command-preserve-state ()
  "Pass the current prefix command state to the next command.
Should be called by all prefix commands.
Runs `prefix-command-preserve-state-hook'."
  (run-hooks 'prefix-command-preserve-state-hook)
  ;; If the current command is a prefix command, we don't want the next (real)
  ;; command to have `last-command' set to, say, `universal-argument'.
  (setq this-command last-command)
  (setq real-this-command real-last-command)
  (prefix-command-update))

(defun reset-this-command-lengths ()
  (declare (obsolete prefix-command-preserve-state "25.1"))
  nil)

;;;;; The main prefix command.

;; FIXME: Declaration of `prefix-arg' should be moved here!?

(add-hook 'prefix-command-echo-keystrokes-functions
          #'universal-argument--description)
(defun universal-argument--description ()
  (when prefix-arg
    (concat "C-u"
            (pcase prefix-arg
              ('(-) " -")
              (`(,(and (pred integerp) n))
               (let ((str ""))
                 (while (and (> n 4) (= (mod n 4) 0))
                   (setq str (concat str " C-u"))
                   (setq n (/ n 4)))
                 (if (= n 4) str (format " %s" prefix-arg))))
              (_ (format " %s" prefix-arg))))))

(add-hook 'prefix-command-preserve-state-hook
          #'universal-argument--preserve)
(defun universal-argument--preserve ()
  (setq prefix-arg current-prefix-arg))

(defvar universal-argument-map
  (let ((map (make-sparse-keymap))
        (universal-argument-minus
         ;; For backward compatibility, minus with no modifiers is an ordinary
         ;; command if digits have already been entered.
         `(menu-item "" negative-argument
                     :filter ,(lambda (cmd)
                                (if (integerp prefix-arg) nil cmd)))))
    (define-key map [switch-frame]
      (lambda (e) (interactive "e")
        (handle-switch-frame e) (universal-argument--mode)))
    (define-key map [?\C-u] 'universal-argument-more)
    (define-key map [?-] universal-argument-minus)
    (define-key map [?0] 'digit-argument)
    (define-key map [?1] 'digit-argument)
    (define-key map [?2] 'digit-argument)
    (define-key map [?3] 'digit-argument)
    (define-key map [?4] 'digit-argument)
    (define-key map [?5] 'digit-argument)
    (define-key map [?6] 'digit-argument)
    (define-key map [?7] 'digit-argument)
    (define-key map [?8] 'digit-argument)
    (define-key map [?9] 'digit-argument)
    (define-key map [kp-0] 'digit-argument)
    (define-key map [kp-1] 'digit-argument)
    (define-key map [kp-2] 'digit-argument)
    (define-key map [kp-3] 'digit-argument)
    (define-key map [kp-4] 'digit-argument)
    (define-key map [kp-5] 'digit-argument)
    (define-key map [kp-6] 'digit-argument)
    (define-key map [kp-7] 'digit-argument)
    (define-key map [kp-8] 'digit-argument)
    (define-key map [kp-9] 'digit-argument)
    (define-key map [kp-subtract] universal-argument-minus)
    map)
  "Keymap used while processing \\[universal-argument].")

(defun universal-argument--mode ()
  (prefix-command-update)
  (set-transient-map universal-argument-map nil))

(defun universal-argument ()
  "Begin a numeric argument for the following command.
Digits or minus sign following \\[universal-argument] make up the numeric argument.
\\[universal-argument] following the digits or minus sign ends the argument.
\\[universal-argument] without digits or minus sign provides 4 as argument.
Repeating \\[universal-argument] without digits or minus sign
 multiplies the argument by 4 each time.
For some commands, just \\[universal-argument] by itself serves as a flag
that is different in effect from any particular numeric argument.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
  (interactive)
  (prefix-command-preserve-state)
  (setq prefix-arg (list 4))
  (universal-argument--mode))

(defun universal-argument-more (arg)
  ;; A subsequent C-u means to multiply the factor by 4 if we've typed
  ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
  (interactive "P")
  (prefix-command-preserve-state)
  (setq prefix-arg (if (consp arg)
                       (list (* 4 (car arg)))
                     (if (eq arg '-)
                         (list -4)
                       arg)))
  (when (consp prefix-arg) (universal-argument--mode)))

(defun negative-argument (arg)
  "Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
  (interactive "P")
  (prefix-command-preserve-state)
  (setq prefix-arg (cond ((integerp arg) (- arg))
                         ((eq arg '-) nil)
                         (t '-)))
  (universal-argument--mode))

(defun digit-argument (arg)
  "Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
  (interactive "P")
  (prefix-command-preserve-state)
  (let* ((char (if (integerp last-command-event)
		   last-command-event
		 (get last-command-event 'ascii-character)))
	 (digit (- (logand char ?\177) ?0)))
    (setq prefix-arg (cond ((integerp arg)
                            (+ (* arg 10)
			       (if (< arg 0) (- digit) digit)))
                           ((eq arg '-)
                            ;; Treat -0 as just -, so that -01 will work.
                            (if (zerop digit) '- (- digit)))
                           (t
                            digit))))
  (universal-argument--mode))
\f

(defvar filter-buffer-substring-functions nil
  "This variable is a wrapper hook around `buffer-substring--filter'.
\(See `with-wrapper-hook' for details about wrapper hooks.)")
(make-obsolete-variable 'filter-buffer-substring-functions
                        'filter-buffer-substring-function "24.4")

(defvar filter-buffer-substring-function #'buffer-substring--filter
  "Function to perform the filtering in `filter-buffer-substring'.
The function is called with the same 3 arguments (BEG END DELETE)
that `filter-buffer-substring' received.  It should return the
buffer substring between BEG and END, after filtering.  If DELETE is
non-nil, it should delete the text between BEG and END from the buffer.")

(defvar buffer-substring-filters nil
  "List of filter functions for `buffer-substring--filter'.
Each function must accept a single argument, a string, and return a string.
The buffer substring is passed to the first function in the list,
and the return value of each function is passed to the next.
As a special convention, point is set to the start of the buffer text
being operated on (i.e., the first argument of `buffer-substring--filter')
before these functions are called.")
(make-obsolete-variable 'buffer-substring-filters
                        'filter-buffer-substring-function "24.1")

(defun filter-buffer-substring (beg end &optional delete)
  "Return the buffer substring between BEG and END, after filtering.
If DELETE is non-nil, delete the text between BEG and END from the buffer.

This calls the function that `filter-buffer-substring-function' specifies
\(passing the same three arguments that it received) to do the work,
and returns whatever it does.  The default function does no filtering,
unless a hook has been set.

Use `filter-buffer-substring' instead of `buffer-substring',
`buffer-substring-no-properties', or `delete-and-extract-region' when
you want to allow filtering to take place.  For example, major or minor
modes can use `filter-buffer-substring-function' to exclude text properties
that are special to a buffer, and should not be copied into other buffers."
  (funcall filter-buffer-substring-function beg end delete))

(defun buffer-substring--filter (beg end &optional delete)
  "Default function to use for `filter-buffer-substring-function'.
Its arguments and return value are as specified for `filter-buffer-substring'.
Also respects the obsolete wrapper hook `filter-buffer-substring-functions'
\(see `with-wrapper-hook' for details about wrapper hooks),
and the abnormal hook `buffer-substring-filters'.
No filtering is done unless a hook says to."
  (subr--with-wrapper-hook-no-warnings
    filter-buffer-substring-functions (beg end delete)
    (cond
     ((or delete buffer-substring-filters)
      (save-excursion
        (goto-char beg)
        (let ((string (if delete (delete-and-extract-region beg end)
                        (buffer-substring beg end))))
          (dolist (filter buffer-substring-filters)
            (setq string (funcall filter string)))
          string)))
     (t
      (buffer-substring beg end)))))


;;;; Window system cut and paste hooks.

(defvar interprogram-cut-function #'gui-select-text
  "Function to call to make a killed region available to other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
MS-Windows, or the pasteboard on Nextstep/Mac OS.

This variable holds a function that Emacs calls whenever text is
put in the kill ring, to make the new kill available to other
programs.  The function takes one argument, TEXT, which is a
string containing the text that should be made available.")

(defvar interprogram-paste-function #'gui-selection-value
  "Function to call to get text cut from other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
MS-Windows, or the pasteboard on Nextstep/Mac OS.

This variable holds a function that Emacs calls to obtain text
that other programs have provided for pasting.  The function is
called with no arguments.  If no other program has provided text
to paste, the function should return nil (in which case the
caller, usually `current-kill', should use the top of the Emacs
kill ring).  If another program has provided text to paste, the
function should return that text as a string (in which case the
caller should put this string in the kill ring as the latest
kill).

The function may also return a list of strings if the window
system supports multiple selections.  The first string will be
used as the pasted text, but the other will be placed in the kill
ring for easy access via `yank-pop'.

Note that the function should return a string only if a program
other than Emacs has provided a string for pasting; if Emacs
provided the most recent string, the function should return nil.
If it is difficult to tell whether Emacs or some other program
provided the current string, it is probably good enough to return
nil if the string is equal (according to `string=') to the last
text Emacs provided.")
\f


;;;; The kill ring data structure.

(defvar kill-ring nil
  "List of killed text sequences.
Since the kill ring is supposed to interact nicely with cut-and-paste
facilities offered by window systems, use of this variable should
interact nicely with `interprogram-cut-function' and
`interprogram-paste-function'.  The functions `kill-new',
`kill-append', and `current-kill' are supposed to implement this
interaction; you may want to use them instead of manipulating the kill
ring directly.")

(defcustom kill-ring-max 120
  "Maximum length of kill ring before oldest elements are thrown away."
  :type 'integer
  :group 'killing
  :version "29.1")

(defvar kill-ring-yank-pointer nil
  "The tail of the kill ring whose car is the last thing yanked.")

(defcustom save-interprogram-paste-before-kill nil
  "Whether to save existing clipboard text into kill ring before replacing it.
A non-nil value means the clipboard text is saved to the `kill-ring'
prior to any kill command.  Such text can subsequently be retrieved
via \\[yank] \\[yank-pop].  This ensures that Emacs kill operations
do not irrevocably overwrite existing clipboard text.

The value of this variable can also be a number, in which case the
clipboard data is only saved to the `kill-ring' if it's shorter
(in characters) than that number.  Any other non-nil value will save
the clipboard data unconditionally."
  :type '(choice (const nil)
                 number
                 (other :tag "Always" t))
  :group 'killing
  :version "23.2")

(defcustom kill-do-not-save-duplicates nil
  "If non-nil, don't add a string to `kill-ring' if it duplicates the last one.
The comparison is done using `equal-including-properties'."
  :type 'boolean
  :group 'killing
  :version "23.2")

(defcustom kill-transform-function nil
  "Function to call to transform a string before it's put on the kill ring.
The function is called with one parameter (the string that's to
be put on the kill ring).  It should return a string or nil.  If
the latter, the string is not put on the kill ring."
  :type '(choice (const :tag "No transform" nil)
                 function)
  :group 'killing
  :version "28.1")

(defun kill-new (string &optional replace)
  "Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
the front of the kill ring, rather than being added to the list.

When `save-interprogram-paste-before-kill' and `interprogram-paste-function'
are non-nil, save the interprogram paste string(s) into `kill-ring' before
STRING.

When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'.  However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
  ;; Allow the user to transform or ignore the string.
  (when (or (not kill-transform-function)
            (setq string (funcall kill-transform-function string)))
    (unless (and kill-do-not-save-duplicates
	         ;; Due to text properties such as 'yank-handler that
	         ;; can alter the contents to yank, comparison using
	         ;; `equal' is unsafe.
	         (equal-including-properties string (car kill-ring)))
      (if (fboundp 'menu-bar-update-yank-menu)
	  (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
    (when save-interprogram-paste-before-kill
      (let ((interprogram-paste (and interprogram-paste-function
                                     (funcall interprogram-paste-function))))
        (when interprogram-paste
          (setq interprogram-paste
                (if (listp interprogram-paste)
                    ;; Use `reverse' to avoid modifying external data.
                    (reverse interprogram-paste)
		  (list interprogram-paste)))
          (when (or (not (numberp save-interprogram-paste-before-kill))
                    (< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0)
                       save-interprogram-paste-before-kill))
            (dolist (s interprogram-paste)
	      (unless (and kill-do-not-save-duplicates
                           (equal-including-properties s (car kill-ring)))
	        (push s kill-ring)))))))
    (unless (and kill-do-not-save-duplicates
	         (equal-including-properties string (car kill-ring)))
      (if (and replace kill-ring)
	  (setcar kill-ring string)
        (let ((history-delete-duplicates nil))
          (add-to-history 'kill-ring string kill-ring-max t))))
    (setq kill-ring-yank-pointer kill-ring)
    (if interprogram-cut-function
        (funcall interprogram-cut-function string))))

;; It has been argued that this should work like `self-insert-command'
;; which merges insertions in `buffer-undo-list' in groups of 20
;; (hard-coded in `undo-auto-amalgamate').
(defcustom kill-append-merge-undo nil
  "Amalgamate appending kills with the last kill for undo.
When non-nil, appending or prepending text to the last kill makes
\\[undo] restore both pieces of text simultaneously."
  :type 'boolean
  :group 'killing
  :version "25.1")

(defun kill-append (string before-p)
  "Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill instead.
If `interprogram-cut-function' is non-nil, call it with the
resulting kill.
If `kill-append-merge-undo' is non-nil, remove the last undo
boundary in the current buffer."
  (let ((cur (car kill-ring)))
    (kill-new (if before-p (concat string cur) (concat cur string))
              (or (= (length cur) 0)
                  (null (get-text-property 0 'yank-handler cur)))))
  (when (and kill-append-merge-undo (not buffer-read-only))
    (let ((prev buffer-undo-list)
          (next (cdr buffer-undo-list)))
      ;; Find the next undo boundary.
      (while (car next)
        (pop next)
        (pop prev))
      ;; Remove this undo boundary.
      (when prev
        (setcdr prev (cdr next))))))

(defcustom yank-pop-change-selection nil
  "Whether rotating the kill ring changes the window system selection.
If non-nil, whenever the kill ring is rotated (usually via the
`yank-pop' command), Emacs also calls `interprogram-cut-function'
to copy the new kill to the window system selection."
  :type 'boolean
  :group 'killing
  :version "23.1")

(defun current-kill (n &optional do-not-move)
  "Rotate the yanking point by N places, and then return that kill.
If N is zero and `interprogram-paste-function' is set to a
function that returns a string or a list of strings, and if that
function doesn't return nil, then that string (or list) is added
to the front of the kill ring and the string (or first string in
the list) is returned as the latest kill.

If N is not zero, and if `yank-pop-change-selection' is
non-nil, use `interprogram-cut-function' to transfer the
kill at the new yank point into the window system selection.

If optional arg DO-NOT-MOVE is non-nil, then don't actually
move the yanking point; just return the Nth kill forward."

  (let ((interprogram-paste (and (= n 0)
				 interprogram-paste-function
				 (funcall interprogram-paste-function))))
    (if interprogram-paste
	(progn
	  ;; Disable the interprogram cut function when we add the new
	  ;; text to the kill ring, so Emacs doesn't try to own the
	  ;; selection, with identical text.
          ;; Also disable the interprogram paste function, so that
          ;; `kill-new' doesn't call it repeatedly.
          (let ((interprogram-cut-function nil)
                (interprogram-paste-function nil))
	    (if (listp interprogram-paste)
                ;; Use `reverse' to avoid modifying external data.
                (mapc #'kill-new (reverse interprogram-paste))
	      (kill-new interprogram-paste)))
	  (car kill-ring))
      (or kill-ring (error "Kill ring is empty"))
      (let ((ARGth-kill-element
	     (nthcdr (mod (- n (length kill-ring-yank-pointer))
			  (length kill-ring))
		     kill-ring)))
	(unless do-not-move
	  (setq kill-ring-yank-pointer ARGth-kill-element)
	  (when (and yank-pop-change-selection
		     (> n 0)
		     interprogram-cut-function)
	    (funcall interprogram-cut-function (car ARGth-kill-element))))
	(car ARGth-kill-element)))))



;;;; Commands for manipulating the kill ring.

(defcustom kill-read-only-ok nil
  "Non-nil means don't signal an error for killing read-only text."
  :type 'boolean
  :group 'killing)

(defun kill-region (beg end &optional region)
  "Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
\(If you want to save the region without killing it, use \\[kill-ring-save].)

If you want to append the killed region to the last killed text,
use \\[append-next-kill] before \\[kill-region].

Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
to make one entry in the kill ring.

The killed text is filtered by `filter-buffer-substring' before it is
saved in the kill ring, so the actual saved text might be different
from what was killed.

If the buffer is read-only, Emacs will beep and refrain from deleting
the text, but put the text in the kill ring anyway.  This means that
you can use the killing commands to copy text from a read-only buffer.

Lisp programs should use this function for killing text.
 (To delete text, use `delete-region'.)
Supply two arguments, character positions BEG and END indicating the
 stretch of text to be killed.  If the optional argument REGION is
 non-nil, the function ignores BEG and END, and kills the current
 region instead.  Interactively, REGION is always non-nil, and so
 this command always kills the current region."
  ;; Pass mark first, then point, because the order matters when
  ;; calling `kill-append'.
  (interactive (progn
                 (let ((beg (mark))
                       (end (point)))
                   (unless (and beg end)
                     (user-error "The mark is not set now, so there is no region"))
                   (list beg end 'region))))
  (condition-case nil
      (let ((string (if region
                        (funcall region-extract-function 'delete)
                      (filter-buffer-substring beg end 'delete))))
	(when string			;STRING is nil if BEG = END
	  ;; Add that string to the kill ring, one way or another.
	  (if (eq last-command 'kill-region)
	      (kill-append string (< end beg))
	    (kill-new string)))
	(when (or string (eq last-command 'kill-region))
	  (setq this-command 'kill-region))
	(setq deactivate-mark t)
	nil)
    ((buffer-read-only text-read-only)
     ;; The code above failed because the buffer, or some of the characters
     ;; in the region, are read-only.
     ;; We should beep, in case the user just isn't aware of this.
     ;; However, there's no harm in putting
     ;; the region's text in the kill ring, anyway.
     (copy-region-as-kill beg end region)
     ;; Set this-command now, so it will be set even if we get an error.
     (setq this-command 'kill-region)
     ;; This should barf, if appropriate, and give us the correct error.
     (if kill-read-only-ok
	 (progn (message "Read only text copied to kill ring") nil)
       ;; Signal an error if the buffer is read-only.
       (barf-if-buffer-read-only)
       ;; If the buffer isn't read-only, the text is.
       (signal 'text-read-only (list (current-buffer)))))))

;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
;; then corrects it with the intended C-w.
(defun copy-region-as-kill (beg end &optional region)
  "Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.

The copied text is filtered by `filter-buffer-substring' before it is
saved in the kill ring, so the actual saved text might be different
from what was in the buffer.

When called from Lisp, save in the kill ring the stretch of text
between BEG and END, unless the optional argument REGION is
non-nil, in which case ignore BEG and END, and save the current
region instead.

This command's old key binding has been given to `kill-ring-save'."
  ;; Pass mark first, then point, because the order matters when
  ;; calling `kill-append'.
  (interactive (list (mark) (point) 'region))
  (let ((str (if region
                 (funcall region-extract-function nil)
               (filter-buffer-substring beg end))))
    (if (eq last-command 'kill-region)
        (kill-append str (< end beg))
      (kill-new str)))
  (setq deactivate-mark t)
  nil)

(defun kill-ring-save (beg end &optional region)
  "Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.

If you want to append the killed region to the last killed text,
use \\[append-next-kill] before \\[kill-ring-save].

The copied text is filtered by `filter-buffer-substring' before it is
saved in the kill ring, so the actual saved text might be different
from what was in the buffer.

When called from Lisp, save in the kill ring the stretch of text
between BEG and END, unless the optional argument REGION is
non-nil, in which case ignore BEG and END, and save the current
region instead.

This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
  ;; Pass mark first, then point, because the order matters when
  ;; calling `kill-append'.
  (interactive (list (mark) (point) 'region))
  (copy-region-as-kill beg end region)
  ;; This use of called-interactively-p is correct because the code it
  ;; controls just gives the user visual feedback.
  (if (called-interactively-p 'interactive)
      (indicate-copied-region)))

(defcustom copy-region-blink-delay 1
  "Time in seconds to delay after showing the other end of the region.
It's used by the command `kill-ring-save' and the function
`indicate-copied-region' to blink the cursor between point and mark.
The value 0 disables blinking."
  :type 'number
  :group 'killing
  :version "28.1")

(defun indicate-copied-region (&optional message-len)
  "Indicate that the region text has been copied interactively.
If the mark is visible in the selected window, blink the cursor between
point and mark if there is currently no active region highlighting.
The option `copy-region-blink-delay' can disable blinking.

If the mark lies outside the selected window, display an
informative message containing a sample of the copied text.  The
optional argument MESSAGE-LEN, if non-nil, specifies the length
of this sample text; it defaults to 40."
  (let ((mark (mark t))
	(point (point))
	;; Inhibit quitting so we can make a quit here
	;; look like a C-g typed as a command.
	(inhibit-quit t))
    (if (pos-visible-in-window-p mark (selected-window))
	;; Swap point-and-mark quickly so as to show the region that
	;; was selected.  Don't do it if the region is highlighted.
	(when (and (numberp copy-region-blink-delay)
		   (> copy-region-blink-delay 0)
		   (or (not (region-active-p))
		       (not (face-background 'region nil t))))
	  ;; Swap point and mark.
	  (set-marker (mark-marker) (point) (current-buffer))
	  (goto-char mark)
	  (sit-for copy-region-blink-delay)
	  ;; Swap back.
	  (set-marker (mark-marker) mark (current-buffer))
	  (goto-char point)
	  ;; If user quit, deactivate the mark
	  ;; as C-g would as a command.
	  (and quit-flag (region-active-p)
	       (deactivate-mark)))
      (let ((len (min (abs (- mark point))
		      (or message-len 40))))
	(if (< point mark)
	    ;; Don't say "killed" or "saved"; that is misleading.
	    (message "Copied text until \"%s\""
		     ;; Don't show newlines literally
		     (query-replace-descr
		      (buffer-substring-no-properties (- mark len) mark)))
	  (message "Copied text from \"%s\""
		   (query-replace-descr
		    (buffer-substring-no-properties mark (+ mark len)))))))))

(defun append-next-kill (&optional interactive)
  "Cause following command, if it kills, to add to previous kill.
If the next command kills forward from point, the kill is
appended to the previous killed text.  If the command kills
backward, the kill is prepended.  Kill commands that act on the
region, such as `kill-region', are regarded as killing forward if
point is after mark, and killing backward if point is before
mark.

If the next command is not a kill command, `append-next-kill' has
no effect.

The argument is used for internal purposes; do not supply one."
  (interactive "p")
  ;; We don't use (interactive-p), since that breaks kbd macros.
  (if interactive
      (progn
	(setq this-command 'kill-region)
	(message "If the next command is a kill, it will append"))
    (setq last-command 'kill-region)))

(defvar bidi-directional-controls-chars "\x202a-\x202e\x2066-\x2069"
  "Character set that matches bidirectional formatting control characters.")

(defvar bidi-directional-non-controls-chars "^\x202a-\x202e\x2066-\x2069"
  "Character set that matches any character except bidirectional controls.")

(defun squeeze-bidi-context-1 (from to category replacement)
  "A subroutine of `squeeze-bidi-context'.
FROM and TO should be markers, CATEGORY and REPLACEMENT should be strings."
  (let ((pt (copy-marker from))
	(limit (copy-marker to))
	(old-pt 0)
	lim1)
    (setq lim1 limit)
    (goto-char pt)
    (while (< pt limit)
      (if (> pt old-pt)
	  (move-marker lim1
		       (save-excursion
			 ;; L and R categories include embedding and
			 ;; override controls, but we don't want to
			 ;; replace them, because that might change
			 ;; the visual order.  Likewise with PDF and
			 ;; isolate controls.
			 (+ pt (skip-chars-forward
				bidi-directional-non-controls-chars
				limit)))))
      ;; Replace any run of non-RTL characters by a single LRM.
      (if (null (re-search-forward category lim1 t))
	  ;; No more characters of CATEGORY, we are done.
	  (setq pt limit)
	(replace-match replacement nil t)
	(move-marker pt (point)))
      (setq old-pt pt)
      ;; Skip directional controls, if any.
      (move-marker
       pt (+ pt (skip-chars-forward bidi-directional-controls-chars limit))))))

(defun squeeze-bidi-context (from to)
  "Replace characters between FROM and TO while keeping bidi context.

This function replaces the region of text with as few characters
as possible, while preserving the effect that region will have on
bidirectional display before and after the region."
  (let ((start (set-marker (make-marker)
			   (if (> from 0) from (+ (point-max) from))))
	(end (set-marker (make-marker) to))
	;; This is for when they copy text with read-only text
	;; properties.
	(inhibit-read-only t))
    (if (null (marker-position end))
	(setq end (point-max-marker)))
    ;; Replace each run of non-RTL characters with a single LRM.
    (squeeze-bidi-context-1 start end "\\CR+" "\x200e")
    ;; Replace each run of non-LTR characters with a single RLM.  Note
    ;; that the \cR category includes both the Arabic Letter (AL) and
    ;; R characters; here we ignore the distinction between them,
    ;; because that distinction affects only Arabic Number (AN)
    ;; characters, which are weak and don't affect the reordering.
    (squeeze-bidi-context-1 start end "\\CL+" "\x200f")))

(defun line-substring-with-bidi-context (start end &optional no-properties)
  "Return buffer text between START and END with its bidi context.

START and END are assumed to belong to the same physical line
of buffer text.  This function prepends and appends to the text
between START and END bidi control characters that preserve the
visual order of that text when it is inserted at some other place."
  (if (or (< start (point-min))
	  (> end (point-max)))
      (signal 'args-out-of-range (list (current-buffer) start end)))
  (let ((buf (current-buffer))
	substr para-dir from to)
    (save-excursion
      (goto-char start)
      (setq para-dir (current-bidi-paragraph-direction))
      (setq from (line-beginning-position)
	    to (line-end-position))
      (goto-char from)
      ;; If we don't have any mixed directional characters in the
      ;; entire line, we can just copy the substring without adding
      ;; any context.
      (if (or (looking-at-p "\\CR*$")
	      (looking-at-p "\\CL*$"))
	  (setq substr (if no-properties
			   (buffer-substring-no-properties start end)
			 (buffer-substring start end)))
	(setq substr
	      (with-temp-buffer
		(if no-properties
		    (insert-buffer-substring-no-properties buf from to)
		  (insert-buffer-substring buf from to))
		(squeeze-bidi-context 1 (1+ (- start from)))
		(squeeze-bidi-context (- end to) nil)
		(buffer-substring 1 (point-max)))))

      ;; Wrap the string in LRI/RLI..PDI pair to achieve 2 effects:
      ;; (1) force the string to have the same base embedding
      ;; direction as the paragraph direction at the source, no matter
      ;; what is the paragraph direction at destination; and (2) avoid
      ;; affecting the visual order of the surrounding text at
      ;; destination if there are characters of different
      ;; directionality there.
      (concat (if (eq para-dir 'left-to-right) "\x2066" "\x2067")
	      substr "\x2069"))))

(defun buffer-substring-with-bidi-context (start end &optional no-properties)
  "Return portion of current buffer between START and END with bidi context.

This function works similar to `buffer-substring', but it prepends and
appends to the text bidi directional control characters necessary to
preserve the visual appearance of the text if it is inserted at another
place.  This is useful when the buffer substring includes bidirectional
text and control characters that cause non-trivial reordering on display.
If copied verbatim, such text can have a very different visual appearance,
and can also change the visual appearance of the surrounding text at the
destination of the copy.

Optional argument NO-PROPERTIES, if non-nil, means copy the text without
the text properties."
  (let (line-end substr)
    (if (or (< start (point-min))
	    (> end (point-max)))
	(signal 'args-out-of-range (list (current-buffer) start end)))
    (save-excursion
      (goto-char start)
      (setq line-end (min end (line-end-position)))
      (while (< start end)
	(setq substr
	      (concat substr
		      (if substr "\n" "")
		      (line-substring-with-bidi-context start line-end
							no-properties)))
	(forward-line 1)
	(setq start (point))
	(setq line-end (min end (line-end-position))))
      substr)))
\f
;; Yanking.

(defcustom yank-handled-properties
  '((font-lock-face . yank-handle-font-lock-face-property)
    (category . yank-handle-category-property))
  "List of special text property handling conditions for yanking.
Each element should have the form (PROP . FUN), where PROP is a
property symbol and FUN is a function.  When the `yank' command
inserts text into the buffer, it scans the inserted text for
stretches of text that have `eq' values of the text property
PROP; for each such stretch of text, FUN is called with three
arguments: the property's value in that text, and the start and
end positions of the text.

This is done prior to removing the properties specified by
`yank-excluded-properties'."
  :group 'killing
  :type '(repeat (cons (symbol :tag "property symbol")
                       function))
  :version "24.3")

;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
  '(category field follow-link fontified font-lock-face help-echo
    intangible invisible keymap local-map mouse-face read-only
    yank-handler)
  "Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties.

See also `yank-handled-properties'."
  :type '(choice (const :tag "All" t) (repeat symbol))
  :group 'killing
  :version "24.3")

(defvar yank-window-start nil)
(defvar yank-undo-function nil
  "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
Function is called with two parameters, START and END corresponding to
the value of the mark and point; it is guaranteed that START <= END.
Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")

(defun yank-pop (&optional arg)
  "Replace just-yanked stretch of killed text with a different stretch.
The main use of this command is immediately after a `yank' or a
`yank-pop'.  At such a time, the region contains a stretch of
reinserted (\"pasted\") previously-killed text.  `yank-pop' deletes
that text and inserts in its place a different stretch of killed text
by traversing the value of the `kill-ring' variable and selecting
another kill from there.

With no argument, the previous kill is inserted.
With argument N, insert the Nth previous kill.
If N is negative, it means to use a more recent kill.

The sequence of kills wraps around, so if you keep invoking this command
time after time, and pass the oldest kill, you get the newest one.

You can also invoke this command after a command other than `yank'
or `yank-pop'.  This is the same as invoking `yank-from-kill-ring',
including the effect of the prefix argument; see there for the details.

This command honors the `yank-handled-properties' and
`yank-excluded-properties' variables, and the `yank-handler' text
property, in the way that `yank' does."
  (interactive "p")
  (if (not (eq last-command 'yank))
      (yank-from-kill-ring (read-from-kill-ring "Yank from kill-ring: ")
                           current-prefix-arg)
    (setq this-command 'yank)
    (unless arg (setq arg 1))
    (let ((inhibit-read-only t)
          (before (< (point) (mark t))))
      (if before
          (funcall (or yank-undo-function 'delete-region) (point) (mark t))
        (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
      (setq yank-undo-function nil)
      (set-marker (mark-marker) (point) (current-buffer))
      (insert-for-yank (current-kill arg))
      ;; Set the window start back where it was in the yank command,
      ;; if possible.
      (set-window-start (selected-window) yank-window-start t)
      (if before
          ;; This is like exchange-point-and-mark, but doesn't activate the mark.
          ;; It is cleaner to avoid activation, even though the command
          ;; loop would deactivate the mark because we inserted text.
          (goto-char (prog1 (mark t)
                       (set-marker (mark-marker) (point) (current-buffer))))))
    nil))

(defun yank (&optional arg)
  "Reinsert (\"paste\") the last stretch of killed text.
More precisely, reinsert the most recent kill, which is the stretch of
text most recently killed OR yanked, as returned by `current-kill' (which
see).  Put point at the end, and set mark at the beginning without
activating it. With just \\[universal-argument] as argument, put point
at beginning, and mark at end.
With argument N, reinsert the Nth most recent kill.

This command honors the `yank-handled-properties' and
`yank-excluded-properties' variables, and the `yank-handler' text
property, as described below.

Properties listed in `yank-handled-properties' are processed,
then those listed in `yank-excluded-properties' are discarded.

If STRING has a non-nil `yank-handler' property anywhere, the
normal insert behavior is altered, and instead, for each contiguous
segment of STRING that has a given value of the `yank-handler'
property, that value is used as follows:

The value of a `yank-handler' property must be a list of one to four
elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
FUNCTION, if non-nil, should be a function of one argument (the
 object to insert); FUNCTION is called instead of `insert'.
PARAM, if present and non-nil, is passed to FUNCTION (to be handled
 in whatever way is appropriate; e.g. if FUNCTION is `yank-rectangle',
 PARAM may be a list of strings to insert as a rectangle).  If PARAM
 is nil, then the current segment of STRING is used.
If NOEXCLUDE is present and non-nil, the normal removal of
 `yank-excluded-properties' is not performed; instead FUNCTION is
 responsible for the removal.  This may be necessary if FUNCTION
 adjusts point before or after inserting the object.
UNDO, if present and non-nil, should be a function to be called
 by `yank-pop' to undo the insertion of the current PARAM.  It is
 given two arguments, the start and end of the region.  FUNCTION
 may set `yank-undo-function' to override UNDO.

See also the command `yank-pop' (\\[yank-pop])."
  (interactive "*P")
  (setq yank-window-start (window-start))
  ;; If we don't get all the way thru, make last-command indicate that
  ;; for the following command.
  (setq this-command t)
  (push-mark)
  (insert-for-yank (current-kill (cond
				  ((listp arg) 0)
				  ((eq arg '-) -2)
				  (t (1- arg)))))
  (if (consp arg)
      ;; This is like exchange-point-and-mark, but doesn't activate the mark.
      ;; It is cleaner to avoid activation, even though the command
      ;; loop would deactivate the mark because we inserted text.
      (goto-char (prog1 (mark t)
		   (set-marker (mark-marker) (point) (current-buffer)))))
  ;; If we do get all the way thru, make this-command indicate that.
  (if (eq this-command t)
      (setq this-command 'yank))
  nil)

(defun rotate-yank-pointer (arg)
  "Rotate the yanking point in the kill ring.
With ARG, rotate that many kills forward (or backward, if negative)."
  (interactive "p")
  (current-kill arg))

(defvar read-from-kill-ring-history)
(defun read-from-kill-ring (prompt)
  "Read a `kill-ring' entry using completion and minibuffer history.
PROMPT is a string to prompt with."
  ;; `current-kill' updates `kill-ring' with a possible interprogram-paste
  (current-kill 0)
  (let* ((history-add-new-input nil)
         (history-pos (when yank-from-kill-ring-rotate
                        (- (length kill-ring)
                           (length kill-ring-yank-pointer))))
         (ellipsis (if (char-displayable-p ?…) "…" "..."))
         ;; Remove keymaps from text properties of copied string,
         ;; because typing RET in the minibuffer might call
         ;; an irrelevant command from the map of copied string.
         (read-from-kill-ring-history
          (mapcar (lambda (s)
                    (remove-list-of-text-properties
                     0 (length s)
                     '(
                       keymap local-map action mouse-action
                       button category help-args)
                     s)
                    s)
                  kill-ring))
         (completions
          (mapcar (lambda (s)
                    (let* ((s (query-replace-descr s))
                           (b 0)
                           (limit (frame-text-cols)))
                      ;; Add ellipsis on leading whitespace
                      (when (string-match "\\`[[:space:]]+" s)
                        (setq b (match-end 0))
                        (add-text-properties 0 b `(display ,ellipsis) s))
                      ;; Add ellipsis at the end of a long string
                      (when (> (length s) (+ limit b))
                        (add-text-properties
                         (min (+ limit b) (length s)) (length s)
                         `(display ,ellipsis) s))
                      s))
                  read-from-kill-ring-history)))
    (minibuffer-with-setup-hook
        (lambda ()
          ;; Allow ‘SPC’ to be self-inserting
          (use-local-map
           (let ((map (make-sparse-keymap)))
             (set-keymap-parent map (current-local-map))
             (define-key map " " nil)
             (define-key map "?" nil)
             map)))
      (completing-read
       prompt
       (lambda (string pred action)
         (if (eq action 'metadata)
             ;; Keep sorted by recency
             '(metadata (display-sort-function . identity))
           (complete-with-action action completions string pred)))
       nil nil nil
       (if history-pos
           (cons 'read-from-kill-ring-history
                 (if (zerop history-pos) history-pos (1+ history-pos)))
         'read-from-kill-ring-history)))))

(defcustom yank-from-kill-ring-rotate t
  "Whether using `yank-from-kill-ring' should rotate `kill-ring-yank-pointer'.
If non-nil, the kill ring is rotated after selecting previously killed text."
  :type 'boolean
  :group 'killing
  :version "28.1")

(defun yank-from-kill-ring (string &optional arg)
  "Select a stretch of previously killed text and insert (\"paste\") it.
This command allows to choose one of the stretches of text killed
or yanked by previous commands, which are recorded in `kill-ring',
and reinsert the chosen kill at point.

This command prompts for a previously-killed text in the minibuffer.
Use the minibuffer history and search commands, or the minibuffer
completion commands, to select a previously-killed text.  In
particular, typing \\<minibuffer-local-completion-map>\\[minibuffer-complete] at the prompt will pop up a buffer showing
all the previously-killed stretches of text from which you can
choose the one you want to reinsert.
Once you select the text you want to reinsert, type \\<minibuffer-local-map>\\[exit-minibuffer] to actually
insert it and exit the minibuffer.
You can also edit the selected text in the minibuffer before
inserting it.

With \\[universal-argument] as argument, this command puts point at
beginning of the inserted text and mark at the end, like `yank' does.

When called from Lisp, insert STRING like `insert-for-yank' does."
  (interactive (list (read-from-kill-ring "Yank from kill-ring: ")
                     current-prefix-arg))
  (setq yank-window-start (window-start))
  (push-mark)
  (insert-for-yank string)
  (when yank-from-kill-ring-rotate
    (let ((pos (seq-position kill-ring string)))
      (if pos
          (setq kill-ring-yank-pointer (nthcdr pos kill-ring))
        (kill-new string))))
  (if (consp arg)
      ;; Swap point and mark like in `yank' and `yank-pop'.
      (goto-char (prog1 (mark t)
                   (set-marker (mark-marker) (point) (current-buffer))))))

\f
;; Some kill commands.

;; Internal subroutine of delete-char
(defun kill-forward-chars (arg)
  (if (listp arg) (setq arg (car arg)))
  (if (eq arg '-) (setq arg -1))
  (kill-region (point) (+ (point) arg)))

;; Internal subroutine of backward-delete-char
(defun kill-backward-chars (arg)
  (if (listp arg) (setq arg (car arg)))
  (if (eq arg '-) (setq arg -1))
  (kill-region (point) (- (point) arg)))

(defcustom backward-delete-char-untabify-method 'untabify
  "The method for untabifying when deleting backward.
Can be `untabify' -- turn a tab to many spaces, then delete one space;
       `hungry' -- delete all whitespace, both tabs and spaces;
       `all' -- delete all whitespace, including tabs, spaces and newlines;
       nil -- just delete one character."
  :type '(choice (const untabify) (const hungry) (const all) (const nil))
  :version "20.3"
  :group 'killing)

(defun backward-delete-char-untabify (arg &optional killp)
  "Delete characters backward, changing tabs into spaces.
The exact behavior depends on `backward-delete-char-untabify-method'.

Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.

If Transient Mark mode is enabled, the mark is active, and ARG is 1,
delete the text in the region and deactivate the mark instead.
To disable this, set option ‘delete-active-region’ to nil.

Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified."
  (interactive "*p\nP")
  (when (eq backward-delete-char-untabify-method 'untabify)
    (let ((count arg))
      (save-excursion
	(while (and (> count 0) (not (bobp)))
	  (if (= (preceding-char) ?\t)
	      (let ((col (current-column)))
		(forward-char -1)
		(setq col (- col (current-column)))
		(insert-char ?\s col)
		(delete-char 1)))
	  (forward-char -1)
	  (setq count (1- count))))))
  (let* ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
                     ((eq backward-delete-char-untabify-method 'all)
                      " \t\n\r")))
         (n (if skip
                (let* ((oldpt (point))
                       (wh (- oldpt (save-excursion
                                      (skip-chars-backward skip)
                                      (constrain-to-field nil oldpt)))))
                  (+ arg (if (zerop wh) 0 (1- wh))))
              arg)))
    ;; Avoid warning about delete-backward-char
    (with-no-warnings (delete-backward-char n killp))))

(defun char-uppercase-p (char)
  "Return non-nil if CHAR is an upper-case character.
If the Unicode tables are not yet available, e.g. during bootstrap,
then gives correct answers only for ASCII characters."
  (cond ((unicode-property-table-internal 'lowercase)
         (characterp (get-char-code-property char 'lowercase)))
        ((and (>= char ?A) (<= char ?Z)))))

(defun zap-to-char (arg char)
  "Kill up to and including ARGth occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
See also `zap-up-to-char'."
  (interactive (list (prefix-numeric-value current-prefix-arg)
		     (read-char-from-minibuffer "Zap to char: "
						nil 'read-char-history)))
  ;; Avoid "obsolete" warnings for translation-table-for-input.
  (with-no-warnings
    (if (char-table-p translation-table-for-input)
	(setq char (or (aref translation-table-for-input char) char))))
  (kill-region (point) (progn
			 (search-forward (char-to-string char) nil nil arg)
			 (point))))

;; kill-line and its subroutines.

(defcustom kill-whole-line nil
  "If non-nil, `kill-line' with no arg at start of line kills the whole line.
This variable also affects `kill-visual-line' in the same way as
it does `kill-line'."
  :type 'boolean
  :group 'killing)

(defun kill-line (&optional arg)
  "Kill the rest of the current line; if no nonblanks there, kill thru newline.
With prefix argument ARG, kill that many lines from point.
Negative arguments kill lines backward.
With zero argument, kills the text before point on the current line.

When calling from a program, nil means \"no arg\",
a number counts as a prefix arg.

To kill a whole line, when point is not at the beginning, type \
\\[move-beginning-of-line] \\[kill-line] \\[kill-line].

If `show-trailing-whitespace' is non-nil, this command will just
kill the rest of the current line, even if there are no nonblanks
there.

If option `kill-whole-line' is non-nil, then this command kills the whole line
including its terminating newline, when used at the beginning of a line
with no argument.  As a consequence, you can always kill a whole line
by typing \\[move-beginning-of-line] \\[kill-line].

If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].

If the buffer is read-only, Emacs will beep and refrain from deleting
the line, but put the line in the kill ring anyway.  This means that
you can use this command to copy text from a read-only buffer.
\(If the variable `kill-read-only-ok' is non-nil, then this won't
even beep.)"
  (interactive "P")
  (kill-region (point)
	       ;; It is better to move point to the other end of the kill
	       ;; before killing.  That way, in a read-only buffer, point
	       ;; moves across the text that is copied to the kill ring.
	       ;; The choice has no effect on undo now that undo records
	       ;; the value of point from before the command was run.
	       (progn
		 (if arg
		     (forward-visible-line (prefix-numeric-value arg))
		   (if (eobp)
		       (signal 'end-of-buffer nil))
		   (let ((end
			  (save-excursion
			    (end-of-visible-line) (point))))
		     (if (or (save-excursion
			       ;; If trailing whitespace is visible,
			       ;; don't treat it as nothing.
			       (unless show-trailing-whitespace
				 (skip-chars-forward " \t" end))
			       (= (point) end))
			     (and kill-whole-line (bolp)))
			 (forward-visible-line 1)
		       (goto-char end))))
		 (point))))

(defun kill-whole-line (&optional arg)
  "Kill current line.
With prefix ARG, kill that many lines starting from the current line.
If ARG is negative, kill backward.  Also kill the preceding newline.
\(This is meant to make \\[repeat] work well with negative arguments.)
If ARG is zero, kill current line but exclude the trailing newline."
  (interactive "p")
  (or arg (setq arg 1))
  (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
      (signal 'end-of-buffer nil))
  (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
      (signal 'beginning-of-buffer nil))
  (unless (eq last-command 'kill-region)
    (kill-new "")
    (setq last-command 'kill-region))
  (cond ((zerop arg)
	 ;; We need to kill in two steps, because the previous command
	 ;; could have been a kill command, in which case the text
	 ;; before point needs to be prepended to the current kill
	 ;; ring entry and the text after point appended.  Also, we
	 ;; need to use save-excursion to avoid copying the same text
	 ;; twice to the kill ring in read-only buffers.
	 (save-excursion
	   (kill-region (point) (progn (forward-visible-line 0) (point))))
	 (kill-region (point) (progn (end-of-visible-line) (point))))
	((< arg 0)
	 (save-excursion
	   (kill-region (point) (progn (end-of-visible-line) (point))))
	 (kill-region (point)
		      (progn (forward-visible-line (1+ arg))
			     (unless (bobp) (backward-char))
			     (point))))
	(t
	 (save-excursion
	   (kill-region (point) (progn (forward-visible-line 0) (point))))
	 (kill-region (point)
		      (progn (forward-visible-line arg) (point))))))

(defun forward-visible-line (arg)
  "Move forward by ARG lines, ignoring currently invisible newlines only.
If ARG is negative, move backward -ARG lines.
If ARG is zero, move to the beginning of the current line."
  (condition-case nil
      (if (> arg 0)
	  (progn
	    (while (> arg 0)
	      (or (zerop (forward-line 1))
		  (signal 'end-of-buffer nil))
	      ;; If the newline we just skipped is invisible,
	      ;; don't count it.
	      (if (invisible-p (1- (point)))
		  (setq arg (1+ arg)))
	      (setq arg (1- arg)))
	    ;; If invisible text follows, and it is a number of complete lines,
	    ;; skip it.
	    (let ((opoint (point)))
	      (while (and (not (eobp))
			  (invisible-p (point)))
		(goto-char
		 (if (get-text-property (point) 'invisible)
		     (or (next-single-property-change (point) 'invisible)
			 (point-max))
		   (next-overlay-change (point)))))
	      (unless (bolp)
		(goto-char opoint))))
	(let ((first t))
	  (while (or first (<= arg 0))
	    (if first
		(beginning-of-line)
	      (or (zerop (forward-line -1))
		  (signal 'beginning-of-buffer nil)))
	    ;; If the newline we just moved to is invisible,
	    ;; don't count it.
	    (unless (bobp)
	      (unless (invisible-p (1- (point)))
		(setq arg (1+ arg))))
	    (setq first nil))
	  ;; If invisible text follows, and it is a number of complete lines,
	  ;; skip it.
	  (let ((opoint (point)))
	    (while (and (not (bobp))
			(invisible-p (1- (point))))
	      (goto-char
	       (if (get-text-property (1- (point)) 'invisible)
		   (or (previous-single-property-change (point) 'invisible)
		       (point-min))
		 (previous-overlay-change (point)))))
	    (unless (bolp)
	      (goto-char opoint)))))
    ((beginning-of-buffer end-of-buffer)
     nil)))

(defun end-of-visible-line ()
  "Move to end of current visible line."
  (end-of-line)
  ;; If the following character is currently invisible,
  ;; skip all characters with that same `invisible' property value,
  ;; then find the next newline.
  (while (and (not (eobp))
	      (save-excursion
		(skip-chars-forward "^\n")
		(invisible-p (point))))
    (skip-chars-forward "^\n")
    (if (get-text-property (point) 'invisible)
	(goto-char (or (next-single-property-change (point) 'invisible)
		       (point-max)))
      (goto-char (next-overlay-change (point))))
    (end-of-line)))

(defun kill-current-buffer ()
  "Kill the current buffer.
When called in the minibuffer, get out of the minibuffer
using `abort-recursive-edit'.

This is like `kill-this-buffer', but it doesn't have to be invoked
via the menu bar, and pays no attention to the menu-bar's frame."
  (interactive)
  (let ((frame (selected-frame)))
    (if (and (frame-live-p frame)
             (not (window-minibuffer-p (frame-selected-window frame))))
        (kill-buffer (current-buffer))
      (abort-recursive-edit))))

\f
(defun insert-buffer (buffer)
  "Insert after point the contents of BUFFER.
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name."
  (declare (interactive-only insert-buffer-substring))
  (interactive
   (list
    (progn
      (barf-if-buffer-read-only)
      (read-buffer "Insert buffer: "
		   (if (eq (selected-window) (next-window))
		       (other-buffer (current-buffer))
		     (window-buffer (next-window)))
		   t))))
  (push-mark
   (save-excursion
     (insert-buffer-substring (get-buffer buffer))
     (point)))
  nil)

(defun append-to-buffer (buffer start end)
  "Append to specified BUFFER the text of the region.
The text is inserted into that buffer before its point.
BUFFER can be a buffer or the name of a buffer; this
function will create BUFFER if it doesn't already exist.

When calling from a program, give three arguments:
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
  (interactive
   (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
	 (region-beginning) (region-end)))
  (let* ((oldbuf (current-buffer))
         (append-to (get-buffer-create buffer))
         (windows (get-buffer-window-list append-to t t))
         point)
    (save-excursion
      (with-current-buffer append-to
        (setq point (point))
        (barf-if-buffer-read-only)
        (insert-buffer-substring oldbuf start end)
        (dolist (window windows)
          (when (= (window-point window) point)
            (set-window-point window (point))))))))

(defun prepend-to-buffer (buffer start end)
  "Prepend to specified BUFFER the text of the region.
The text is inserted into that buffer after its point.
BUFFER can be a buffer or the name of a buffer; this
function will create BUFFER if it doesn't already exist.

When calling from a program, give three arguments:
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
  (interactive "BPrepend to buffer: \nr")
  (let ((oldbuf (current-buffer)))
    (with-current-buffer (get-buffer-create buffer)
      (barf-if-buffer-read-only)
      (save-excursion
	(insert-buffer-substring oldbuf start end)))))

(defun copy-to-buffer (buffer start end)
  "Copy to specified BUFFER the text of the region.
The text is inserted into that buffer, replacing existing text there.
BUFFER can be a buffer or the name of a buffer; this
function will create BUFFER if it doesn't already exist.

When calling from a program, give three arguments:
BUFFER (or buffer name), START and END.
START and END specify the portion of the current buffer to be copied."
  (interactive "BCopy to buffer: \nr")
  (let ((oldbuf (current-buffer)))
    (with-current-buffer (get-buffer-create buffer)
      (barf-if-buffer-read-only)
      (erase-buffer)
      (save-excursion
	(insert-buffer-substring oldbuf start end)))))
\f
(define-error 'mark-inactive (purecopy "The mark is not active now"))

(defvar activate-mark-hook nil
  "Hook run when the mark becomes active.
It is also run when the region is reactivated, for instance after
using a command that switches back to a buffer that has an active
mark.")

(defvar deactivate-mark-hook nil
  "Hook run when the mark becomes inactive.")

(defun mark (&optional force)
  "Return this buffer's mark value as integer, or nil if never set.

In Transient Mark mode, this function signals an error if
the mark is not active.  However, if `mark-even-if-inactive' is non-nil,
or the argument FORCE is non-nil, it disregards whether the mark
is active, and returns an integer or nil in the usual way.

If you are using this in an editing command, you are most likely making
a mistake; see the documentation of `set-mark'."
  (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
      (marker-position (mark-marker))
    (signal 'mark-inactive nil)))

;; Behind display-selections-p.

(defun deactivate-mark (&optional force)
  "Deactivate the mark.
If Transient Mark mode is disabled, this function normally does
nothing; but if FORCE is non-nil, it deactivates the mark anyway.

Deactivating the mark sets `mark-active' to nil, updates the
primary selection according to `select-active-regions', and runs
`deactivate-mark-hook'.

If Transient Mark mode was temporarily enabled, reset the value
of the variable `transient-mark-mode'; if this causes Transient
Mark mode to be disabled, don't change `mark-active' to nil or
run `deactivate-mark-hook'."
  (when (or (region-active-p) force)
    (when (and (if (eq select-active-regions 'only)
		   (eq (car-safe transient-mark-mode) 'only)
		 select-active-regions)
	       (region-active-p)
	       (display-selections-p))
      ;; The var `saved-region-selection', if non-nil, is the text in
      ;; the region prior to the last command modifying the buffer.
      ;; Set the selection to that, or to the current region.
      (cond (saved-region-selection
	     (if (gui-backend-selection-owner-p 'PRIMARY)
		 (gui-set-selection 'PRIMARY saved-region-selection))
	     (setq saved-region-selection nil))
	    ;; If another program has acquired the selection, region
	    ;; deactivation should not clobber it (Bug#11772).
	    ((and (/= (region-beginning) (region-end))
		  (or (gui-backend-selection-owner-p 'PRIMARY)
		      (null (gui-backend-selection-exists-p 'PRIMARY))))
	     (gui-set-selection 'PRIMARY
                                (funcall region-extract-function nil)))))
    (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382).
    (cond
     ((eq (car-safe transient-mark-mode) 'only)
      (setq transient-mark-mode (cdr transient-mark-mode))
      (if (eq transient-mark-mode (default-value 'transient-mark-mode))
          (kill-local-variable 'transient-mark-mode)))
     ((eq transient-mark-mode 'lambda)
      (kill-local-variable 'transient-mark-mode)))
    (setq mark-active nil)
    (run-hooks 'deactivate-mark-hook)
    (redisplay--update-region-highlight (selected-window))))

(defun activate-mark (&optional no-tmm)
  "Activate the mark.
If NO-TMM is non-nil, leave `transient-mark-mode' alone."
  (when (mark t)
    (unless (region-active-p)
      (force-mode-line-update) ;Refresh toolbar (bug#16382).
      (setq mark-active t)
      (unless (or transient-mark-mode no-tmm)
        (setq-local transient-mark-mode 'lambda))
      (run-hooks 'activate-mark-hook))))

(defun set-mark (pos)
  "Set this buffer's mark to POS.  Don't use this function!
That is to say, don't use this function unless you want
the user to see that the mark has moved, and you want the previous
mark position to be lost.

Normally, when a new mark is set, the old one should go on the stack.
This is why most applications should use `push-mark', not `set-mark'.

Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes.  The mark saves a location for the user's convenience.
Most editing commands should not alter the mark.
To remember a location for internal use in the Lisp program,
store it in a Lisp variable.  Example:

   (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
  (if pos
      (progn
        (set-marker (mark-marker) pos (current-buffer))
        (activate-mark 'no-tmm))
    ;; Normally we never clear mark-active except in Transient Mark mode.
    ;; But when we actually clear out the mark value too, we must
    ;; clear mark-active in any mode.
    (deactivate-mark t)
    ;; `deactivate-mark' sometimes leaves mark-active non-nil, but
    ;; it should never be nil if the mark is nil.
    (setq mark-active nil)
    (set-marker (mark-marker) nil)))

(defun save-mark-and-excursion--save ()
  (cons
   (let ((mark (mark-marker)))
     (and (marker-position mark) (copy-marker mark)))
   mark-active))

(defun save-mark-and-excursion--restore (saved-mark-info)
  (let ((saved-mark (car saved-mark-info))
        (omark (marker-position (mark-marker)))
        (nmark nil)
        (saved-mark-active (cdr saved-mark-info)))
    ;; Mark marker
    (if (null saved-mark)
        (set-marker (mark-marker) nil)
      (setf nmark (marker-position saved-mark))
      (set-marker (mark-marker) nmark)
      (set-marker saved-mark nil))
    ;; Mark active
    (let ((cur-mark-active mark-active))
      (setq mark-active saved-mark-active)
      ;; If mark is active now, and either was not active or was at a
      ;; different place, run the activate hook.
      (if saved-mark-active
          (when (or (not cur-mark-active)
                    (not (eq omark nmark)))
            (run-hooks 'activate-mark-hook))
        ;; If mark has ceased to be active, run deactivate hook.
        (when cur-mark-active
          (run-hooks 'deactivate-mark-hook))))))

(defmacro save-mark-and-excursion (&rest body)
  "Like `save-excursion', but also save and restore the mark state.
This macro does what `save-excursion' did before Emacs 25.1."
  (declare (indent 0) (debug t))
  (let ((saved-marker-sym (make-symbol "saved-marker")))
    `(let ((,saved-marker-sym (save-mark-and-excursion--save)))
       (unwind-protect
            (save-excursion ,@body)
         (save-mark-and-excursion--restore ,saved-marker-sym)))))

(defcustom use-empty-active-region nil
  "Whether \"region-aware\" commands should act on empty regions.
If nil, region-aware commands treat the empty region as inactive.
If non-nil, region-aware commands treat the region as active as
long as the mark is active, even if the region is empty.

Region-aware commands are those that act on the region if it is
active and Transient Mark mode is enabled, and on the text near
point otherwise."
  :type 'boolean
  :version "23.1"
  :group 'editing-basics)

(defun use-region-p ()
  "Return t if the region is active and it is appropriate to act on it.
This is used by commands that act specially on the region under
Transient Mark mode.

The return value is t if Transient Mark mode is enabled and the
mark is active; furthermore, if `use-empty-active-region' is nil,
the region must not be empty.  Otherwise, the return value is nil.

For some commands, it may be appropriate to ignore the value of
`use-empty-active-region'; in that case, use `region-active-p'."
  (and (region-active-p)
       (or use-empty-active-region (> (region-end) (region-beginning)))
       t))

(defun region-active-p ()
  "Return t if Transient Mark mode is enabled and the mark is active.

Some commands act specially on the region when Transient Mark
mode is enabled.  Usually, such commands should use
`use-region-p' instead of this function, because `use-region-p'
also checks the value of `use-empty-active-region'."
  (and transient-mark-mode mark-active
       ;; FIXME: Somehow we sometimes end up with mark-active non-nil but
       ;; without the mark being set (e.g. bug#17324).  We really should fix
       ;; that problem, but in the mean time, let's make sure we don't say the
       ;; region is active when there's no mark.
       (progn (cl-assert (mark)) t)))

(defun region-bounds ()
  "Return the boundaries of the region.
Value is a list of one or more cons cells of the form (START . END).
It will have more than one cons cell when the region is non-contiguous,
see `region-noncontiguous-p' and `extract-rectangle-bounds'."
  (funcall region-extract-function 'bounds))

(defun region-noncontiguous-p ()
  "Return non-nil if the region contains several pieces.
An example is a rectangular region handled as a list of
separate contiguous regions for each line."
  (cdr (region-bounds)))

(defun redisplay--unhighlight-overlay-function (rol)
  "If ROL is an overlay, call `delete-overlay'."
  (when (overlayp rol) (delete-overlay rol)))

(defvar redisplay-unhighlight-region-function
  #'redisplay--unhighlight-overlay-function
  "Function to remove the region-highlight overlay.")

(defun redisplay--highlight-overlay-function (start end window rol &optional face)
  "Update the overlay ROL in WINDOW with FACE in range START-END."
  (unless face (setq face 'region))
  (if (not (overlayp rol))
      (let ((nrol (make-overlay start end)))
        (funcall redisplay-unhighlight-region-function rol)
        (overlay-put nrol 'window window)
        (overlay-put nrol 'face face)
        ;; Normal priority so that a large region doesn't hide all the
        ;; overlays within it, but high secondary priority so that if it
        ;; ends/starts in the middle of a small overlay, that small overlay
        ;; won't hide the region's boundaries.
        (overlay-put nrol 'priority '(nil . 100))
        nrol)
    (unless (eq (overlay-get rol 'face) face)
      (overlay-put rol 'face face))
    (unless (and (eq (overlay-buffer rol) (current-buffer))
                 (eq (overlay-start rol) start)
                 (eq (overlay-end rol) end))
      (move-overlay rol start end (current-buffer)))
    rol))

(defvar redisplay-highlight-region-function
  #'redisplay--highlight-overlay-function
  "Function to move the region-highlight overlay.
This function is called with four parameters, START, END, WINDOW
and OVERLAY.  If OVERLAY is nil, a new overlay is created.  In
any case, the overlay is adjusted to reflect the other three
parameters.

The overlay is returned by the function.")

(defun redisplay--update-region-highlight (window)
  (let ((rol (window-parameter window 'internal-region-overlay)))
    (if (not (and (region-active-p)
                  (or highlight-nonselected-windows
                      (eq window (selected-window))
                      (and (window-minibuffer-p)
                           (eq window (minibuffer-selected-window))))))
        (funcall redisplay-unhighlight-region-function rol)
      (let* ((pt (window-point window))
             (mark (mark))
             (start (min pt mark))
             (end   (max pt mark))
             (new
              (funcall redisplay-highlight-region-function
                       start end window rol)))
        (unless (equal new rol)
          (set-window-parameter window 'internal-region-overlay new))))))

(defcustom cursor-face-highlight-nonselected-window nil
  "Non-nil means highlight text with `cursor-face' even in nonselected windows.
This variable is similar to `highlight-nonselected-windows'."
  :local t
  :type 'boolean
  :version "29.1")

(defun redisplay--update-cursor-face-highlight (window)
  "Highlights the overlay used to highlight text with cursor-face."
  (let ((rol (window-parameter window 'internal-cursor-face-overlay)))
    (if-let* (((or cursor-face-highlight-nonselected-window
                   (eq window (selected-window))
                   (and (window-minibuffer-p)
                        (eq window (minibuffer-selected-window)))))
              (pt (window-point window))
              (cursor-face (get-text-property pt 'cursor-face)))
        (let* ((start (previous-single-property-change
                       (1+ pt) 'cursor-face nil (point-min)))
               (end (next-single-property-change
                     pt 'cursor-face nil (point-max)))
               (new (redisplay--highlight-overlay-function
                     start end window rol cursor-face)))
          (unless (equal new rol)
            (set-window-parameter window 'internal-cursor-face-overlay new)))
      (redisplay--unhighlight-overlay-function rol))))

(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
  "Hook run just before redisplay.
It is called in each window that is to be redisplayed.  It takes one argument,
which is the window that will be redisplayed.  When run, the `current-buffer'
is set to the buffer displayed in that window.")

(define-minor-mode cursor-face-highlight-mode
  "When enabled, respect the cursor-face property."
  :global nil
  (if cursor-face-highlight-mode
      (add-hook 'pre-redisplay-functions
                #'redisplay--update-cursor-face-highlight nil t)
    (remove-hook 'pre-redisplay-functions
                 #'redisplay--update-cursor-face-highlight t)))

(defun redisplay--pre-redisplay-functions (windows)
  (with-demoted-errors "redisplay--pre-redisplay-functions: %S"
    (if (null windows)
        (with-current-buffer (window-buffer (selected-window))
          (run-hook-with-args 'pre-redisplay-functions (selected-window)))
      (dolist (win (if (listp windows) windows (window-list-1 nil nil t)))
        (with-current-buffer (window-buffer win)
          (run-hook-with-args 'pre-redisplay-functions win))))))

(when (eq pre-redisplay-function #'ignore)
  ;; Override the default set in the C code.
  ;; This is not done using `add-function' so as to loosen the bootstrap
  ;; dependencies.
  (setq pre-redisplay-function #'redisplay--pre-redisplay-functions))

(defvar-local mark-ring nil
  "The list of former marks of the current buffer, most recent first.")
(put 'mark-ring 'permanent-local t)

(defcustom mark-ring-max 16
  "Maximum size of mark ring.  Start discarding off end if gets this big."
  :type 'integer
  :group 'editing-basics)

(defvar global-mark-ring nil
  "The list of saved global marks, most recent first.")

(defcustom global-mark-ring-max 16
  "Maximum size of global mark ring.  \
Start discarding off end if gets this big."
  :type 'integer
  :group 'editing-basics)

(defun pop-to-mark-command ()
  "Jump to mark, and pop a new position for mark off the ring.
\(Does not affect global mark ring)."
  (interactive)
  (if (null (mark t))
      (user-error "No mark set in this buffer")
    (if (= (point) (mark t))
	(message "Mark popped"))
    (goto-char (mark t))
    (pop-mark)))

(defun push-mark-command (arg &optional nomsg)
  "Set mark at where point is.
If no prefix ARG and mark is already set there, just activate it.
Display `Mark set' unless the optional second arg NOMSG is non-nil."
  (interactive "P")
  (let ((mark (mark t)))
    (if (or arg (null mark) (/= mark (point)))
	(push-mark nil nomsg t)
      (activate-mark 'no-tmm)
      (unless nomsg
	(message "Mark activated")))))

(defcustom set-mark-command-repeat-pop nil
  "Non-nil means repeating \\[set-mark-command] after popping mark pops it again.
That means that \\[universal-argument] \\[set-mark-command] \\[set-mark-command]
will pop the mark twice, and
\\[universal-argument] \\[set-mark-command] \\[set-mark-command] \\[set-mark-command]
will pop the mark three times.

A value of nil means \\[set-mark-command]'s behavior does not change
after \\[universal-argument] \\[set-mark-command]."
  :type 'boolean
  :group 'editing-basics)

(defun set-mark-command (arg)
  "Set the mark where point is, and activate it; or jump to the mark.
Setting the mark also alters the region, which is the text
between point and mark; this is the closest equivalent in
Emacs to what some editors call the \"selection\".

With no prefix argument, set the mark at point, and push the
old mark position on local mark ring.  Also push the new mark on
global mark ring, if the previous mark was set in another buffer.

When Transient Mark Mode is off, immediately repeating this
command activates `transient-mark-mode' temporarily.

With prefix argument (e.g., \\[universal-argument] \\[set-mark-command]), \
jump to the mark, and set the mark from
position popped off the local mark ring (this does not affect the global
mark ring).  Use \\[pop-global-mark] to jump to a mark popped off the global
mark ring (see `pop-global-mark').

If `set-mark-command-repeat-pop' is non-nil, repeating
the \\[set-mark-command] command with no prefix argument pops the next position
off the local (or global) mark ring and jumps there.

With \\[universal-argument] \\[universal-argument] as prefix
argument, unconditionally set mark where point is, even if
`set-mark-command-repeat-pop' is non-nil.

Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes.  See the documentation of `set-mark' for more information."
  (interactive "P")
  (cond ((eq transient-mark-mode 'lambda)
	 (kill-local-variable 'transient-mark-mode))
	((eq (car-safe transient-mark-mode) 'only)
	 (deactivate-mark)))
  (cond
   ((and (consp arg) (> (prefix-numeric-value arg) 4))
    (push-mark-command nil))
   ((not (eq this-command 'set-mark-command))
    (if arg
	(pop-to-mark-command)
      (push-mark-command t)))
   ((and set-mark-command-repeat-pop
	 (eq last-command 'pop-global-mark)
	 (not arg))
    (setq this-command 'pop-global-mark)
    (pop-global-mark))
   ((or (and set-mark-command-repeat-pop
             (eq last-command 'pop-to-mark-command))
        arg)
    (setq this-command 'pop-to-mark-command)
    (pop-to-mark-command))
   ((eq last-command 'set-mark-command)
    (if (region-active-p)
        (progn
          (deactivate-mark)
          (message "Mark deactivated"))
      (activate-mark)
      (message "Mark activated")))
   (t
    (push-mark-command nil))))

(defun push-mark (&optional location nomsg activate)
  "Set mark at LOCATION (point, by default) and push old mark on mark ring.
If the last global mark pushed was not in the current buffer,
also push LOCATION on the global mark ring.
Display `Mark set' unless the optional second arg NOMSG is non-nil.

Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes.  See the documentation of `set-mark' for more information.

In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil."
  (when (mark t)
    (let ((old (nth mark-ring-max mark-ring))
          (history-delete-duplicates nil))
      (add-to-history 'mark-ring (copy-marker (mark-marker)) mark-ring-max t)
      (when old
        (set-marker old nil))))
  (set-marker (mark-marker) (or location (point)) (current-buffer))
  ;; Don't push the mark on the global mark ring if the last global
  ;; mark pushed was in this same buffer.
  (unless (and global-mark-ring
               (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
    (let ((old (nth global-mark-ring-max global-mark-ring))
          (history-delete-duplicates nil))
      (add-to-history
       'global-mark-ring (copy-marker (mark-marker)) global-mark-ring-max t)
      (when old
        (set-marker old nil))))
  (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
      (message "Mark set"))
  (if (or activate (not transient-mark-mode))
      (set-mark (mark t)))
  nil)

(defun pop-mark ()
  "Pop off mark ring into the buffer's actual mark.
Does not set point.  Does nothing if mark ring is empty."
  (when mark-ring
    (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
    (set-marker (mark-marker) (car mark-ring))
    (set-marker (car mark-ring) nil)
    (pop mark-ring))
  (deactivate-mark))

(defun exchange-point-and-mark (&optional arg)
  "Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
and it reactivates the mark.

If Transient Mark mode is on, a prefix ARG deactivates the mark
if it is active, and otherwise avoids reactivating it.  If
Transient Mark mode is off, a prefix ARG enables Transient Mark
mode temporarily."
  (interactive "P")
  (let ((omark (mark t))
	(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
    (if (null omark)
        (user-error "No mark set in this buffer"))
    (set-mark (point))
    (goto-char omark)
    (or temp-highlight
        (cond ((xor arg (not (region-active-p)))
	       (deactivate-mark))
	      (t (activate-mark))))
    nil))

(defcustom shift-select-mode t
  "When non-nil, shifted motion keys activate the mark momentarily.

While the mark is activated in this way, any shift-translated point
motion key extends the region, and if Transient Mark mode was off, it
is temporarily turned on.  Furthermore, the mark will be deactivated
by any subsequent point motion key that was not shift-translated, or
by any action that normally deactivates the mark in Transient Mark mode.

When the value is `permanent', the mark will be deactivated by any
action which normally does that, but not by motion keys that were
not shift-translated.

See `this-command-keys-shift-translated' for the meaning of
shift-translation."
  :type '(choice (const :tag "Off" nil)
                 (const :tag "Permanent" permanent)
                 (other :tag "On" t))
  :version "28.1"
  :group 'editing-basics)

(defun handle-shift-selection ()
  "Activate/deactivate mark depending on invocation thru shift translation.
This function is called by `call-interactively' when a command
with a `^' character in its `interactive' spec is invoked, before
running the command itself.

If `shift-select-mode' is enabled and the command was invoked
through shift translation, set the mark and activate the region
temporarily, unless it was already set in this way.  See
`this-command-keys-shift-translated' for the meaning of shift
translation.

Otherwise, if the region has been activated temporarily,
deactivate it, and restore the variable `transient-mark-mode' to
its earlier value."
  (cond ((and (eq shift-select-mode 'permanent)
              this-command-keys-shift-translated)
         (unless mark-active
           (push-mark nil nil t)))
        ((and shift-select-mode
              this-command-keys-shift-translated)
         (unless (and mark-active
		      (eq (car-safe transient-mark-mode) 'only))
	   (setq-local transient-mark-mode
                       (cons 'only
                             (unless (eq transient-mark-mode 'lambda)
                               transient-mark-mode)))
           (push-mark nil nil t)))
        ((eq (car-safe transient-mark-mode) 'only)
         (setq transient-mark-mode (cdr transient-mark-mode))
         (if (eq transient-mark-mode (default-value 'transient-mark-mode))
             (kill-local-variable 'transient-mark-mode))
         (deactivate-mark))))

(define-minor-mode transient-mark-mode
  "Toggle Transient Mark mode.

Transient Mark mode is a global minor mode.  When enabled, the
region is highlighted with the `region' face whenever the mark
is active.  The mark is \"deactivated\" after certain non-motion
commands, including those that change the text in the buffer, and
during shift or mouse selection by any unshifted cursor motion
command (see Info node `Shift Selection' for more details).

You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].

Many commands change their behavior when Transient Mark mode is
in effect and the mark is active, by acting on the region instead
of their usual default part of the buffer's text.  Examples of
such commands include \\[comment-dwim], \\[flush-lines], \\[keep-lines],
\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo].
To see the documentation of commands that are sensitive to the
Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\"
or \"mark.*active\" at the prompt."
  :global t
  ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
  :variable (default-value 'transient-mark-mode))

(define-minor-mode indent-tabs-mode
  "Toggle whether indentation can insert TAB characters."
  :global t :group 'indent :variable indent-tabs-mode)

(defvar widen-automatically t
  "Non-nil means it is ok for commands to call `widen' when they want to.
Some commands will do this in order to go to positions outside
the current accessible part of the buffer.

If `widen-automatically' is nil, these commands will do something else
as a fallback, and won't change the buffer bounds.")

(defvar non-essential nil
  "Whether the currently executing code is performing an essential task.
This variable should be non-nil only when running code that should not
disturb the user.  E.g., it can be used to prevent Tramp from prompting
the user for a password when we are simply scanning a set of files in the
background or displaying possible completions before the user even asked
for it.")

(defun pop-global-mark ()
  "Pop off global mark ring and jump to the top location."
  (interactive)
  ;; Pop entries that refer to non-existent buffers.
  (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
    (setq global-mark-ring (cdr global-mark-ring)))
  (or global-mark-ring
      (error "No global mark set"))
  (let* ((marker (car global-mark-ring))
	 (buffer (marker-buffer marker))
	 (position (marker-position marker)))
    (setq global-mark-ring (nconc (cdr global-mark-ring)
				  (list (car global-mark-ring))))
    (set-buffer buffer)
    (or (and (>= position (point-min))
	     (<= position (point-max)))
	(if widen-automatically
	    (widen)
	  (error "Global mark position is outside accessible part of buffer %s"
                 (buffer-name buffer))))
    (goto-char position)
    (switch-to-buffer buffer)))
\f
(defcustom next-line-add-newlines nil
  "If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
  :type 'boolean
  :version "21.1"
  :group 'editing-basics)

(defun next-line (&optional arg try-vscroll)
  "Move cursor vertically down ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
function will not vscroll.

ARG defaults to 1.

If there is no character in the target line exactly under the current column,
the cursor is positioned after the character in that line that spans this
column, or at the end of the line if it is not long enough.
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line.  Otherwise it moves the
cursor to the end of the buffer.

If the variable `line-move-visual' is non-nil, this command moves
by display lines.  Otherwise, it moves by buffer lines, without
taking variable-width characters or continued lines into account.
See \\[next-logical-line] for a command that always moves by buffer lines.

The command \\[set-goal-column] can be used to create
a semipermanent goal column for this command.
Then instead of trying to move exactly vertically (or as close as possible),
this command moves to the specified goal column (or as close as possible).
The goal column is stored in the variable `goal-column', which is nil
when there is no goal column.  Note that setting `goal-column'
overrides `line-move-visual' and causes this command to move by buffer
lines rather than by display lines."
  (declare (interactive-only forward-line))
  (interactive "^p\np")
  (or arg (setq arg 1))
  (if (and next-line-add-newlines (= arg 1))
      (if (save-excursion (end-of-line) (eobp))
	  ;; When adding a newline, don't expand an abbrev.
	  (let ((abbrev-mode nil))
	    (end-of-line)
	    (insert (if use-hard-newlines hard-newline "\n")))
	(line-move arg nil nil try-vscroll))
    (if (called-interactively-p 'interactive)
	(condition-case err
	    (line-move arg nil nil try-vscroll)
	  ((beginning-of-buffer end-of-buffer)
	   (signal (car err) (cdr err))))
      (line-move arg nil nil try-vscroll)))
  nil)

(defun previous-line (&optional arg try-vscroll)
  "Move cursor vertically up ARG lines.
Interactively, vscroll tall lines if `auto-window-vscroll' is enabled.
Non-interactively, use TRY-VSCROLL to control whether to vscroll tall
lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this
function will not vscroll.

ARG defaults to 1.

If there is no character in the target line exactly over the current column,
the cursor is positioned after the character in that line that spans this
column, or at the end of the line if it is not long enough.

If the variable `line-move-visual' is non-nil, this command moves
by display lines.  Otherwise, it moves by buffer lines, without
taking variable-width characters or continued lines into account.
See \\[previous-logical-line] for a command that always moves by buffer lines.

The command \\[set-goal-column] can be used to create
a semipermanent goal column for this command.
Then instead of trying to move exactly vertically (or as close as possible),
this command moves to the specified goal column (or as close as possible).
The goal column is stored in the variable `goal-column', which is nil
when there is no goal column.  Note that setting `goal-column'
overrides `line-move-visual' and causes this command to move by buffer
lines rather than by display lines."
  (declare (interactive-only
            "use `forward-line' with negative argument instead."))
  (interactive "^p\np")
  (or arg (setq arg 1))
  (if (called-interactively-p 'interactive)
      (condition-case err
	  (line-move (- arg) nil nil try-vscroll)
	((beginning-of-buffer end-of-buffer)
	 (signal (car err) (cdr err))))
    (line-move (- arg) nil nil try-vscroll))
  nil)

(defcustom track-eol nil
  "Non-nil means vertical motion starting at end of line keeps to ends of lines.
This means moving to the end of each line moved onto.
The beginning of a blank line does not count as the end of a line.
This has no effect when the variable `line-move-visual' is non-nil."
  :type 'boolean
  :group 'editing-basics)

(defcustom goal-column nil
  "Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.
A non-nil setting overrides the variable `line-move-visual', which see."
  :type '(choice integer
		 (const :tag "None" nil))
  :group 'editing-basics)
(make-variable-buffer-local 'goal-column)

(defvar temporary-goal-column 0
  "Current goal column for vertical motion.
It is the column where point was at the start of the current run
of vertical motion commands.

When moving by visual lines via the function `line-move-visual', it is a cons
cell (COL . HSCROLL), where COL is the x-position, in pixels,
divided by the default column width, and HSCROLL is the number of
columns by which window is scrolled from left margin.

When the `track-eol' feature is doing its job, the value is
`most-positive-fixnum'.")

(defcustom line-move-ignore-invisible t
  "Non-nil means commands that move by lines ignore invisible newlines.
When this option is non-nil, \\[next-line], \\[previous-line], \\[move-end-of-line], and \\[move-beginning-of-line] behave
as if newlines that are invisible didn't exist, and count
only visible newlines.  Thus, moving across 2 newlines
one of which is invisible will be counted as a one-line move.
Also, a non-nil value causes invisible text to be ignored when
counting columns for the purposes of keeping point in the same
column by \\[next-line] and \\[previous-line].

Outline mode sets this."
  :type 'boolean
  :group 'editing-basics)

(defcustom line-move-visual t
  "When non-nil, `line-move' moves point by visual lines.
This movement is based on where the cursor is displayed on the
screen, instead of relying on buffer contents alone.  It takes
into account variable-width characters and line continuation.
If nil, `line-move' moves point by logical lines.
A non-nil setting of `goal-column' overrides the value of this variable
and forces movement by logical lines.
A window that is horizontally scrolled also forces movement by logical
lines."
  :type 'boolean
  :group 'editing-basics
  :version "23.1")

;; Used only if display-graphic-p.
(declare-function font-info "font.c" (name &optional frame))

(defun default-font-height ()
  "Return the height in pixels of the current buffer's default face font.

If the default font is remapped (see `face-remapping-alist'), the
function returns the height of the remapped face.
This function uses the definition of the default face for the currently
selected frame."
  (let ((default-font (face-font 'default)))
    (cond
     ((and (display-multi-font-p)
	   ;; Avoid calling font-info if the frame's default font was
	   ;; not changed since the frame was created.  That's because
	   ;; font-info is expensive for some fonts, see bug #14838.
	   (not (string= (frame-parameter nil 'font) default-font)))
      (aref (font-info default-font) 3))
     (t (frame-char-height)))))

(defun default-font-width ()
  "Return the width in pixels of the current buffer's default face font.

If the default font is remapped (see `face-remapping-alist'), the
function returns the width of the remapped face.
This function uses the definition of the default face for the currently
selected frame."
  (let ((default-font (face-font 'default)))
    (cond
     ((and (display-multi-font-p)
	   ;; Avoid calling font-info if the frame's default font was
	   ;; not changed since the frame was created.  That's because
	   ;; font-info is expensive for some fonts, see bug #14838.
	   (not (string= (frame-parameter nil 'font) default-font)))
      (let* ((info (font-info (face-font 'default)))
	     (width (aref info 11)))
	(if (> width 0)
	    width
	  (aref info 10))))
     (t (frame-char-width)))))

(defun default-line-height ()
  "Return the pixel height of current buffer's default-face text line.

The value includes `line-spacing', if any, defined for the buffer
or the frame.
This function uses the definition of the default face for the currently
selected frame."
  (let ((dfh (default-font-height))
	(lsp (if (display-graphic-p)
		 (or line-spacing
		     (default-value 'line-spacing)
		     (frame-parameter nil 'line-spacing)
		     0)
	       0)))
    (if (floatp lsp)
	(setq lsp (truncate (* (frame-char-height) lsp))))
    (+ dfh lsp)))

(defun window-screen-lines ()
  "Return the number of screen lines in the text area of the selected window.

This is different from `window-text-height' in that this function counts
lines in units of the height of the font used by the default face displayed
in the window, not in units of the frame's default font, and also accounts
for `line-spacing', if any, defined for the window's buffer or frame.

The value is a floating-point number."
  (let ((edges (window-inside-pixel-edges))
	(dlh (default-line-height)))
    (/ (float (- (nth 3 edges) (nth 1 edges))) dlh)))

;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror &optional _to-end)
  (if (< arg 0)
      ;; Move backward (up).
      ;; If already vscrolled, reduce vscroll
      (let ((vs (window-vscroll nil t))
	    (dlh (default-line-height)))
	(when (> vs dlh)
	  (set-window-vscroll nil (- vs dlh) t)))

    ;; Move forward (down).
    (let* ((lh (window-line-height -1))
	   (rowh (car lh))
	   (vpos (nth 1 lh))
	   (ypos (nth 2 lh))
	   (rbot (nth 3 lh))
	   (this-lh (window-line-height))
	   (this-height (car this-lh))
	   (this-ypos (nth 2 this-lh))
	   (dlh (default-line-height))
	   (wslines (window-screen-lines))
	   (edges (window-inside-pixel-edges))
	   (winh (- (nth 3 edges) (nth 1 edges) 1))
	   py vs last-line)
      (if (> (mod wslines 1.0) 0.0)
	  (setq wslines (round (+ wslines 0.5))))
      (when (or (null lh)
		(>= rbot dlh)
		(<= ypos (- dlh))
		(null this-lh)
		(<= this-ypos (- dlh)))
	(unless lh
	  (let ((wend (pos-visible-in-window-p t nil t)))
	    (setq rbot (nth 3 wend)
		  rowh  (nth 4 wend)
		  vpos (nth 5 wend))))
	(unless this-lh
	  (let ((wstart (pos-visible-in-window-p nil nil t)))
	    (setq this-ypos (nth 2 wstart)
		  this-height (nth 4 wstart))))
	(setq py
	      (or (nth 1 this-lh)
		  (let ((ppos (posn-at-point))
			col-row)
		    (setq col-row (posn-actual-col-row ppos))
		    (if col-row
			(- (cdr col-row) (window-vscroll))
		      (cdr (posn-col-row ppos))))))
	;; VPOS > 0 means the last line is only partially visible.
	;; But if the part that is visible is at least as tall as the
	;; default font, that means the line is actually fully
	;; readable, and something like line-spacing is hidden.  So in
	;; that case we accept the last line in the window as still
	;; visible, and consider the margin as starting one line
	;; later.
	(if (and vpos (> vpos 0))
	    (if (and rowh
		     (>= rowh (default-font-height))
		     (< rowh dlh))
		(setq last-line (min (- wslines scroll-margin) vpos))
	      (setq last-line (min (- wslines scroll-margin 1) (1- vpos)))))
	(cond
	 ;; If last line of window is fully visible, and vscrolling
	 ;; more would make this line invisible, move forward.
	 ((and (or (< (setq vs (window-vscroll nil t)) dlh)
		   (null this-height)
		   (<= this-height dlh))
	       (or (null rbot) (= rbot 0)))
	  nil)
	 ;; If cursor is not in the bottom scroll margin, and the
	 ;; current line is not too tall, or if there's a continuation
	 ;; line below this one, move forward.
	 ((and (or (null this-height) (<= this-height winh))
	       vpos
	       (> vpos 0)
	       (or (< py last-line)
                   (display--line-is-continued-p)))
	  nil)
	 ;; When already vscrolled, we vscroll some more if we can,
	 ;; or clear vscroll and move forward at end of tall image.
	 ((> vs 0)
	  (when (or (and rbot (> rbot 0))
		    (and this-height (> this-height dlh)))
	    (set-window-vscroll nil (+ vs dlh) t)))
	 ;; If cursor just entered the bottom scroll margin, move forward,
	 ;; but also optionally vscroll one line so redisplay won't recenter.
	 ((and vpos
	       (> vpos 0)
	       (= py last-line))
	  ;; Don't vscroll if the partially-visible line at window
	  ;; bottom is not too tall (a.k.a. "just one more text
	  ;; line"): in that case, we do want redisplay to behave
	  ;; normally, i.e. recenter or whatever.
	  ;;
	  ;; Note: ROWH + RBOT from the value returned by
	  ;; pos-visible-in-window-p give the total height of the
	  ;; partially-visible glyph row at the end of the window.  As
	  ;; we are dealing with floats, we disregard sub-pixel
	  ;; discrepancies between that and DLH.
	  (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
	      (set-window-vscroll nil dlh t))
	  (line-move-1 arg noerror)
	  t)
	 ;; If there are lines above the last line, scroll-up one line.
	 ((and vpos (> vpos 0))
	  (scroll-up 1)
	  t)
	 ;; Finally, start vscroll.
	 (t
	  (set-window-vscroll nil dlh t)))))))


;; This is like line-move-1 except that it also performs
;; vertical scrolling of tall images if appropriate.
;; That is not really a clean thing to do, since it mixes
;; scrolling with cursor motion.  But so far we don't have
;; a cleaner solution to the problem of making C-n do something
;; useful given a tall image.
(defun line-move (arg &optional noerror _to-end try-vscroll)
  "Move forward ARG lines.
If NOERROR, don't signal an error if we can't move ARG lines.
TO-END is unused.
TRY-VSCROLL controls whether to vscroll tall lines: if either
`auto-window-vscroll' or TRY-VSCROLL is nil, this function will
not vscroll."
  (if noninteractive
      (line-move-1 arg noerror)
    (unless (and auto-window-vscroll try-vscroll
		 ;; Only vscroll for single line moves
		 (= (abs arg) 1)
		 ;; Under scroll-conservatively, the display engine
		 ;; does this better.
		 (zerop scroll-conservatively)
		 ;; But don't vscroll in a keyboard macro.
		 (not defining-kbd-macro)
		 (not executing-kbd-macro)
		 (line-move-partial arg noerror))
      (set-window-vscroll nil 0 t)
      (if (and line-move-visual
	       ;; Display-based column are incompatible with goal-column.
	       (not goal-column)
	       ;; When the text in the window is scrolled to the left,
	       ;; display-based motion doesn't make sense (because each
	       ;; logical line occupies exactly one screen line).
	       (not (> (window-hscroll) 0))
	       ;; Likewise when the text _was_ scrolled to the left
	       ;; when the current run of vertical motion commands
	       ;; started.
	       (not (and (memq last-command
			       `(next-line previous-line ,this-command))
			 auto-hscroll-mode
			 (numberp temporary-goal-column)
			 (>= temporary-goal-column
			    (- (window-width) hscroll-margin)))))
	  (prog1 (line-move-visual arg noerror)
	    ;; If we moved into a tall line, set vscroll to make
	    ;; scrolling through tall images more smooth.
	    (let ((lh (line-pixel-height))
		  (edges (window-inside-pixel-edges))
		  (dlh (default-line-height))
		  winh)
	      (setq winh (- (nth 3 edges) (nth 1 edges) 1))
	      (if (and (< arg 0)
		       (< (point) (window-start))
		       (> lh winh))
		  (set-window-vscroll
		   nil
		   (- lh dlh) t))))
	(line-move-1 arg noerror)))))

;; Display-based alternative to line-move-1.
;; Arg says how many lines to move.  The value is t if we can move the
;; specified number of lines.
(defun line-move-visual (arg &optional noerror)
  "Move ARG lines forward.
If NOERROR, don't signal an error if we can't move that many lines."
  (let ((opoint (point))
	(hscroll (window-hscroll))
        (lnum-width (line-number-display-width t))
	target-hscroll)
    ;; Check if the previous command was a line-motion command, or if
    ;; we were called from some other command.
    (if (and (consp temporary-goal-column)
	     (memq last-command `(next-line previous-line ,this-command)))
	;; If so, there's no need to reset `temporary-goal-column',
	;; but we may need to hscroll.
        (if (or (/= (cdr temporary-goal-column) hscroll)
                (>  (cdr temporary-goal-column) 0))
            (setq target-hscroll (cdr temporary-goal-column)))
      ;; Otherwise, we should reset `temporary-goal-column'.
      (let ((posn (posn-at-point))
	    x-pos)
	(cond
	 ;; Handle the `overflow-newline-into-fringe' case
	 ;; (left-fringe is for the R2L case):
	 ((memq (nth 1 posn) '(right-fringe left-fringe))
	  (setq temporary-goal-column (cons (window-width) hscroll)))
	 ((car (posn-x-y posn))
	  (setq x-pos (- (car (posn-x-y posn)) lnum-width))
	  ;; In R2L lines, the X pixel coordinate is measured from the
	  ;; left edge of the window, but columns are still counted
	  ;; from the logical-order beginning of the line, i.e. from
	  ;; the right edge in this case.  We need to adjust for that.
	  (if (eq (current-bidi-paragraph-direction) 'right-to-left)
	      (setq x-pos (- (window-body-width nil t) 1 x-pos)))
	  (setq temporary-goal-column
		(cons (/ (float x-pos)
			 (frame-char-width))
                      hscroll)))
	 (executing-kbd-macro
	  ;; When we move beyond the first/last character visible in
	  ;; the window, posn-at-point will return nil, so we need to
	  ;; approximate the goal column as below.
	  (setq temporary-goal-column
		(mod (current-column) (window-text-width)))))))
    (if target-hscroll
	(set-window-hscroll (selected-window) target-hscroll))
    ;; vertical-motion can move more than it was asked to if it moves
    ;; across display strings with newlines.  We don't want to ring
    ;; the bell and announce beginning/end of buffer in that case.
    (or (and (or (and (>= arg 0)
		      (>= (vertical-motion
			   (cons (or goal-column
				     (if (consp temporary-goal-column)
					 (car temporary-goal-column)
				       temporary-goal-column))
				 arg))
			  arg))
		 (and (< arg 0)
		      (<= (vertical-motion
			   (cons (or goal-column
				     (if (consp temporary-goal-column)
					 (car temporary-goal-column)
				       temporary-goal-column))
				 arg))
			  arg)))
	     (or (>= arg 0)
		 (/= (point) opoint)
		 ;; If the goal column lies on a display string,
		 ;; `vertical-motion' advances the cursor to the end
		 ;; of the string.  For arg < 0, this can cause the
		 ;; cursor to get stuck.  (Bug#3020).
		 (= (vertical-motion arg) arg)))
	(unless noerror
	  (signal (if (< arg 0) 'beginning-of-buffer 'end-of-buffer)
		  nil)))))

;; This is the guts of next-line and previous-line.
;; Arg says how many lines to move.
;; The value is t if we can move the specified number of lines.
(defun line-move-1 (arg &optional noerror _to-end)
  ;; Don't run any point-motion hooks, and disregard intangibility,
  ;; for intermediate positions.
  (let ((inhibit-point-motion-hooks t)
	(opoint (point))
	(orig-arg arg))
    (if (consp temporary-goal-column)
	(setq temporary-goal-column (+ (car temporary-goal-column)
				       (cdr temporary-goal-column))))
    (unwind-protect
	(progn
	  (if (not (memq last-command '(next-line previous-line)))
	      (setq temporary-goal-column
		    (if (and track-eol (eolp)
			     ;; Don't count beg of empty line as end of line
			     ;; unless we just did explicit end-of-line.
			     (or (not (bolp)) (eq last-command 'move-end-of-line)))
			most-positive-fixnum
		      (current-column))))

	  (if (not (or (integerp selective-display)
                       line-move-ignore-invisible))
	      ;; Use just newline characters.
	      ;; Set ARG to 0 if we move as many lines as requested.
	      (or (if (> arg 0)
		      (progn (if (> arg 1) (forward-line (1- arg)))
			     ;; This way of moving forward ARG lines
			     ;; verifies that we have a newline after the last one.
			     ;; It doesn't get confused by intangible text.
			     (end-of-line)
			     (if (zerop (forward-line 1))
				 (setq arg 0)))
		    (and (zerop (forward-line arg))
			 (bolp)
			 (setq arg 0)))
		  (unless noerror
		    (signal (if (< arg 0)
				'beginning-of-buffer
			      'end-of-buffer)
			    nil)))
	    ;; Move by arg lines, but ignore invisible ones.
	    (let (done)
	      (while (and (> arg 0) (not done))
		;; If the following character is currently invisible,
		;; skip all characters with that same `invisible' property value.
		(while (and (not (eobp)) (invisible-p (point)))
		  (goto-char (next-char-property-change (point))))
		;; Move a line.
		;; We don't use `end-of-line', since we want to escape
		;; from field boundaries occurring exactly at point.
		(goto-char (constrain-to-field
			    (let ((inhibit-field-text-motion t))
			      (line-end-position))
			    (point) t t
			    'inhibit-line-move-field-capture))
		;; If there's no invisibility here, move over the newline.
		(cond
		 ((eobp)
		  (if (not noerror)
		      (signal 'end-of-buffer nil)
		    (setq done t)))
		 ((and (> arg 1)  ;; Use vertical-motion for last move
		       (not (integerp selective-display))
		       (not (invisible-p (point))))
		  ;; We avoid vertical-motion when possible
		  ;; because that has to fontify.
		  (forward-line 1))
		 ;; Otherwise move a more sophisticated way.
		 ((zerop (vertical-motion 1))
		  (if (not noerror)
		      (signal 'end-of-buffer nil)
		    (setq done t))))
		(unless done
		  (setq arg (1- arg))))
	      ;; The logic of this is the same as the loop above,
	      ;; it just goes in the other direction.
	      (while (and (< arg 0) (not done))
		;; For completely consistency with the forward-motion
		;; case, we should call beginning-of-line here.
		;; However, if point is inside a field and on a
		;; continued line, the call to (vertical-motion -1)
		;; below won't move us back far enough; then we return
		;; to the same column in line-move-finish, and point
		;; gets stuck -- cyd
		(forward-line 0)
		(cond
		 ((bobp)
		  (if (not noerror)
		      (signal 'beginning-of-buffer nil)
		    (setq done t)))
		 ((and (< arg -1) ;; Use vertical-motion for last move
		       (not (integerp selective-display))
		       (not (invisible-p (1- (point)))))
		  (forward-line -1))
		 ((zerop (vertical-motion -1))
		  (if (not noerror)
		      (signal 'beginning-of-buffer nil)
		    (setq done t))))
		(unless done
		  (setq arg (1+ arg))
		  (while (and ;; Don't move over previous invis lines
			  ;; if our target is the middle of this line.
			  (or (zerop (or goal-column temporary-goal-column))
			      (< arg 0))
			  (not (bobp)) (invisible-p (1- (point))))
		    (goto-char (previous-char-property-change (point))))))))
	  ;; This is the value the function returns.
	  (= arg 0))

      (cond ((> arg 0)
	     ;; If we did not move down as far as desired, at least go
	     ;; to end of line.  Be sure to call point-entered and
	     ;; point-left-hooks.
	     (let* ((npoint (prog1 (line-end-position)
			      (goto-char opoint)))
		    (inhibit-point-motion-hooks nil))
	       (goto-char npoint)))
	    ((< arg 0)
	     ;; If we did not move up as far as desired,
	     ;; at least go to beginning of line.
	     (let* ((npoint (prog1 (line-beginning-position)
			      (goto-char opoint)))
		    (inhibit-point-motion-hooks nil))
	       (goto-char npoint)))
	    (t
	     (line-move-finish (or goal-column temporary-goal-column)
			       opoint (> orig-arg 0)))))))

(defun line-move-finish (column opoint forward)
  (let ((repeat t))
    (while repeat
      ;; Set REPEAT to t to repeat the whole thing.
      (setq repeat nil)

      (let (new
	    (old (point))
	    (line-beg (line-beginning-position))
	    (line-end
	     ;; Compute the end of the line
	     ;; ignoring effectively invisible newlines.
	     (save-excursion
	       ;; Like end-of-line but ignores fields.
	       (skip-chars-forward "^\n")
	       (while (and (not (eobp)) (invisible-p (point)))
		 (goto-char (next-char-property-change (point)))
		 (skip-chars-forward "^\n"))
	       (point))))

	;; Move to the desired column.
        (if (and line-move-visual
                 (not (or truncate-lines truncate-partial-width-windows)))
            ;; Under line-move-visual, goal-column should be
            ;; interpreted in units of the frame's canonical character
            ;; width, which is exactly what vertical-motion does.
            (vertical-motion (cons column 0))
          (line-move-to-column (truncate column)))

	;; Corner case: suppose we start out in a field boundary in
	;; the middle of a continued line.  When we get to
	;; line-move-finish, point is at the start of a new *screen*
	;; line but the same text line; then line-move-to-column would
	;; move us backwards.  Test using C-n with point on the "x" in
	;;   (insert "a" (propertize "x" 'field t) (make-string 89 ?y))
	(and forward
	     (< (point) old)
	     (goto-char old))

	(setq new (point))

	;; Process intangibility within a line.
	;; With inhibit-point-motion-hooks bound to nil, a call to
	;; goto-char moves point past intangible text.

	;; However, inhibit-point-motion-hooks controls both the
	;; intangibility and the point-entered/point-left hooks.  The
	;; following hack avoids calling the point-* hooks
	;; unnecessarily.  Note that we move *forward* past intangible
	;; text when the initial and final points are the same.
	(goto-char new)
	(let ((inhibit-point-motion-hooks nil))
	  (goto-char new)

	  ;; If intangibility moves us to a different (later) place
	  ;; in the same line, use that as the destination.
	  (if (<= (point) line-end)
	      (setq new (point))
	    ;; If that position is "too late",
	    ;; try the previous allowable position.
	    ;; See if it is ok.
	    (backward-char)
	    (if (if forward
		    ;; If going forward, don't accept the previous
		    ;; allowable position if it is before the target line.
		    (< line-beg (point))
		  ;; If going backward, don't accept the previous
		  ;; allowable position if it is still after the target line.
		  (<= (point) line-end))
		(setq new (point))
	      ;; As a last resort, use the end of the line.
	      (setq new line-end))))

	;; Now move to the updated destination, processing fields
	;; as well as intangibility.
	(goto-char opoint)
	(let ((inhibit-point-motion-hooks nil))
	  (goto-char
	   ;; Ignore field boundaries if the initial and final
	   ;; positions have the same `field' property, even if the
	   ;; fields are non-contiguous.  This seems to be "nicer"
	   ;; behavior in many situations.
	   (if (eq (get-char-property new 'field)
	   	   (get-char-property opoint 'field))
	       new
	     (constrain-to-field new opoint t t
				 'inhibit-line-move-field-capture))))

	;; If all this moved us to a different line,
	;; retry everything within that new line.
	(when (or (< (point) line-beg) (> (point) line-end))
	  ;; Repeat the intangibility and field processing.
	  (setq repeat t))))))

(defun line-move-to-column (col)
  "Try to find column COL, considering invisibility.
This function works only in certain cases,
because what we really need is for `move-to-column'
and `current-column' to be able to ignore invisible text."
  (if (zerop col)
      (beginning-of-line)
    (move-to-column col))

  (when (and line-move-ignore-invisible
	     (not (bolp)) (invisible-p (1- (point))))
    (let ((normal-location (point))
	  (normal-column (current-column)))
      ;; If the following character is currently invisible,
      ;; skip all characters with that same `invisible' property value.
      (while (and (not (eobp))
		  (invisible-p (point)))
	(goto-char (next-char-property-change (point))))
      ;; Have we advanced to a larger column position?
      (if (> (current-column) normal-column)
	  ;; We have made some progress towards the desired column.
	  ;; See if we can make any further progress.
	  (line-move-to-column (+ (current-column) (- col normal-column)))
	;; Otherwise, go to the place we originally found
	;; and move back over invisible text.
	;; that will get us to the same place on the screen
	;; but with a more reasonable buffer position.
	(goto-char normal-location)
	(let ((line-beg
               ;; We want the real line beginning, so it's consistent
               ;; with bolp below, otherwise we might infloop.
               (let ((inhibit-field-text-motion t))
                 (line-beginning-position))))
	  (while (and (not (bolp)) (invisible-p (1- (point))))
	    (goto-char (previous-char-property-change (point) line-beg))))))))

(defun move-end-of-line (arg)
  "Move point to end of current line as displayed.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.

To ignore the effects of the `intangible' text or overlay
property, bind `inhibit-point-motion-hooks' to t.
If there is an image in the current line, this function
disregards newlines that are part of the text on which the image
rests."
  (interactive "^p")
  (or arg (setq arg 1))
  (let (done)
    (while (not done)
      (let ((newpos
	     (save-excursion
	       (let ((goal-column 0)
		     (line-move-visual nil))
		 (and (line-move arg t)
		      ;; With bidi reordering, we may not be at bol,
		      ;; so make sure we are.
		      (skip-chars-backward "^\n")
		      (not (bobp))
		      (progn
			(while (and (not (bobp)) (invisible-p (1- (point))))
			  (goto-char (previous-single-char-property-change
                                      (point) 'invisible)))
			(backward-char 1)))
		 (point)))))
	(goto-char newpos)
	(if (and (> (point) newpos)
		 (eq (preceding-char) ?\n))
	    (backward-char 1)
	  (if (and (> (point) newpos) (not (eobp))
		   (not (eq (following-char) ?\n)))
	      ;; If we skipped something intangible and now we're not
	      ;; really at eol, keep going.
	      (setq arg 1)
	    (setq done t)))))))

(defun move-beginning-of-line (arg)
  "Move point to visible beginning of current logical line.
This disregards any invisible newline characters.

When moving from position that has no `field' property, this
command doesn't enter text which has non-nil `field' property.
In particular, when invoked in the minibuffer, the command will
stop short of entering the text of the minibuffer prompt.
See `inhibit-field-text-motion' for how to inhibit this.

With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
beginning of the last line.)

To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
For motion by visual lines, see `beginning-of-visual-line'."
  (interactive "^p")
  (or arg (setq arg 1))

  (let ((orig (point))
	first-vis first-vis-field-value)

    ;; Move by lines, if ARG is not 1 (the default).
    (if (/= arg 1)
	(let ((line-move-visual nil))
	  (line-move (1- arg) t)))

    ;; Move to beginning-of-line, ignoring fields and invisible text.
    (skip-chars-backward "^\n")
    (while (and (not (bobp)) (invisible-p (1- (point))))
      (goto-char (previous-char-property-change (point)))
      (skip-chars-backward "^\n"))

    ;; Now find first visible char in the line.
    (while (and (< (point) orig) (invisible-p (point)))
      (goto-char (next-char-property-change (point) orig)))
    (setq first-vis (point))

    ;; See if fields would stop us from reaching FIRST-VIS.
    (setq first-vis-field-value
	  (constrain-to-field first-vis orig (/= arg 1) t nil))

    (goto-char (if (/= first-vis-field-value first-vis)
		   ;; If yes, obey them.
		   first-vis-field-value
		 ;; Otherwise, move to START with attention to fields.
		 ;; (It is possible that fields never matter in this case.)
		 (constrain-to-field (point) orig
				     (/= arg 1) t nil)))))


;; Many people have said they rarely use this feature, and often type
;; it by accident.  Maybe it shouldn't even be on a key.
(put 'set-goal-column 'disabled t)

(defun set-goal-column (arg)
  "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
Those commands will move to this position in the line moved to
rather than trying to keep the same horizontal position.
With a non-nil argument ARG, clears out the goal column
so that \\[next-line] and \\[previous-line] resume vertical motion.
The goal column is stored in the variable `goal-column'.
This is a buffer-local setting."
  (interactive "P")
  (if arg
      (progn
        (setq goal-column nil)
        (message "No goal column"))
    (setq goal-column (current-column))
    ;; The older method below can be erroneous if `set-goal-column' is bound
    ;; to a sequence containing %
    ;;(message (substitute-command-keys
    ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
    ;;goal-column)
    (message "%s"
	     (concat
	      (format "Goal column %d " goal-column)
	      (substitute-command-keys
	       "(use \\[set-goal-column] with an arg to unset it)")))

    )
  nil)
\f
;;; Editing based on visual lines, as opposed to logical lines.

(defun end-of-visual-line (&optional n)
  "Move point to end of current visual line.
With argument N not nil or 1, move forward N - 1 visual lines first.
If point reaches the beginning or end of buffer, it stops there.
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
  (interactive "^p")
  (or n (setq n 1))
  (if (/= n 1)
      (let ((line-move-visual t))
	(line-move (1- n) t)))
  ;; Unlike `move-beginning-of-line', `move-end-of-line' doesn't
  ;; constrain to field boundaries, so we don't either.
  (vertical-motion (cons (window-width) 0)))

(defun beginning-of-visual-line (&optional n)
  "Move point to beginning of current visual line.
With argument N not nil or 1, move forward N - 1 visual lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
beginning of the last visual line.)
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
  (interactive "^p")
  (or n (setq n 1))
  (let ((opoint (point)))
    (if (/= n 1)
	(let ((line-move-visual t))
	  (line-move (1- n) t)))
    (vertical-motion 0)
    ;; Constrain to field boundaries, like `move-beginning-of-line'.
    (goto-char (constrain-to-field (point) opoint (/= n 1)))))

(defun kill-visual-line (&optional arg)
  "Kill the rest of the visual line.
With prefix argument ARG, kill that many visual lines from point.
If ARG is negative, kill visual lines backward.
If ARG is zero, kill the text before point on the current visual
line.

If the variable `kill-whole-line' is non-nil, and this command is
invoked at start of a line that ends in a newline, kill the newline
as well.

If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].

If the buffer is read-only, Emacs will beep and refrain from deleting
the line, but put the line in the kill ring anyway.  This means that
you can use this command to copy text from a read-only buffer.
\(If the variable `kill-read-only-ok' is non-nil, then this won't
even beep.)"
  (interactive "P")
  ;; Like in `kill-line', it's better to move point to the other end
  ;; of the kill before killing.
  (let ((opoint (point))
        (kill-whole-line (and kill-whole-line (bolp)))
        (orig-vlnum (cdr (nth 6 (posn-at-point)))))
    (if arg
	(vertical-motion (prefix-numeric-value arg))
      (end-of-visual-line 1)
      (if (= (point) opoint)
	  (vertical-motion 1)
        ;; The first condition below verifies we are still on the same
        ;; screen line, i.e. that the line isn't continued, and that
        ;; end-of-visual-line didn't overshoot due to complications
        ;; like display or overlay strings, intangible text, etc.:
        ;; otherwise, we don't want to kill a character that's
        ;; unrelated to the place where the visual line wraps.
        (and (= (cdr (nth 6 (posn-at-point))) orig-vlnum)
             ;; Make sure we delete the character where the line wraps
             ;; under visual-line-mode, be it whitespace or a
             ;; character whose category set allows to wrap at it.
             (or (looking-at-p "[ \t]")
                 (and word-wrap-by-category
                      (aref (char-category-set (following-char)) ?\|)))
             (forward-char))))
    (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
			    (1+ (point))
			  (point)))))

(defun next-logical-line (&optional arg try-vscroll)
  "Move cursor vertically down ARG lines.
This is identical to `next-line', except that it always moves
by logical lines instead of visual lines, ignoring the value of
the variable `line-move-visual'."
  (interactive "^p\np")
  (let ((line-move-visual nil))
    (with-no-warnings
      (next-line arg try-vscroll))))

(defun previous-logical-line (&optional arg try-vscroll)
  "Move cursor vertically up ARG lines.
This is identical to `previous-line', except that it always moves
by logical lines instead of visual lines, ignoring the value of
the variable `line-move-visual'."
  (interactive "^p\np")
  (let ((line-move-visual nil))
    (with-no-warnings
      (previous-line arg try-vscroll))))

(defgroup visual-line nil
  "Editing based on visual lines."
  :group 'convenience
  :version "23.1")

(defvar visual-line-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [remap kill-line] 'kill-visual-line)
    (define-key map [remap move-beginning-of-line] 'beginning-of-visual-line)
    (define-key map [remap move-end-of-line]  'end-of-visual-line)
    ;; These keybindings interfere with xterm function keys.  Are
    ;; there any other suitable bindings?
    ;; (define-key map "\M-[" 'previous-logical-line)
    ;; (define-key map "\M-]" 'next-logical-line)
    map))

(defcustom visual-line-fringe-indicators '(nil nil)
  "How fringe indicators are shown for wrapped lines in `visual-line-mode'.
The value should be a list of the form (LEFT RIGHT), where LEFT
and RIGHT are symbols representing the bitmaps to display, to
indicate wrapped lines, in the left and right fringes respectively.
See also `fringe-indicator-alist'.
The default is not to display fringe indicators for wrapped lines.
This variable does not affect fringe indicators displayed for
other purposes."
  :type '(list (choice (const :tag "Hide left indicator" nil)
		       (const :tag "Left curly arrow" left-curly-arrow)
		       (symbol :tag "Other bitmap"))
	       (choice (const :tag "Hide right indicator" nil)
		       (const :tag "Right curly arrow" right-curly-arrow)
		       (symbol :tag "Other bitmap")))
  :set (lambda (symbol value)
	 (dolist (buf (buffer-list))
	   (with-current-buffer buf
	     (when (and (boundp 'visual-line-mode)
			(symbol-value 'visual-line-mode))
	       (setq fringe-indicator-alist
		     (cons (cons 'continuation value)
			   (assq-delete-all
			    'continuation
			    (copy-tree fringe-indicator-alist)))))))
	 (set-default symbol value)))

(defvar visual-line--saved-state nil)

(define-minor-mode visual-line-mode
  "Toggle visual line based editing (Visual Line mode) in the current buffer.

When Visual Line mode is enabled, `word-wrap' is turned on in
this buffer, and simple editing commands are redefined to act on
visual lines, not logical lines.  See Info node `Visual Line
Mode' for details.
Turning on this mode disables line truncation set up by
variables `truncate-lines' and `truncate-partial-width-windows'."
  :keymap visual-line-mode-map
  :group 'visual-line
  :lighter " Wrap"
  (if visual-line-mode
      (progn
        (unless visual-line--saved-state
	  (setq-local visual-line--saved-state (list nil))
	  ;; Save the local values of some variables, to be restored if
	  ;; visual-line-mode is turned off.
	  (dolist (var '(line-move-visual truncate-lines
		                          truncate-partial-width-windows
		                          word-wrap fringe-indicator-alist))
	    (if (local-variable-p var)
	        (push (cons var (symbol-value var))
		      visual-line--saved-state))))
        (setq-local line-move-visual t)
        (setq-local truncate-partial-width-windows nil)
	(setq truncate-lines nil
	      word-wrap t
	      fringe-indicator-alist
	      (cons (cons 'continuation visual-line-fringe-indicators)
		    fringe-indicator-alist)))
    (kill-local-variable 'line-move-visual)
    (kill-local-variable 'word-wrap)
    (kill-local-variable 'truncate-lines)
    (kill-local-variable 'truncate-partial-width-windows)
    (kill-local-variable 'fringe-indicator-alist)
    (dolist (saved visual-line--saved-state)
      (when (car saved)
        (set (make-local-variable (car saved)) (cdr saved))))
    (kill-local-variable 'visual-line--saved-state)))

(defun turn-on-visual-line-mode ()
  (visual-line-mode 1))

(define-globalized-minor-mode global-visual-line-mode
  visual-line-mode turn-on-visual-line-mode)

\f
(defun transpose-chars (arg)
  "Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other characters (backward if ARG negative).
If no argument and at end of line, the previous two chars are exchanged."
  (interactive "*P")
  (when (and (null arg) (eolp) (not (bobp))
	     (not (get-text-property (1- (point)) 'read-only)))
    (forward-char -1))
  (transpose-subr 'forward-char (prefix-numeric-value arg)))

(defun transpose-words (arg)
  "Interchange words around point, leaving point at end of them.
With prefix arg ARG, effect is to take word before or around point
and drag it forward past ARG other words (backward if ARG negative).
If ARG is zero, the words around or after point and around or after mark
are interchanged."
  ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
  (interactive "*p")
  (transpose-subr 'forward-word arg))

(defun transpose-sexps (arg &optional interactive)
  "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
Unlike `transpose-words', point must be between the two sexps and not
in the middle of a sexp to be transposed.
With non-zero prefix arg ARG, effect is to take the sexp before point
and drag it forward past ARG other sexps (backward if ARG is negative).
If ARG is zero, the sexps ending at or after point and at or after mark
are interchanged.
If INTERACTIVE is non-nil, as it is interactively,
report errors as appropriate for this kind of usage."
  (interactive "*p\nd")
  (if interactive
      (condition-case nil
          (transpose-sexps arg nil)
        (scan-error (user-error "Not between two complete sexps")))
    (transpose-subr
     (lambda (arg)
       ;; Here we should try to simulate the behavior of
       ;; (cons (progn (forward-sexp x) (point))
       ;;       (progn (forward-sexp (- x)) (point)))
       ;; Except that we don't want to rely on the second forward-sexp
       ;; putting us back to where we want to be, since forward-sexp-function
       ;; might do funny things like infix-precedence.
       (if (if (> arg 0)
	       (looking-at "\\sw\\|\\s_")
	     (and (not (bobp))
		  (save-excursion
                    (forward-char -1)
                    (looking-at "\\sw\\|\\s_"))))
	   ;; Jumping over a symbol.  We might be inside it, mind you.
	   (progn (funcall (if (> arg 0)
			       'skip-syntax-backward 'skip-syntax-forward)
			   "w_")
		  (cons (save-excursion (forward-sexp arg) (point)) (point)))
         ;; Otherwise, we're between sexps.  Take a step back before jumping
         ;; to make sure we'll obey the same precedence no matter which
         ;; direction we're going.
         (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
                  " .")
         (cons (save-excursion (forward-sexp arg) (point))
	       (progn (while (or (forward-comment (if (> arg 0) 1 -1))
			         (not (zerop (funcall (if (> arg 0)
							  'skip-syntax-forward
						        'skip-syntax-backward)
						      ".")))))
		      (point)))))
     arg 'special)))

(defun transpose-lines (arg)
  "Exchange current line and previous line, leaving point after both.
With argument ARG, takes previous line and moves it past ARG lines.
With argument 0, interchanges line point is in with line mark is in."
  (interactive "*p")
  (transpose-subr (lambda (arg)
                    (if (> arg 0)
                        (progn
                          ;; Move forward over ARG lines,
                          ;; but create newlines if necessary.
                          (setq arg (forward-line arg))
                          (if (/= (preceding-char) ?\n)
                              (setq arg (1+ arg)))
                          (if (> arg 0)
                              (newline arg)))
                      (forward-line arg)))
		  arg))

;; FIXME seems to leave point BEFORE the current object when ARG = 0,
;; which seems inconsistent with the ARG /= 0 case.
;; FIXME document SPECIAL.
(defun transpose-subr (mover arg &optional special)
  "Subroutine to do the work of transposing objects.
Works for lines, sentences, paragraphs, etc.  MOVER is a function that
moves forward by units of the given object (e.g. `forward-sentence',
`forward-paragraph').  If ARG is zero, exchanges the current object
with the one containing mark.  If ARG is an integer, moves the
current object past ARG following (if ARG is positive) or
preceding (if ARG is negative) objects, leaving point after the
current object."
  (let ((aux (if special mover
	       (lambda (x)
		 (cons (progn (funcall mover x) (point))
		       (progn (funcall mover (- x)) (point))))))
	pos1 pos2)
    (cond
     ((= arg 0)
      (save-excursion
	(setq pos1 (funcall aux 1))
	(goto-char (or (mark) (error "No mark set in this buffer")))
	(setq pos2 (funcall aux 1))
	(transpose-subr-1 pos1 pos2))
      (exchange-point-and-mark))
     ((> arg 0)
      (setq pos1 (funcall aux -1))
      (setq pos2 (funcall aux arg))
      (transpose-subr-1 pos1 pos2)
      (goto-char (car pos2)))
     (t
      (setq pos1 (funcall aux -1))
      (goto-char (car pos1))
      (setq pos2 (funcall aux arg))
      (transpose-subr-1 pos1 pos2)
      (goto-char (+ (car pos2) (- (cdr pos1) (car pos1))))))))

(defun transpose-subr-1 (pos1 pos2)
  (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
  (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
  (when (> (car pos1) (car pos2))
    (let ((swap pos1))
      (setq pos1 pos2 pos2 swap)))
  (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
  (atomic-change-group
    ;; This sequence of insertions attempts to preserve marker
    ;; positions at the start and end of the transposed objects.
    (let* ((word (buffer-substring (car pos2) (cdr pos2)))
	   (len1 (- (cdr pos1) (car pos1)))
	   (len2 (length word))
	   (boundary (make-marker)))
      (set-marker boundary (car pos2))
      (goto-char (cdr pos1))
      (insert-before-markers word)
      (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1)))
      (goto-char boundary)
      (insert word)
      (goto-char (+ boundary len1))
      (delete-region (point) (+ (point) len2))
      (set-marker boundary nil))))
\f
(defun backward-word (&optional arg)
  "Move backward until encountering the beginning of a word.
With argument ARG, do this that many times.
If ARG is omitted or nil, move point backward one word.

The word boundaries are normally determined by the buffer's
syntax table and character script (according to
`char-script-table'), but `find-word-boundary-function-table',
such as set up by `subword-mode', can change that.  If a Lisp
program needs to move by words determined strictly by the syntax
table, it should use `backward-word-strictly' instead.  See Info
node `(elisp) Word Motion' for details."
  (interactive "^p")
  (forward-word (- (or arg 1))))

(defun mark-word (&optional arg allow-extend)
  "Set mark ARG words away from point.
The place mark goes is the same place \\[forward-word] would
move to with the same argument.
Interactively, if this command is repeated
or (in Transient Mark mode) if the mark is active,
it marks the next ARG words after the ones already marked."
  (interactive "P\np")
  (cond ((and allow-extend
	      (or (and (eq last-command this-command) (mark t))
		  (region-active-p)))
	 (setq arg (if arg (prefix-numeric-value arg)
		     (if (< (mark) (point)) -1 1)))
	 (set-mark
	  (save-excursion
	    (goto-char (mark))
	    (forward-word arg)
	    (point))))
	(t
	 (push-mark
	  (save-excursion
	    (forward-word (prefix-numeric-value arg))
	    (point))
	  nil t))))

(defun kill-word (arg)
  "Kill characters forward until encountering the end of a word.
With argument ARG, do this that many times."
  (interactive "p")
  (kill-region (point) (progn (forward-word arg) (point))))

(defun backward-kill-word (arg)
  "Kill characters backward until encountering the beginning of a word.
With argument ARG, do this that many times."
  (interactive "p")
  (kill-word (- arg)))

(defun current-word (&optional strict really-word)
  "Return the word at or near point, as a string.
The return value includes no text properties.

If optional arg STRICT is non-nil, return nil unless point is
within or adjacent to a word, otherwise look for a word within
point's line.  If there is no word anywhere on point's line, the
value is nil regardless of STRICT.

By default, this function treats as a single word any sequence of
characters that have either word or symbol syntax.  If optional
arg REALLY-WORD is non-nil, only characters of word syntax can
constitute a word."
  (save-excursion
    (let* ((oldpoint (point)) (start (point)) (end (point))
	   (syntaxes (if really-word "w" "w_"))
	   (not-syntaxes (concat "^" syntaxes)))
      (skip-syntax-backward syntaxes) (setq start (point))
      (goto-char oldpoint)
      (skip-syntax-forward syntaxes) (setq end (point))
      (when (and (eq start oldpoint) (eq end oldpoint)
		 ;; Point is neither within nor adjacent to a word.
		 (not strict))
	;; Look for preceding word in same line.
	(skip-syntax-backward not-syntaxes (line-beginning-position))
	(if (bolp)
	    ;; No preceding word in same line.
	    ;; Look for following word in same line.
	    (progn
	      (skip-syntax-forward not-syntaxes (line-end-position))
	      (setq start (point))
	      (skip-syntax-forward syntaxes)
	      (setq end (point)))
	  (setq end (point))
	  (skip-syntax-backward syntaxes)
	  (setq start (point))))
      ;; If we found something nonempty, return it as a string.
      (unless (= start end)
	(buffer-substring-no-properties start end)))))
\f
(defcustom fill-prefix nil
  "String for filling to insert at front of new line, or nil for none."
  :type '(choice (const :tag "None" nil)
		 string)
  :group 'fill)
(make-variable-buffer-local 'fill-prefix)
(put 'fill-prefix 'safe-local-variable 'string-or-null-p)

(defcustom auto-fill-inhibit-regexp nil
  "Regexp to match lines that should not be auto-filled."
  :type '(choice (const :tag "None" nil)
		 regexp)
  :group 'fill)

(defun do-auto-fill ()
  "The default value for `normal-auto-fill-function'.
This is the default auto-fill function, some major modes use a different one.
Returns t if it really did any work."
  (let (fc justify give-up
	   (fill-prefix fill-prefix))
    (if (or (not (setq justify (current-justification)))
	    (null (setq fc (current-fill-column)))
	    (and (eq justify 'left)
		 (<= (current-column) fc))
	    (and auto-fill-inhibit-regexp
		 (save-excursion (beginning-of-line)
				 (looking-at auto-fill-inhibit-regexp))))
	nil ;; Auto-filling not required
      (if (memq justify '(full center right))
	  (save-excursion (unjustify-current-line)))

      ;; Choose a fill-prefix automatically.
      (when (and adaptive-fill-mode
		 (or (null fill-prefix) (string= fill-prefix "")))
	(let ((prefix
	       (fill-context-prefix
		(save-excursion (fill-forward-paragraph -1) (point))
		(save-excursion (fill-forward-paragraph 1) (point)))))
	  (and prefix (not (equal prefix ""))
	       ;; Use auto-indentation rather than a guessed empty prefix.
	       (not (and fill-indent-according-to-mode
			 (string-match "\\`[ \t]*\\'" prefix)))
	       (setq fill-prefix prefix))))

      (while (and (not give-up) (> (current-column) fc))
        ;; Determine where to split the line.
        (let ((fill-point
               (save-excursion
                 (beginning-of-line)
                 ;; Don't split earlier in the line than the length of the
                 ;; fill prefix, since the resulting line would be longer.
                 (when fill-prefix
                   (move-to-column (string-width fill-prefix)))
                 (let ((after-prefix (point)))
                    (move-to-column (1+ fc))
                    (fill-move-to-break-point after-prefix)
                    (point)))))

	  ;; See whether the place we found is any good.
	  (if (save-excursion
		(goto-char fill-point)
		(or (bolp)
		    ;; There is no use breaking at end of line.
		    (save-excursion (skip-chars-forward " ") (eolp))
		    ;; Don't split right after a comment starter
		    ;; since we would just make another comment starter.
		    (and comment-start-skip
			 (let ((limit (point)))
			   (beginning-of-line)
			   (and (re-search-forward comment-start-skip
						   limit t)
				(eq (point) limit))))))
	      ;; No good place to break => stop trying.
	      (setq give-up t)
	    ;; Ok, we have a useful place to break the line.  Do it.
	    (let ((prev-column (current-column)))
	      ;; If point is at the fill-point, do not `save-excursion'.
	      ;; Otherwise, if a comment prefix or fill-prefix is inserted,
	      ;; point will end up before it rather than after it.
	      (if (save-excursion
		    (skip-chars-backward " \t")
		    (= (point) fill-point))
		  (default-indent-new-line t)
		(save-excursion
		  (goto-char fill-point)
		  (default-indent-new-line t)))
	      ;; Now do justification, if required
	      (if (not (eq justify 'left))
		  (save-excursion
		    (end-of-line 0)
		    (justify-current-line justify nil t)))
	      ;; If making the new line didn't reduce the hpos of
	      ;; the end of the line, then give up now;
	      ;; trying again will not help.
	      (if (>= (current-column) prev-column)
		  (setq give-up t))))))
      ;; Justify last line.
      (justify-current-line justify t t)
      t)))

(defvar comment-line-break-function 'comment-indent-new-line
  "Mode-specific function that line breaks and continues a comment.
This function is called during auto-filling when a comment syntax
is defined.
The function should take a single optional argument, which is a flag
indicating whether it should use soft newlines.")

(defun default-indent-new-line (&optional soft force)
  "Break line at point and indent.
If a comment syntax is defined, call `comment-line-break-function'.

The inserted newline is marked hard if variable `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
  (interactive (list nil t))
  (if comment-start
      ;; Force breaking the line when called interactively.
      (if force
          (let ((comment-auto-fill-only-comments nil))
            (funcall comment-line-break-function soft))
        (funcall comment-line-break-function soft))
    ;; Insert the newline before removing empty space so that markers
    ;; get preserved better.
    (if soft (insert-and-inherit ?\n) (newline 1))
    (save-excursion (forward-char -1) (delete-horizontal-space))
    (delete-horizontal-space)

    (if (and fill-prefix (not adaptive-fill-mode))
	;; Blindly trust a non-adaptive fill-prefix.
	(progn
	  (indent-to-left-margin)
	  (insert-before-markers-and-inherit fill-prefix))

      (cond
       ;; If there's an adaptive prefix, use it unless we're inside
       ;; a comment and the prefix is not a comment starter.
       (fill-prefix
	(indent-to-left-margin)
	(insert-and-inherit fill-prefix))
       ;; If we're not inside a comment, just try to indent.
       (t (indent-according-to-mode))))))

(defun internal-auto-fill ()
  "The function called by `self-insert-command' to perform auto-filling."
  (when (or (not comment-start)
            (not comment-auto-fill-only-comments)
            (nth 4 (syntax-ppss)))
    (funcall auto-fill-function)))

(defvar normal-auto-fill-function 'do-auto-fill
  "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")

(put 'auto-fill-function :minor-mode-function 'auto-fill-mode)
;; `functions' and `hooks' are usually unsafe to set, but setting
;; auto-fill-function to nil in a file-local setting is safe and
;; can be useful to prevent auto-filling.
(put 'auto-fill-function 'safe-local-variable 'null)

(define-minor-mode auto-fill-mode
  "Toggle automatic line breaking (Auto Fill mode).

When Auto Fill mode is enabled, inserting a space at a column
beyond `current-fill-column' automatically breaks the line at a
previous space.

When `auto-fill-mode' is on, the `auto-fill-function' variable is
non-nil.

The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
  :variable (auto-fill-function
             . (lambda (v) (setq auto-fill-function
                            (if v normal-auto-fill-function)))))

;; This holds a document string used to document auto-fill-mode.
(defun auto-fill-function ()
  "Automatically break line at a previous space, in insertion of text."
  nil)

(defun turn-on-auto-fill ()
  "Unconditionally turn on Auto Fill mode."
  (auto-fill-mode 1))

(defun turn-off-auto-fill ()
  "Unconditionally turn off Auto Fill mode."
  (auto-fill-mode -1))

(custom-add-option 'text-mode-hook 'turn-on-auto-fill)

(defun set-fill-column (arg)
  "Set `fill-column' to specified argument.
Use \\[universal-argument] followed by a number to specify a column.
Just \\[universal-argument] as argument means to use the current column."
  (interactive
   (list (or current-prefix-arg
             ;; We used to use current-column silently, but C-x f is too easily
             ;; typed as a typo for C-x C-f, so we turned it into an error and
             ;; now an interactive prompt.
             (read-number (format "Change fill-column from %s to: " fill-column)
                          (current-column)))))
  (if (consp arg)
      (setq arg (current-column)))
  (if (not (integerp arg))
      ;; Disallow missing argument; it's probably a typo for C-x C-f.
      (error "set-fill-column requires an explicit argument")
    (message "Fill column set to %d (was %d)" arg fill-column)
    (setq fill-column arg)))
\f
(defun set-selective-display (arg)
  "Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
lines whose indentation is >= that value are not displayed.
The variable `selective-display' has a separate value for each buffer."
  (interactive "P")
  (if (eq selective-display t)
      (error "selective-display already in use for marked lines"))
  (let ((current-vpos
	 (save-restriction
	   (narrow-to-region (point-min) (point))
	   (goto-char (window-start))
	   (vertical-motion (window-height)))))
    (setq selective-display
	  (and arg (prefix-numeric-value arg)))
    (recenter current-vpos))
  (set-window-start (selected-window) (window-start))
  (princ "selective-display set to " t)
  (prin1 selective-display t)
  (princ "." t))

(defvaralias 'indicate-unused-lines 'indicate-empty-lines)

(defun toggle-truncate-lines (&optional arg)
  "Toggle truncating of long lines for the current buffer.
When truncating is off, long lines are folded.
With prefix argument ARG, truncate long lines if ARG is positive,
otherwise fold them.  Note that in side-by-side windows, this
command has no effect if `truncate-partial-width-windows' is
non-nil."
  (interactive "P")
  (setq truncate-lines
	(if (null arg)
	    (not truncate-lines)
	  (> (prefix-numeric-value arg) 0)))
  (force-mode-line-update)
  (unless truncate-lines
    (let ((buffer (current-buffer)))
      (walk-windows (lambda (window)
		      (if (eq buffer (window-buffer window))
			  (set-window-hscroll window 0)))
		    nil t)))
  (message "Truncate long lines %s%s"
	   (if truncate-lines "enabled" "disabled")
           (if (and truncate-lines visual-line-mode)
               (progn
                 (visual-line-mode -1)
                 (format-message " and `visual-line-mode' disabled"))
             "")))

(defun toggle-word-wrap (&optional arg)
  "Toggle whether to use word-wrapping for continuation lines.
With prefix argument ARG, wrap continuation lines at word boundaries
if ARG is positive, otherwise wrap them at the right screen edge.
This command toggles the value of `word-wrap'.  It has no effect
if long lines are truncated."
  (interactive "P")
  (setq word-wrap
	(if (null arg)
	    (not word-wrap)
	  (> (prefix-numeric-value arg) 0)))
  (force-mode-line-update)
  (message "Word wrapping %s"
	   (if word-wrap "enabled" "disabled")))

(defvar overwrite-mode-textual (purecopy " Ovwrt")
  "The string displayed in the mode line when in overwrite mode.")
(defvar overwrite-mode-binary (purecopy " Bin Ovwrt")
  "The string displayed in the mode line when in binary overwrite mode.")

(define-minor-mode overwrite-mode
  "Toggle Overwrite mode.

When Overwrite mode is enabled, printing characters typed in
replace existing text on a one-for-one basis, rather than pushing
it to the right.  At the end of a line, such characters extend
the line.  Before a tab, such characters insert until the tab is
filled in.  \\[quoted-insert] still inserts characters in
overwrite mode; this is supposed to make it easier to insert
characters when necessary."
  :variable (overwrite-mode
             . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual)))))

(define-minor-mode binary-overwrite-mode
  "Toggle Binary Overwrite mode.

When Binary Overwrite mode is enabled, printing characters typed
in replace existing text.  Newlines are not treated specially, so
typing at the end of a line joins the line to the next, with the
typed character between them.  Typing before a tab character
simply replaces the tab with the character typed.
\\[quoted-insert] replaces the text at the cursor, just as
ordinary typing characters do.

Note that Binary Overwrite mode is not its own minor mode; it is
a specialization of overwrite mode, entered by setting the
`overwrite-mode' variable to `overwrite-mode-binary'."
  :variable (overwrite-mode
             . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary)))))

(define-minor-mode line-number-mode
  "Toggle line number display in the mode line (Line Number mode).

Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
and `line-number-display-limit-width'.

See `mode-line-position-line-format' for how this number is
presented."
  :init-value t :global t :group 'mode-line)

(define-minor-mode column-number-mode
  "Toggle column number display in the mode line (Column Number mode).

See `mode-line-position-column-format' for how this number is
presented."
  :global t :group 'mode-line)

(define-minor-mode size-indication-mode
  "Toggle buffer size display in the mode line (Size Indication mode)."
  :global t :group 'mode-line)

(define-minor-mode auto-save-mode
  "Toggle auto-saving in the current buffer (Auto Save mode)."
  :variable ((and buffer-auto-save-file-name
                  ;; If auto-save is off because buffer has shrunk,
                  ;; then toggling should turn it on.
                  (>= buffer-saved-size 0))
             . (lambda (val)
                 (setq buffer-auto-save-file-name
                       (cond
                        ((null val) nil)
                        ((and buffer-file-name auto-save-visited-file-name
                              (not buffer-read-only))
                         buffer-file-name)
                        (t (make-auto-save-file-name))))))
  ;; If -1 was stored here, to temporarily turn off saving,
  ;; turn it back on.
  (and (< buffer-saved-size 0)
       (setq buffer-saved-size 0)))
\f
(defgroup paren-blinking nil
  "Blinking matching of parens and expressions."
  :prefix "blink-matching-"
  :group 'paren-matching)

(defcustom blink-matching-paren t
  "Non-nil means show matching open-paren when close-paren is inserted.
If this is non-nil, then when you type a closing delimiter, such as a
closing parenthesis or brace, Emacs briefly indicates the location
of the matching opening delimiter.

The valid values are:

  t                 Highlight the matching open-paren if it is visible
                    in the window, otherwise show the text with matching
                    open-paren in the echo area.  This is the default.
  `jump'            If the matching open-paren is visible in the window,
                    briefly move cursor to its position; otherwise show
                    the text with matching open-paren in the echo area.
  `jump-offscreen'  Briefly move cursor to the matching open-paren
                    even if it is not visible in the window.
  nil               Don't show the matching open-paren.

Any other non-nil value is handled the same as t."

  :type '(choice
          (const :tag "Disable" nil)
          (const :tag "Highlight open-paren if visible" t)
          (const :tag "Move cursor to open-paren if visible" jump)
          (const :tag "Move cursor even if it's off screen" jump-offscreen))
  :group 'paren-blinking)

(defcustom blink-matching-paren-on-screen t
  "Non-nil means show matching open-paren when it is on screen.
If nil, don't show it (but the open-paren can still be shown
in the echo area when it is off screen).

This variable has no effect if `blink-matching-paren' is nil.
\(In that case, the open-paren is never shown.)
It is also ignored if `show-paren-mode' is enabled."
  :type 'boolean
  :group 'paren-blinking)

(defcustom blink-matching-paren-distance (* 100 1024)
  "If non-nil, maximum distance to search backwards for matching open-paren.
If nil, search stops at the beginning of the accessible portion of the buffer."
  :version "23.2"                       ; 25->100k
  :type '(choice (const nil) integer)
  :group 'paren-blinking)

(defcustom blink-matching-delay 1
  "Time in seconds to delay after showing a matching paren."
  :type 'number
  :group 'paren-blinking)

(defcustom blink-matching-paren-dont-ignore-comments nil
  "If nil, `blink-matching-paren' ignores comments.
More precisely, when looking for the matching parenthesis,
it skips the contents of comments that end before point."
  :type 'boolean
  :group 'paren-blinking)

(defun blink-matching-check-mismatch (start end)
  "Return whether or not START...END are matching parens.
END is the current point and START is the blink position.
START might be nil if no matching starter was found.
Returns non-nil if we find there is a mismatch."
  (let* ((end-syntax (syntax-after (1- end)))
         (matching-paren (and (consp end-syntax)
                              (eq (syntax-class end-syntax) 5)
                              (cdr end-syntax))))
    ;; For self-matched chars like " and $, we can't know when they're
    ;; mismatched or unmatched, so we can do it only for parens.
    (when matching-paren
      (not (and start
                (or
                 (eq (char-after start) matching-paren)
                 ;; The cdr might hold a new paren-class info rather than
                 ;; a matching-char info, in which case the two CDRs
                 ;; should match.
                 (eq matching-paren (cdr-safe (syntax-after start)))))))))

(defvar blink-matching-check-function #'blink-matching-check-mismatch
  "Function to check parentheses mismatches.
The function takes two arguments (START and END) where START is the
position just before the opening token and END is the position right after.
START can be nil, if it was not found.
The function should return non-nil if the two tokens do not match.")

(defvar blink-matching--overlay
  (let ((ol (make-overlay (point) (point) nil t)))
    (overlay-put ol 'face 'show-paren-match)
    (delete-overlay ol)
    ol)
  "Overlay used to highlight the matching paren.")

(defun blink-matching-open ()
  "Momentarily highlight the beginning of the sexp before point."
  (interactive)
  (when (and (not (bobp))
	     blink-matching-paren)
    (let* ((oldpos (point))
	   (message-log-max nil) ; Don't log messages about paren matching.
	   (blinkpos
            (save-excursion
              (save-restriction
		(syntax-propertize (point))
                (if blink-matching-paren-distance
                    (narrow-to-region
                     (max (minibuffer-prompt-end) ;(point-min) unless minibuf.
                          (- (point) blink-matching-paren-distance))
                     oldpos))
                (let ((parse-sexp-ignore-comments
                       (and parse-sexp-ignore-comments
                            (not blink-matching-paren-dont-ignore-comments))))
                  (condition-case ()
                      (progn
                        (forward-sexp -1)
                        ;; backward-sexp skips backward over prefix chars,
                        ;; so move back to the matching paren.
                        (while (and (< (point) (1- oldpos))
                                    (let ((code (syntax-after (point))))
                                      (or (eq (syntax-class code) 6)
                                          (eq (logand 1048576 (car code))
                                              1048576))))
                          (forward-char 1))
                        (point))
                    (error nil))))))
           (mismatch (funcall blink-matching-check-function blinkpos oldpos)))
      (cond
       (mismatch
        (if blinkpos
            (if (minibufferp)
                (minibuffer-message "Mismatched parentheses")
              (message "Mismatched parentheses"))
          (if (minibufferp)
              (minibuffer-message "No matching parenthesis found")
            (message "No matching parenthesis found"))))
       ((not blinkpos) nil)
       ((or
         (eq blink-matching-paren 'jump-offscreen)
         (pos-visible-in-window-p blinkpos))
        ;; Matching open within window, temporarily move to or highlight
        ;; char after blinkpos but only if `blink-matching-paren-on-screen'
        ;; is non-nil.
        (and blink-matching-paren-on-screen
             (not show-paren-mode)
             (if (memq blink-matching-paren '(jump jump-offscreen))
                 (save-excursion
                   (goto-char blinkpos)
                   (sit-for blink-matching-delay))
               (unwind-protect
                   (progn
                     (move-overlay blink-matching--overlay blinkpos (1+ blinkpos)
                                   (current-buffer))
                     (sit-for blink-matching-delay))
                 (delete-overlay blink-matching--overlay)))))
       ((not show-paren-context-when-offscreen)
        (minibuffer-message
         "Matches %s"
         (substring-no-properties
          (blink-paren-open-paren-line-string blinkpos))))))))

(defun blink-paren-open-paren-line-string (pos)
  "Return the line string that contains the openparen at POS."
  (save-excursion
    (goto-char pos)
    ;; Show what precedes the open in its line, if anything.
    (cond
     ((save-excursion (skip-chars-backward " \t") (not (bolp)))
      (buffer-substring (line-beginning-position)
                        (1+ pos)))
     ;; Show what follows the open in its line, if anything.
     ((save-excursion
        (forward-char 1)
        (skip-chars-forward " \t")
        (not (eolp)))
      (buffer-substring pos
                        (line-end-position)))
     ;; Otherwise show the previous nonblank line,
     ;; if there is one.
     ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
      (concat
       (buffer-substring (progn
                           (skip-chars-backward "\n \t")
                           (line-beginning-position))
                         (progn (end-of-line)
                                (skip-chars-backward " \t")
                                (point)))
       ;; Replace the newline and other whitespace with `...'.
       "..."
       (buffer-substring pos (1+ pos))))
     ;; There is nothing to show except the char itself.
     (t (buffer-substring pos (1+ pos))))))

(defvar blink-paren-function 'blink-matching-open
  "Function called, if non-nil, whenever a close parenthesis is inserted.
More precisely, a char with closeparen syntax is self-inserted.")

(defun blink-paren-post-self-insert-function ()
  (when (and (eq (char-before) last-command-event) ; Sanity check.
             (memq (char-syntax last-command-event) '(?\) ?\$))
             blink-paren-function
             (not executing-kbd-macro)
             (not noninteractive)
	     ;; Verify an even number of quoting characters precede the close.
             ;; FIXME: Also check if this parenthesis closes a comment as
             ;; can happen in Pascal and SML.
	     (= 1 (logand 1 (- (point)
			       (save-excursion
				 (forward-char -1)
				 (skip-syntax-backward "/\\")
				 (point))))))
    (funcall blink-paren-function)))

(put 'blink-paren-post-self-insert-function 'priority 100)

(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
          ;; Most likely, this hook is nil, so this arg doesn't matter,
          ;; but I use it as a reminder that this function usually
          ;; likes to be run after others since it does
          ;; `sit-for'. That's also the reason it get a `priority' prop
          ;; of 100.
          'append)
\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the maybe_quit function at the C code level.
(defun keyboard-quit ()
  "Signal a `quit' condition.
During execution of Lisp code, this character causes a quit directly.
At top-level, as an editor command, this simply beeps."
  (interactive)
  ;; Avoid adding the region to the window selection.
  (setq saved-region-selection nil)
  (let (select-active-regions)
    (deactivate-mark))
  (if (fboundp 'kmacro-keyboard-quit)
      (kmacro-keyboard-quit))
  (when completion-in-region-mode
    (completion-in-region-mode -1))
  ;; Force the next redisplay cycle to remove the "Def" indicator from
  ;; all the mode lines.
  (if defining-kbd-macro
      (force-mode-line-update t))
  (setq defining-kbd-macro nil)
  (let ((debug-on-quit nil))
    (signal 'quit nil)))

(defvar buffer-quit-function nil
  "Function to call to \"quit\" the current buffer, or nil if none.
\\[keyboard-escape-quit] calls this function when its more local actions
\(such as canceling a prefix argument, minibuffer or region) do not apply.")

(defun keyboard-escape-quit ()
  "Exit the current \"mode\" (in a generalized sense of the word).
This command can exit an interactive command such as `query-replace',
can clear out a prefix argument or a region,
can get out of the minibuffer or other recursive edit,
cancel the use of the current buffer (for special-purpose buffers),
or go back to just one window (by deleting all but the selected window)."
  (interactive)
  (cond ((eq last-command 'mode-exited) nil)
	((region-active-p)
	 (deactivate-mark))
	((> (minibuffer-depth) 0)
	 (abort-recursive-edit))
	(current-prefix-arg
	 nil)
	((> (recursion-depth) 0)
	 (exit-recursive-edit))
	(buffer-quit-function
	 (funcall buffer-quit-function))
	((not (one-window-p t))
	 (delete-other-windows))
	((string-match "^ \\*" (buffer-name (current-buffer)))
	 (bury-buffer))))

(defun play-sound-file (file &optional volume device)
  "Play sound stored in FILE.
VOLUME and DEVICE correspond to the keywords of the sound
specification for `play-sound'."
  (interactive "fPlay sound file: ")
  (let ((sound (list :file file)))
    (if volume
	(plist-put sound :volume volume))
    (if device
	(plist-put sound :device device))
    (push 'sound sound)
    (play-sound sound)))

\f
(defcustom read-mail-command 'rmail
  "Your preference for a mail reading package.
This is used by some keybindings that support reading mail.
See also `mail-user-agent' concerning sending mail."
  :type '(radio (function-item :tag "Rmail" :format "%t\n" rmail)
                (function-item :tag "Gnus" :format "%t\n" gnus)
                (function-item :tag "Emacs interface to MH"
                               :format "%t\n" mh-rmail)
                (function :tag "Other"))
  :version "21.1"
  :group 'mail)

(defcustom mail-user-agent 'message-user-agent
  "Your preference for a mail composition package.
Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message.  This variable lets you specify which
mail-sending package you prefer.

Valid values include:

  `message-user-agent'  -- use the Message package.
                           See Info node `(message)'.
  `sendmail-user-agent' -- use the Mail package.
                           See Info node `(emacs)Sending Mail'.
  `mh-e-user-agent'     -- use the Emacs interface to the MH mail system.
                           See Info node `(mh-e)'.
  `gnus-user-agent'     -- like `message-user-agent', but with Gnus
                           paraphernalia if Gnus is running, particularly
                           the Gcc: header for archiving.

Additional valid symbols may be available; check with the author of
your package for details.  The function should return non-nil if it
succeeds.

See also `read-mail-command' concerning reading mail."
  :type '(radio (function-item :tag "Message package"
			       :format "%t\n"
			       message-user-agent)
		(function-item :tag "Mail package"
			       :format "%t\n"
			       sendmail-user-agent)
		(function-item :tag "Emacs interface to MH"
			       :format "%t\n"
			       mh-e-user-agent)
		(function-item :tag "Message with full Gnus features"
			       :format "%t\n"
			       gnus-user-agent)
		(symbol :tag "Other"))
  :version "23.2"                       ; sendmail->message
  :group 'mail)

(defcustom compose-mail-user-agent-warnings t
  "If non-nil, `compose-mail' warns about changes in `mail-user-agent'.
If the value of `mail-user-agent' is the default, and the user
appears to have customizations applying to the old default,
`compose-mail' issues a warning."
  :type 'boolean
  :version "23.2"
  :group 'mail)

(defun rfc822-goto-eoh ()
  "If the buffer starts with a mail header, move point to the header's end.
Otherwise, moves to `point-min'.
The end of the header is the start of the next line, if there is one,
else the end of the last line.  This function obeys RFC 822 (or later)."
  (goto-char (point-min))
  (when (re-search-forward
	 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
    (goto-char (match-beginning 0))))

;; Used by Rmail (e.g., rmail-forward).
(defvar mail-encode-mml nil
  "If non-nil, mail-user-agent's `sendfunc' command should mml-encode
the outgoing message before sending it.")

(defun compose-mail (&optional to subject other-headers continue
		     switch-function yank-action send-actions
		     return-action)
  "Start composing a mail message to send.
This uses the user's chosen mail composition package
as selected with the variable `mail-user-agent'.
The optional arguments TO and SUBJECT specify recipients
and the initial Subject field, respectively.

OTHER-HEADERS is an alist specifying additional
header fields.  Elements look like (HEADER . VALUE) where both
HEADER and VALUE are strings.

By default, if an unsent message is already being composed, this
command will ask whether to erase the unsent message, and will not
start a new message if the user doesn't allow erasing.  However, if
CONTINUE is non-nil, it means to continue editing a message already
being composed without asking.  Interactively, CONTINUE is the prefix
argument.

SWITCH-FUNCTION, if non-nil, is a function to use to
switch to and display the buffer used for mail composition.

YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
to insert the raw text of the message being replied to.
It has the form (FUNCTION . ARGS).  The user agent will apply
FUNCTION to ARGS, to insert the raw text of the original message.
\(The user agent will also run `mail-citation-hook', *after* the
original text has been inserted in this way.)

SEND-ACTIONS is a list of actions to call when the message is sent.
Each action has the form (FUNCTION . ARGS).

RETURN-ACTION, if non-nil, is an action for returning to the
caller.  It has the form (FUNCTION . ARGS).  The function is
called after the mail has been sent or put aside, and the mail
buffer buried."
  (interactive
   (list nil nil nil current-prefix-arg))

  ;; In Emacs 23.2, the default value of `mail-user-agent' changed
  ;; from sendmail-user-agent to message-user-agent.  Some users may
  ;; encounter incompatibilities.  This hack tries to detect problems
  ;; and warn about them.
  (and compose-mail-user-agent-warnings
       (eq mail-user-agent 'message-user-agent)
       (let (warn-vars)
	 (dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook
			mail-citation-hook mail-archive-file-name
			mail-default-reply-to mail-mailing-lists
			mail-self-blind))
	   (and (boundp var)
		(symbol-value var)
		(push var warn-vars)))
	 (when warn-vars
	   (display-warning 'mail
			    (format-message "\
The default mail mode is now Message mode.
You have the following Mail mode variable%s customized:
\n  %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
To disable this warning, set `compose-mail-user-agent-warnings' to nil."
				    (if (> (length warn-vars) 1) "s" "")
				    (mapconcat 'symbol-name
					       warn-vars " "))))))

  (let ((function (get mail-user-agent 'composefunc)))
    (unless function
      (error "Invalid value for `mail-user-agent'"))
    (funcall function to subject other-headers continue switch-function
	     yank-action send-actions return-action)))

(defun compose-mail-other-window (&optional to subject other-headers continue
					    yank-action send-actions
					    return-action)
  "Like \\[compose-mail], but edit the outgoing message in another window."
  (interactive (list nil nil nil current-prefix-arg))
  (compose-mail to subject other-headers continue
		'switch-to-buffer-other-window yank-action send-actions
		return-action))

(defun compose-mail-other-frame (&optional to subject other-headers continue
					    yank-action send-actions
					    return-action)
  "Like \\[compose-mail], but edit the outgoing message in another frame."
  (interactive (list nil nil nil current-prefix-arg))
  (compose-mail to subject other-headers continue
		'switch-to-buffer-other-frame yank-action send-actions
		return-action))

\f
(defvar set-variable-value-history nil
  "History of values entered with `set-variable'.

Maximum length of the history list is determined by the value
of `history-length', which see.")

(defun set-variable (variable value &optional make-local)
  "Set VARIABLE to VALUE.  VALUE is a Lisp object.
VARIABLE should be a user option variable name, a Lisp variable
meant to be customized by users.  You should enter VALUE in Lisp syntax,
so if you want VALUE to be a string, you must surround it with doublequotes.
VALUE is used literally, not evaluated.

If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read VALUE.

If VARIABLE has been defined with `defcustom', then the type information
in the definition is used to check that VALUE is valid.

Note that this function is at heart equivalent to the basic `set' function.
For a variable defined with `defcustom', it does not pay attention to
any :set property that the variable might have (if you want that, use
\\[customize-set-variable] instead).

With a prefix argument, set VARIABLE to VALUE buffer-locally.

When called interactively, the user is prompted for VARIABLE and
then VALUE.  The current value of VARIABLE will be put in the
minibuffer history so that it can be accessed with \\`M-n', which
makes it easier to edit it."
  (interactive
   (let* ((default-var (variable-at-point))
          (var (if (custom-variable-p default-var)
		   (read-variable (format-prompt "Set variable" default-var)
				  default-var)
		 (read-variable "Set variable: ")))
	  (minibuffer-help-form `(describe-variable ',var))
	  (prop (get var 'variable-interactive))
          (obsolete (car (get var 'byte-obsolete-variable)))
	  (prompt (format "Set %s %s to value: " var
			  (cond ((local-variable-p var)
				 "(buffer-local)")
				((or current-prefix-arg
				     (local-variable-if-set-p var))
				 "buffer-locally")
				(t "globally"))))
	  (val (progn
                 (when obsolete
                   (message (concat "`%S' is obsolete; "
                                    (if (symbolp obsolete) "use `%S' instead" "%s"))
                            var obsolete)
                   (sit-for 3))
                 (if prop
                     ;; Use VAR's `variable-interactive' property
                     ;; as an interactive spec for prompting.
                     (call-interactively `(lambda (arg)
                                            (interactive ,prop)
                                            arg))
                   (read-from-minibuffer prompt nil
                                         read-expression-map t
                                         'set-variable-value-history
                                         (format "%S" (symbol-value var)))))))
     (list var val current-prefix-arg)))

  (and (custom-variable-p variable)
       (not (get variable 'custom-type))
       (custom-load-symbol variable))
  (let ((type (get variable 'custom-type)))
    (when type
      ;; Match with custom type.
      (require 'cus-edit)
      (setq type (widget-convert type))
      (unless (widget-apply type :match value)
	(user-error "Value `%S' does not match type %S of %S"
		    value (car type) variable))))

  (if make-local
      (make-local-variable variable))

  (set variable value)

  ;; Force a thorough redisplay for the case that the variable
  ;; has an effect on the display, like `tab-width' has.
  (force-mode-line-update))
\f
;; Define the major mode for lists of completions.

(defvar completion-list-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map special-mode-map)
    (define-key map "g" nil) ;; There's nothing to revert from.
    (define-key map [mouse-2] 'choose-completion)
    (define-key map [follow-link] 'mouse-face)
    (define-key map [down-mouse-2] nil)
    (define-key map "\C-m" 'choose-completion)
    (define-key map "\e\e\e" 'delete-completion-window)
    (define-key map [remap keyboard-quit] #'delete-completion-window)
    (define-key map [left] 'previous-completion)
    (define-key map [right] 'next-completion)
    (define-key map [?\t] 'next-completion)
    (define-key map [backtab] 'previous-completion)
    (define-key map "z" 'kill-current-buffer)
    (define-key map "n" 'next-completion)
    (define-key map "p" 'previous-completion)
    (define-key map "\M-g\M-c" 'switch-to-minibuffer)
    map)
  "Local map for completion list buffers.")

;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)

(defvar completion-reference-buffer nil
  "Record the buffer that was current when the completion list was requested.
This is a local variable in the completion list buffer.
Initial value is nil to avoid some compiler warnings.")

(defvar completion-no-auto-exit nil
  "Non-nil means `choose-completion-string' should never exit the minibuffer.
This also applies to other functions such as `choose-completion'.")

(defvar completion-base-position nil
  "Position of the base of the text corresponding to the shown completions.
This variable is used in the *Completions* buffers.
Its value is a list of the form (START END) where START is the place
where the completion should be inserted and END (if non-nil) is the end
of the text to replace.  If END is nil, point is used instead.")

(defvar completion-base-affixes nil
  "Base context of the text corresponding to the shown completions.
This variable is used in the *Completions* buffer.
Its value is a list of the form (PREFIX SUFFIX) where PREFIX is the text
before the place where completion should be inserted, and SUFFIX is the text
after the completion.")

(defvar completion-use-base-affixes nil
  "Non-nil means to restore original prefix and suffix in the minibuffer.")

(defvar completion-list-insert-choice-function #'completion--replace
  "Function to use to insert the text chosen in *Completions*.
Called with three arguments (BEG END TEXT), it should replace the text
between BEG and END with TEXT.  Expected to be set buffer-locally
in the *Completions* buffer.")

(defun delete-completion-window ()
  "Delete the completion list window.
Go to the window from which completion was requested."
  (interactive)
  (let ((buf completion-reference-buffer))
    (if (one-window-p t)
	(if (window-dedicated-p) (delete-frame))
      (delete-window (selected-window))
      (if (get-buffer-window buf)
	  (select-window (get-buffer-window buf))))))

(defcustom completion-wrap-movement t
  "Non-nil means to wrap around when selecting completion options.
This affects the commands `next-completion' and
`previous-completion'."
  :type 'boolean
  :version "29.1"
  :group 'completion)

(defcustom completion-auto-select nil
  "Non-nil means to automatically select the *Completions* buffer.
When the value is t, pressing TAB will switch to the completion list
buffer when Emacs pops up a window showing that buffer.
If the value is `second-tab', then the first TAB will pop up the
window shwoing the completions list buffer, and the next TAB will
switch to that window.
See `completion-auto-help' for controlling when the window showing
the completions is popped up and down."
  :type '(choice (const :tag "Don't auto-select completions window" nil)
                 (const :tag "Select completions window on first TAB" t)
                 (const :tag
                        "Select completions window on second TAB" second-tab))
  :version "29.1"
  :group 'completion)

(defun previous-completion (n)
  "Move to the previous item in the completion list.
With prefix argument N, move back N items (negative N means move
forward).

Also see the `completion-wrap-movement' variable."
  (interactive "p")
  (next-completion (- n)))

(defun next-completion (n)
  "Move to the next item in the completion list.
With prefix argument N, move N items (negative N means move
backward).

Also see the `completion-wrap-movement' variable."
  (interactive "p")
  (let ((prev (previous-single-property-change (point) 'mouse-face)))
    (goto-char (cond
                ((not prev)
                 (1- (next-single-property-change (point) 'mouse-face)))
                ((/= prev (point))
                 (point))
                (t prev))))

  (let ((beg (point-min))
        (end (point-max))
        (tabcommand (member (this-command-keys) '("\t" [backtab])))
        prop)
    (catch 'bound
      (while (> n 0)
        ;; If in a completion, move to the end of it.
        (when (get-text-property (point) 'mouse-face)
          (goto-char (next-single-property-change (point) 'mouse-face nil end)))
        ;; If at the last completion option, wrap or skip to the
        ;; minibuffer, if requested. We can't use (eobp) because some
        ;; extra text may be after the last candidate: ex: when
        ;; completion-detailed
        (setq prop (next-single-property-change (point) 'mouse-face nil end))
        (when (and completion-wrap-movement (eq end prop))
          (if (and completion-auto-select tabcommand)
              (throw 'bound nil)
            (goto-char (point-min))))
        ;; Move to start of next one.
        (unless (get-text-property (point) 'mouse-face)
          (goto-char (next-single-property-change (point) 'mouse-face nil end)))
        (setq n (1- n)))

      (while (and (< n 0) (not (bobp)))
        (setq prop (get-text-property (1- (point)) 'mouse-face))
        ;; If in a completion, move to the start of it.
        (when (and prop (eq prop (get-text-property (point) 'mouse-face)))
          (goto-char (previous-single-property-change
                      (point) 'mouse-face nil beg)))
        ;; Move to end of the previous completion.
        (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
          (goto-char (previous-single-property-change
                      (point) 'mouse-face nil beg)))
        ;; If at the first completion option, wrap or skip to the
        ;; minibuffer, if requested.
        (setq prop (previous-single-property-change (point) 'mouse-face nil beg))
        (when (and completion-wrap-movement (eq beg prop))
          (if (and completion-auto-select tabcommand)
              (progn
                (goto-char (next-single-property-change (point) 'mouse-face nil end))
                (throw 'bound nil))
            (goto-char (point-max))))
        ;; Move to the start of that one.
        (goto-char (previous-single-property-change
                    (point) 'mouse-face nil beg))
        (setq n (1+ n))))
    (when (/= 0 n)
      (switch-to-minibuffer))))

(defun choose-completion (&optional event no-exit no-quit)
  "Choose the completion at point.
If EVENT, use EVENT's position to determine the starting position.
With prefix argument NO-EXIT, insert the completion at point to the
minibuffer, but don't exit the minibuffer.  When the prefix argument
is not provided, then whether to exit the minibuffer depends on the value
of `completion-no-auto-exit'.
If NO-QUIT is non-nil, insert the completion at point to the
minibuffer, but don't quit the completions window."
  (interactive (list last-nonmenu-event current-prefix-arg))
  ;; In case this is run via the mouse, give temporary modes such as
  ;; isearch a chance to turn off.
  (run-hooks 'mouse-leave-buffer-hook)
  (with-current-buffer (window-buffer (posn-window (event-start event)))
    (let ((buffer completion-reference-buffer)
          (base-position completion-base-position)
          (base-affixes completion-base-affixes)
          (insert-function completion-list-insert-choice-function)
          (completion-no-auto-exit (if no-exit t completion-no-auto-exit))
          (choice
           (save-excursion
             (goto-char (posn-point (event-start event)))
             (let (beg)
               (cond
                ((and (not (eobp)) (get-text-property (point) 'mouse-face))
                 (setq beg (1+ (point))))
                ((and (not (bobp))
                      (get-text-property (1- (point)) 'mouse-face))
                 (setq beg (point)))
                (t (error "No completion here")))
               (setq beg (previous-single-property-change beg 'mouse-face))
               (substring-no-properties
                (get-text-property beg 'completion--string))))))

      (unless (buffer-live-p buffer)
        (error "Destination buffer is dead"))
      (unless no-quit
        (quit-window nil (posn-window (event-start event))))

      (with-current-buffer buffer
        (choose-completion-string
         choice buffer
         (or (and completion-use-base-affixes base-affixes)
             base-position
             ;; If all else fails, just guess.
             (list (choose-completion-guess-base-position choice)))
         insert-function)))))

;; Delete the longest partial match for STRING
;; that can be found before POINT.
(defun choose-completion-guess-base-position (string)
  (save-excursion
    (let ((opoint (point))
          len)
      ;; Try moving back by the length of the string.
      (goto-char (max (- (point) (length string))
                      (minibuffer-prompt-end)))
      ;; See how far back we were actually able to move.  That is the
      ;; upper bound on how much we can match and delete.
      (setq len (- opoint (point)))
      (if completion-ignore-case
          (setq string (downcase string)))
      (while (and (> len 0)
                  (let ((tail (buffer-substring (point) opoint)))
                    (if completion-ignore-case
                        (setq tail (downcase tail)))
                    (not (string= tail (substring string 0 len)))))
        (setq len (1- len))
        (forward-char 1))
      (point))))

(defvar choose-completion-string-functions nil
  "Functions that may override the normal insertion of a completion choice.
These functions are called in order with three arguments:
CHOICE - the string to insert in the buffer,
BUFFER - the buffer in which the choice should be inserted,
BASE-POSITION - where to insert the completion.

Functions should also accept and ignore a potential fourth
argument, passed for backwards compatibility.

If a function in the list returns non-nil, that function is supposed
to have inserted the CHOICE in the BUFFER, and possibly exited
the minibuffer; no further functions will be called.

If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")

(defun choose-completion-string (choice &optional
                                        buffer base-position insert-function)
  "Switch to BUFFER and insert the completion choice CHOICE.
BASE-POSITION says where to insert the completion.
INSERT-FUNCTION says how to insert the completion and falls
back on `completion-list-insert-choice-function' when nil."

  ;; If BUFFER is the minibuffer, exit the minibuffer
  ;; unless it is reading a file name and CHOICE is a directory,
  ;; or completion-no-auto-exit is non-nil.

  (let* ((buffer (or buffer completion-reference-buffer))
	 (mini-p (minibufferp buffer)))
    ;; If BUFFER is a minibuffer, barf unless it's the currently
    ;; active minibuffer.
    (if (and mini-p
             (not (and (active-minibuffer-window)
                       (equal buffer
			     (window-buffer (active-minibuffer-window))))))
	(error "Minibuffer is not active for completion")
      ;; Set buffer so buffer-local choose-completion-string-functions works.
      (set-buffer buffer)
      (unless (run-hook-with-args-until-success
	       'choose-completion-string-functions
               ;; The fourth arg used to be `mini-p' but was useless
               ;; (since minibufferp can be used on the `buffer' arg)
               ;; and indeed unused.  The last used to be `base-size', so we
               ;; keep it to try and avoid breaking old code.
	       choice buffer base-position nil)
        ;; This remove-text-properties should be unnecessary since `choice'
        ;; comes from buffer-substring-no-properties.
        ;;(remove-text-properties 0 (length choice) '(mouse-face nil) choice)
	;; Insert the completion into the buffer where it was requested.
        (funcall (or insert-function completion-list-insert-choice-function)
                 (or (car base-position) (point))
                 (or (cadr base-position) (point))
                 choice)
        ;; Update point in the window that BUFFER is showing in.
	(let ((window (get-buffer-window buffer t)))
	  (set-window-point window (point)))
	;; If completing for the minibuffer, exit it with this choice.
	(and (not completion-no-auto-exit)
             (minibufferp buffer)
	     minibuffer-completion-table
	     ;; If this is reading a file name, and the file name chosen
	     ;; is a directory, don't exit the minibuffer.
             (let* ((result (buffer-substring (field-beginning) (point)))
                    (bounds
                     (completion-boundaries result minibuffer-completion-table
                                            minibuffer-completion-predicate
                                            "")))
               (if (eq (car bounds) (length result))
                   ;; The completion chosen leads to a new set of completions
                   ;; (e.g. it's a directory): don't exit the minibuffer yet.
                   (let ((mini (active-minibuffer-window)))
                     (select-window mini)
                     (when minibuffer-auto-raise
                       (raise-frame (window-frame mini))))
                 (exit-minibuffer))))))))

(define-derived-mode completion-list-mode nil "Completion List"
  "Major mode for buffers showing lists of possible completions.
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
 to select the completion near point.
Or click to select one with the mouse.

See the `completions-format' user option to control how this
buffer is formatted.

\\{completion-list-mode-map}")

(defun completion-list-mode-finish ()
  "Finish setup of the completions buffer.
Called from `temp-buffer-show-hook'."
  (when (eq major-mode 'completion-list-mode)
    (setq buffer-read-only t)))

(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)


;; Variables and faces used in `completion-setup-function'.

(defcustom completion-show-help t
  "Non-nil means show help message in *Completions* buffer."
  :type 'boolean
  :version "22.1"
  :group 'completion)

;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
  (let* ((mainbuf (current-buffer))
         (base-dir
          ;; FIXME: This is a bad hack.  We try to set the default-directory
          ;; in the *Completions* buffer so that the relative file names
          ;; displayed there can be treated as valid file names, independently
          ;; from the completion context.  But this suffers from many problems:
          ;; - It's not clear when the completions are file names.  With some
          ;;   completion tables (e.g. bzr revision specs), the listed
          ;;   completions can mix file names and other things.
          ;; - It doesn't pay attention to possible quoting.
          ;; - With fancy completion styles, the code below will not always
          ;;   find the right base directory.
          (if minibuffer-completing-file-name
              (file-name-as-directory
               (expand-file-name
                (buffer-substring (minibuffer-prompt-end) (point)))))))
    (with-current-buffer standard-output
      (let ((base-position completion-base-position)
            (base-affixes completion-base-affixes)
            (insert-fun completion-list-insert-choice-function))
        (completion-list-mode)
        (setq-local completion-base-position base-position)
        (setq-local completion-base-affixes base-affixes)
        (setq-local completion-list-insert-choice-function insert-fun))
      (setq-local completion-reference-buffer mainbuf)
      (if base-dir (setq default-directory base-dir))
      (when completion-tab-width
        (setq tab-width completion-tab-width))
      ;; Maybe enable cursor completions-highlight.
      (when completions-highlight-face
        (cursor-face-highlight-mode 1))
      ;; Maybe insert help string.
      (when completion-show-help
	(goto-char (point-min))
	(if (display-mouse-p)
	    (insert "Click on a completion to select it.\n"))
	(insert (substitute-command-keys
		 "In this buffer, type \\[choose-completion] to \
select the completion near point.\n\n")))))
  (when (eq completion-auto-select t)
    (switch-to-completions)))

(add-hook 'completion-setup-hook #'completion-setup-function)

(defun switch-to-completions ()
  "Select the completion list window."
  (interactive)
  (when-let ((window (or (get-buffer-window "*Completions*" 0)
		         ;; Make sure we have a completions window.
                         (progn (minibuffer-completion-help)
                                (get-buffer-window "*Completions*" 0)))))
    (select-window window)
    (when (bobp)
      (cond
       ((and (memq this-command '(completion-at-point minibuffer-complete))
             (equal (this-command-keys) [backtab]))
        (goto-char (point-max))
        (previous-completion 1))
       (t (next-completion 1))))))

(defun read-expression-switch-to-completions ()
  "Select the completion list window while reading an expression."
  (interactive)
  (completion-help-at-point)
  (switch-to-completions))

(defun switch-to-minibuffer ()
  "Select the minibuffer window."
  (interactive)
  (when (active-minibuffer-window)
    (select-window (active-minibuffer-window))))
\f
;;; Support keyboard commands to turn on various modifiers.

;; These functions -- which are not commands -- each add one modifier
;; to the following event.

(defun event-apply-alt-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Alt modifier to the following event.
For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
  (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Super modifier to the following event.
For example, type \\[event-apply-super-modifier] & to enter Super-&."
  (vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Hyper modifier to the following event.
For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
  (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Shift modifier to the following event.
For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
  (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Ctrl modifier to the following event.
For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
  (vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (_ignore-prompt)
  "\\<function-key-map>Add the Meta modifier to the following event.
For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
  (vector (event-apply-modifier (read-event) 'meta 27 "M-")))

(defun event-apply-modifier (event symbol lshiftby prefix)
  "Apply a modifier flag to event EVENT.
SYMBOL is the name of this modifier, as a symbol.
LSHIFTBY is the numeric value of this modifier, in keyboard events.
PREFIX is the string that represents this modifier in an event type symbol."
  (if (numberp event)
      (cond ((eq symbol 'control)
	     (if (<= 64 (upcase event) 95)
		 (- (upcase event) 64)
	       (logior (ash 1 lshiftby) event)))
	    ((eq symbol 'shift)
             ;; FIXME: Should we also apply this "upcase" behavior of shift
             ;; to non-ascii letters?
	     (if (and (<= (downcase event) ?z)
		      (>= (downcase event) ?a))
		 (upcase event)
	       (logior (ash 1 lshiftby) event)))
	    (t
	     (logior (ash 1 lshiftby) event)))
    (if (memq symbol (event-modifiers event))
	event
      (let ((event-type (if (symbolp event) event (car event))))
	(setq event-type (intern (concat prefix (symbol-name event-type))))
	(if (symbolp event)
	    event-type
	  (cons event-type (cdr event)))))))

(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
\f
;;;; Keypad support.

;; Make the keypad keys act like ordinary typing keys.  If people add
;; bindings for the function key symbols, then those bindings will
;; override these, so this shouldn't interfere with any existing
;; bindings.

;; Also tell read-char how to handle these keys.
(mapc
 (lambda (keypad-normal)
   (let ((keypad (nth 0 keypad-normal))
	 (normal (nth 1 keypad-normal)))
     (put keypad 'ascii-character normal)
     (define-key function-key-map (vector keypad) (vector normal))))
 ;; See also kp-keys bound in bindings.el.
 '((kp-space ?\s)
   (kp-tab ?\t)
   (kp-enter ?\r)
   (kp-separator ?,)
   (kp-equal ?=)
   ;; Do the same for various keys that are represented as symbols under
   ;; GUIs but naturally correspond to characters.
   (backspace 127)
   (delete 127)
   (tab ?\t)
   (linefeed ?\n)
   (clear ?\C-l)
   (return ?\C-m)
   (escape ?\e)
   ))
\f
;;;;
;;;; forking a twin copy of a buffer.
;;;;

(defvar clone-buffer-hook nil
  "Normal hook to run in the new buffer at the end of `clone-buffer'.")

(defun clone-process (process &optional newname)
  "Create a twin copy of PROCESS.
If NEWNAME is nil, it defaults to PROCESS' name;
NEWNAME is modified by adding or incrementing <N> at the end as necessary.
If PROCESS is associated with a buffer, the new process will be associated
  with the current buffer instead.
Returns nil if PROCESS has already terminated."
  (setq newname (or newname (process-name process)))
  (if (string-match "<[0-9]+>\\'" newname)
      (setq newname (substring newname 0 (match-beginning 0))))
  (when (memq (process-status process) '(run stop open))
    (let* ((process-connection-type (process-tty-name process))
	   (new-process
	    (if (memq (process-status process) '(open))
		(let ((args (process-contact process t)))
		  (setq args (plist-put args :name newname))
		  (setq args (plist-put args :buffer
					(if (process-buffer process)
					    (current-buffer))))
		  (apply 'make-network-process args))
	      (apply 'start-process newname
		     (if (process-buffer process) (current-buffer))
		     (process-command process)))))
      (set-process-query-on-exit-flag
       new-process (process-query-on-exit-flag process))
      (set-process-inherit-coding-system-flag
       new-process (process-inherit-coding-system-flag process))
      (set-process-filter new-process (process-filter process))
      (set-process-sentinel new-process (process-sentinel process))
      (set-process-plist new-process (copy-sequence (process-plist process)))
      new-process)))

;; things to maybe add (currently partly covered by `funcall mode'):
;; - syntax-table
;; - overlays
(defun clone-buffer (&optional newname display-flag)
  "Create and return a twin copy of the current buffer.
Unlike an indirect buffer, the new buffer can be edited
independently of the old one (if it is not read-only).
NEWNAME is the name of the new buffer.  It may be modified by
adding or incrementing <N> at the end as necessary to create a
unique buffer name.  If nil, it defaults to the name of the
current buffer, with the proper suffix.  If DISPLAY-FLAG is
non-nil, the new buffer is shown with `pop-to-buffer'.  Trying to
clone a file-visiting buffer, or a buffer whose major mode symbol
has a non-nil `no-clone' property, results in an error.

Interactively, DISPLAY-FLAG is t and NEWNAME is the name of the
current buffer with appropriate suffix.  However, if a prefix
argument is given, then the command prompts for NEWNAME in the
minibuffer.

This runs the normal hook `clone-buffer-hook' in the new buffer
after it has been set up properly in other respects."
  (interactive
   (progn
     (if buffer-file-name
	 (error "Cannot clone a file-visiting buffer"))
     (if (get major-mode 'no-clone)
	 (error "Cannot clone a buffer in %s mode" mode-name))
     (list (if current-prefix-arg
	       (read-buffer "Name of new cloned buffer: " (current-buffer)))
	   t)))
  (if buffer-file-name
      (error "Cannot clone a file-visiting buffer"))
  (if (get major-mode 'no-clone)
      (error "Cannot clone a buffer in %s mode" mode-name))
  (setq newname (or newname (buffer-name)))
  (if (string-match "<[0-9]+>\\'" newname)
      (setq newname (substring newname 0 (match-beginning 0))))
  (let ((buf (current-buffer))
	(ptmin (point-min))
	(ptmax (point-max))
	(pt (point))
	(mk (if mark-active (mark t)))
	(modified (buffer-modified-p))
	(mode major-mode)
	(lvars (buffer-local-variables))
	(process (get-buffer-process (current-buffer)))
	(new (generate-new-buffer (or newname (buffer-name)))))
    (save-restriction
      (widen)
      (with-current-buffer new
	(insert-buffer-substring buf)))
    (with-current-buffer new
      (narrow-to-region ptmin ptmax)
      (goto-char pt)
      (if mk (set-mark mk))
      (set-buffer-modified-p modified)

      ;; Clone the old buffer's process, if any.
      (when process (clone-process process))

      ;; Now set up the major mode.
      (funcall mode)

      ;; Set up other local variables.
      (mapc (lambda (v)
	      (condition-case ()
		  (if (symbolp v)
		      (makunbound (make-local-variable v))
		    (set (make-local-variable (car v)) (cdr v)))
		(setting-constant nil))) ;E.g. for enable-multibyte-characters.
	    lvars)

      (setq mark-ring (mapcar (lambda (mk) (copy-marker (marker-position mk)))
                              mark-ring))

      ;; Run any hooks (typically set up by the major mode
      ;; for cloning to work properly).
      (run-hooks 'clone-buffer-hook))
    (if display-flag
        ;; Presumably the current buffer is shown in the selected frame, so
        ;; we want to display the clone elsewhere.
        (let ((same-window-regexps nil)
              (same-window-buffer-names))
          (pop-to-buffer new)))
    new))


(defun clone-indirect-buffer (newname display-flag &optional norecord)
  "Create an indirect buffer that is a twin copy of the current buffer.

Give the indirect buffer name NEWNAME.  Interactively, read NEWNAME
from the minibuffer when invoked with a prefix arg.  If NEWNAME is nil
or if not called with a prefix arg, NEWNAME defaults to the current
buffer's name.  The name is modified by adding a `<N>' suffix to it
or by incrementing the N in an existing suffix.  Trying to clone a
buffer whose major mode symbol has a non-nil `no-clone-indirect'
property results in an error.

DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
This is always done when called interactively.

Optional third arg NORECORD non-nil means do not put this buffer at the
front of the list of recently selected ones.

Returns the newly created indirect buffer."
  (interactive
   (progn
     (if (get major-mode 'no-clone-indirect)
	 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
     (list (if current-prefix-arg
	       (read-buffer "Name of indirect buffer: " (current-buffer)))
	   t)))
  (if (get major-mode 'no-clone-indirect)
      (error "Cannot indirectly clone a buffer in %s mode" mode-name))
  (setq newname (or newname (buffer-name)))
  (if (string-match "<[0-9]+>\\'" newname)
      (setq newname (substring newname 0 (match-beginning 0))))
  (let* ((name (generate-new-buffer-name newname))
	 (buffer (make-indirect-buffer (current-buffer) name t)))
    (when display-flag
      (pop-to-buffer buffer nil norecord))
    buffer))


(defun clone-indirect-buffer-other-window (newname display-flag &optional norecord)
  "Like `clone-indirect-buffer' but display in another window."
  (interactive
   (progn
     (if (get major-mode 'no-clone-indirect)
	 (error "Cannot indirectly clone a buffer in %s mode" mode-name))
     (list (if current-prefix-arg
	       (read-buffer "Name of indirect buffer: " (current-buffer)))
	   t)))
  (let ((pop-up-windows t))
    (clone-indirect-buffer newname display-flag norecord)))

\f
;;; Handling of Backspace and Delete keys.

(defcustom normal-erase-is-backspace 'maybe
  "Set the default behavior of the Delete and Backspace keys.

If set to t, Delete key deletes forward and Backspace key deletes
backward.

If set to nil, both Delete and Backspace keys delete backward.

If set to `maybe' (which is the default), Emacs automatically
selects a behavior.  On window systems, the behavior depends on
the keyboard used.  If the keyboard has both a Backspace key and
a Delete key, and both are mapped to their usual meanings, the
option's default value is set to t, so that Backspace can be used
to delete backward, and Delete can be used to delete forward.

If not running under a window system, customizing this option
accomplishes a similar effect by mapping C-h, which is usually
generated by the Backspace key, to DEL, and by mapping DEL to C-d
via `keyboard-translate'.  The former functionality of C-h is
available on the F1 key.  You should probably not use this
setting if you don't have both Backspace, Delete and F1 keys.

Setting this variable with setq doesn't take effect.  Programmatically,
call `normal-erase-is-backspace-mode' (which see) instead."
  :type '(choice (const :tag "Off" nil)
		 (const :tag "Maybe" maybe)
		 (other :tag "On" t))
  :group 'editing-basics
  :version "21.1"
  :set (lambda (symbol value)
	 ;; The fboundp is because of a problem with :set when
	 ;; dumping Emacs.  It doesn't really matter.
	 (when (fboundp 'normal-erase-is-backspace-mode)
	   (normal-erase-is-backspace-mode (or value 0)))
	 (set-default symbol value)))

(defun normal-erase-is-backspace-setup-frame (&optional frame)
  "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
  (unless frame (setq frame (selected-frame)))
  (with-selected-frame frame
    (unless (terminal-parameter nil 'normal-erase-is-backspace)
      (normal-erase-is-backspace-mode
       (if (if (eq normal-erase-is-backspace 'maybe)
               (and (not noninteractive)
                    (or (memq system-type '(ms-dos windows-nt))
			(memq window-system '(w32 ns pgtk))
                        (and (eq window-system 'x)
                             (fboundp 'x-backspace-delete-keys-p)
                             (x-backspace-delete-keys-p))
                        ;; If the terminal Emacs is running on has erase char
                        ;; set to ^H, use the Backspace key for deleting
                        ;; backward, and the Delete key for deleting forward.
                        (and (null window-system)
                             (eq tty-erase-char ?\^H))))
             normal-erase-is-backspace)
           1 0)))))

(declare-function display-symbol-keys-p "frame" (&optional display))

(define-minor-mode normal-erase-is-backspace-mode
  "Toggle the Erase and Delete mode of the Backspace and Delete keys.

On window systems, when this mode is on, Delete is mapped to C-d
and Backspace is mapped to DEL; when this mode is off, both
Delete and Backspace are mapped to DEL.  (The remapping goes via
`local-function-key-map', so binding Delete or Backspace in the
global or local keymap will override that.)

In addition, on window systems, the bindings of C-Delete, M-Delete,
C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in
the global keymap in accordance with the functionality of Delete and
Backspace.  For example, if Delete is remapped to C-d, which deletes
forward, C-Delete is bound to `kill-word', but if Delete is remapped
to DEL, which deletes backward, C-Delete is bound to
`backward-kill-word'.

If not running on a window system, a similar effect is accomplished by
remapping C-h (normally produced by the Backspace key) and DEL via
`keyboard-translate': if this mode is on, C-h is mapped to DEL and DEL
to C-d; if it's off, the keys are not remapped.

When not running on a window system, and this mode is turned on, the
former functionality of C-h is available on the F1 key.  You should
probably not turn on this mode on a text-only terminal if you don't
have both Backspace, Delete and F1 keys.

See also `normal-erase-is-backspace'."
  :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1)
             . (lambda (v)
                 (setf (terminal-parameter nil 'normal-erase-is-backspace)
                       (if v 1 0))))
  (let ((enabled (eq 1 (terminal-parameter
                        nil 'normal-erase-is-backspace))))

    (cond ((display-symbol-keys-p)
	   (let ((bindings
		  '(([M-delete] [M-backspace])
		    ([C-M-delete] [C-M-backspace])
		    ([?\e C-delete] [?\e C-backspace]))))

	     (if enabled
		 (progn
		   (define-key local-function-key-map [delete] [deletechar])
		   (define-key local-function-key-map [kp-delete] [deletechar])
		   (define-key local-function-key-map [backspace] [?\C-?])
                   (dolist (b bindings)
                     ;; Not sure if input-decode-map is really right, but
                     ;; keyboard-translate-table (used below) works only
                     ;; for integer events, and key-translation-table is
                     ;; global (like the global-map, used earlier).
                     (define-key input-decode-map (car b) nil)
                     (define-key input-decode-map (cadr b) nil)))
	       (define-key local-function-key-map [delete] [?\C-?])
	       (define-key local-function-key-map [kp-delete] [?\C-?])
	       (define-key local-function-key-map [backspace] [?\C-?])
               (dolist (b bindings)
                 (define-key input-decode-map (car b) (cadr b))
                 (define-key input-decode-map (cadr b) (car b))))))
	  (t
	   (if enabled
	       (progn
		 (keyboard-translate ?\C-h ?\C-?)
		 (keyboard-translate ?\C-? ?\C-d))
	     (keyboard-translate ?\C-h ?\C-h)
	     (keyboard-translate ?\C-? ?\C-?))))

    (if (called-interactively-p 'interactive)
	(message "Delete key deletes %s"
		 (if (eq 1 (terminal-parameter nil 'normal-erase-is-backspace))
		     "forward" "backward")))))
\f
(defvar vis-mode-saved-buffer-invisibility-spec nil
  "Saved value of `buffer-invisibility-spec' when Visible mode is on.")

(define-minor-mode read-only-mode
  "Change whether the current buffer is read-only.

If buffer is read-only and `view-read-only' is non-nil, enter
view mode.

Do not call this from a Lisp program unless you really intend to
do the same thing as the \\[read-only-mode] command, including
possibly enabling or disabling View mode.  Also, note that this
command works by setting the variable `buffer-read-only', which
does not affect read-only regions caused by text properties.  To
ignore read-only status in a Lisp program (whether due to text
properties or buffer state), bind `inhibit-read-only' temporarily
to a non-nil value."
  :variable buffer-read-only
  (cond
   ((and (not buffer-read-only) view-mode)
    (View-exit-and-edit)
    (setq-local view-read-only t))		; Must leave view mode.
   ((and buffer-read-only view-read-only
         ;; If view-mode is already active, `view-mode-enter' is a nop.
         (not view-mode)
         (not (eq (get major-mode 'mode-class) 'special)))
    (view-mode-enter))))

(define-minor-mode visible-mode
  "Toggle making all invisible text temporarily visible (Visible mode).

This mode works by saving the value of `buffer-invisibility-spec'
and setting it to nil."
  :lighter " Vis"
  :group 'editing-basics
  (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
    (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
    (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
  (when visible-mode
    (setq-local vis-mode-saved-buffer-invisibility-spec
                buffer-invisibility-spec)
    (setq buffer-invisibility-spec nil)))
\f
(defvar messages-buffer-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map special-mode-map)
    (define-key map "g" nil)            ; nothing to revert
    map))

(define-derived-mode messages-buffer-mode special-mode "Messages"
  "Major mode used in the \"*Messages*\" buffer.")

(defun messages-buffer ()
  "Return the \"*Messages*\" buffer.
If it does not exist, create it and switch it to `messages-buffer-mode'."
  (or (get-buffer "*Messages*")
      (with-current-buffer (get-buffer-create "*Messages*")
        (messages-buffer-mode)
        (current-buffer))))

\f
;; Minibuffer prompt stuff.

;;(defun minibuffer-prompt-modification (start end)
;;  (error "You cannot modify the prompt"))
;;
;;
;;(defun minibuffer-prompt-insertion (start end)
;;  (let ((inhibit-modification-hooks t))
;;    (delete-region start end)
;;    ;; Discard undo information for the text insertion itself
;;    ;; and for the text deletion.above.
;;    (when (consp buffer-undo-list)
;;      (setq buffer-undo-list (cddr buffer-undo-list)))
;;    (message "You cannot modify the prompt")))
;;
;;
;;(setq minibuffer-prompt-properties
;;  (list 'modification-hooks '(minibuffer-prompt-modification)
;;	'insert-in-front-hooks '(minibuffer-prompt-insertion)))

\f
;;;; Problematic external packages.

;; rms says this should be done by specifying symbols that define
;; versions together with bad values.  This is therefore not as
;; flexible as it could be.  See the thread:
;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00300.html
(defconst bad-packages-alist nil
  "Alist of packages known to cause problems in this version of Emacs.
Each element has the form (PACKAGE SYMBOL REGEXP STRING).
PACKAGE is either a regular expression to match file names, or a
symbol (a feature name), like for `with-eval-after-load'.
SYMBOL is either the name of a string variable, or t.  Upon
loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
warning using STRING as the message.")
(make-obsolete-variable 'bad-packages-alist nil "29.1")

(defun bad-package-check (package)
  "Run a check using the element from `bad-packages-alist' matching PACKAGE."
  (declare (obsolete nil "29.1"))
  (condition-case nil
      (let* ((list (assoc package bad-packages-alist))
             (symbol (nth 1 list)))
        (and list
             (boundp symbol)
             (or (eq symbol t)
                 (and (stringp (setq symbol (symbol-value symbol)))
                      (string-match-p (nth 2 list) symbol)))
             (display-warning package (nth 3 list) :warning)))
    (error nil)))

\f
;;; Generic dispatcher commands

;; Macro `define-alternatives' is used to create generic commands.
;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
;; that can have different alternative implementations where choosing
;; among them is exclusively a matter of user preference.

;; (define-alternatives COMMAND) creates a new interactive command
;; M-x COMMAND and a customizable variable COMMAND-alternatives.
;; Typically, the user will not need to customize this variable; packages
;; wanting to add alternative implementations should use
;;
;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives

(defmacro define-alternatives (command &rest customizations)
  "Define the new command `COMMAND'.

The argument `COMMAND' should be a symbol.

Running `\\[execute-extended-command] COMMAND RET' for \
the first time prompts for which
alternative to use and records the selected command as a custom
variable.

Running `\\[universal-argument] \\[execute-extended-command] COMMAND RET' \
prompts again for an alternative
and overwrites the previous choice.

The variable `COMMAND-alternatives' contains an alist with
alternative implementations of COMMAND.  `define-alternatives'
does not have any effect until this variable is set.

CUSTOMIZATIONS, if non-nil, should be composed of alternating
`defcustom' keywords and values to add to the declaration of
`COMMAND-alternatives' (typically :group and :version)."
  (declare (indent defun))
  (let* ((command-name (symbol-name command))
         (varalt-name (concat command-name "-alternatives"))
         (varalt-sym (intern varalt-name))
         (varimp-sym (intern (concat command-name "--implementation"))))
    `(progn

       (defcustom ,varalt-sym nil
         ,(format "Alist of alternative implementations for the `%s' command.

Each entry must be a pair (ALTNAME . ALTFUN), where:
ALTNAME - The name shown at user to describe the alternative implementation.
ALTFUN  - The function called to implement this alternative."
                  command-name)
         :type '(alist :key-type string :value-type function)
         ,@customizations)

       (put ',varalt-sym 'definition-name ',command)
       (defvar ,varimp-sym nil "Internal use only.")

       (defun ,command (&optional arg)
         ,(format "Run generic command `%s'.
If used for the first time, or with interactive ARG, ask the user which
implementation to use for `%s'.  The variable `%s'
contains the list of implementations currently supported for this command."
                  command-name command-name varalt-name)
         (interactive "P")
         (when (or arg (null ,varimp-sym))
           (let ((val (completing-read
		       ,(format-message
                         "Select implementation for command `%s': "
                         command-name)
		       ,varalt-sym nil t)))
             (unless (string-equal val "")
	       (when (null ,varimp-sym)
		 (message
		  "Use `C-u M-x %s RET' to select another implementation"
		  ,command-name)
		 (sit-for 3))
	       (customize-save-variable ',varimp-sym
					(cdr (assoc-string val ,varalt-sym))))))
         (if ,varimp-sym
             (call-interactively ,varimp-sym)
           (message "%s" ,(format-message
                           "No implementation selected for command `%s'"
                           command-name)))))))

\f
;;; Functions for changing capitalization that Do What I Mean
(defun upcase-dwim (arg)
  "Upcase words in the region, if active; if not, upcase word at point.
If the region is active, this function calls `upcase-region'.
Otherwise, it calls `upcase-word', with prefix argument passed to it
to upcase ARG words."
  (interactive "*p")
  (if (use-region-p)
      (upcase-region (region-beginning) (region-end) (region-noncontiguous-p))
    (upcase-word arg)))

(defun downcase-dwim (arg)
    "Downcase words in the region, if active; if not, downcase word at point.
If the region is active, this function calls `downcase-region'.
Otherwise, it calls `downcase-word', with prefix argument passed to it
to downcase ARG words."
  (interactive "*p")
  (if (use-region-p)
      (downcase-region (region-beginning) (region-end) (region-noncontiguous-p))
    (downcase-word arg)))

(defun capitalize-dwim (arg)
  "Capitalize words in the region, if active; if not, capitalize word at point.
If the region is active, this function calls `capitalize-region'.
Otherwise, it calls `capitalize-word', with prefix argument passed to it
to capitalize ARG words."
  (interactive "*p")
  (if (use-region-p)
      (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
    (capitalize-word arg)))

;;; Accessors for `decode-time' values.

(cl-defstruct (decoded-time
               (:constructor nil)
               (:copier nil)
               (:type list))
  (second nil :documentation "\
This is an integer or a Lisp timestamp (TICKS . HZ) representing a nonnegative
number of seconds less than 61.  (If not less than 60, it is a leap second,
which only some operating systems support.)")
  (minute nil :documentation "This is an integer between 0 and 59 (inclusive).")
  (hour nil :documentation "This is an integer between 0 and 23 (inclusive).")
  (day nil :documentation "This is an integer between 1 and 31 (inclusive).")
  (month nil :documentation "\
This is an integer between 1 and 12 (inclusive).  January is 1.")
  (year nil :documentation "This is a four digit integer.")
  (weekday nil :documentation "\
This is a number between 0 and 6, and 0 is Sunday.")
  (dst nil :documentation "\
This is t if daylight saving time is in effect, nil if it is not
in effect, and -1 if daylight saving information is not
available.")
  (zone nil :documentation "\
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich.")
  )

(defun get-scratch-buffer-create ()
  "Return the *scratch* buffer, creating a new one if needed."
  (or (get-buffer "*scratch*")
      (let ((scratch (get-buffer-create "*scratch*")))
        ;; Don't touch the buffer contents or mode unless we know that
        ;; we just created it.
        (with-current-buffer scratch
          (when initial-scratch-message
            (insert (substitute-command-keys initial-scratch-message))
            (set-buffer-modified-p nil))
          (funcall initial-major-mode))
        scratch)))

(defun scratch-buffer ()
  "Switch to the *scratch* buffer.
If the buffer doesn't exist, create it first."
  (interactive)
  (pop-to-buffer-same-window (get-scratch-buffer-create)))

\f

(provide 'simple)

;;; simple.el ends here

debug log:

solving bee7e90f72 ...
found bee7e90f72 in https://yhetil.org/emacs-devel/87y1ytd9if.fsf@elite.giraud/
found cd7a82b7ac in https://git.savannah.gnu.org/cgit/emacs.git
preparing index
index prepared:
100644 cd7a82b7acaf9abe1122fdb3f9b50c5409ef3114	lisp/simple.el

applying [1/1] https://yhetil.org/emacs-devel/87y1ytd9if.fsf@elite.giraud/
diff --git a/lisp/simple.el b/lisp/simple.el
index cd7a82b7ac..bee7e90f72 100644

Checking patch lisp/simple.el...
Applied patch lisp/simple.el cleanly.

index at:
100644 bee7e90f72c1f0a0e1012299ce0ebe00105f045b	lisp/simple.el

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).