commit c895727b6441e04504671c807068b5fcca2fc50c from: Lukas Henkel date: Mon Sep 01 07:14:13 2025 UTC Add csv-mode commit - c1d758392ffa58c9e0257b54b3d9ea517f7b3026 commit + c895727b6441e04504671c807068b5fcca2fc50c blob - /dev/null blob + de8cc7c83b682e848afa34381d8c5c8112969f29 (mode 644) --- /dev/null +++ elpa/csv-mode-1.27/csv-mode-autoloads.el @@ -0,0 +1,76 @@ +;;; csv-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from csv-mode.el + +(autoload 'csv-mode "csv-mode" "\ +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} + +(fn)" t) +(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) +(add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode)) +(autoload 'tsv-mode "csv-mode" "\ +Major mode for editing files of tab-separated value type. + +(fn)" t) +(register-definition-prefixes "csv-mode" '("csv-" "tsv-")) + + +;;; Generated autoloads from csv-mode-tests.el + +(register-definition-prefixes "csv-mode-tests" '("csv-tests--")) + +;;; End of scraped data + +(provide 'csv-mode-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; csv-mode-autoloads.el ends here blob - /dev/null blob + 9f6ddfff0cbfd4fe0e4185b771dd45a3fc39b15e (mode 644) --- /dev/null +++ elpa/csv-mode-1.27/csv-mode-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from csv-mode.el -*- no-byte-compile: t -*- +(define-package "csv-mode" "1.27" "Major mode for editing comma/char separated values" '((emacs "27.1") (cl-lib "0.5")) :commit "a16e9d8b0952de1badf6da8e652b178a7f6c4498" :url "https://elpa.gnu.org/packages/csv-mode.html" :authors '(("Francis J. Wright" . "F.J.Wright@qmul.ac.uk")) :maintainer '(nil . "emacs-devel@gnu.org") :keywords '("convenience")) blob - /dev/null blob + 6aae7369993dae2933c27267470127db977a80ae (mode 644) --- /dev/null +++ elpa/csv-mode-1.27/csv-mode-tests.el @@ -0,0 +1,199 @@ +;;; csv-mode-tests.el --- Tests for CSV mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc + +;; Author: Simen Heggestøyl +;; Keywords: + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'csv-mode) +(eval-when-compile (require 'subr-x)) + +(ert-deftest csv-tests-end-of-field () + (with-temp-buffer + (csv-mode) + (insert "aaa,bbb") + (goto-char (point-min)) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) "aaa")) + (forward-char) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) + "aaa,bbb")))) + +(ert-deftest csv-tests-end-of-field-with-quotes () + (with-temp-buffer + (csv-mode) + (insert "aaa,\"b,b\"") + (goto-char (point-min)) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) "aaa")) + (forward-char) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) + "aaa,\"b,b\"")))) + +(ert-deftest csv-tests-end-of-field-unclosed-quotes () + (with-temp-buffer + (csv-mode) + (insert "a,b,c +1,2,3 +1,2,\" +\"1, +\"") + (goto-char (point-min)) + (while (not (eobp)) + ;; Should not error + (csv-end-of-field) + (unless (eobp) + (forward-char))))) + +(ert-deftest csv-tests-beginning-of-field () + (with-temp-buffer + (csv-mode) + (insert "aaa,bbb") + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) "bbb")) + (backward-char) + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) + "aaa,bbb")))) + +(ert-deftest csv-tests-beginning-of-field-with-quotes () + (with-temp-buffer + (csv-mode) + (insert "aaa,\"b,b\"") + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) "\"b,b\"")) + (backward-char) + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) + "aaa,\"b,b\"")))) + +(defun csv-tests--align-fields (before after) + (with-temp-buffer + (insert (string-join before "\n")) + (csv-align-fields t (point-min) (point-max)) + (should (equal (buffer-string) (string-join after "\n"))))) + +(ert-deftest csv-tests-align-fields () + (csv-tests--align-fields + '("aaa,bbb,ccc" + "1,2,3") + '("aaa, bbb, ccc" + "1 , 2 , 3"))) + +(ert-deftest csv-tests-align-fields-with-quotes () + (csv-tests--align-fields + '("aaa,\"b,b\",ccc" + "1,2,3") + '("aaa, \"b,b\", ccc" + "1 , 2 , 3"))) + +;; Bug#14053 +(ert-deftest csv-tests-align-fields-double-quote-comma () + (csv-tests--align-fields + '("1,2,3" + "a,\"b\"\"c,\",d") + '("1, 2 , 3" + "a, \"b\"\"c,\", d"))) + +(defvar csv-tests--data + "1,4;Sun, 2022-04-10;4,12 +8;Mon, 2022-04-11;3,19 +3,2;Tue, 2022-04-12;1,00 +2;Wed, 2022-04-13;0,37 +9;Wed, 2022-04-13;0,37") + +(ert-deftest csv-tests-guess-separator () + (should-not (csv-guess-separator "")) + (should (= (csv-guess-separator csv-tests--data 3) ?,)) + (should (= (csv-guess-separator csv-tests--data) ?\;)) + (should (= (csv-guess-separator csv-tests--data) + (csv-guess-separator csv-tests--data + (length csv-tests--data))))) + +(ert-deftest csv-tests-separator-candidates () + (should-not (csv--separator-candidates "")) + (should-not (csv--separator-candidates csv-tests--data 0)) + (should + (equal (sort (csv--separator-candidates csv-tests--data 4) #'<) + '(?, ?\;))) + (should + (equal (sort (csv--separator-candidates csv-tests--data) #'<) + '(?\s ?, ?- ?\;))) + (should + (equal + (sort (csv--separator-candidates csv-tests--data) #'<) + (sort (csv--separator-candidates csv-tests--data + (length csv-tests--data)) + #'<)))) + +(ert-deftest csv-tests-separator-score () + (should (< (csv--separator-score ?, csv-tests--data) + (csv--separator-score ?\s csv-tests--data) + (csv--separator-score ?- csv-tests--data))) + (should (= (csv--separator-score ?- csv-tests--data) + (csv--separator-score ?\; csv-tests--data))) + (should (= 0 (csv--separator-score ?\; csv-tests--data 0))) + (should (= (csv--separator-score ?\; csv-tests--data) + (csv--separator-score ?\; csv-tests--data + (length csv-tests--data))))) + +(ert-deftest csv-tests-unquote-value () + (should (equal (csv--unquote-value "Hello, World") + "Hello, World")) + (should (equal (csv--unquote-value "\"Hello, World\"") + "Hello, World")) + (should (equal (csv--unquote-value "Hello, \"\"World") + "Hello, \"\"World")) + (should (equal (csv--unquote-value "\"Hello, \"\"World\"\"\"") + "Hello, \"World\"")) + (should (equal (csv--unquote-value "'Hello, World'") + "'Hello, World'")) + (should (equal (let ((csv-field-quotes '("\"" "'"))) + (csv--unquote-value "\"Hello, World'")) + "\"Hello, World'")) + (should (equal (let ((csv-field-quotes '("\"" "'"))) + (csv--unquote-value "'Hello, World'")) + "Hello, World")) + (should (equal (let ((csv-field-quotes '("\"" "'"))) + (csv--unquote-value "'Hello, ''World'''")) + "Hello, 'World'")) + (should (equal (let ((csv-field-quotes '("\"" "'"))) + (csv--unquote-value "'Hello, \"World\"'")) + "Hello, \"World\"")) + (should (equal (csv--unquote-value "|Hello, World|") + "|Hello, World|"))) + +(ert-deftest csv-tests-guess-separator-avoid-comment () + ;; bug#71042 + (let ((testdata "### +### +Foo;Bar;Quux +123;456;blah, blah +")) + (message "Guessed separator: %c" (csv-guess-separator testdata)) + (should-not (equal (csv-guess-separator testdata) ?#)))) + +(provide 'csv-mode-tests) +;;; csv-mode-tests.el ends here blob - /dev/null blob + b29019f6be0f2cd3d51b6beba8bd2677374fea1a (mode 644) --- /dev/null +++ elpa/csv-mode-1.27/csv-mode.el @@ -0,0 +1,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" +;; 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 . + +;;; 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 , 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 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 + :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 blob - /dev/null blob + 8d4174a295b747137ea5babc380433f1c3b13341 (mode 644) --- /dev/null +++ elpa/csv-mode-1.27.signed @@ -0,0 +1 @@ +Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) (trust undefined) created at 2024-08-09T11:05:02+0200 using EDDSA \ No newline at end of file blob - 7508912acf49b083a499de4a5d0b1b84ea47d90a blob + b1b1249c775aa5b9d58ab5f254db197c828c11dd --- init.el +++ init.el @@ -23,8 +23,8 @@ ("melpa-stable" . 1) ("melpa" . 0)) package-pinned-packages '((sly . "melpa")) - package-selected-packages '(magit nhexl-mode notmuch ob-restclient paredit paredit-menu - restclient restclient-jq sly)) + package-selected-packages '(csv-mode elfeed magit nhexl-mode notmuch ob-restclient paredit + paredit-menu restclient restclient-jq sly)) (package-initialize) ;;;; Completions @@ -64,6 +64,9 @@ (add-hook 'lisp-mode-hook 'paredit-mode) (add-hook 'emacs-lisp-mode-hook 'paredit-mode) +;;;;; CSV +(add-hook 'csv-mode-hook 'csv-align-mode) + ;;;; elfeed (let ((elfeed-feeds-file (expand-file-name "feeds.el" user-emacs-directory)) (elfeed-data-dir (expand-file-name "elfeed" lh/dir-data-home)))