+++ /dev/null
-Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasignNOSPAMelpa.gnu.org> (trust undefined) created at 2023-02-08T23:05:02+0100 using RSA
\ No newline at end of file
+++ /dev/null
-;;; csv-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "csv-mode" "csv-mode.el" (0 0 0 0))
-;;; 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 nil)
-
-(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 nil)
-
-(register-definition-prefixes "csv-mode" '("csv-" "tsv-"))
-
-;;;***
-\f
-;;;### (autoloads nil "csv-mode-tests" "csv-mode-tests.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from csv-mode-tests.el
-
-(register-definition-prefixes "csv-mode-tests" '("csv-tests--"))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("csv-mode-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; csv-mode-autoloads.el ends here
+++ /dev/null
-;; Generated package description from csv-mode.el -*- no-byte-compile: t -*-
-(define-package "csv-mode" "1.22" "Major mode for editing comma/char separated values" '((emacs "27.1") (cl-lib "0.5")) :commit "db8a3e3aef31d35ce5bd1fd09127a3bbfdd0c340" :url "https://elpa.gnu.org/packages/csv-mode.html" :authors '(("\"Francis J. Wright\"" . "F.J.WrightNOSPAMqmul.ac.uk")) :maintainer '(nil . "emacs-develNOSPAMgnu.org") :keywords '("convenience"))
+++ /dev/null
-;;; csv-mode-tests.el --- Tests for CSV mode -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020-2022 Free Software Foundation, Inc
-
-;; Author: Simen Heggestøyl <simenhegNOSPAMrunbox.com>
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; 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-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)))))
-
-(provide 'csv-mode-tests)
-;;; csv-mode-tests.el ends here
+++ /dev/null
-;;; csv-mode.el --- Major mode for editing comma/char separated values -*- lexical-binding: t -*-
-
-;; Copyright (C) 2003-2023 Free Software Foundation, Inc
-
-;; Author: "Francis J. Wright" <F.J.WrightNOSPAMqmul.ac.uk>
-;; Maintainer: emacs-develNOSPAMgnu.org
-;; Version: 1.22
-;; 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.21:
-;; - New command `csv-insert-column'.
-;; - New config var `csv-align-min-width' for `csv-align-mode'.
-
-;; 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)
-
-(defface csv-separator-face
- '((t :inherit escape-glyph))
- "CSV mode face used to highlight separators.")
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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))
- (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))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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 (not ended)
- (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))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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)))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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)))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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))))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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)))))
-
-(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))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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)
- (and (not (member c '(?. ?/ ?\" ?')))
- (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
--- /dev/null
+Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasignNOSPAMelpa.gnu.org> (trust undefined) created at 2024-08-09T11:05:02+0200 using EDDSA
\ No newline at end of file
--- /dev/null
+;;; 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)))
+
+
+\f
+;;; 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-"))
+
+\f
+;;; Generated autoloads from csv-mode-tests.el
+
+(register-definition-prefixes "csv-mode-tests" '("csv-tests--"))
+\f
+;;; 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
--- /dev/null
+;; 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.WrightNOSPAMqmul.ac.uk")) :maintainer '(nil . "emacs-develNOSPAMgnu.org") :keywords '("convenience"))
--- /dev/null
+;;; csv-mode-tests.el --- Tests for CSV mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc
+
+;; Author: Simen Heggestøyl <simenhegNOSPAMrunbox.com>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; 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.WrightNOSPAMqmul.ac.uk>
+;; Maintainer: emacs-develNOSPAMgnu.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.")
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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))))))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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))
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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
+++ /dev/null
-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 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.
-
-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)
projects / emacsconfig.git / commitdiff