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
|
;;; csv-mode.el --- Major mode for editing comma/char separated values -*- lexical-binding: t -*-
;; Copyright (C) 2003-2024 Free Software Foundation, Inc
;; Author: "Francis J. Wright" <F.J.Wright@qmul.ac.uk>
;; Maintainer: emacs-devel@gnu.org
;; Version: 1.27
;; Package-Requires: ((emacs "27.1") (cl-lib "0.5"))
;; Keywords: convenience
;; This package 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, or (at your option)
;; any later version.
;; This package 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:
;; This package implements CSV mode, a major mode for editing records
;; in a generalized CSV (character-separated values) format. It binds
;; files with prefix ".csv" to `csv-mode' (and ".tsv" to `tsv-mode') in
;; `auto-mode-alist'.
;; In CSV mode, the following commands are available:
;; - C-c C-s (`csv-sort-fields') and C-c C-n (`csv-sort-numeric-fields')
;; respectively sort lexicographically and numerically on a
;; specified field or column.
;; - C-c C-r (`csv-reverse-region') reverses the order. (These
;; commands are based closely on, and use, code in `sort.el'.)
;; - C-c C-k (`csv-kill-fields') and C-c C-y (`csv-yank-fields') kill
;; and yank fields or columns, although they do not use the normal
;; kill ring. C-c C-k can kill more than one field at once, but
;; multiple killed fields can be yanked only as a fixed group
;; equivalent to a single field.
;; - `csv-align-mode' keeps fields visually aligned, on-the-fly.
;; It truncates fields to a maximum width that can be changed per-column
;; with `csv-align-set-column-width'.
;; Alternatively, C-c C-a (`csv-align-fields') aligns fields into columns
;; and C-c C-u (`csv-unalign-fields') undoes such alignment;
;; separators can be hidden within aligned records (controlled by
;; `csv-invisibility-default' and `csv-toggle-invisibility').
;; - C-c C-t (`csv-transpose') interchanges rows and columns. For
;; details, see the documentation for the individual commands.
;; - `csv-set-separator' sets the CSV separator of the current buffer,
;; while `csv-guess-set-separator' guesses and sets the separator
;; based on the current buffer's contents.
;; `csv-guess-set-separator' can be useful to add to the mode hook
;; to have CSV mode guess and set the separator automatically when
;; visiting a buffer:
;;
;; (add-hook 'csv-mode-hook 'csv-guess-set-separator)
;; CSV mode can recognize fields separated by any of several single
;; characters, specified by the value of the customizable user option
;; `csv-separators'. CSV data fields can be delimited by quote
;; characters (and must if they contain separator characters). This
;; implementation supports quoted fields, where the quote characters
;; allowed are specified by the value of the customizable user option
;; `csv-field-quotes'. By default, the both commas and tabs are considered
;; as separators and the only field quote is a double quote.
;; These user options can be changed ONLY by customizing them, e.g. via M-x
;; customize-variable.
;; CSV mode commands ignore blank lines and comment lines beginning
;; with the value of the buffer local variable `csv-comment-start',
;; which by default is #. The user interface is similar to that of
;; the standard commands `sort-fields' and `sort-numeric-fields', but
;; see the major mode documentation below.
;; The global minor mode `csv-field-index-mode' provides display of
;; the current field index in the mode line, cf. `line-number-mode'
;; and `column-number-mode'. It is on by default.
;;;; See also:
;; the standard GNU Emacs 21 packages align.el, which will align
;; columns within a region, and delim-col.el, which helps to prettify
;; columns in a text region or rectangle;
;; csv.el by Ulf Jasper <ulf.jasper at web.de>, which provides
;; functions for reading/parsing comma-separated value files and is
;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in
;; the gnu.emacs.sources archives).
;;; Installation:
;; Put this file somewhere that Emacs can find it (i.e. in one of the
;; directories in your `load-path' such as `site-lisp'), optionally
;; byte-compile it (recommended), and put this in your .emacs file:
;;
;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
;; (autoload 'csv-mode "csv-mode"
;; "Major mode for editing comma-separated value files." t)
;;; News:
;; Since 1.27:
;; - `csv-end-of-field' no longer errors out in the presence of
;; unclosed quotes.
;; Since 1.26:
;; - `csv-guess-separator' will no longer guess the comment-start
;; character as a potential separator character.
;; Since 1.25:
;; - The ASCII control character 31 Unit Separator can now be
;; recognized as a CSV separator by `csv-guess-separator'.
;; Since 1.24:
;; - New function `csv--unquote-value'.
;; - New function `csv-parse-current-row'.
;; Since 1.21:
;; - New command `csv-insert-column'.
;; - New config var `csv-align-min-width' for `csv-align-mode'.
;; - New option `csv-confirm-region'.
;; Since 1.20:
;; - New command `csv-guess-set-separator' that automatically guesses
;; and sets the CSV separator of the current buffer.
;; - New command `csv-set-separator' for setting the CSV separator
;; manually.
;; Since 1.9:
;; - `csv-align-mode' auto-aligns columns dynamically (on screen).
;; Before that:
;; Begun on 15 November 2003 to provide lexicographic sorting of
;; simple CSV data by field and released as csv.el. Facilities to
;; kill multiple fields and customize separator added on 9 April 2004.
;; Converted to a major mode and renamed csv-mode.el on 10 April 2004,
;; partly at the suggestion of Stefan Monnier <monnier at
;; IRO.UMontreal.CA> to avoid conflict with csv.el by Ulf Jasper.
;; Field alignment, comment support and CSV mode customization group
;; added on 1 May 2004. Support for index ranges added on 6 June
;; 2004. Multiple field separators added on 12 June 2004.
;; Transposition added on 22 June 2004. Separator invisibility added
;; on 23 June 2004.
;;; To do (maybe):
;; Make separators and quotes buffer-local and locally settable.
;; Support (La)TeX tables: set separator and comment; support record
;; end string.
;; Convert comma-separated to space- or tab-separated.
;;; Code:
(eval-when-compile
(require 'cl-lib)
(require 'subr-x))
(defgroup CSV nil
"Major mode for editing files of comma-separated value type."
:group 'convenience)
(defvar csv-separator-chars nil
"Field separators as a list of character.
Set by customizing `csv-separators' -- do not set directly!")
(defvar csv-separator-regexp nil
"Regexp to match a field separator.
Set by customizing `csv-separators' -- do not set directly!")
(defvar csv--skip-chars nil
"Char set used by `skip-chars-forward' etc. to skip fields.
Set by customizing `csv-separators' -- do not set directly!")
(defvar csv-font-lock-keywords nil
"Font lock keywords to highlight the field separators in CSV mode.
Set by customizing `csv-separators' -- do not set directly!")
(defcustom csv-separators '("," "\t")
"Field separators: a list of *single-character* strings.
For example: (\",\"), the default, or (\",\" \";\" \":\").
Neighbouring fields may be separated by any one of these characters.
The first is used when inserting a field separator into the buffer.
All must be different from the field quote characters, `csv-field-quotes'.
Changing this variable with `setq' won't affect the current Emacs
session. Use `customize-set-variable' instead if that is required."
;; Suggested by Eckhard Neber <neber@mwt.e-technik.uni-ulm.de>
:type '(repeat string)
;; FIXME: Character would be better, but in Emacs 21.3 does not display
;; correctly in a customization buffer.
:set (lambda (variable value)
(mapc (lambda (x)
(if (/= (length x) 1)
(error "Non-single-char string %S" x))
(if (and (boundp 'csv-field-quotes)
(member x csv-field-quotes))
(error "%S is already a quote" x)))
value)
(custom-set-default variable value)
(setq csv-separator-chars (mapcar #'string-to-char value))
(setq csv--skip-chars
(apply #'concat "^\n"
(mapcar (lambda (s) (concat "\\" s)) value)))
(setq csv-separator-regexp (regexp-opt value))
(setq csv-font-lock-keywords
;; NB: csv-separator-face variable evaluates to itself.
`((,csv-separator-regexp (0 'csv-separator-face))))))
(defcustom csv-field-quotes '("\"")
"Field quotes: a list of *single-character* strings.
For example: (\"\\\"\"), the default, or (\"\\\"\" \"\\='\" \"\\=`\").
A field can be delimited by a pair of any of these characters.
All must be different from the field separators, `csv-separators'."
:type '(repeat string)
;; Character would be better, but in Emacs 21 does not display
;; correctly in a customization buffer.
:set (lambda (variable value)
(mapc (lambda (x)
(if (/= (length x) 1)
(error "Non-single-char string %S" x))
(if (member x csv-separators)
(error "%S is already a separator" x)))
value)
(when (boundp 'csv-mode-syntax-table)
;; FIRST remove old quote syntax:
(with-syntax-table text-mode-syntax-table
(mapc (lambda (x)
(modify-syntax-entry
(string-to-char x)
(string (char-syntax (string-to-char x)))
;; symbol-value to avoid compiler warning:
(symbol-value 'csv-mode-syntax-table)))
csv-field-quotes))
;; THEN set new quote syntax:
(csv-set-quote-syntax value))
;; BEFORE setting new value of `csv-field-quotes':
(custom-set-default variable value)))
(defun csv-set-quote-syntax (field-quotes)
"Set syntax for field quote characters FIELD-QUOTES to be \"string\".
FIELD-QUOTES should be a list of single-character strings."
(mapc (lambda (x)
(modify-syntax-entry
(string-to-char x) "\""
;; symbol-value to avoid compiler warning:
(symbol-value 'csv-mode-syntax-table)))
field-quotes))
(defvar csv-comment-start nil
"String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
This variable is buffer local; its default value is that of
`csv-comment-start-default'. It is set by the function
`csv-set-comment-start' -- do not set it directly!")
(make-variable-buffer-local 'csv-comment-start)
(defcustom csv-comment-start-default "#"
"String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
Default value of buffer-local variable `csv-comment-start'.
Changing this variable does not affect any existing CSV mode buffer."
:type '(choice (const :tag "None" nil) string)
:set (lambda (variable value)
(custom-set-default variable value)
(setq-default csv-comment-start value)))
(defcustom csv-align-style 'left
"Aligned field style: one of `left', `centre', `right' or `auto'.
Alignment style used by `csv-align-mode' and `csv-align-fields'.
Auto-alignment means left align text and right align numbers."
:type '(choice (const left) (const centre)
(const right) (const auto)))
(defcustom csv-align-padding 1
"Aligned field spacing: must be a positive integer.
Number of spaces used by `csv-align-mode' and `csv-align-fields'
after separators."
:type 'integer)
(defcustom csv-header-lines 0
"Header lines to skip when setting region automatically."
:type 'integer)
(defcustom csv-invisibility-default t
"If non-nil, make separators in aligned records invisible."
:type 'boolean)
(defcustom csv-confirm-region t
"If non-nil, confirm that region is OK in interactive commands."
:type 'boolean)
(defface csv-separator-face
'((t :inherit escape-glyph))
"CSV mode face used to highlight separators.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Mode definition, key bindings and menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst csv-mode-line-format
'(csv-field-index-string ("" csv-field-index-string))
"Mode line format string for CSV mode.")
(defvar csv-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [(control ?c) (control ?v)] #'csv-toggle-invisibility)
(define-key map [(control ?c) (control ?t)] #'csv-transpose)
(define-key map [(control ?c) (control ?c)] #'csv-set-comment-start)
(define-key map [(control ?c) (control ?u)] #'csv-unalign-fields)
(define-key map [(control ?c) (control ?a)] #'csv-align-fields)
(define-key map [(control ?c) (control ?z)] #'csv-yank-as-new-table)
(define-key map [(control ?c) (control ?y)] #'csv-yank-fields)
(define-key map [(control ?c) (control ?k)] #'csv-kill-fields)
(define-key map [(control ?c) (control ?d)] #'csv-toggle-descending)
(define-key map [(control ?c) (control ?r)] #'csv-reverse-region)
(define-key map [(control ?c) (control ?n)] #'csv-sort-numeric-fields)
(define-key map [(control ?c) (control ?s)] #'csv-sort-fields)
(define-key map "\t" #'csv-tab-command)
(define-key map [backtab] #'csv-backtab-command)
map))
;;;###autoload
(define-derived-mode csv-mode text-mode "CSV"
"Major mode for editing files of comma-separated value type.
CSV mode is derived from `text-mode', and runs `text-mode-hook' before
running `csv-mode-hook'. It turns `auto-fill-mode' off by default.
CSV mode can be customized by user options in the CSV customization
group. The separators are specified by the value of `csv-separators'.
CSV mode commands ignore blank lines and comment lines beginning with
the value of `csv-comment-start', which delimit \"paragraphs\".
\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp'
\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields.
Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]).
If `font-lock-mode' is enabled then separators, quoted values and
comment lines are highlighted using respectively `csv-separator-face',
`font-lock-string-face' and `font-lock-comment-face'.
The user interface (UI) for CSV mode commands is similar to that of
the standard commands `sort-fields' and `sort-numeric-fields', except
that if there is no prefix argument then the UI prompts for the field
index or indices. In `transient-mark-mode' only: if the region is not
set then the UI attempts to set it to include all consecutive CSV
records around point, and prompts for confirmation; if there is no
prefix argument then the UI prompts for it, offering as a default the
index of the field containing point if the region was not set
explicitly. The region set automatically is delimited by blank lines
and comment lines, and the number of header lines at the beginning of
the region given by the value of `csv-header-lines' are skipped.
Sort order is controlled by `csv-descending'.
CSV mode provides the following specific keyboard key bindings:
\\{csv-mode-map}"
:group 'CSV
;; We used to `turn-off-auto-fill' here instead, but that's not very
;; effective since text-mode-hook is run afterwards anyway!
(setq-local normal-auto-fill-function nil)
;; Set syntax for field quotes:
(csv-set-quote-syntax csv-field-quotes)
;; Make sexp functions apply to fields:
(set (make-local-variable 'forward-sexp-function) #'csv-forward-field)
(csv-set-comment-start csv-comment-start)
;; Font locking -- separator plus syntactic:
(setq font-lock-defaults '(csv-font-lock-keywords))
(setq-local jit-lock-contextually nil) ;Each line should be independent.
(if csv-invisibility-default (add-to-invisibility-spec 'csv))
;; Mode line to support `csv-field-index-mode':
(set (make-local-variable 'mode-line-position)
(pcase mode-line-position
(`(,(or (pred consp) (pred stringp)) . ,_)
`(,@mode-line-position ,csv-mode-line-format))
(_ `("" ,mode-line-position ,csv-mode-line-format))))
(set (make-local-variable 'truncate-lines) t)
;; Enable or disable `csv-field-index-mode' (could probably do this
;; a bit more efficiently):
(csv-field-index-mode (symbol-value 'csv-field-index-mode)))
(defun csv-set-comment-start (string)
"Set comment start for this CSV mode buffer to STRING.
It must be either a string or nil."
(interactive
(list (edit-and-eval-command
"Comment start (string or nil): " csv-comment-start)))
;; Paragraph means a group of contiguous records:
(set (make-local-variable 'paragraph-separate) "[[:space:]]*$") ; White space.
(set (make-local-variable 'paragraph-start) "\n");Must include \n explicitly!
;; Remove old comment-start/end if available
(with-syntax-table text-mode-syntax-table
(when comment-start
(modify-syntax-entry (string-to-char comment-start)
(string (char-syntax (string-to-char comment-start)))
csv-mode-syntax-table))
(modify-syntax-entry ?\n
(string (char-syntax ?\n))
csv-mode-syntax-table))
(when string
(setq paragraph-separate (concat paragraph-separate "\\|" string)
paragraph-start (concat paragraph-start "\\|" string))
(set (make-local-variable 'comment-start) string)
(modify-syntax-entry
(string-to-char string) "<" csv-mode-syntax-table)
(modify-syntax-entry ?\n ">" csv-mode-syntax-table))
(setq csv-comment-start string))
(defvar csv--set-separator-history nil)
(defun csv-set-separator (sep)
"Set the CSV separator in the current buffer to SEP."
(interactive (list (read-char-from-minibuffer
"Separator: " nil 'csv--set-separator-history)))
(when (and (boundp 'csv-field-quotes)
(member (string sep) csv-field-quotes))
(error "%c is already a quote" sep))
(setq-local csv-separators (list (string sep)))
(setq-local csv-separator-chars (list sep))
(setq-local csv--skip-chars (format "^\n\\%c" sep))
(setq-local csv-separator-regexp (regexp-quote (string sep)))
(setq-local csv-font-lock-keywords
`((,csv-separator-regexp (0 'csv-separator-face))))
(font-lock-refresh-defaults))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
(defvar csv-descending nil
"If non-nil, CSV mode sort functions sort in order of descending sort key.
Usually they sort in order of ascending sort key.")
(defun csv-toggle-descending ()
"Toggle `csv-descending'."
(interactive)
(setq csv-descending (not csv-descending))
(message "Sort order is %sscending" (if csv-descending "de" "a")))
(defun csv-toggle-invisibility ()
;; FIXME: Make it into a proper minor mode?
"Toggle `buffer-invisibility-spec'."
(interactive)
(if (memq 'csv buffer-invisibility-spec)
(remove-from-invisibility-spec 'csv)
(add-to-invisibility-spec 'csv))
(message "Separators in aligned records will be %svisible \
\(after re-aligning if soft)"
(if (memq 'csv buffer-invisibility-spec) "in" ""))
(redraw-frame (selected-frame)))
(easy-menu-define
csv-menu
csv-mode-map
"CSV major mode menu keymap"
'("CSV"
["Sort By Field Lexicographically" csv-sort-fields :active t
:help "Sort lines in region lexicographically by the specified field"]
["Sort By Field Numerically" csv-sort-numeric-fields :active t
:help "Sort lines in region numerically by the specified field"]
["Reverse Order of Lines" csv-reverse-region :active t
:help "Reverse the order of the lines in the region"]
["Use Descending Sort Order" csv-toggle-descending :active t
:style toggle :selected csv-descending
:help "If selected, use descending order when sorting"]
"--"
["Kill Fields (Columns)" csv-kill-fields :active t
:help "Kill specified fields of each line in the region"]
["Yank Fields (Columns)" csv-yank-fields :active t
:help "Yank killed fields as specified field of each line in region"]
["Yank As New Table" csv-yank-as-new-table :active t
:help "Yank killed fields as a new table at point"]
["Align Fields into Columns" csv-align-fields :active t
:help "Align the start of every field of each line in the region"]
["Unalign Columns into Fields" csv-unalign-fields :active t
:help "Undo soft alignment and optionally remove redundant white space"]
["Transpose Rows and Columns" csv-transpose :active t
:help "Rewrite rows (which may have different lengths) as columns"]
"--"
["Forward Field" forward-sexp :active t
:help "Move forward across one field; with ARG, do it that many times"]
["Backward Field" backward-sexp :active t
:help "Move backward across one field; with ARG, do it that many times"]
["Kill Field Forward" kill-sexp :active t
:help "Kill field following cursor; with ARG, do it that many times"]
["Kill Field Backward" backward-kill-sexp :active t
:help "Kill field preceding cursor; with ARG, do it that many times"]
"--"
("Alignment Style"
["Left" (setq csv-align-style 'left) :active t
:style radio :selected (eq csv-align-style 'left)
:help "If selected, `csv-align' left aligns fields"]
["Centre" (setq csv-align-style 'centre) :active t
:style radio :selected (eq csv-align-style 'centre)
:help "If selected, `csv-align' centres fields"]
["Right" (setq csv-align-style 'right) :active t
:style radio :selected (eq csv-align-style 'right)
:help "If selected, `csv-align' right aligns fields"]
["Auto" (setq csv-align-style 'auto) :active t
:style radio :selected (eq csv-align-style 'auto)
:help "\
If selected, `csv-align' left aligns text and right aligns numbers"]
)
["Set header line" csv-header-line :active t]
["Auto-(re)align fields" csv-align-mode
:style toggle :selected csv-align-mode]
["Show Current Field Index" csv-field-index-mode :active t
:style toggle :selected csv-field-index-mode
:help "If selected, display current field index in mode line"]
["Make Separators Invisible" csv-toggle-invisibility :active t
:style toggle :selected (memq 'csv buffer-invisibility-spec)
:visible (not (tsv--mode-p))
:help "If selected, separators in aligned records are invisible"]
["Set Buffer's Comment Start" csv-set-comment-start :active t
:help "Set comment start string for this buffer"]
["Customize CSV Mode" (customize-group 'CSV) :active t
:help "Open a customization buffer to change CSV mode options"]
))
(require 'sort)
(defsubst csv-not-looking-at-record ()
"Return t if looking at blank or comment line, nil otherwise.
Assumes point is at beginning of line."
(looking-at paragraph-separate))
(defun csv-interactive-args (&optional type)
"Get arg or field(s) and region interactively, offering sensible defaults.
Signal an error if the buffer is read-only.
If TYPE is noarg then return a list (beg end).
Otherwise, return a list (arg beg end), where arg is:
the raw prefix argument by default;
a single field index if TYPE is single;
a list of field indices or index ranges if TYPE is multiple.
Field defaults to the current prefix arg; if not set, prompt user.
A field index list consists of positive or negative integers or ranges,
separated by any non-integer characters. A range has the form m-n,
where m and n are positive or negative integers, m < n, and n defaults
to the last field index if omitted.
In transient mark mode, if the mark is not active then automatically
select and highlight CSV records around point, and query user.
The default field when read interactively is the current field."
;; Must be run interactively to activate mark!
(let* ((arg current-prefix-arg) (default-field 1)
(region
(if (not (use-region-p))
;; Set region automatically:
(save-excursion
(if arg
(beginning-of-line)
(let ((lbp (line-beginning-position)))
(while (re-search-backward csv-separator-regexp lbp 1)
;; Move as far as possible, i.e. to beginning of line.
(setq default-field (1+ default-field)))))
(if (csv-not-looking-at-record)
(error "Point must be within CSV records"))
(let ((startline (point)))
;; Set mark at beginning of region:
(while (not (or (bobp) (csv-not-looking-at-record)))
(forward-line -1))
(if (csv-not-looking-at-record) (forward-line 1))
;; Skip header lines:
(forward-line csv-header-lines)
(set-mark (point)) ; OK since in save-excursion
;; Move point to end of region:
(goto-char startline)
(beginning-of-line)
(while (not (or (eobp) (csv-not-looking-at-record)))
(forward-line 1))
;; Show mark briefly if necessary:
(unless (and (pos-visible-in-window-p)
(pos-visible-in-window-p (mark)))
(exchange-point-and-mark)
(sit-for 1)
(exchange-point-and-mark))
(when csv-confirm-region
(or (y-or-n-p "Region OK? ")
(error "Action aborted by user"))
(message nil)) ; clear y-or-n-p message
(list (region-beginning) (region-end))))
;; Use region set by user:
(list (region-beginning) (region-end)))))
(setq default-field (number-to-string default-field))
(cond
((eq type 'multiple)
(if arg
;; Ensure that field is a list:
(or (consp arg)
(setq arg (list (prefix-numeric-value arg))))
;; Read field interactively, ignoring non-integers:
(setq arg
(mapcar
(lambda (x)
(if (string-match "-" x 1) ; not first character
;; Return a range as a pair - the cdr may be nil:
(let ((m (substring x 0 (match-beginning 0)))
(n (substring x (match-end 0))))
(cons (car (read-from-string m))
(and (not (string= n ""))
(car (read-from-string n)))))
;; Return a number as a number:
(car (read-from-string x))))
(split-string
(read-string
"Fields (sequence of integers or ranges): " default-field)
"[^-+0-9]+")))))
((eq type 'single)
(if arg
(setq arg (prefix-numeric-value arg))
(while (not (integerp arg))
(setq arg (eval-minibuffer "Field (integer): " default-field))))))
(if (eq type 'noarg) region (cons arg region))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sorting by field
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun csv-nextrecfun ()
"Called by `csv-sort-fields-1' with point at end of previous record.
It moves point to the start of the next record.
It should move point to the end of the buffer if there are no more records."
(forward-line)
(while (and (not (eobp)) (csv-not-looking-at-record))
(forward-line)))
(defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun)
"Modified version of `sort-fields-1' that skips blank or comment lines.
FIELD is a single field index, and BEG and END specify the region to
sort.
STARTKEYFUN moves from the start of the record to the start of the key.
It may return either a non-nil value to be used as the key, or
else the key is the substring between the values of point after
STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key
starts at the beginning of the record.
ENDKEYFUN moves from the start of the sort key to the end of the sort key.
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
same as ENDRECFUN."
(let ((tbl (syntax-table)))
(if (zerop field) (setq field 1))
(unwind-protect
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(set-syntax-table sort-fields-syntax-table)
(sort-subr csv-descending
'csv-nextrecfun 'end-of-line
startkeyfun endkeyfun)))
(set-syntax-table tbl))))
(defun csv-sort-fields (field beg end)
"Sort lines in region lexicographically by the ARGth field of each line.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Ignore blank and comment lines. The variable `sort-fold-case'
determines whether alphabetic case affects the sort order.
When called non-interactively, FIELD is a single field index;
BEG and END specify the region to sort."
;; (interactive "*P\nr")
(interactive (csv-interactive-args 'single))
(barf-if-buffer-read-only)
(csv-sort-fields-1 field beg end
(lambda () (csv-sort-skip-fields field) nil)
(lambda () (skip-chars-forward csv--skip-chars))))
(defun csv-sort-numeric-fields (field beg end)
"Sort lines in region numerically by the ARGth field of each line.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators'.
Null fields are allowed anywhere and sort as zeros.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Specified non-null field must contain a number in each line of the region,
which may begin with \"0x\" or \"0\" for hexadecimal and octal values.
Otherwise, the number is interpreted according to sort-numeric-base.
Ignore blank and comment lines.
When called non-interactively, FIELD is a single field index;
BEG and END specify the region to sort."
;; (interactive "*P\nr")
(interactive (csv-interactive-args 'single))
(barf-if-buffer-read-only)
(csv-sort-fields-1 field beg end
(lambda ()
(csv-sort-skip-fields field)
(let* ((case-fold-search t)
(base
(if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
(cond ((match-beginning 1)
(goto-char (match-end 1))
16)
((match-beginning 2)
(goto-char (match-end 2))
8)
(t nil)))))
(string-to-number (buffer-substring (point)
(save-excursion
(forward-sexp 1)
(point)))
(or base sort-numeric-base))))
nil))
(defun csv-reverse-region (beg end)
"Reverse the order of the lines in the region.
This is just a CSV-mode style interface to `reverse-region', which is
the function that should be used non-interactively. It takes two
point or marker arguments, BEG and END, delimiting the region."
;; (interactive "*P\nr")
(interactive (csv-interactive-args 'noarg))
(barf-if-buffer-read-only)
(reverse-region beg end))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Moving by field
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun csv-end-of-field ()
"Skip forward over one field."
(skip-chars-forward " ")
;; If the first character is a double quote, then we have a quoted
;; value.
(when (eq (char-syntax (following-char)) ?\")
(forward-char)
(let ((ended nil))
(while (and (not ended) (not (eolp)))
(cond ((not (eq (char-syntax (following-char)) ?\"))
(forward-char 1))
;; According to RFC-4180 (sec 2.7), quotes inside quoted strings
;; are quoted by doubling the quote char: a,"b""c,",d
;; FIXME: Maybe we should handle this via syntax-propertize?
((let ((c (char-after (1+ (point)))))
(and c (eq (char-syntax c) ?\")))
(forward-char 2))
(t
(setq ended t))))))
(skip-chars-forward csv--skip-chars))
(defun csv--bof-p ()
(or (bolp)
(memq (preceding-char) csv-separator-chars)))
(defun csv--eof-p ()
(or (eolp)
(memq (following-char) csv-separator-chars)))
(defun csv-beginning-of-field ()
"Skip backward over one field."
(skip-syntax-backward " ")
(if (eq (char-syntax (preceding-char)) ?\")
(goto-char (scan-sexps (point) -1)))
(skip-chars-backward csv--skip-chars))
(defun csv-forward-field (arg)
"Move forward across one field, cf. `forward-sexp'.
With ARG, do it that many times. Negative arg -N means
move backward across N fields."
(interactive "p")
(if (< arg 0)
(csv-backward-field (- arg))
(while (>= (setq arg (1- arg)) 0)
(if (or (bolp)
(when (and (not (eobp)) (eolp)) (forward-char) t))
(while (and (not (eobp)) (csv-not-looking-at-record))
(forward-line 1)))
(if (memq (following-char) csv-separator-chars) (forward-char))
(csv-end-of-field))))
(defun csv-backward-field (arg)
"Move backward across one field, cf. `backward-sexp'.
With ARG, do it that many times. Negative arg -N means
move forward across N fields."
(interactive "p")
(if (< arg 0)
(csv-forward-field (- arg))
(while (>= (setq arg (1- arg)) 0)
(when (or (eolp)
(when (and (not (bobp)) (bolp)) (backward-char) t))
(while (progn
(beginning-of-line)
(csv-not-looking-at-record))
(backward-char))
(end-of-line))
(if (memq (preceding-char) csv-separator-chars) (backward-char))
(csv-beginning-of-field))))
(defun csv-tab-command ()
"Skip to the next field on the same line.
Create a new field at end of line, if needed."
(interactive)
(skip-chars-forward csv--skip-chars)
(if (eolp)
(insert (car csv-separators))
(forward-char 1)))
(defun csv-backtab-command ()
"Skip to the beginning of the previous field."
(interactive)
(skip-chars-backward csv--skip-chars)
(forward-char -1)
(skip-chars-backward csv--skip-chars))
(defun csv-sort-skip-fields (n &optional yank)
"Position point at the beginning of field N on the current line.
Fields are separated by `csv-separators'; null terminal field allowed.
Assumes point is initially at the beginning of the line.
YANK non-nil allows N to be greater than the number of fields, in
which case extend the record as necessary."
(if (> n 0)
;; Skip across N - 1 fields.
(let ((i (1- n)))
(while (> i 0)
(csv-end-of-field)
(if (eolp)
(if yank
(if (> i 1) (insert (car csv-separators)))
(error "Line has too few fields: %s"
(buffer-substring
(save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point)))))
(forward-char)) ; skip separator
(setq i (1- i))))
(end-of-line)
;; Skip back across -N - 1 fields.
(let ((i (1- (- n))))
(while (> i 0)
(csv-beginning-of-field)
(if (bolp)
(error "Line has too few fields: %s"
(buffer-substring
(save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point)))))
(backward-char) ; skip separator
(setq i (1- i)))
;; Position at the front of the field
;; even if moving backwards.
(csv-beginning-of-field))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Field index mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Based partly on paren.el
(defcustom csv-field-index-delay 0.125
"Time in seconds to delay before updating field index display."
:type '(number :tag "seconds"))
(defvar csv-field-index-idle-timer nil)
(defvar csv-field-index-string nil)
(make-variable-buffer-local 'csv-field-index-string)
(defvar csv-field-index-old nil)
(make-variable-buffer-local 'csv-field-index-old)
(define-minor-mode csv-field-index-mode
"Toggle CSV-Field-Index mode.
With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive.
Returns the new status of CSV-Field-Index mode (non-nil means on).
When CSV-Field-Index mode is enabled, the current field index appears in
the mode line after `csv-field-index-delay' seconds of Emacs idle time."
:global t
:init-value t ; for documentation, since default is t
;; This macro generates a function that first sets the mode
;; variable, then runs the following code, runs the mode hooks,
;; displays a message if interactive, updates the mode line and
;; finally returns the variable value.
;; First, always disable the mechanism (to avoid having two timers):
(when csv-field-index-idle-timer
(cancel-timer csv-field-index-idle-timer)
(setq csv-field-index-idle-timer nil))
;; Now, if the mode is on and any buffer is in CSV mode then
;; re-initialize and enable the mechanism by setting up a new timer:
(if csv-field-index-mode
(if (memq t (mapcar (lambda (buffer)
(with-current-buffer buffer
(when (derived-mode-p 'csv-mode)
(setq csv-field-index-string nil
csv-field-index-old nil)
t)))
(buffer-list)))
(setq csv-field-index-idle-timer
(run-with-idle-timer csv-field-index-delay t
#'csv-field-index)))
;; but if the mode is off then remove the display from the mode
;; lines of all CSV buffers:
(mapc (lambda (buffer)
(with-current-buffer buffer
(when (derived-mode-p 'csv-mode)
(setq csv-field-index-string nil
csv-field-index-old nil)
(force-mode-line-update))))
(buffer-list))))
(defun csv--field-index ()
(save-excursion
(let ((start (point))
(field 0))
(beginning-of-line)
(while (and (<= (point) start)
(not (eolp)))
(csv-end-of-field)
(unless (eolp)
(forward-char 1))
(setq field (1+ field)))
field)))
(defun csv-field-index ()
"Construct `csv-field-index-string' to display in mode line.
Called by `csv-field-index-idle-timer'."
(if (derived-mode-p 'csv-mode)
(let ((field (csv--field-index)))
(when (not (eq field csv-field-index-old))
(setq csv-field-index-old field
csv-field-index-string
(and field (format "F%d" field)))
(force-mode-line-update)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Killing and yanking fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar csv-killed-fields nil
"A list of the fields or sub-records last killed by `csv-kill-fields'.")
(defun csv-kill-fields (fields beg end)
"Kill specified fields of each line in the region.
If not set, the region defaults to the CSV records around point.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
The fields are stored for use by `csv-yank-fields'. Fields can be
specified in any order but are saved in increasing index order.
Ignore blank and comment lines.
When called interactively, a prefix argument specifies a single field,
otherwise prompt for a field list, which may include ranges in the form
m-n, where m < n and n defaults to the last field index if omitted.
When called non-interactively, FIELDS is a single field index or a
list of field indices, with ranges specified as (m.n) or (m), and BEG
and END specify the region to process."
;; (interactive "*P\nr")
(interactive (csv-interactive-args 'multiple))
(barf-if-buffer-read-only)
;; Kill the field(s):
(setq csv-killed-fields nil)
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(if (or (cdr fields) (consp (car fields)))
(csv-kill-many-columns fields)
(csv-kill-one-column (car fields)))))
(setq csv-killed-fields (nreverse csv-killed-fields)))
(defun csv-kill-one-field (field)
"Kill field with index FIELD in current line.
Return killed text. Assumes point is at beginning of line."
;; Move to start of field to kill:
(csv-sort-skip-fields field)
;; Kill to end of field (cf. `kill-region'):
(prog1 (delete-and-extract-region
(point)
(progn (csv-end-of-field) (point)))
(if (eolp)
(unless (bolp) (delete-char -1)) ; Delete trailing separator at eol
(delete-char 1)))) ; or following separator otherwise.
(defun csv-kill-one-column (field)
"Kill field with index FIELD in all lines in (narrowed) buffer.
Save killed fields in `csv-killed-fields'.
Assumes point is at `point-min'. Called by `csv-kill-fields'.
Ignore blank and comment lines."
(while (not (eobp))
(or (csv-not-looking-at-record)
(push (csv-kill-one-field field) csv-killed-fields))
(forward-line)))
(defun csv-insert-column (field)
"Insert an empty column at point."
(interactive
(let ((cur (csv--field-index)))
(list (if (and (csv--eof-p) (not (csv--bof-p))) (1+ cur) cur))))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(or (csv-not-looking-at-record)
(progn
(csv-sort-skip-fields field t)
(insert (car csv-separators))))
(forward-line 1))
(csv--jit-flush-columns)))
(defun csv-kill-many-columns (fields)
"Kill several fields in all lines in (narrowed) buffer.
FIELDS is an unordered list of field indices.
Save killed fields in increasing index order in `csv-killed-fields'.
Assumes point is at `point-min'. Called by `csv-kill-fields'.
Ignore blank and comment lines."
(if (eolp) (error "First record is empty"))
;; Convert non-positive to positive field numbers:
(let ((last 1) (f fields))
(csv-end-of-field)
(while (not (eolp))
(forward-char) ; skip separator
(csv-end-of-field)
(setq last (1+ last))) ; last = # fields in first record
(while f
(cond ((consp (car f))
;; Expand a field range: (m.n) -> m m+1 ... n-1 n.
;; If n is nil then it defaults to the number of fields.
(let* ((range (car f)) (cdrf (cdr f))
(m (car range)) (n (cdr range)))
(if (< m 0) (setq m (+ m last 1)))
(if n
(if (< n 0) (setq n (+ n last 1)))
(setq n last))
(setq range (list n))
(while (> n m) (push (setq n (1- n)) range))
(setcar f (car range))
(setcdr f (cdr range))
(setcdr (setq f (last range)) cdrf)))
((zerop (car f)) (setcar f 1))
((< (car f) 0) (setcar f (+ f last 1))))
(setq f (cdr f))))
(goto-char (point-min))
;; Kill from right to avoid miscounting:
(setq fields (sort fields #'>))
(while (not (eobp))
(or (csv-not-looking-at-record)
(let ((fields fields) killed-fields field)
(while fields
(setq field (car fields)
fields (cdr fields))
(beginning-of-line)
(push (csv-kill-one-field field) killed-fields))
(push (mapconcat #'identity killed-fields (car csv-separators))
csv-killed-fields)))
(forward-line)))
(defun csv-yank-fields (field beg end)
"Yank fields as the ARGth field of each line in the region.
ARG may be arbitrarily large and records are extended as necessary.
If not set, the region defaults to the CSV records around point;
if point is not in a CSV record then offer to yank as a new table.
The fields yanked are those last killed by `csv-kill-fields'.
Fields are separated by `csv-separators' and null fields are allowed anywhere.
Field indices increase from 1 on the left or decrease from -1 on the right.
A prefix argument specifies a single field, otherwise prompt for field index.
Ignore blank and comment lines. When called non-interactively, FIELD
is a single field index; BEG and END specify the region to process."
;; (interactive "*P\nr")
(interactive (condition-case err
(csv-interactive-args 'single)
(error (list nil nil err))))
(barf-if-buffer-read-only)
(if (null beg)
(if (y-or-n-p (concat (error-message-string end)
". Yank as a new table? "))
(csv-yank-as-new-table)
(error (error-message-string end)))
(if (<= field 0) (setq field (1+ field)))
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(let ((fields csv-killed-fields))
(while (not (eobp))
(unless (csv-not-looking-at-record)
;; Yank at start of specified field if possible,
;; otherwise yank at end of record:
(if (zerop field)
(end-of-line)
(csv-sort-skip-fields field 'yank))
(and (eolp) (insert (car csv-separators)))
(when fields
(insert (car fields))
(setq fields (cdr fields)))
(or (eolp) (insert (car csv-separators))))
(forward-line)))))))
(defun csv-yank-as-new-table ()
"Yank fields as a new table starting at point.
The fields yanked are those last killed by `csv-kill-fields'."
(interactive "*")
(let ((fields csv-killed-fields))
(while fields
(insert (car fields) ?\n)
(setq fields (cdr fields)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Aligning fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun csv--make-overlay (beg end &optional buffer front-advance rear-advance props)
(let ((o (make-overlay beg end buffer front-advance rear-advance)))
(overlay-put o 'csv t)
(while props
(overlay-put o (pop props) (pop props)))
o))
(defun csv--delete-overlay (o)
(and (overlay-get o 'csv) (delete-overlay o)))
(defun csv--column-widths (beg end)
"Return a list of two lists (COLUMN-WIDTHS FIELD-WIDTHS).
COLUMN-WIDTHS is a list of elements (WIDTH START END)
indicating the widths of the columns after point (and the position of the
widest field that determined the overall width).
FIELD-WIDTHS contains the widths of each individual field after
point."
(let ((column-widths '())
(field-widths '()))
(goto-char beg)
;; Construct list of column widths:
(while (< (point) end) ; for each record...
(or (csv-not-looking-at-record)
(let ((w column-widths)
(col (current-column))
(beg (point))
field-width)
(while (not (eolp))
(csv-end-of-field)
(setq field-width (- (current-column) col))
(push field-width field-widths)
(if w
(if (> field-width (caar w))
(setcar w (list field-width beg (point))))
(setq w (list (list field-width beg (point)))
column-widths (nconc column-widths w)))
(or (eolp) (forward-char)) ; Skip separator.
(setq w (cdr w) col (current-column) beg (point)))))
(forward-line))
(list column-widths (nreverse field-widths))))
(defun csv-align-fields (hard beg end)
"Align all the fields in the region to form columns.
The alignment style is specified by `csv-align-style'. The number of
spaces specified by `csv-align-padding' appears after each separator.
Use soft alignment done by displaying virtual white space after the
separators unless invoked with an argument, in which case insert real
space characters into the buffer after the separators.
Unalign first (see `csv-unalign-fields'). Ignore blank and comment lines.
In hard-aligned records, separators become invisible whenever
`buffer-invisibility-spec' is non-nil. In soft-aligned records, make
separators invisible if and only if `buffer-invisibility-spec' is
non-nil when the records are aligned; this can be changed only by
re-aligning. \(Unaligning always makes separators visible.)
When called non-interactively, use hard alignment if HARD is non-nil;
BEG and END specify the region to align.
If there is no selected region, default to the whole buffer."
(interactive (cons current-prefix-arg
(if (use-region-p)
(list (region-beginning) (region-end))
(list (point-min) (point-max)))))
;; FIXME: Use csv--jit-align when applicable!
(setq end (copy-marker end))
(csv-unalign-fields hard beg end) ; If hard then barfs if buffer read only.
(save-excursion
(pcase-let ((`(,column-widths ,field-widths) (csv--column-widths beg end)))
(save-restriction
(narrow-to-region beg end)
(set-marker end nil)
;; Align fields:
(goto-char (point-min))
(while (not (eobp)) ; for each record...
(unless (csv-not-looking-at-record)
(let ((w column-widths)
(column 0)) ;Desired position of left-side of this column.
(while (and w (not (eolp)))
(let* ((beg (point))
(align-padding (if (bolp) 0 csv-align-padding))
(left-padding 0) (right-padding 0)
(field-width (pop field-widths))
(column-width (car (pop w)))
(x (- column-width field-width))) ; Required padding.
(csv-end-of-field)
(set-marker end (point)) ; End of current field.
;; beg = beginning of current field
;; end = (point) = end of current field
;; Compute required padding:
(cond
((eq csv-align-style 'left)
;; Left align -- pad on the right:
(setq left-padding align-padding
right-padding x))
((eq csv-align-style 'right)
;; Right align -- pad on the left:
(setq left-padding (+ align-padding x)))
((eq csv-align-style 'auto)
;; Auto align -- left align text, right align numbers:
(if (string-match "\\`[-+.[:digit:]]+\\'"
(buffer-substring beg (point)))
;; Right align -- pad on the left:
(setq left-padding (+ align-padding x))
;; Left align -- pad on the right:
(setq left-padding align-padding
right-padding x)))
((eq csv-align-style 'centre)
;; Centre -- pad on both left and right:
(let ((y (/ x 2))) ; truncated integer quotient
(setq left-padding (+ align-padding y)
right-padding (- x y)))))
(cond
(hard ;; Hard alignment...
(when (> left-padding 0) ; Pad on the left.
;; Insert spaces before field:
(if (= beg end) ; null field
(insert (make-string left-padding ?\ ))
(goto-char beg) ; beginning of current field
(insert (make-string left-padding ?\ ))
(goto-char end))) ; end of current field
(unless (eolp)
(if (> right-padding 0) ; pad on the right
;; Insert spaces after field:
(insert (make-string right-padding ?\ )))
;; Make separator (potentially) invisible;
;; in Emacs 21.3, neighbouring overlays
;; conflict, so use the following only
;; with hard alignment:
(csv--make-overlay (point) (1+ (point)) nil t nil
'(invisible csv evaporate t))
(forward-char))) ; skip separator
;; Soft alignment...
((or (memq 'csv buffer-invisibility-spec)
;; For TSV, hidden or not doesn't make much difference,
;; but the behavior is slightly better when we "hide"
;; the TABs with a `display' property than if we add
;; before/after-strings.
(tsv--mode-p))
;; Hide separators...
;; Merge right-padding from previous field
;; with left-padding from this field:
(if (zerop column)
(when (> left-padding 0)
;; Display spaces before first field
;; by overlaying first character:
(csv--make-overlay
beg (1+ beg) nil nil nil
`(before-string ,(make-string left-padding ?\ ))))
;; Display separator as spaces:
(with-silent-modifications
(put-text-property
(1- beg) beg
'display `(space :align-to
,(+ left-padding column)))))
(unless (eolp) (forward-char)) ; Skip separator.
(setq column (+ column column-width align-padding)))
(t ;; Do not hide separators...
(let ((overlay (csv--make-overlay beg (point) nil nil t)))
(when (> left-padding 0) ; Pad on the left.
;; Display spaces before field:
(overlay-put overlay 'before-string
(make-string left-padding ?\ )))
(unless (eolp)
(if (> right-padding 0) ; Pad on the right.
;; Display spaces after field:
(overlay-put
overlay
'after-string (make-string right-padding ?\ )))
(forward-char)))) ; Skip separator.
)))))
(forward-line)))))
(set-marker end nil))
(defun csv-unalign-fields (hard beg end)
"Undo soft alignment and optionally remove redundant white space.
Undo soft alignment introduced by `csv-align-fields'. If invoked with
an argument then also remove all spaces and tabs around separators.
Also make all invisible separators visible again.
Ignore blank and comment lines. When called non-interactively, remove
spaces and tabs if HARD non-nil; BEG and END specify region to unalign.
If there is no selected region, default to the whole buffer."
(interactive (cons current-prefix-arg
(if (use-region-p)
(list (region-beginning) (region-end))
(list (point-min) (point-max)))))
;; Remove any soft alignment:
(mapc #'csv--delete-overlay (overlays-in beg end))
(with-silent-modifications
(remove-list-of-text-properties beg end '(display invisible)))
(when hard
(barf-if-buffer-read-only)
;; Remove any white-space padding around separators:
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(while (not (eobp))
(or (csv-not-looking-at-record)
(while (not (eolp))
;; Delete horizontal white space forward:
;; (delete-horizontal-space)
;; This relies on left-to-right argument evaluation;
;; see info node (elisp) Function Forms.
(delete-region (point)
(+ (point) (skip-chars-forward " \t")))
(csv-end-of-field)
;; Delete horizontal white space backward:
;; (delete-horizontal-space t)
(delete-region (point)
(+ (point) (skip-chars-backward " \t")))
(or (eolp) (forward-char))))
(forward-line))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Transposing rows and columns
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun csv-transpose (beg end)
"Rewrite rows (which may have different lengths) as columns.
Null fields are introduced as necessary within records but are
stripped from the ends of records. Preserve soft alignment.
This function is its own inverse. Ignore blank and comment lines.
When called non-interactively, BEG and END specify region to process."
;; (interactive "*P\nr")
(interactive (csv-interactive-args 'noarg))
(barf-if-buffer-read-only)
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
;; Delete rows and collect them as a reversed list of lists of
;; fields, skipping comment and blank lines:
(let ((sep (car csv-separators))
(align (overlays-in beg end))
rows columns)
;; Remove soft alignment if necessary:
(when align
(mapc #'csv--delete-overlay align)
(setq align t))
(while (not (eobp))
(if (csv-not-looking-at-record)
;; Skip blank and comment lines:
(forward-line)
(let ((lep (line-end-position)))
(push
(csv--collect-fields lep)
rows)
(delete-region (point) lep)
(or (eobp) (delete-char 1)))))
;; Rows must have monotonic decreasing lengths to be
;; transposable, so ensure this by padding with null fields.
;; rows is currently a reversed list of field lists, which
;; must therefore have monotonic increasing lengths.
(let ((oldlen (length (car rows))) newlen
(r (cdr rows)))
(while r
(setq newlen (length (car r)))
(if (< newlen oldlen)
(nconc (car r) (make-list (- oldlen newlen) nil))
(setq oldlen newlen))
(setq r (cdr r))))
;; Collect columns as a reversed list of lists of fields:
(while rows
(let (column (r rows) row)
(while r
(setq row (car r))
;; Provided it would not be a trailing null field, push
;; field onto column:
(if (or column (string< "" (car row)))
(push (car row) column))
;; Pop field off row:
(setcar r (cdr row))
;; If row is now empty then remove it:
(or (car r) (setq rows (cdr rows)))
(setq r (cdr r)))
(push column columns)))
;; Insert columns into buffer as rows:
(setq columns (nreverse columns))
(while columns
(insert (mapconcat #'identity (car columns) sep) ?\n)
(setq columns (cdr columns)))
;; Re-do soft alignment if necessary:
(if align (csv-align-fields nil (point-min) (point-max)))))))
(defun csv--collect-fields (row-end-position)
"Collect the fields of a row.
Splits a row into fields, honoring quoted fields, and returns
the list of fields. ROW-END-POSITION is the end-of-line position.
point is assumed to be at the beginning of the line."
(let ((csv-field-quotes-regexp (apply #'concat `("[" ,@csv-field-quotes "]")))
(row-text (buffer-substring-no-properties (point) row-end-position))
fields field-start)
(if (not (string-match csv-field-quotes-regexp row-text))
(split-string row-text csv-separator-regexp)
(save-excursion
(while (< (setq field-start (point)) row-end-position)
;; csv-forward-field will skip a separator if point is on
;; it, and we'll miss an empty field
(unless (memq (following-char) csv-separator-chars)
(csv-forward-field 1))
(push
(buffer-substring-no-properties field-start (point))
fields)
(if (memq (following-char) csv-separator-chars)
(forward-char)))
(nreverse fields)))))
(defun csv--unquote-value (value)
"Remove quotes around VALUE.
If VALUE contains escaped quote characters, un-escape them. If
VALUE is not quoted, return it unchanged."
(save-match-data
(let ((quote-regexp (apply #'concat `("[" ,@csv-field-quotes "]"))))
(if-let (((string-match (concat "^\\(" quote-regexp "\\)\\(.*\\)\\(" quote-regexp "\\)$") value))
(quote-char (match-string 1 value))
((equal quote-char (match-string 3 value)))
(unquoted (match-string 2 value)))
(replace-regexp-in-string (concat quote-char quote-char) quote-char unquoted)
value))))
(defun csv-parse-current-row ()
"Parse the current CSV line.
Return the field values as a list."
(save-mark-and-excursion
(goto-char (line-beginning-position))
(mapcar #'csv--unquote-value (csv--collect-fields (line-end-position)))))
(defvar-local csv--header-line nil)
(defvar-local csv--header-hscroll nil)
(defvar-local csv--header-string nil)
(defun csv-header-line (&optional use-current-line)
"Set/unset the header line.
If the optional prefix arg USE-CURRENT-LINE is nil, use the first line
as the header line.
If there is already a header line, then unset the header line."
(interactive "P")
(if csv--header-line
(progn
(delete-overlay csv--header-line)
(setq csv--header-line nil)
(kill-local-variable 'header-line-format))
(save-excursion
(unless use-current-line (goto-char (point-min)))
(setq csv--header-line (make-overlay (line-beginning-position)
(line-end-position)
nil nil t))
(overlay-put csv--header-line 'modification-hooks
'(csv--header-flush)))
(csv--header-flush)
;; These are introduced in Emacs 29.
(unless (boundp 'header-line-indent)
(setq-local header-line-indent ""
header-line-indent-width 0))
(setq header-line-format
'("" header-line-indent (:eval (csv--header-string))))))
(defun csv--header-flush (&rest _)
;; Force re-computation of the header-line.
(setq csv--header-hscroll nil))
(defun csv--header-string ()
;; FIXME: Won't work with multiple windows showing that same buffer.
(if (eql (window-hscroll) csv--header-hscroll)
csv--header-string
(setq csv--header-hscroll (window-hscroll))
(setq csv--header-string
(csv--compute-header-string))))
(defun csv--compute-header-string ()
(with-demoted-errors "csv--compute-header-string %S"
(save-excursion
(goto-char (overlay-start csv--header-line))
;; Re-set the line-end-position, just in case.
(move-overlay csv--header-line (point) (line-end-position))
(jit-lock-fontify-now (point) (line-end-position))
;; Not sure why it is sometimes nil!
(move-to-column (or csv--header-hscroll 0))
(let ((str (replace-regexp-in-string
"%" "%%" (buffer-substring (point) (line-end-position))))
(i 0))
(while (and i (< i (length str)))
(let ((prop (get-text-property i 'display str)))
(and (eq (car-safe prop) 'space)
(eq (car-safe (cdr prop)) :align-to)
(let* ((x (nth 2 prop))
(nexti (next-single-property-change i 'display str))
(newprop
`(space :align-to
(+ ,(if (numberp x)
(- x (or csv--header-hscroll 0))
`(- ,x csv--header-hscroll))
header-line-indent-width))))
(put-text-property i (or nexti (length str))
'display newprop str)
(setq i nexti))))
(setq i (next-single-property-change i 'display str)))
(concat (propertize " " 'display '((space :align-to 0))) str)))))
;;; Auto-alignment
(defcustom csv-align-max-width 40
"Maximum width of a column in `csv-align-mode'.
This does not apply to the last column (for which the usual `truncate-lines'
setting works better)."
:type 'integer)
(defcustom csv-align-min-width 1
"Minimum width of a column in `csv-align-mode'."
:type 'integer)
(defvar-local csv--config-column-widths nil
"Settings per column, stored as a list indexed by the column.")
(defun csv-align--set-column (column value)
(let ((len (length csv--config-column-widths)))
(if (< len column)
(setq csv--config-column-widths
(nconc csv--config-column-widths (make-list (- column len) nil))))
(setf (nth (1- column) csv--config-column-widths) value)))
(defun csv-align-set-column-width (column width)
"Set the max WIDTH to use for COLUMN."
(interactive
(let* ((field (or (csv--field-index) 1))
(curwidth (nth (1- field) csv--config-column-widths)))
(list field
(cond
((numberp current-prefix-arg)
current-prefix-arg)
(current-prefix-arg
(read-number (format "Column width (for field %d): " field)
curwidth))
(t (if curwidth nil (csv--ellipsis-width)))))))
(when (eql width csv-align-max-width)
(setq width nil))
(csv-align--set-column column width)
(jit-lock-refontify))
(defvar-local csv--jit-columns nil)
(defun csv--jit-flush-columns ()
"Throw away all cached info about column widths."
;; FIXME: Maybe we should kill its overlays as well.
(setq csv--jit-columns nil))
(defun csv--jit-merge-columns (column-widths)
;; FIXME: The incremental update (delayed by jit-lock-context-time) of column
;; width is a bit jarring at times. It's OK while scrolling or when
;; extending a column, but not right when enabling the csv-align-mode or
;; when shortening the longest field (or deleting the line containing it),
;; because in that case we have *several* cascaded updates, e.g.:
;; - Remove the line with the longest field of column N.
;; - Edit some line: this line is updated as if its field was the widest,
;; hence its subsequent fields are too much to the left.
;; - The rest is updated starting from the first few lines (according
;; to jit-lock-chunk-size).
;; - After the first few lines, come the next set of few lines,
;; which may cause the previous few lines to need refresh again.
;; - etc.. until arriving again at the edited line which is re-aligned
;; again.
;; - etc.. until the end of the windows, potentially causing yet more
;; refreshes as we discover yet-wider fields for this column.
(let ((old-columns csv--jit-columns)
(changed nil))
(while (and old-columns column-widths)
(when (or (> (caar column-widths) (caar old-columns))
;; Apparently modification-hooks aren't run when the
;; whole text containing the overlay is deleted (e.g.
;; the whole line), so detect this case here.
;; It's a bit too late, but better than never.
(null (overlay-buffer (cdar old-columns))))
(setq changed t) ;; Return non-nil if some existing column changed.
(pcase-let ((`(,width ,beg ,end) (car column-widths)))
(setf (caar old-columns) width)
(move-overlay (cdar old-columns) beg end)))
(setq old-columns (cdr old-columns))
(setq column-widths (cdr column-widths)))
(when column-widths
;; New columns appeared.
(setq csv--jit-columns
(nconc csv--jit-columns
(mapcar (lambda (x)
(pcase-let*
((`(,width ,beg ,end) x)
(ol (make-overlay beg end)))
(overlay-put ol 'csv-width t)
(overlay-put ol 'evaporate t)
(overlay-put ol 'modification-hooks
(list #'csv--jit-width-change))
(cons width ol)))
column-widths))))
changed))
(defun csv--jit-width-change (ol after _beg _end &optional len)
(when (and after (> len 0))
;; (let ((x (rassq ol csv--jit-columns)))
;; (when x (setf (car x) -1)))
(delete-overlay ol)))
(defun csv--jit-unalign (beg end)
(with-silent-modifications
(remove-text-properties beg end
'( display nil csv--jit nil invisible nil
cursor-sensor-functions nil csv--revealed nil))
(remove-overlays beg end 'csv--jit t)))
(defun csv--jit-flush (beg end)
"Cause all the buffer (except for the BEG...END region) to be re-aligned."
(cl-assert (>= end beg))
;; The buffer shouldn't have changed since beg/end were computed,
;; but just in case, let's make sure they're still sane.
(when (< beg (point-min))
(setq beg (point-min) end (max end beg)))
(when (< (point-max) end)
(setq end (point-max) beg (min end beg)))
(let ((pos (point-min)))
(while (and (< pos beg)
(setq pos (text-property-any pos beg 'csv--jit t)))
(jit-lock-refontify
pos (setq pos (or (text-property-any pos beg 'csv--jit nil) beg))))
(setq pos end)
(while (and (< pos (point-max))
(setq pos (text-property-any pos (point-max) 'csv--jit t)))
(jit-lock-refontify
pos (setq pos (or (text-property-any pos (point-max) 'csv--jit nil)
(point-max))))))
(csv--header-flush))
(defun csv--ellipsis-width ()
(let ((ellipsis
(when standard-display-table
(display-table-slot standard-display-table
'selective-display))))
(if ellipsis (length ellipsis) 3)))
(defun csv-align--cursor-truncated (window oldpos dir)
;; FIXME: Neither the `entered' nor the `left' event are guaranteed
;; to be sent, and for the `left' case, even when we do get called,
;; it may be unclear where the revealed text was (it's somewhere around
;; `oldpos', but that position can be stale).
;; Worse, if we have several windows displaying the buffer, when one
;; cursor leaves we may need to keep the text revealed because of
;; another window's cursor.
(let* ((prop (if (eq dir 'entered) 'invisible 'csv--revealed))
(pos (cond
((eq dir 'entered) (window-point window))
(t (max (point-min)
(min (point-max)
(or oldpos (window-point window)))))))
(start (cond
((and (> pos (point-min))
(eq (get-text-property (1- pos) prop) 'csv-truncate))
(or (previous-single-property-change pos prop) (point-min)))
(t pos)))
(end (if (eq (get-text-property pos prop) 'csv-truncate)
(or (next-single-property-change pos prop) (point-max))
pos)))
(unless (eql start end)
(with-silent-modifications
(put-text-property start end
(if (eq dir 'entered) 'csv--revealed 'invisible)
'csv-truncate)
(remove-text-properties start end (list prop))))))
(defun csv--jit-align (beg end)
(save-excursion
;; This is run with inhibit-modification-hooks set, so the overlays'
;; modification-hook doesn't work :-(
(and csv--header-line
(<= beg (overlay-end csv--header-line))
(>= end (overlay-start csv--header-line))
(csv--header-flush))
;; First, round up to a whole number of lines.
(goto-char end)
(unless (bolp) (forward-line 1) (setq end (point)))
(goto-char beg)
(unless (bolp) (forward-line 1) (setq beg (point)))
(csv--jit-unalign beg end)
(put-text-property beg end 'csv--jit t)
(pcase-let* ((`(,column-widths ,field-widths) (csv--column-widths beg end))
(changed (csv--jit-merge-columns column-widths))
(ellipsis-width (csv--ellipsis-width)))
(when changed
;; Do it after the current redisplay is over.
(run-with-timer jit-lock-context-time nil #'csv--jit-flush beg end))
;; Align fields:
(goto-char beg)
(while (< (point) end)
(unless (csv-not-looking-at-record)
(let ((w csv--jit-columns)
(widths-config csv--config-column-widths)
(column 0)) ;Desired position of left-side of this column.
(while (and w (not (eolp)))
(let* ((field-beg (point))
(width-config (pop widths-config))
(align-padding (if (bolp) 0 csv-align-padding))
(left-padding 0) (right-padding 0)
(field-width (pop field-widths))
(column-width
(min (max csv-align-min-width
(car (pop w)))
(or width-config
;; Don't apply csv-align-max-width
;; to the last field!
(if w csv-align-max-width
most-positive-fixnum))))
(x (- column-width field-width)) ; Required padding.
(truncate nil))
(csv-end-of-field)
;; beg = beginning of current field
;; end = (point) = end of current field
(when (< x 0)
(setq truncate (max column
(+ column column-width
align-padding (- ellipsis-width))))
(setq x 0))
;; Compute required padding:
(pcase csv-align-style
('left
;; Left align -- pad on the right:
(setq left-padding align-padding
right-padding x))
('right
;; Right align -- pad on the left:
(setq left-padding (+ align-padding x)))
('auto
;; Auto align -- left align text, right align numbers:
(if (string-match "\\`[-+.[:digit:]]+\\'"
(buffer-substring field-beg (point)))
;; Right align -- pad on the left:
(setq left-padding (+ align-padding x))
;; Left align -- pad on the right:
(setq left-padding align-padding
right-padding x)))
('centre
;; Centre -- pad on both left and right:
(let ((y (/ x 2))) ; truncated integer quotient
(setq left-padding (+ align-padding y)
right-padding (- x y)))))
(cond
((or (memq 'csv buffer-invisibility-spec)
;; For TSV, hidden or not doesn't make much difference,
;; but the behavior is slightly better when we "hide"
;; the TABs with a `display' property than if we add
;; before/after-strings.
(tsv--mode-p))
;; Hide separators...
;; Merge right-padding from previous field
;; with left-padding from this field:
(if (zerop column)
(when (> left-padding 0)
;; Display spaces before first field
;; by overlaying first character:
(csv--make-overlay
field-beg (1+ field-beg) nil nil nil
`(before-string ,(make-string left-padding ?\ )
csv--jit t)))
;; Display separator as spaces:
(with-silent-modifications
(put-text-property
(1- field-beg) field-beg
'display `(space :align-to
,(+ left-padding column))))))
(t ;; Do not hide separators...
(let ((overlay (csv--make-overlay field-beg (point)
nil nil t
'(csv--jit t))))
(when (> left-padding 0) ; Pad on the left.
;; Display spaces before field:
(overlay-put overlay 'before-string
(make-string left-padding ?\ )))
(unless (eolp)
(if (> right-padding 0) ; Pad on the right.
;; Display spaces after field:
(overlay-put
overlay
'after-string (make-string right-padding ?\ )))))))
(setq column (+ column column-width align-padding))
;; Do it after applying the property, so `move-to-column' can
;; take it into account.
(when truncate
(let ((trunc-pos
(save-excursion
;; ¡¡ BIG UGLY HACK !!
;; `current-column' and `move-to-column' count
;; text hidden with an ellipsis "as if" it were
;; fully visible, which is completely wrong here,
;; so circumvent this by temporarily pretending
;; that `csv-truncate' is fully invisible (which
;; isn't quite right either, but should work
;; just well enough for us here).
(let ((buffer-invisibility-spec
buffer-invisibility-spec))
(add-to-invisibility-spec 'csv-truncate)
(move-to-column truncate))
(point))))
(put-text-property trunc-pos (point)
'invisible 'csv-truncate)
(when (> (- (point) trunc-pos) 1)
;; Arrange to temporarily untruncate the string when
;; cursor moves into it.
;; FIXME: This only works if
;; `global-disable-point-adjustment' is non-nil!
;; Arguably this should be fixed by making
;; point-adjustment code pay attention to
;; cursor-sensor-functions!
(put-text-property
(1+ trunc-pos) (point)
'cursor-sensor-functions
(list #'csv-align--cursor-truncated)))))
(unless (eolp) (forward-char)) ; Skip separator.
))))
(forward-line)))
`(jit-lock-bounds ,beg . ,end)))
(define-minor-mode csv-align-mode
"Align columns on the fly."
:global nil
(csv-unalign-fields nil (point-min) (point-max)) ;Just in case.
(cond
(csv-align-mode
(add-to-invisibility-spec '(csv-truncate . t))
(kill-local-variable 'csv--jit-columns)
(cursor-sensor-mode 1)
(when (fboundp 'header-line-indent-mode)
(header-line-indent-mode))
(jit-lock-register #'csv--jit-align)
(jit-lock-refontify))
(t
(remove-from-invisibility-spec '(csv-truncate . t))
(jit-lock-unregister #'csv--jit-align)
(csv--jit-unalign (point-min) (point-max))))
(csv--header-flush))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Separator guessing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar csv--preferred-separators
'(?, ?\; ?\t)
"Preferred separator characters in case of a tied score.")
(defun csv-guess-set-separator ()
"Guess and set the CSV separator of the current buffer.
Add it to the mode hook to have CSV mode guess and set the
separator automatically when visiting a buffer:
(add-hook \\='csv-mode-hook \\='csv-guess-set-separator)"
(interactive)
(let ((sep (csv-guess-separator
(buffer-substring-no-properties
(point-min)
;; We're probably only going to look at the first 2048
;; or so chars, but take more than we probably need to
;; minimize the chance of breaking the input in the
;; middle of a (long) row.
(min 8192 (point-max)))
2048)))
(when sep
(csv-set-separator sep))))
(defun csv-guess-separator (text &optional cutoff)
"Return a guess of which character is the CSV separator in TEXT."
(let ((best-separator nil)
(best-score 0))
(dolist (candidate (csv--separator-candidates text cutoff))
(let ((candidate-score
(csv--separator-score candidate text cutoff)))
(when (or (> candidate-score best-score)
(and (= candidate-score best-score)
(member candidate csv--preferred-separators)))
(setq best-separator candidate)
(setq best-score candidate-score))))
best-separator))
(defun csv--separator-candidates (text &optional cutoff)
"Return a list of candidate CSV separators in TEXT.
When CUTOFF is passed, look only at the first CUTOFF number of characters."
(let ((chars (make-hash-table)))
(dolist (c (string-to-list
(if cutoff
(substring text 0 (min cutoff (length text)))
text)))
(when (and (not (gethash c chars))
(or (= c ?\t)
(= c ?\C-_)
(and (not (member c '(?. ?/ ?\" ?')))
(not (= c (string-to-char csv-comment-start)))
(not (member (get-char-code-property c 'general-category)
'(Lu Ll Lt Lm Lo Nd Nl No Ps Pe Cc Co))))))
(puthash c t chars)))
(hash-table-keys chars)))
(defun csv--separator-score (separator text &optional cutoff)
"Return a score on how likely SEPARATOR is a separator in TEXT.
When CUTOFF is passed, stop the calculation at the next whole
line after having read CUTOFF number of characters.
The scoring is based on the idea that most CSV data is tabular,
i.e. separators should appear equally often on each line.
Furthermore, more commonly appearing characters are scored higher
than those who appear less often.
Adapted from the paper \"Wrangling Messy CSV Files by Detecting
Row and Type Patterns\" by Gerrit J.J. van den Burg , Alfredo
Nazábal, and Charles Sutton: https://arxiv.org/abs/1811.11242."
(let ((groups
(with-temp-buffer
(csv-set-separator separator)
(save-excursion
(insert text))
(let ((groups (make-hash-table))
(chars-read 0))
(while (and (/= (point) (point-max))
(or (not cutoff)
(< chars-read cutoff)))
(let* ((lep (line-end-position))
(nfields (length (csv--collect-fields lep))))
(cl-incf (gethash nfields groups 0))
(cl-incf chars-read (- lep (point)))
(goto-char (+ lep 1))))
groups)))
(sum 0))
(maphash
(lambda (length num)
(cl-incf sum (* num (/ (- length 1) (float length)))))
groups)
(let ((unique-groups (hash-table-count groups)))
(if (= 0 unique-groups)
0
(/ sum unique-groups)))))
;;; TSV support
;; Since "the" CSV format is really a bunch of different formats, it includes
;; TSV as a subcase, but this subcase is sufficiently interesting that it has
;; its own mime-type and mostly standard file extension, also it suffers
;; less from the usual quoting problems of CSV (because the only problematic
;; chars are LF and TAB, really, which are much less common inside fields than
;; commas, space, and semi-colons) so it's "better behaved".
(defvar tsv-mode-syntax-table
;; Inherit from `text-mode-syntax-table' rather than from
;; `csv-mode-syntax-table' so as not to inherit the
;; `csv-field-quotes' settings.
(let ((st (make-syntax-table text-mode-syntax-table)))
st))
(defvar tsv-mode-map
(let ((map (make-sparse-keymap)))
;; In `tsv-mode', the `csv-invisibility-default/csv-toggle-invisibility'
;; business doesn't make much sense.
(define-key map [remap csv-toggle-invisibility] #'undefined)
map))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode))
(defun tsv--mode-p ()
(equal csv-separator-chars '(?\t)))
;;;###autoload
(define-derived-mode tsv-mode csv-mode "TSV"
"Major mode for editing files of tab-separated value type."
:group 'CSV
;; In TSV we know TAB is the only possible separator.
(setq-local csv-separators '("\t"))
;; FIXME: Copy&pasted from the `:set'ter of csv-separators!
(setq-local csv-separator-chars '(?\t))
(setq-local csv--skip-chars "^\n\t")
(setq-local csv-separator-regexp "\t")
(setq-local csv-font-lock-keywords
;; NB: csv-separator-face variable evaluates to itself.
`((,csv-separator-regexp (0 'csv-separator-face))))
;; According to wikipedia, TSV doesn't use quotes but uses backslash escapes
;; of the form \n, \t, \r, and \\ instead.
(setq-local csv-field-quotes nil))
(provide 'csv-mode)
;;; csv-mode.el ends here
|