config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

csv-mode.el (84342B)


      1 ;;; csv-mode.el --- Major mode for editing comma/char separated values  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2003-2024  Free Software Foundation, Inc
      4 
      5 ;; Author: "Francis J. Wright" <F.J.Wright@qmul.ac.uk>
      6 ;; Maintainer: emacs-devel@gnu.org
      7 ;; Version: 1.27
      8 ;; Package-Requires: ((emacs "27.1") (cl-lib "0.5"))
      9 ;; Keywords: convenience
     10 
     11 ;; This package is free software; you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation; either version 3, or (at your option)
     14 ;; any later version.
     15 
     16 ;; This package is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; This package implements CSV mode, a major mode for editing records
     27 ;; in a generalized CSV (character-separated values) format.  It binds
     28 ;; files with prefix ".csv" to `csv-mode' (and ".tsv" to `tsv-mode') in
     29 ;; `auto-mode-alist'.
     30 
     31 ;; In CSV mode, the following commands are available:
     32 
     33 ;; - C-c C-s (`csv-sort-fields') and C-c C-n (`csv-sort-numeric-fields')
     34 ;;   respectively sort lexicographically and numerically on a
     35 ;;   specified field or column.
     36 
     37 ;; - C-c C-r (`csv-reverse-region') reverses the order.  (These
     38 ;;   commands are based closely on, and use, code in `sort.el'.)
     39 
     40 ;; - C-c C-k (`csv-kill-fields') and C-c C-y (`csv-yank-fields') kill
     41 ;;   and yank fields or columns, although they do not use the normal
     42 ;;   kill ring.  C-c C-k can kill more than one field at once, but
     43 ;;   multiple killed fields can be yanked only as a fixed group
     44 ;;   equivalent to a single field.
     45 
     46 ;; - `csv-align-mode' keeps fields visually aligned, on-the-fly.
     47 ;;   It truncates fields to a maximum width that can be changed per-column
     48 ;;   with `csv-align-set-column-width'.
     49 ;;   Alternatively, C-c C-a (`csv-align-fields') aligns fields into columns
     50 ;;   and C-c C-u (`csv-unalign-fields') undoes such alignment;
     51 ;;   separators can be hidden within aligned records (controlled by
     52 ;;   `csv-invisibility-default' and `csv-toggle-invisibility').
     53 
     54 ;; - C-c C-t (`csv-transpose') interchanges rows and columns.  For
     55 ;;   details, see the documentation for the individual commands.
     56 
     57 ;; - `csv-set-separator' sets the CSV separator of the current buffer,
     58 ;;   while `csv-guess-set-separator' guesses and sets the separator
     59 ;;   based on the current buffer's contents.
     60 ;;   `csv-guess-set-separator' can be useful to add to the mode hook
     61 ;;   to have CSV mode guess and set the separator automatically when
     62 ;;   visiting a buffer:
     63 ;;
     64 ;;     (add-hook 'csv-mode-hook 'csv-guess-set-separator)
     65 
     66 ;; CSV mode can recognize fields separated by any of several single
     67 ;; characters, specified by the value of the customizable user option
     68 ;; `csv-separators'.  CSV data fields can be delimited by quote
     69 ;; characters (and must if they contain separator characters).  This
     70 ;; implementation supports quoted fields, where the quote characters
     71 ;; allowed are specified by the value of the customizable user option
     72 ;; `csv-field-quotes'.  By default, the both commas and tabs are considered
     73 ;; as separators and the only field quote is a double quote.
     74 ;; These user options can be changed ONLY by customizing them, e.g. via M-x
     75 ;; customize-variable.
     76 
     77 ;; CSV mode commands ignore blank lines and comment lines beginning
     78 ;; with the value of the buffer local variable `csv-comment-start',
     79 ;; which by default is #.  The user interface is similar to that of
     80 ;; the standard commands `sort-fields' and `sort-numeric-fields', but
     81 ;; see the major mode documentation below.
     82 
     83 ;; The global minor mode `csv-field-index-mode' provides display of
     84 ;; the current field index in the mode line, cf. `line-number-mode'
     85 ;; and `column-number-mode'.  It is on by default.
     86 
     87 ;;;; See also:
     88 
     89 ;; the standard GNU Emacs 21 packages align.el, which will align
     90 ;; columns within a region, and delim-col.el, which helps to prettify
     91 ;; columns in a text region or rectangle;
     92 
     93 ;; csv.el by Ulf Jasper <ulf.jasper at web.de>, which provides
     94 ;; functions for reading/parsing comma-separated value files and is
     95 ;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in
     96 ;; the gnu.emacs.sources archives).
     97 
     98 ;;; Installation:
     99 
    100 ;; Put this file somewhere that Emacs can find it (i.e. in one of the
    101 ;; directories in your `load-path' such as `site-lisp'), optionally
    102 ;; byte-compile it (recommended), and put this in your .emacs file:
    103 ;;
    104 ;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
    105 ;; (autoload 'csv-mode "csv-mode"
    106 ;;   "Major mode for editing comma-separated value files." t)
    107 
    108 ;;; News:
    109 
    110 ;; Since 1.27:
    111 ;; - `csv-end-of-field' no longer errors out in the presence of
    112 ;;    unclosed quotes.
    113 
    114 ;; Since 1.26:
    115 ;; - `csv-guess-separator' will no longer guess the comment-start
    116 ;;    character as a potential separator character.
    117 
    118 ;; Since 1.25:
    119 ;; - The ASCII control character 31 Unit Separator can now be
    120 ;;   recognized as a CSV separator by `csv-guess-separator'.
    121 
    122 ;; Since 1.24:
    123 ;; - New function `csv--unquote-value'.
    124 ;; - New function `csv-parse-current-row'.
    125 
    126 ;; Since 1.21:
    127 ;; - New command `csv-insert-column'.
    128 ;; - New config var `csv-align-min-width' for `csv-align-mode'.
    129 ;; - New option `csv-confirm-region'.
    130 
    131 ;; Since 1.20:
    132 ;; - New command `csv-guess-set-separator' that automatically guesses
    133 ;;   and sets the CSV separator of the current buffer.
    134 ;; - New command `csv-set-separator' for setting the CSV separator
    135 ;;   manually.
    136 
    137 ;; Since 1.9:
    138 ;; - `csv-align-mode' auto-aligns columns dynamically (on screen).
    139 
    140 ;; Before that:
    141 ;; Begun on 15 November 2003 to provide lexicographic sorting of
    142 ;; simple CSV data by field and released as csv.el.  Facilities to
    143 ;; kill multiple fields and customize separator added on 9 April 2004.
    144 ;; Converted to a major mode and renamed csv-mode.el on 10 April 2004,
    145 ;; partly at the suggestion of Stefan Monnier <monnier at
    146 ;; IRO.UMontreal.CA> to avoid conflict with csv.el by Ulf Jasper.
    147 ;; Field alignment, comment support and CSV mode customization group
    148 ;; added on 1 May 2004.  Support for index ranges added on 6 June
    149 ;; 2004.  Multiple field separators added on 12 June 2004.
    150 ;; Transposition added on 22 June 2004.  Separator invisibility added
    151 ;; on 23 June 2004.
    152 
    153 ;;; To do (maybe):
    154 
    155 ;; Make separators and quotes buffer-local and locally settable.
    156 ;; Support (La)TeX tables: set separator and comment; support record
    157 ;; end string.
    158 ;; Convert comma-separated to space- or tab-separated.
    159 
    160 ;;; Code:
    161 
    162 (eval-when-compile
    163   (require 'cl-lib)
    164   (require 'subr-x))
    165 
    166 (defgroup CSV nil
    167   "Major mode for editing files of comma-separated value type."
    168   :group 'convenience)
    169 
    170 (defvar csv-separator-chars nil
    171   "Field separators as a list of character.
    172 Set by customizing `csv-separators' -- do not set directly!")
    173 
    174 (defvar csv-separator-regexp nil
    175   "Regexp to match a field separator.
    176 Set by customizing `csv-separators' -- do not set directly!")
    177 
    178 (defvar csv--skip-chars nil
    179   "Char set used by `skip-chars-forward' etc. to skip fields.
    180 Set by customizing `csv-separators' -- do not set directly!")
    181 
    182 (defvar csv-font-lock-keywords nil
    183   "Font lock keywords to highlight the field separators in CSV mode.
    184 Set by customizing `csv-separators' -- do not set directly!")
    185 
    186 (defcustom csv-separators '("," "\t")
    187   "Field separators: a list of *single-character* strings.
    188 For example: (\",\"), the default, or (\",\" \";\" \":\").
    189 Neighbouring fields may be separated by any one of these characters.
    190 The first is used when inserting a field separator into the buffer.
    191 All must be different from the field quote characters, `csv-field-quotes'.
    192 
    193 Changing this variable with `setq' won't affect the current Emacs
    194 session.  Use `customize-set-variable' instead if that is required."
    195   ;; Suggested by Eckhard Neber <neber@mwt.e-technik.uni-ulm.de>
    196   :type '(repeat string)
    197   ;; FIXME: Character would be better, but in Emacs 21.3 does not display
    198   ;; correctly in a customization buffer.
    199   :set (lambda (variable value)
    200 	 (mapc (lambda (x)
    201 		 (if (/= (length x) 1)
    202 		     (error "Non-single-char string %S" x))
    203                  (if (and (boundp 'csv-field-quotes)
    204                           (member x csv-field-quotes))
    205                      (error "%S is already a quote" x)))
    206 	       value)
    207 	 (custom-set-default variable value)
    208          (setq csv-separator-chars (mapcar #'string-to-char value))
    209          (setq csv--skip-chars
    210                (apply #'concat "^\n"
    211                       (mapcar (lambda (s) (concat "\\" s)) value)))
    212          (setq csv-separator-regexp (regexp-opt value))
    213          (setq csv-font-lock-keywords
    214                ;; NB: csv-separator-face variable evaluates to itself.
    215                `((,csv-separator-regexp (0 'csv-separator-face))))))
    216 
    217 (defcustom csv-field-quotes '("\"")
    218   "Field quotes: a list of *single-character* strings.
    219 For example: (\"\\\"\"), the default, or (\"\\\"\" \"\\='\" \"\\=`\").
    220 A field can be delimited by a pair of any of these characters.
    221 All must be different from the field separators, `csv-separators'."
    222   :type '(repeat string)
    223   ;; Character would be better, but in Emacs 21 does not display
    224   ;; correctly in a customization buffer.
    225   :set (lambda (variable value)
    226 	 (mapc (lambda (x)
    227 		 (if (/= (length x) 1)
    228 		     (error "Non-single-char string %S" x))
    229 		 (if (member x csv-separators)
    230 		     (error "%S is already a separator" x)))
    231 	       value)
    232 	 (when (boundp 'csv-mode-syntax-table)
    233 	   ;; FIRST remove old quote syntax:
    234 	   (with-syntax-table text-mode-syntax-table
    235 	     (mapc (lambda (x)
    236 		     (modify-syntax-entry
    237 		      (string-to-char x)
    238 		      (string (char-syntax (string-to-char x)))
    239 		      ;; symbol-value to avoid compiler warning:
    240 		      (symbol-value 'csv-mode-syntax-table)))
    241 		   csv-field-quotes))
    242 	   ;; THEN set new quote syntax:
    243 	   (csv-set-quote-syntax value))
    244 	 ;; BEFORE setting new value of `csv-field-quotes':
    245 	 (custom-set-default variable value)))
    246 
    247 (defun csv-set-quote-syntax (field-quotes)
    248   "Set syntax for field quote characters FIELD-QUOTES to be \"string\".
    249 FIELD-QUOTES should be a list of single-character strings."
    250   (mapc (lambda (x)
    251 	  (modify-syntax-entry
    252 	   (string-to-char x) "\""
    253 	   ;; symbol-value to avoid compiler warning:
    254 	   (symbol-value 'csv-mode-syntax-table)))
    255 	field-quotes))
    256 
    257 (defvar csv-comment-start nil
    258   "String that starts a comment line, or nil if no comment syntax.
    259 Such comment lines are ignored by CSV mode commands.
    260 This variable is buffer local; its default value is that of
    261 `csv-comment-start-default'.  It is set by the function
    262 `csv-set-comment-start' -- do not set it directly!")
    263 
    264 (make-variable-buffer-local 'csv-comment-start)
    265 
    266 (defcustom csv-comment-start-default "#"
    267   "String that starts a comment line, or nil if no comment syntax.
    268 Such comment lines are ignored by CSV mode commands.
    269 Default value of buffer-local variable `csv-comment-start'.
    270 Changing this variable does not affect any existing CSV mode buffer."
    271   :type '(choice (const :tag "None" nil) string)
    272   :set (lambda (variable value)
    273 	 (custom-set-default variable value)
    274 	 (setq-default csv-comment-start value)))
    275 
    276 (defcustom csv-align-style 'left
    277   "Aligned field style: one of `left', `centre', `right' or `auto'.
    278 Alignment style used by `csv-align-mode' and `csv-align-fields'.
    279 Auto-alignment means left align text and right align numbers."
    280   :type '(choice (const left) (const centre)
    281 		 (const right) (const auto)))
    282 
    283 (defcustom csv-align-padding 1
    284   "Aligned field spacing: must be a positive integer.
    285 Number of spaces used by `csv-align-mode' and `csv-align-fields'
    286 after separators."
    287   :type 'integer)
    288 
    289 (defcustom csv-header-lines 0
    290   "Header lines to skip when setting region automatically."
    291   :type 'integer)
    292 
    293 (defcustom csv-invisibility-default t
    294   "If non-nil, make separators in aligned records invisible."
    295   :type 'boolean)
    296 
    297 (defcustom csv-confirm-region t
    298   "If non-nil, confirm that region is OK in interactive commands."
    299   :type 'boolean)
    300 
    301 (defface csv-separator-face
    302   '((t :inherit escape-glyph))
    303   "CSV mode face used to highlight separators.")
    304 
    305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    306 ;;;  Mode definition, key bindings and menu
    307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    308 
    309 
    310 (defconst csv-mode-line-format
    311   '(csv-field-index-string ("" csv-field-index-string))
    312   "Mode line format string for CSV mode.")
    313 
    314 (defvar csv-mode-map
    315   (let ((map (make-sparse-keymap)))
    316     (define-key map [(control ?c) (control ?v)] #'csv-toggle-invisibility)
    317     (define-key map [(control ?c) (control ?t)] #'csv-transpose)
    318     (define-key map [(control ?c) (control ?c)] #'csv-set-comment-start)
    319     (define-key map [(control ?c) (control ?u)] #'csv-unalign-fields)
    320     (define-key map [(control ?c) (control ?a)] #'csv-align-fields)
    321     (define-key map [(control ?c) (control ?z)] #'csv-yank-as-new-table)
    322     (define-key map [(control ?c) (control ?y)] #'csv-yank-fields)
    323     (define-key map [(control ?c) (control ?k)] #'csv-kill-fields)
    324     (define-key map [(control ?c) (control ?d)] #'csv-toggle-descending)
    325     (define-key map [(control ?c) (control ?r)] #'csv-reverse-region)
    326     (define-key map [(control ?c) (control ?n)] #'csv-sort-numeric-fields)
    327     (define-key map [(control ?c) (control ?s)] #'csv-sort-fields)
    328     (define-key map "\t"      #'csv-tab-command)
    329     (define-key map [backtab] #'csv-backtab-command)
    330     map))
    331 
    332 ;;;###autoload
    333 (define-derived-mode csv-mode text-mode "CSV"
    334   "Major mode for editing files of comma-separated value type.
    335 
    336 CSV mode is derived from `text-mode', and runs `text-mode-hook' before
    337 running `csv-mode-hook'.  It turns `auto-fill-mode' off by default.
    338 CSV mode can be customized by user options in the CSV customization
    339 group.  The separators are specified by the value of `csv-separators'.
    340 
    341 CSV mode commands ignore blank lines and comment lines beginning with
    342 the value of `csv-comment-start', which delimit \"paragraphs\".
    343 \"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp'
    344 \(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields.
    345 Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]).
    346 
    347 If `font-lock-mode' is enabled then separators, quoted values and
    348 comment lines are highlighted using respectively `csv-separator-face',
    349 `font-lock-string-face' and `font-lock-comment-face'.
    350 
    351 The user interface (UI) for CSV mode commands is similar to that of
    352 the standard commands `sort-fields' and `sort-numeric-fields', except
    353 that if there is no prefix argument then the UI prompts for the field
    354 index or indices.  In `transient-mark-mode' only: if the region is not
    355 set then the UI attempts to set it to include all consecutive CSV
    356 records around point, and prompts for confirmation; if there is no
    357 prefix argument then the UI prompts for it, offering as a default the
    358 index of the field containing point if the region was not set
    359 explicitly.  The region set automatically is delimited by blank lines
    360 and comment lines, and the number of header lines at the beginning of
    361 the region given by the value of `csv-header-lines' are skipped.
    362 
    363 Sort order is controlled by `csv-descending'.
    364 
    365 CSV mode provides the following specific keyboard key bindings:
    366 
    367 \\{csv-mode-map}"
    368   :group 'CSV
    369   ;; We used to `turn-off-auto-fill' here instead, but that's not very
    370   ;; effective since text-mode-hook is run afterwards anyway!
    371   (setq-local normal-auto-fill-function nil)
    372   ;; Set syntax for field quotes:
    373   (csv-set-quote-syntax csv-field-quotes)
    374   ;; Make sexp functions apply to fields:
    375   (set (make-local-variable 'forward-sexp-function) #'csv-forward-field)
    376   (csv-set-comment-start csv-comment-start)
    377   ;; Font locking -- separator plus syntactic:
    378   (setq font-lock-defaults '(csv-font-lock-keywords))
    379   (setq-local jit-lock-contextually nil) ;Each line should be independent.
    380   (if csv-invisibility-default (add-to-invisibility-spec 'csv))
    381   ;; Mode line to support `csv-field-index-mode':
    382   (set (make-local-variable 'mode-line-position)
    383        (pcase mode-line-position
    384          (`(,(or (pred consp) (pred stringp)) . ,_)
    385           `(,@mode-line-position ,csv-mode-line-format))
    386          (_ `("" ,mode-line-position ,csv-mode-line-format))))
    387   (set (make-local-variable 'truncate-lines) t)
    388   ;; Enable or disable `csv-field-index-mode' (could probably do this
    389   ;; a bit more efficiently):
    390   (csv-field-index-mode (symbol-value 'csv-field-index-mode)))
    391 
    392 (defun csv-set-comment-start (string)
    393   "Set comment start for this CSV mode buffer to STRING.
    394 It must be either a string or nil."
    395   (interactive
    396    (list (edit-and-eval-command
    397 	  "Comment start (string or nil): " csv-comment-start)))
    398   ;; Paragraph means a group of contiguous records:
    399   (set (make-local-variable 'paragraph-separate) "[[:space:]]*$") ; White space.
    400   (set (make-local-variable 'paragraph-start) "\n");Must include \n explicitly!
    401   ;; Remove old comment-start/end if available
    402   (with-syntax-table text-mode-syntax-table
    403     (when comment-start
    404       (modify-syntax-entry (string-to-char comment-start)
    405 			   (string (char-syntax (string-to-char comment-start)))
    406 			   csv-mode-syntax-table))
    407     (modify-syntax-entry ?\n
    408 			 (string (char-syntax ?\n))
    409 			 csv-mode-syntax-table))
    410   (when string
    411     (setq paragraph-separate (concat paragraph-separate "\\|" string)
    412 	  paragraph-start (concat paragraph-start "\\|" string))
    413     (set (make-local-variable 'comment-start) string)
    414     (modify-syntax-entry
    415      (string-to-char string) "<" csv-mode-syntax-table)
    416     (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
    417   (setq csv-comment-start string))
    418 
    419 (defvar csv--set-separator-history nil)
    420 
    421 (defun csv-set-separator (sep)
    422   "Set the CSV separator in the current buffer to SEP."
    423   (interactive (list (read-char-from-minibuffer
    424                       "Separator: " nil 'csv--set-separator-history)))
    425   (when (and (boundp 'csv-field-quotes)
    426              (member (string sep) csv-field-quotes))
    427     (error "%c is already a quote" sep))
    428   (setq-local csv-separators (list (string sep)))
    429   (setq-local csv-separator-chars (list sep))
    430   (setq-local csv--skip-chars (format "^\n\\%c" sep))
    431   (setq-local csv-separator-regexp (regexp-quote (string sep)))
    432   (setq-local csv-font-lock-keywords
    433               `((,csv-separator-regexp (0 'csv-separator-face))))
    434   (font-lock-refresh-defaults))
    435 
    436 ;;;###autoload
    437 (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
    438 
    439 (defvar csv-descending nil
    440   "If non-nil, CSV mode sort functions sort in order of descending sort key.
    441 Usually they sort in order of ascending sort key.")
    442 
    443 (defun csv-toggle-descending ()
    444   "Toggle `csv-descending'."
    445   (interactive)
    446   (setq csv-descending (not csv-descending))
    447   (message "Sort order is %sscending" (if csv-descending "de" "a")))
    448 
    449 (defun csv-toggle-invisibility ()
    450   ;; FIXME: Make it into a proper minor mode?
    451   "Toggle `buffer-invisibility-spec'."
    452   (interactive)
    453   (if (memq 'csv buffer-invisibility-spec)
    454       (remove-from-invisibility-spec 'csv)
    455     (add-to-invisibility-spec 'csv))
    456   (message "Separators in aligned records will be %svisible \
    457 \(after re-aligning if soft)"
    458 	   (if (memq 'csv buffer-invisibility-spec) "in" ""))
    459   (redraw-frame (selected-frame)))
    460 
    461 (easy-menu-define
    462   csv-menu
    463   csv-mode-map
    464   "CSV major mode menu keymap"
    465   '("CSV"
    466     ["Sort By Field Lexicographically" csv-sort-fields :active t
    467      :help "Sort lines in region lexicographically by the specified field"]
    468     ["Sort By Field Numerically" csv-sort-numeric-fields :active t
    469      :help "Sort lines in region numerically by the specified field"]
    470     ["Reverse Order of Lines" csv-reverse-region :active t
    471      :help "Reverse the order of the lines in the region"]
    472     ["Use Descending Sort Order" csv-toggle-descending :active t
    473      :style toggle :selected csv-descending
    474      :help "If selected, use descending order when sorting"]
    475     "--"
    476     ["Kill Fields (Columns)" csv-kill-fields :active t
    477      :help "Kill specified fields of each line in the region"]
    478     ["Yank Fields (Columns)" csv-yank-fields :active t
    479      :help "Yank killed fields as specified field of each line in region"]
    480     ["Yank As New Table" csv-yank-as-new-table :active t
    481      :help "Yank killed fields as a new table at point"]
    482     ["Align Fields into Columns" csv-align-fields :active t
    483      :help "Align the start of every field of each line in the region"]
    484     ["Unalign Columns into Fields" csv-unalign-fields :active t
    485      :help "Undo soft alignment and optionally remove redundant white space"]
    486     ["Transpose Rows and Columns" csv-transpose :active t
    487      :help "Rewrite rows (which may have different lengths) as columns"]
    488     "--"
    489     ["Forward Field" forward-sexp :active t
    490      :help "Move forward across one field; with ARG, do it that many times"]
    491     ["Backward Field" backward-sexp :active t
    492      :help "Move backward across one field; with ARG, do it that many times"]
    493     ["Kill Field Forward" kill-sexp :active t
    494      :help "Kill field following cursor; with ARG, do it that many times"]
    495     ["Kill Field Backward" backward-kill-sexp :active t
    496      :help "Kill field preceding cursor; with ARG, do it that many times"]
    497     "--"
    498     ("Alignment Style"
    499      ["Left" (setq csv-align-style 'left) :active t
    500       :style radio :selected (eq csv-align-style 'left)
    501       :help "If selected, `csv-align' left aligns fields"]
    502      ["Centre" (setq csv-align-style 'centre) :active t
    503       :style radio :selected (eq csv-align-style 'centre)
    504       :help "If selected, `csv-align' centres fields"]
    505      ["Right" (setq csv-align-style 'right) :active t
    506       :style radio :selected (eq csv-align-style 'right)
    507       :help "If selected, `csv-align' right aligns fields"]
    508      ["Auto" (setq csv-align-style 'auto) :active t
    509       :style radio :selected (eq csv-align-style 'auto)
    510       :help "\
    511 If selected, `csv-align' left aligns text and right aligns numbers"]
    512      )
    513     ["Set header line" csv-header-line :active t]
    514     ["Auto-(re)align fields" csv-align-mode
    515      :style toggle :selected csv-align-mode]
    516     ["Show Current Field Index" csv-field-index-mode :active t
    517      :style toggle :selected csv-field-index-mode
    518      :help "If selected, display current field index in mode line"]
    519     ["Make Separators Invisible" csv-toggle-invisibility :active t
    520      :style toggle :selected (memq 'csv buffer-invisibility-spec)
    521      :visible (not (tsv--mode-p))
    522      :help "If selected, separators in aligned records are invisible"]
    523     ["Set Buffer's Comment Start" csv-set-comment-start :active t
    524      :help "Set comment start string for this buffer"]
    525     ["Customize CSV Mode" (customize-group 'CSV) :active t
    526      :help "Open a customization buffer to change CSV mode options"]
    527     ))
    528 
    529 (require 'sort)
    530 
    531 (defsubst csv-not-looking-at-record ()
    532   "Return t if looking at blank or comment line, nil otherwise.
    533 Assumes point is at beginning of line."
    534   (looking-at paragraph-separate))
    535 
    536 (defun csv-interactive-args (&optional type)
    537   "Get arg or field(s) and region interactively, offering sensible defaults.
    538 Signal an error if the buffer is read-only.
    539 If TYPE is noarg then return a list (beg end).
    540 Otherwise, return a list (arg beg end), where arg is:
    541   the raw prefix argument by default;
    542   a single field index if TYPE is single;
    543   a list of field indices or index ranges if TYPE is multiple.
    544 Field defaults to the current prefix arg; if not set, prompt user.
    545 
    546 A field index list consists of positive or negative integers or ranges,
    547 separated by any non-integer characters.  A range has the form m-n,
    548 where m and n are positive or negative integers, m < n, and n defaults
    549 to the last field index if omitted.
    550 
    551 In transient mark mode, if the mark is not active then automatically
    552 select and highlight CSV records around point, and query user.
    553 The default field when read interactively is the current field."
    554   ;; Must be run interactively to activate mark!
    555   (let* ((arg current-prefix-arg) (default-field 1)
    556 	 (region
    557 	  (if (not (use-region-p))
    558 	      ;; Set region automatically:
    559 	      (save-excursion
    560                 (if arg
    561                     (beginning-of-line)
    562                   (let ((lbp (line-beginning-position)))
    563                     (while (re-search-backward csv-separator-regexp lbp 1)
    564                       ;; Move as far as possible, i.e. to beginning of line.
    565                       (setq default-field (1+ default-field)))))
    566                 (if (csv-not-looking-at-record)
    567                     (error "Point must be within CSV records"))
    568 		(let ((startline (point)))
    569 		  ;; Set mark at beginning of region:
    570 		  (while (not (or (bobp) (csv-not-looking-at-record)))
    571 		    (forward-line -1))
    572 		  (if (csv-not-looking-at-record) (forward-line 1))
    573 		  ;; Skip header lines:
    574 		  (forward-line csv-header-lines)
    575 		  (set-mark (point))	; OK since in save-excursion
    576 		  ;; Move point to end of region:
    577 		  (goto-char startline)
    578 		  (beginning-of-line)
    579 		  (while (not (or (eobp) (csv-not-looking-at-record)))
    580 		    (forward-line 1))
    581 		  ;; Show mark briefly if necessary:
    582 		  (unless (and (pos-visible-in-window-p)
    583 			       (pos-visible-in-window-p (mark)))
    584 		    (exchange-point-and-mark)
    585 		    (sit-for 1)
    586 		    (exchange-point-and-mark))
    587                   (when csv-confirm-region
    588                     (or (y-or-n-p "Region OK? ")
    589                         (error "Action aborted by user"))
    590                     (message nil))      ; clear y-or-n-p message
    591 		  (list (region-beginning) (region-end))))
    592 	    ;; Use region set by user:
    593 	    (list (region-beginning) (region-end)))))
    594     (setq default-field (number-to-string default-field))
    595     (cond
    596      ((eq type 'multiple)
    597       (if arg
    598 	  ;; Ensure that field is a list:
    599 	  (or (consp arg)
    600 	      (setq arg (list (prefix-numeric-value arg))))
    601 	;; Read field interactively, ignoring non-integers:
    602 	(setq arg
    603 	      (mapcar
    604 	       (lambda (x)
    605 		 (if (string-match "-" x 1) ; not first character
    606 		     ;; Return a range as a pair - the cdr may be nil:
    607 		     (let ((m (substring x 0 (match-beginning 0)))
    608 			   (n (substring x (match-end 0))))
    609 		       (cons (car (read-from-string m))
    610 			     (and (not (string= n ""))
    611 				  (car (read-from-string n)))))
    612 		   ;; Return a number as a number:
    613 		   (car (read-from-string x))))
    614 	       (split-string
    615 		(read-string
    616 		 "Fields (sequence of integers or ranges): " default-field)
    617 		"[^-+0-9]+")))))
    618      ((eq type 'single)
    619       (if arg
    620 	  (setq arg (prefix-numeric-value arg))
    621 	(while (not (integerp arg))
    622 	  (setq arg (eval-minibuffer "Field (integer): " default-field))))))
    623     (if (eq type 'noarg) region (cons arg region))))
    624 
    625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    626 ;;;  Sorting by field
    627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    628 
    629 (defun csv-nextrecfun ()
    630   "Called by `csv-sort-fields-1' with point at end of previous record.
    631 It moves point to the start of the next record.
    632 It should move point to the end of the buffer if there are no more records."
    633   (forward-line)
    634   (while (and (not (eobp)) (csv-not-looking-at-record))
    635     (forward-line)))
    636 
    637 (defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun)
    638   "Modified version of `sort-fields-1' that skips blank or comment lines.
    639 
    640 FIELD is a single field index, and BEG and END specify the region to
    641 sort.
    642 
    643 STARTKEYFUN moves from the start of the record to the start of the key.
    644 It may return either a non-nil value to be used as the key, or
    645 else the key is the substring between the values of point after
    646 STARTKEYFUN and ENDKEYFUN are called.  If STARTKEYFUN is nil, the key
    647 starts at the beginning of the record.
    648 
    649 ENDKEYFUN moves from the start of the sort key to the end of the sort key.
    650 ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
    651 same as ENDRECFUN."
    652   (let ((tbl (syntax-table)))
    653     (if (zerop field) (setq field 1))
    654     (unwind-protect
    655 	(save-excursion
    656 	  (save-restriction
    657 	    (narrow-to-region beg end)
    658 	    (goto-char (point-min))
    659 	    (set-syntax-table sort-fields-syntax-table)
    660 	    (sort-subr csv-descending
    661 		       'csv-nextrecfun 'end-of-line
    662 		       startkeyfun endkeyfun)))
    663       (set-syntax-table tbl))))
    664 
    665 (defun csv-sort-fields (field beg end)
    666   "Sort lines in region lexicographically by the ARGth field of each line.
    667 If not set, the region defaults to the CSV records around point.
    668 Fields are separated by `csv-separators' and null fields are allowed anywhere.
    669 Field indices increase from 1 on the left or decrease from -1 on the right.
    670 A prefix argument specifies a single field, otherwise prompt for field index.
    671 Ignore blank and comment lines.  The variable `sort-fold-case'
    672 determines whether alphabetic case affects the sort order.
    673 When called non-interactively, FIELD is a single field index;
    674 BEG and END specify the region to sort."
    675   ;; (interactive "*P\nr")
    676   (interactive (csv-interactive-args 'single))
    677   (barf-if-buffer-read-only)
    678   (csv-sort-fields-1 field beg end
    679 		     (lambda () (csv-sort-skip-fields field) nil)
    680 		     (lambda () (skip-chars-forward csv--skip-chars))))
    681 
    682 (defun csv-sort-numeric-fields (field beg end)
    683   "Sort lines in region numerically by the ARGth field of each line.
    684 If not set, the region defaults to the CSV records around point.
    685 Fields are separated by `csv-separators'.
    686 Null fields are allowed anywhere and sort as zeros.
    687 Field indices increase from 1 on the left or decrease from -1 on the right.
    688 A prefix argument specifies a single field, otherwise prompt for field index.
    689 Specified non-null field must contain a number in each line of the region,
    690 which may begin with \"0x\" or \"0\" for hexadecimal and octal values.
    691 Otherwise, the number is interpreted according to sort-numeric-base.
    692 Ignore blank and comment lines.
    693 When called non-interactively, FIELD is a single field index;
    694 BEG and END specify the region to sort."
    695   ;; (interactive "*P\nr")
    696   (interactive (csv-interactive-args 'single))
    697   (barf-if-buffer-read-only)
    698   (csv-sort-fields-1 field beg end
    699 		 (lambda ()
    700 		   (csv-sort-skip-fields field)
    701 		   (let* ((case-fold-search t)
    702 			  (base
    703 			   (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
    704 			       (cond ((match-beginning 1)
    705 				      (goto-char (match-end 1))
    706 				      16)
    707 				     ((match-beginning 2)
    708 				      (goto-char (match-end 2))
    709 				      8)
    710 				     (t nil)))))
    711 		     (string-to-number (buffer-substring (point)
    712 							 (save-excursion
    713 							   (forward-sexp 1)
    714 							   (point)))
    715 				       (or base sort-numeric-base))))
    716 		 nil))
    717 
    718 (defun csv-reverse-region (beg end)
    719   "Reverse the order of the lines in the region.
    720 This is just a CSV-mode style interface to `reverse-region', which is
    721 the function that should be used non-interactively.  It takes two
    722 point or marker arguments, BEG and END, delimiting the region."
    723   ;; (interactive "*P\nr")
    724   (interactive (csv-interactive-args 'noarg))
    725   (barf-if-buffer-read-only)
    726   (reverse-region beg end))
    727 
    728 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    729 ;;;  Moving by field
    730 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    731 
    732 (defun csv-end-of-field ()
    733   "Skip forward over one field."
    734   (skip-chars-forward " ")
    735   ;; If the first character is a double quote, then we have a quoted
    736   ;; value.
    737   (when (eq (char-syntax (following-char)) ?\")
    738     (forward-char)
    739     (let ((ended nil))
    740       (while (and (not ended) (not (eolp)))
    741 	(cond ((not (eq (char-syntax (following-char)) ?\"))
    742 	       (forward-char 1))
    743 	      ;; According to RFC-4180 (sec 2.7), quotes inside quoted strings
    744 	      ;; are quoted by doubling the quote char: a,"b""c,",d
    745 	      ;; FIXME: Maybe we should handle this via syntax-propertize?
    746               ((let ((c (char-after (1+ (point)))))
    747                  (and c (eq (char-syntax c) ?\")))
    748 	       (forward-char 2))
    749 	      (t
    750 	       (setq ended t))))))
    751   (skip-chars-forward csv--skip-chars))
    752 
    753 (defun csv--bof-p ()
    754   (or (bolp)
    755       (memq (preceding-char) csv-separator-chars)))
    756 
    757 (defun csv--eof-p ()
    758   (or (eolp)
    759       (memq (following-char) csv-separator-chars)))
    760 
    761 (defun csv-beginning-of-field ()
    762   "Skip backward over one field."
    763   (skip-syntax-backward " ")
    764   (if (eq (char-syntax (preceding-char)) ?\")
    765       (goto-char (scan-sexps (point) -1)))
    766   (skip-chars-backward csv--skip-chars))
    767 
    768 (defun csv-forward-field (arg)
    769   "Move forward across one field, cf. `forward-sexp'.
    770 With ARG, do it that many times.  Negative arg -N means
    771 move backward across N fields."
    772   (interactive "p")
    773   (if (< arg 0)
    774       (csv-backward-field (- arg))
    775     (while (>= (setq arg (1- arg)) 0)
    776       (if (or (bolp)
    777 	      (when (and (not (eobp)) (eolp)) (forward-char) t))
    778 	  (while (and (not (eobp)) (csv-not-looking-at-record))
    779 	    (forward-line 1)))
    780       (if (memq (following-char) csv-separator-chars) (forward-char))
    781       (csv-end-of-field))))
    782 
    783 (defun csv-backward-field (arg)
    784   "Move backward across one field, cf. `backward-sexp'.
    785 With ARG, do it that many times.  Negative arg -N means
    786 move forward across N fields."
    787   (interactive "p")
    788   (if (< arg 0)
    789       (csv-forward-field (- arg))
    790     (while (>= (setq arg (1- arg)) 0)
    791       (when (or (eolp)
    792 		(when (and (not (bobp)) (bolp)) (backward-char) t))
    793 	(while (progn
    794 		 (beginning-of-line)
    795 		 (csv-not-looking-at-record))
    796 	  (backward-char))
    797 	(end-of-line))
    798       (if (memq (preceding-char) csv-separator-chars) (backward-char))
    799       (csv-beginning-of-field))))
    800 
    801 (defun csv-tab-command ()
    802   "Skip to the next field on the same line.
    803 Create a new field at end of line, if needed."
    804   (interactive)
    805   (skip-chars-forward csv--skip-chars)
    806   (if (eolp)
    807       (insert (car csv-separators))
    808     (forward-char 1)))
    809 
    810 (defun csv-backtab-command ()
    811   "Skip to the beginning of the previous field."
    812   (interactive)
    813   (skip-chars-backward csv--skip-chars)
    814   (forward-char -1)
    815   (skip-chars-backward csv--skip-chars))
    816 
    817 (defun csv-sort-skip-fields (n &optional yank)
    818   "Position point at the beginning of field N on the current line.
    819 Fields are separated by `csv-separators'; null terminal field allowed.
    820 Assumes point is initially at the beginning of the line.
    821 YANK non-nil allows N to be greater than the number of fields, in
    822 which case extend the record as necessary."
    823   (if (> n 0)
    824       ;; Skip across N - 1 fields.
    825       (let ((i (1- n)))
    826 	(while (> i 0)
    827 	  (csv-end-of-field)
    828 	  (if (eolp)
    829 	      (if yank
    830 		  (if (> i 1) (insert (car csv-separators)))
    831 		(error "Line has too few fields: %s"
    832 		       (buffer-substring
    833 			(save-excursion (beginning-of-line) (point))
    834 			(save-excursion (end-of-line) (point)))))
    835 	    (forward-char))		; skip separator
    836 	  (setq i (1- i))))
    837     (end-of-line)
    838     ;; Skip back across -N - 1 fields.
    839     (let ((i (1- (- n))))
    840       (while (> i 0)
    841 	(csv-beginning-of-field)
    842 	(if (bolp)
    843 	    (error "Line has too few fields: %s"
    844 		   (buffer-substring
    845 		    (save-excursion (beginning-of-line) (point))
    846 		    (save-excursion (end-of-line) (point)))))
    847 	(backward-char)			; skip separator
    848 	(setq i (1- i)))
    849       ;; Position at the front of the field
    850       ;; even if moving backwards.
    851       (csv-beginning-of-field))))
    852 
    853 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    854 ;;;  Field index mode
    855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    856 
    857 ;; Based partly on paren.el
    858 
    859 (defcustom csv-field-index-delay 0.125
    860   "Time in seconds to delay before updating field index display."
    861   :type '(number :tag "seconds"))
    862 
    863 (defvar csv-field-index-idle-timer nil)
    864 
    865 (defvar csv-field-index-string nil)
    866 (make-variable-buffer-local 'csv-field-index-string)
    867 
    868 (defvar csv-field-index-old nil)
    869 (make-variable-buffer-local 'csv-field-index-old)
    870 
    871 (define-minor-mode csv-field-index-mode
    872   "Toggle CSV-Field-Index mode.
    873 With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive.
    874 Returns the new status of CSV-Field-Index mode (non-nil means on).
    875 When CSV-Field-Index mode is enabled, the current field index appears in
    876 the mode line after `csv-field-index-delay' seconds of Emacs idle time."
    877   :global t
    878   :init-value t		       ; for documentation, since default is t
    879   ;; This macro generates a function that first sets the mode
    880   ;; variable, then runs the following code, runs the mode hooks,
    881   ;; displays a message if interactive, updates the mode line and
    882   ;; finally returns the variable value.
    883 
    884   ;; First, always disable the mechanism (to avoid having two timers):
    885   (when csv-field-index-idle-timer
    886     (cancel-timer csv-field-index-idle-timer)
    887     (setq csv-field-index-idle-timer nil))
    888   ;; Now, if the mode is on and any buffer is in CSV mode then
    889   ;; re-initialize and enable the mechanism by setting up a new timer:
    890   (if csv-field-index-mode
    891       (if (memq t (mapcar (lambda (buffer)
    892 			    (with-current-buffer buffer
    893 			      (when (derived-mode-p 'csv-mode)
    894 				(setq csv-field-index-string nil
    895 				      csv-field-index-old nil)
    896 				t)))
    897 			  (buffer-list)))
    898 	  (setq csv-field-index-idle-timer
    899 		(run-with-idle-timer csv-field-index-delay t
    900 				     #'csv-field-index)))
    901     ;; but if the mode is off then remove the display from the mode
    902     ;; lines of all CSV buffers:
    903     (mapc (lambda (buffer)
    904 	    (with-current-buffer buffer
    905 	      (when (derived-mode-p 'csv-mode)
    906 		(setq csv-field-index-string nil
    907 		      csv-field-index-old nil)
    908 		(force-mode-line-update))))
    909 	    (buffer-list))))
    910 
    911 (defun csv--field-index ()
    912   (save-excursion
    913     (let ((start (point))
    914 	  (field 0))
    915       (beginning-of-line)
    916       (while (and (<= (point) start)
    917                   (not (eolp)))
    918 	(csv-end-of-field)
    919 	(unless (eolp)
    920 	  (forward-char 1))
    921 	(setq field (1+ field)))
    922       field)))
    923 
    924 (defun csv-field-index ()
    925   "Construct `csv-field-index-string' to display in mode line.
    926 Called by `csv-field-index-idle-timer'."
    927   (if (derived-mode-p 'csv-mode)
    928       (let ((field (csv--field-index)))
    929 	(when (not (eq field csv-field-index-old))
    930 	  (setq csv-field-index-old field
    931 		csv-field-index-string
    932 		(and field (format "F%d" field)))
    933 	  (force-mode-line-update)))))
    934 
    935 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    936 ;;;  Killing and yanking fields
    937 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    938 
    939 (defvar csv-killed-fields nil
    940   "A list of the fields or sub-records last killed by `csv-kill-fields'.")
    941 
    942 (defun csv-kill-fields (fields beg end)
    943   "Kill specified fields of each line in the region.
    944 If not set, the region defaults to the CSV records around point.
    945 Fields are separated by `csv-separators' and null fields are allowed anywhere.
    946 Field indices increase from 1 on the left or decrease from -1 on the right.
    947 The fields are stored for use by `csv-yank-fields'.  Fields can be
    948 specified in any order but are saved in increasing index order.
    949 Ignore blank and comment lines.
    950 
    951 When called interactively, a prefix argument specifies a single field,
    952 otherwise prompt for a field list, which may include ranges in the form
    953 m-n, where m < n and n defaults to the last field index if omitted.
    954 
    955 When called non-interactively, FIELDS is a single field index or a
    956 list of field indices, with ranges specified as (m.n) or (m), and BEG
    957 and END specify the region to process."
    958   ;; (interactive "*P\nr")
    959   (interactive (csv-interactive-args 'multiple))
    960   (barf-if-buffer-read-only)
    961   ;; Kill the field(s):
    962   (setq csv-killed-fields nil)
    963   (save-excursion
    964     (save-restriction
    965       (narrow-to-region beg end)
    966       (goto-char (point-min))
    967       (if (or (cdr fields) (consp (car fields)))
    968 	  (csv-kill-many-columns fields)
    969 	(csv-kill-one-column (car fields)))))
    970   (setq csv-killed-fields (nreverse csv-killed-fields)))
    971 
    972 (defun csv-kill-one-field (field)
    973   "Kill field with index FIELD in current line.
    974 Return killed text.  Assumes point is at beginning of line."
    975   ;; Move to start of field to kill:
    976   (csv-sort-skip-fields field)
    977   ;; Kill to end of field (cf. `kill-region'):
    978   (prog1 (delete-and-extract-region
    979           (point)
    980           (progn (csv-end-of-field) (point)))
    981     (if (eolp)
    982         (unless (bolp) (delete-char -1)) ; Delete trailing separator at eol
    983       (delete-char 1))))                 ; or following separator otherwise.
    984 
    985 (defun csv-kill-one-column (field)
    986   "Kill field with index FIELD in all lines in (narrowed) buffer.
    987 Save killed fields in `csv-killed-fields'.
    988 Assumes point is at `point-min'.  Called by `csv-kill-fields'.
    989 Ignore blank and comment lines."
    990   (while (not (eobp))
    991     (or (csv-not-looking-at-record)
    992 	(push (csv-kill-one-field field) csv-killed-fields))
    993     (forward-line)))
    994 
    995 (defun csv-insert-column (field)
    996   "Insert an empty column at point."
    997   (interactive
    998    (let ((cur (csv--field-index)))
    999      (list (if (and (csv--eof-p) (not (csv--bof-p))) (1+ cur) cur))))
   1000   (save-excursion
   1001     (goto-char (point-min))
   1002     (while (not (eobp))
   1003       (or (csv-not-looking-at-record)
   1004 	  (progn
   1005 	    (csv-sort-skip-fields field t)
   1006 	    (insert (car csv-separators))))
   1007       (forward-line 1))
   1008     (csv--jit-flush-columns)))
   1009 
   1010 (defun csv-kill-many-columns (fields)
   1011   "Kill several fields in all lines in (narrowed) buffer.
   1012 FIELDS is an unordered list of field indices.
   1013 Save killed fields in increasing index order in `csv-killed-fields'.
   1014 Assumes point is at `point-min'.  Called by `csv-kill-fields'.
   1015 Ignore blank and comment lines."
   1016   (if (eolp) (error "First record is empty"))
   1017   ;; Convert non-positive to positive field numbers:
   1018   (let ((last 1) (f fields))
   1019     (csv-end-of-field)
   1020     (while (not (eolp))
   1021       (forward-char)			; skip separator
   1022       (csv-end-of-field)
   1023       (setq last (1+ last)))	     ; last = # fields in first record
   1024     (while f
   1025       (cond ((consp (car f))
   1026 	     ;; Expand a field range: (m.n) -> m m+1 ... n-1 n.
   1027 	     ;; If n is nil then it defaults to the number of fields.
   1028 	     (let* ((range (car f)) (cdrf (cdr f))
   1029 		    (m (car range)) (n (cdr range)))
   1030 	       (if (< m 0) (setq m (+ m last 1)))
   1031 	       (if n
   1032 		   (if (< n 0) (setq n (+ n last 1)))
   1033 		 (setq n last))
   1034 	       (setq range (list n))
   1035 	       (while (> n m) (push (setq n (1- n)) range))
   1036 	       (setcar f (car range))
   1037 	       (setcdr f (cdr range))
   1038 	       (setcdr (setq f (last range)) cdrf)))
   1039 	    ((zerop (car f)) (setcar f 1))
   1040 	    ((< (car f) 0) (setcar f (+ f last 1))))
   1041       (setq f (cdr f))))
   1042   (goto-char (point-min))
   1043   ;; Kill from right to avoid miscounting:
   1044   (setq fields (sort fields #'>))
   1045   (while (not (eobp))
   1046     (or (csv-not-looking-at-record)
   1047 	(let ((fields fields) killed-fields field)
   1048 	  (while fields
   1049 	    (setq field (car fields)
   1050 		  fields (cdr fields))
   1051 	    (beginning-of-line)
   1052 	    (push (csv-kill-one-field field) killed-fields))
   1053 	  (push (mapconcat #'identity killed-fields (car csv-separators))
   1054 		csv-killed-fields)))
   1055     (forward-line)))
   1056 
   1057 (defun csv-yank-fields (field beg end)
   1058   "Yank fields as the ARGth field of each line in the region.
   1059 ARG may be arbitrarily large and records are extended as necessary.
   1060 If not set, the region defaults to the CSV records around point;
   1061 if point is not in a CSV record then offer to yank as a new table.
   1062 The fields yanked are those last killed by `csv-kill-fields'.
   1063 Fields are separated by `csv-separators' and null fields are allowed anywhere.
   1064 Field indices increase from 1 on the left or decrease from -1 on the right.
   1065 A prefix argument specifies a single field, otherwise prompt for field index.
   1066 Ignore blank and comment lines.  When called non-interactively, FIELD
   1067 is a single field index; BEG and END specify the region to process."
   1068   ;; (interactive "*P\nr")
   1069   (interactive (condition-case err
   1070 		   (csv-interactive-args 'single)
   1071 		 (error (list nil nil err))))
   1072   (barf-if-buffer-read-only)
   1073   (if (null beg)
   1074       (if (y-or-n-p (concat (error-message-string end)
   1075 			    ".  Yank as a new table? "))
   1076 	  (csv-yank-as-new-table)
   1077 	(error (error-message-string end)))
   1078     (if (<= field 0) (setq field (1+ field)))
   1079     (save-excursion
   1080       (save-restriction
   1081 	(narrow-to-region beg end)
   1082 	(goto-char (point-min))
   1083 	(let ((fields csv-killed-fields))
   1084 	  (while (not (eobp))
   1085 	    (unless (csv-not-looking-at-record)
   1086 	      ;; Yank at start of specified field if possible,
   1087 	      ;; otherwise yank at end of record:
   1088 	      (if (zerop field)
   1089 		  (end-of-line)
   1090 		(csv-sort-skip-fields field 'yank))
   1091 	      (and (eolp) (insert (car csv-separators)))
   1092 	      (when fields
   1093 		(insert (car fields))
   1094 		(setq fields (cdr fields)))
   1095 	      (or (eolp) (insert (car csv-separators))))
   1096 	    (forward-line)))))))
   1097 
   1098 (defun csv-yank-as-new-table ()
   1099   "Yank fields as a new table starting at point.
   1100 The fields yanked are those last killed by `csv-kill-fields'."
   1101   (interactive "*")
   1102   (let ((fields csv-killed-fields))
   1103     (while fields
   1104       (insert (car fields) ?\n)
   1105       (setq fields (cdr fields)))))
   1106 
   1107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1108 ;;;  Aligning fields
   1109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1110 
   1111 (defun csv--make-overlay (beg end &optional buffer front-advance rear-advance props)
   1112   (let ((o (make-overlay beg end buffer front-advance rear-advance)))
   1113     (overlay-put o 'csv t)
   1114     (while props
   1115       (overlay-put o (pop props) (pop props)))
   1116     o))
   1117 
   1118 (defun csv--delete-overlay (o)
   1119   (and (overlay-get o 'csv) (delete-overlay o)))
   1120 
   1121 (defun csv--column-widths (beg end)
   1122   "Return a list of two lists (COLUMN-WIDTHS FIELD-WIDTHS).
   1123 COLUMN-WIDTHS is a list of elements (WIDTH START END)
   1124 indicating the widths of the columns after point (and the position of the
   1125 widest field that determined the overall width).
   1126 FIELD-WIDTHS contains the widths of each individual field after
   1127 point."
   1128   (let ((column-widths '())
   1129         (field-widths '()))
   1130     (goto-char beg)
   1131     ;; Construct list of column widths:
   1132     (while (< (point) end)              ; for each record...
   1133       (or (csv-not-looking-at-record)
   1134           (let ((w column-widths)
   1135                 (col (current-column))
   1136                 (beg (point))
   1137                 field-width)
   1138             (while (not (eolp))
   1139               (csv-end-of-field)
   1140               (setq field-width (- (current-column) col))
   1141               (push field-width field-widths)
   1142               (if w
   1143                   (if (> field-width (caar w))
   1144                       (setcar w (list field-width beg (point))))
   1145                 (setq w (list (list field-width beg (point)))
   1146                       column-widths (nconc column-widths w)))
   1147               (or (eolp) (forward-char)) ; Skip separator.
   1148               (setq w (cdr w) col (current-column) beg (point)))))
   1149       (forward-line))
   1150     (list column-widths (nreverse field-widths))))
   1151 
   1152 (defun csv-align-fields (hard beg end)
   1153   "Align all the fields in the region to form columns.
   1154 The alignment style is specified by `csv-align-style'.  The number of
   1155 spaces specified by `csv-align-padding' appears after each separator.
   1156 Use soft alignment done by displaying virtual white space after the
   1157 separators unless invoked with an argument, in which case insert real
   1158 space characters into the buffer after the separators.
   1159 Unalign first (see `csv-unalign-fields').  Ignore blank and comment lines.
   1160 
   1161 In hard-aligned records, separators become invisible whenever
   1162 `buffer-invisibility-spec' is non-nil.  In soft-aligned records, make
   1163 separators invisible if and only if `buffer-invisibility-spec' is
   1164 non-nil when the records are aligned; this can be changed only by
   1165 re-aligning.  \(Unaligning always makes separators visible.)
   1166 
   1167 When called non-interactively, use hard alignment if HARD is non-nil;
   1168 BEG and END specify the region to align.
   1169 If there is no selected region, default to the whole buffer."
   1170   (interactive (cons current-prefix-arg
   1171                      (if (use-region-p)
   1172                          (list (region-beginning) (region-end))
   1173                        (list (point-min) (point-max)))))
   1174   ;; FIXME: Use csv--jit-align when applicable!
   1175   (setq end (copy-marker end))
   1176   (csv-unalign-fields hard beg end) ; If hard then barfs if buffer read only.
   1177   (save-excursion
   1178     (pcase-let ((`(,column-widths ,field-widths) (csv--column-widths beg end)))
   1179       (save-restriction
   1180         (narrow-to-region beg end)
   1181         (set-marker end nil)
   1182 
   1183 	;; Align fields:
   1184 	(goto-char (point-min))
   1185 	(while (not (eobp))		; for each record...
   1186 	  (unless (csv-not-looking-at-record)
   1187             (let ((w column-widths)
   1188                   (column 0))    ;Desired position of left-side of this column.
   1189               (while (and w (not (eolp)))
   1190                 (let* ((beg (point))
   1191                        (align-padding (if (bolp) 0 csv-align-padding))
   1192                        (left-padding 0) (right-padding 0)
   1193                        (field-width (pop field-widths))
   1194                        (column-width (car (pop w)))
   1195                        (x (- column-width field-width))) ; Required padding.
   1196                   (csv-end-of-field)
   1197                   (set-marker end (point)) ; End of current field.
   1198                   ;; beg = beginning of current field
   1199                   ;; end = (point) = end of current field
   1200 
   1201                   ;; Compute required padding:
   1202                   (cond
   1203                    ((eq csv-align-style 'left)
   1204                     ;; Left align -- pad on the right:
   1205                     (setq left-padding align-padding
   1206                           right-padding x))
   1207                    ((eq csv-align-style 'right)
   1208                     ;; Right align -- pad on the left:
   1209                     (setq left-padding (+ align-padding x)))
   1210                    ((eq csv-align-style 'auto)
   1211                     ;; Auto align -- left align text, right align numbers:
   1212                     (if (string-match "\\`[-+.[:digit:]]+\\'"
   1213                                       (buffer-substring beg (point)))
   1214                         ;; Right align -- pad on the left:
   1215                         (setq left-padding (+ align-padding x))
   1216                       ;; Left align -- pad on the right:
   1217                       (setq left-padding align-padding
   1218                             right-padding x)))
   1219                    ((eq csv-align-style 'centre)
   1220                     ;; Centre -- pad on both left and right:
   1221                     (let ((y (/ x 2)))  ; truncated integer quotient
   1222                       (setq left-padding (+ align-padding y)
   1223                             right-padding (- x y)))))
   1224 
   1225                   (cond
   1226                    (hard ;; Hard alignment...
   1227                     (when (> left-padding 0) ; Pad on the left.
   1228                       ;; Insert spaces before field:
   1229                       (if (= beg end)   ; null field
   1230                           (insert (make-string left-padding ?\ ))
   1231                         (goto-char beg) ; beginning of current field
   1232                         (insert (make-string left-padding ?\ ))
   1233                         (goto-char end))) ; end of current field
   1234                     (unless (eolp)
   1235                       (if (> right-padding 0) ; pad on the right
   1236                           ;; Insert spaces after field:
   1237                           (insert (make-string right-padding ?\ )))
   1238                       ;; Make separator (potentially) invisible;
   1239                       ;; in Emacs 21.3, neighbouring overlays
   1240                       ;; conflict, so use the following only
   1241                       ;; with hard alignment:
   1242 		      (csv--make-overlay (point) (1+ (point)) nil t nil
   1243 					 '(invisible csv evaporate t))
   1244                       (forward-char)))  ; skip separator
   1245 
   1246                    ;; Soft alignment...
   1247                    ((or (memq 'csv buffer-invisibility-spec)
   1248                         ;; For TSV, hidden or not doesn't make much difference,
   1249                         ;; but the behavior is slightly better when we "hide"
   1250                         ;; the TABs with a `display' property than if we add
   1251                         ;; before/after-strings.
   1252                         (tsv--mode-p))
   1253 
   1254                     ;; Hide separators...
   1255                     ;; Merge right-padding from previous field
   1256                     ;; with left-padding from this field:
   1257                     (if (zerop column)
   1258                         (when (> left-padding 0)
   1259                           ;; Display spaces before first field
   1260                           ;; by overlaying first character:
   1261 			  (csv--make-overlay
   1262 			   beg (1+ beg) nil nil nil
   1263 			   `(before-string ,(make-string left-padding ?\ ))))
   1264                       ;; Display separator as spaces:
   1265                       (with-silent-modifications
   1266                         (put-text-property
   1267                          (1- beg) beg
   1268                          'display `(space :align-to
   1269                                           ,(+ left-padding column)))))
   1270                     (unless (eolp) (forward-char)) ; Skip separator.
   1271                     (setq column (+ column column-width align-padding)))
   1272 
   1273                    (t ;; Do not hide separators...
   1274                     (let ((overlay (csv--make-overlay beg (point) nil nil t)))
   1275                       (when (> left-padding 0) ; Pad on the left.
   1276                         ;; Display spaces before field:
   1277                         (overlay-put overlay 'before-string
   1278                                      (make-string left-padding ?\ )))
   1279                       (unless (eolp)
   1280                         (if (> right-padding 0) ; Pad on the right.
   1281                             ;; Display spaces after field:
   1282                             (overlay-put
   1283                              overlay
   1284                              'after-string (make-string right-padding ?\ )))
   1285                         (forward-char)))) ; Skip separator.
   1286 
   1287                    )))))
   1288 	  (forward-line)))))
   1289   (set-marker end nil))
   1290 
   1291 (defun csv-unalign-fields (hard beg end)
   1292   "Undo soft alignment and optionally remove redundant white space.
   1293 Undo soft alignment introduced by `csv-align-fields'.  If invoked with
   1294 an argument then also remove all spaces and tabs around separators.
   1295 Also make all invisible separators visible again.
   1296 Ignore blank and comment lines.  When called non-interactively, remove
   1297 spaces and tabs if HARD non-nil; BEG and END specify region to unalign.
   1298 If there is no selected region, default to the whole buffer."
   1299   (interactive (cons current-prefix-arg
   1300                      (if (use-region-p)
   1301                          (list (region-beginning) (region-end))
   1302                        (list (point-min) (point-max)))))
   1303   ;; Remove any soft alignment:
   1304   (mapc #'csv--delete-overlay (overlays-in beg end))
   1305   (with-silent-modifications
   1306     (remove-list-of-text-properties beg end '(display invisible)))
   1307   (when hard
   1308     (barf-if-buffer-read-only)
   1309     ;; Remove any white-space padding around separators:
   1310     (save-excursion
   1311       (save-restriction
   1312 	(narrow-to-region beg end)
   1313 	(goto-char (point-min))
   1314 	(while (not (eobp))
   1315 	  (or (csv-not-looking-at-record)
   1316 	      (while (not (eolp))
   1317 		;; Delete horizontal white space forward:
   1318 		;; (delete-horizontal-space)
   1319 		;; This relies on left-to-right argument evaluation;
   1320 		;; see info node (elisp) Function Forms.
   1321 		(delete-region (point)
   1322 			       (+ (point) (skip-chars-forward " \t")))
   1323 		(csv-end-of-field)
   1324 		;; Delete horizontal white space backward:
   1325 		;; (delete-horizontal-space t)
   1326 		(delete-region (point)
   1327 			       (+ (point) (skip-chars-backward " \t")))
   1328 		(or (eolp) (forward-char))))
   1329 	  (forward-line))))))
   1330 
   1331 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1332 ;;;  Transposing rows and columns
   1333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1334 
   1335 (defun csv-transpose (beg end)
   1336   "Rewrite rows (which may have different lengths) as columns.
   1337 Null fields are introduced as necessary within records but are
   1338 stripped from the ends of records.  Preserve soft alignment.
   1339 This function is its own inverse.  Ignore blank and comment lines.
   1340 When called non-interactively, BEG and END specify region to process."
   1341   ;; (interactive "*P\nr")
   1342   (interactive (csv-interactive-args 'noarg))
   1343   (barf-if-buffer-read-only)
   1344   (save-excursion
   1345     (save-restriction
   1346       (narrow-to-region beg end)
   1347       (goto-char (point-min))
   1348       ;; Delete rows and collect them as a reversed list of lists of
   1349       ;; fields, skipping comment and blank lines:
   1350       (let ((sep (car csv-separators))
   1351 	    (align (overlays-in beg end))
   1352 	    rows columns)
   1353 	;; Remove soft alignment if necessary:
   1354 	(when align
   1355 	  (mapc #'csv--delete-overlay align)
   1356 	  (setq align t))
   1357 	(while (not (eobp))
   1358 	  (if (csv-not-looking-at-record)
   1359 	      ;; Skip blank and comment lines:
   1360 	      (forward-line)
   1361 	    (let ((lep (line-end-position)))
   1362 	      (push
   1363 	       (csv--collect-fields lep)
   1364 	       rows)
   1365 	      (delete-region (point) lep)
   1366 	      (or (eobp) (delete-char 1)))))
   1367 	;; Rows must have monotonic decreasing lengths to be
   1368 	;; transposable, so ensure this by padding with null fields.
   1369 	;; rows is currently a reversed list of field lists, which
   1370 	;; must therefore have monotonic increasing lengths.
   1371 	(let ((oldlen (length (car rows))) newlen
   1372 	      (r (cdr rows)))
   1373 	  (while r
   1374 	    (setq newlen (length (car r)))
   1375 	    (if (< newlen oldlen)
   1376 		(nconc (car r) (make-list (- oldlen newlen) nil))
   1377 	      (setq oldlen newlen))
   1378 	    (setq r (cdr r))))
   1379 	;; Collect columns as a reversed list of lists of fields:
   1380 	(while rows
   1381 	  (let (column (r rows) row)
   1382 	    (while r
   1383 	      (setq row (car r))
   1384 	      ;; Provided it would not be a trailing null field, push
   1385 	      ;; field onto column:
   1386 	      (if (or column (string< "" (car row)))
   1387 		  (push (car row) column))
   1388 	      ;; Pop field off row:
   1389 	      (setcar r (cdr row))
   1390 	      ;; If row is now empty then remove it:
   1391 	      (or (car r) (setq rows (cdr rows)))
   1392 	      (setq r (cdr r)))
   1393 	    (push column columns)))
   1394 	;; Insert columns into buffer as rows:
   1395 	(setq columns (nreverse columns))
   1396 	(while columns
   1397 	  (insert (mapconcat #'identity (car columns) sep) ?\n)
   1398 	  (setq columns (cdr columns)))
   1399 	;; Re-do soft alignment if necessary:
   1400 	(if align (csv-align-fields nil (point-min) (point-max)))))))
   1401 
   1402 (defun csv--collect-fields (row-end-position)
   1403   "Collect the fields of a row.
   1404 Splits a row into fields, honoring quoted fields, and returns
   1405 the list of fields.  ROW-END-POSITION is the end-of-line position.
   1406 point is assumed to be at the beginning of the line."
   1407   (let ((csv-field-quotes-regexp (apply #'concat `("[" ,@csv-field-quotes "]")))
   1408 	(row-text (buffer-substring-no-properties (point) row-end-position))
   1409 	fields field-start)
   1410     (if (not (string-match csv-field-quotes-regexp row-text))
   1411 	(split-string row-text csv-separator-regexp)
   1412       (save-excursion
   1413 	(while (< (setq field-start (point)) row-end-position)
   1414           ;; csv-forward-field will skip a separator if point is on
   1415           ;; it, and we'll miss an empty field
   1416           (unless (memq (following-char) csv-separator-chars)
   1417 	    (csv-forward-field 1))
   1418 	  (push
   1419 	   (buffer-substring-no-properties field-start (point))
   1420 	   fields)
   1421 	  (if (memq (following-char) csv-separator-chars)
   1422 	      (forward-char)))
   1423 	(nreverse fields)))))
   1424 
   1425 (defun csv--unquote-value (value)
   1426   "Remove quotes around VALUE.
   1427 If VALUE contains escaped quote characters, un-escape them.  If
   1428 VALUE is not quoted, return it unchanged."
   1429   (save-match-data
   1430     (let ((quote-regexp (apply #'concat `("[" ,@csv-field-quotes "]"))))
   1431       (if-let (((string-match (concat "^\\(" quote-regexp "\\)\\(.*\\)\\(" quote-regexp "\\)$") value))
   1432                (quote-char (match-string 1 value))
   1433                ((equal quote-char (match-string 3 value)))
   1434                (unquoted (match-string 2 value)))
   1435           (replace-regexp-in-string (concat quote-char quote-char) quote-char unquoted)
   1436         value))))
   1437 
   1438 (defun csv-parse-current-row ()
   1439   "Parse the current CSV line.
   1440 Return the field values as a list."
   1441   (save-mark-and-excursion
   1442     (goto-char (line-beginning-position))
   1443     (mapcar #'csv--unquote-value (csv--collect-fields (line-end-position)))))
   1444 
   1445 (defvar-local csv--header-line nil)
   1446 (defvar-local csv--header-hscroll nil)
   1447 (defvar-local csv--header-string nil)
   1448 
   1449 (defun csv-header-line (&optional use-current-line)
   1450   "Set/unset the header line.
   1451 If the optional prefix arg USE-CURRENT-LINE is nil, use the first line
   1452 as the header line.
   1453 If there is already a header line, then unset the header line."
   1454   (interactive "P")
   1455   (if csv--header-line
   1456       (progn
   1457         (delete-overlay csv--header-line)
   1458         (setq csv--header-line nil)
   1459         (kill-local-variable 'header-line-format))
   1460     (save-excursion
   1461       (unless use-current-line (goto-char (point-min)))
   1462       (setq csv--header-line (make-overlay (line-beginning-position)
   1463                                            (line-end-position)
   1464                                            nil nil t))
   1465       (overlay-put csv--header-line 'modification-hooks
   1466                    '(csv--header-flush)))
   1467     (csv--header-flush)
   1468     ;; These are introduced in Emacs 29.
   1469     (unless (boundp 'header-line-indent)
   1470       (setq-local header-line-indent ""
   1471                   header-line-indent-width 0))
   1472     (setq header-line-format
   1473           '("" header-line-indent (:eval (csv--header-string))))))
   1474 
   1475 (defun csv--header-flush (&rest _)
   1476   ;; Force re-computation of the header-line.
   1477   (setq csv--header-hscroll nil))
   1478 
   1479 (defun csv--header-string ()
   1480   ;; FIXME: Won't work with multiple windows showing that same buffer.
   1481   (if (eql (window-hscroll) csv--header-hscroll)
   1482       csv--header-string
   1483     (setq csv--header-hscroll (window-hscroll))
   1484     (setq csv--header-string
   1485           (csv--compute-header-string))))
   1486 
   1487 (defun csv--compute-header-string ()
   1488   (with-demoted-errors "csv--compute-header-string %S"
   1489     (save-excursion
   1490       (goto-char (overlay-start csv--header-line))
   1491       ;; Re-set the line-end-position, just in case.
   1492       (move-overlay csv--header-line (point) (line-end-position))
   1493       (jit-lock-fontify-now (point) (line-end-position))
   1494       ;; Not sure why it is sometimes nil!
   1495       (move-to-column (or csv--header-hscroll 0))
   1496       (let ((str (replace-regexp-in-string
   1497 		  "%" "%%" (buffer-substring (point) (line-end-position))))
   1498             (i 0))
   1499         (while (and i (< i (length str)))
   1500           (let ((prop (get-text-property i 'display str)))
   1501             (and (eq (car-safe prop) 'space)
   1502                  (eq (car-safe (cdr prop)) :align-to)
   1503                  (let* ((x (nth 2 prop))
   1504                         (nexti (next-single-property-change i 'display str))
   1505                         (newprop
   1506                          `(space :align-to
   1507                                  (+ ,(if (numberp x)
   1508                                          (- x (or csv--header-hscroll 0))
   1509                                        `(- ,x csv--header-hscroll))
   1510                                     header-line-indent-width))))
   1511                    (put-text-property i (or nexti (length str))
   1512                                       'display newprop str)
   1513                    (setq i nexti))))
   1514           (setq i (next-single-property-change i 'display str)))
   1515         (concat (propertize " " 'display '((space :align-to 0))) str)))))
   1516 
   1517 ;;; Auto-alignment
   1518 
   1519 (defcustom csv-align-max-width 40
   1520   "Maximum width of a column in `csv-align-mode'.
   1521 This does not apply to the last column (for which the usual `truncate-lines'
   1522 setting works better)."
   1523   :type 'integer)
   1524 
   1525 (defcustom csv-align-min-width 1
   1526   "Minimum width of a column in `csv-align-mode'."
   1527   :type 'integer)
   1528 
   1529 (defvar-local csv--config-column-widths nil
   1530   "Settings per column, stored as a list indexed by the column.")
   1531 
   1532 (defun csv-align--set-column (column value)
   1533   (let ((len (length csv--config-column-widths)))
   1534     (if (< len column)
   1535         (setq csv--config-column-widths
   1536               (nconc csv--config-column-widths (make-list (- column len) nil))))
   1537     (setf (nth (1- column) csv--config-column-widths) value)))
   1538 
   1539 (defun csv-align-set-column-width (column width)
   1540   "Set the max WIDTH to use for COLUMN."
   1541   (interactive
   1542    (let* ((field (or (csv--field-index) 1))
   1543           (curwidth (nth (1- field) csv--config-column-widths)))
   1544      (list field
   1545            (cond
   1546             ((numberp current-prefix-arg)
   1547              current-prefix-arg)
   1548             (current-prefix-arg
   1549              (read-number (format "Column width (for field %d): " field)
   1550                           curwidth))
   1551             (t (if curwidth nil (csv--ellipsis-width)))))))
   1552   (when (eql width csv-align-max-width)
   1553     (setq width nil))
   1554   (csv-align--set-column column width)
   1555   (jit-lock-refontify))
   1556 
   1557 (defvar-local csv--jit-columns nil)
   1558 
   1559 (defun csv--jit-flush-columns ()
   1560   "Throw away all cached info about column widths."
   1561   ;; FIXME: Maybe we should kill its overlays as well.
   1562   (setq csv--jit-columns nil))
   1563 
   1564 (defun csv--jit-merge-columns (column-widths)
   1565   ;; FIXME: The incremental update (delayed by jit-lock-context-time) of column
   1566   ;; width is a bit jarring at times.  It's OK while scrolling or when
   1567   ;; extending a column, but not right when enabling the csv-align-mode or
   1568   ;; when shortening the longest field (or deleting the line containing it),
   1569   ;; because in that case we have *several* cascaded updates, e.g.:
   1570   ;; - Remove the line with the longest field of column N.
   1571   ;; - Edit some line: this line is updated as if its field was the widest,
   1572   ;;   hence its subsequent fields are too much to the left.
   1573   ;; - The rest is updated starting from the first few lines (according
   1574   ;;   to jit-lock-chunk-size).
   1575   ;; - After the first few lines, come the next set of few lines,
   1576   ;;   which may cause the previous few lines to need refresh again.
   1577   ;; - etc.. until arriving again at the edited line which is re-aligned
   1578   ;;   again.
   1579   ;; - etc.. until the end of the windows, potentially causing yet more
   1580   ;;   refreshes as we discover yet-wider fields for this column.
   1581   (let ((old-columns csv--jit-columns)
   1582         (changed nil))
   1583     (while (and old-columns column-widths)
   1584       (when (or (> (caar column-widths) (caar old-columns))
   1585                 ;; Apparently modification-hooks aren't run when the
   1586                 ;; whole text containing the overlay is deleted (e.g.
   1587                 ;; the whole line), so detect this case here.
   1588                 ;; It's a bit too late, but better than never.
   1589                 (null (overlay-buffer (cdar old-columns))))
   1590         (setq changed t) ;; Return non-nil if some existing column changed.
   1591         (pcase-let ((`(,width ,beg ,end) (car column-widths)))
   1592           (setf (caar old-columns) width)
   1593           (move-overlay (cdar old-columns) beg end)))
   1594       (setq old-columns (cdr old-columns))
   1595       (setq column-widths (cdr column-widths)))
   1596     (when column-widths
   1597       ;; New columns appeared.
   1598       (setq csv--jit-columns
   1599             (nconc csv--jit-columns
   1600                    (mapcar (lambda (x)
   1601                              (pcase-let*
   1602                                  ((`(,width ,beg ,end) x)
   1603                                   (ol (make-overlay beg end)))
   1604                                (overlay-put ol 'csv-width t)
   1605                                (overlay-put ol 'evaporate t)
   1606                                (overlay-put ol 'modification-hooks
   1607                                             (list #'csv--jit-width-change))
   1608                                (cons width ol)))
   1609                            column-widths))))
   1610     changed))
   1611 
   1612 (defun csv--jit-width-change (ol after _beg _end &optional len)
   1613   (when (and after (> len 0))
   1614     ;; (let ((x (rassq ol csv--jit-columns)))
   1615     ;;   (when x (setf (car x) -1)))
   1616     (delete-overlay ol)))
   1617 
   1618 (defun csv--jit-unalign (beg end)
   1619   (with-silent-modifications
   1620     (remove-text-properties beg end
   1621                             '( display nil csv--jit nil invisible nil
   1622                                cursor-sensor-functions nil csv--revealed nil))
   1623     (remove-overlays beg end 'csv--jit t)))
   1624 
   1625 (defun csv--jit-flush (beg end)
   1626   "Cause all the buffer (except for the BEG...END region) to be re-aligned."
   1627   (cl-assert (>= end beg))
   1628   ;; The buffer shouldn't have changed since beg/end were computed,
   1629   ;; but just in case, let's make sure they're still sane.
   1630   (when (< beg (point-min))
   1631     (setq beg (point-min) end (max end beg)))
   1632   (when (< (point-max) end)
   1633     (setq end (point-max) beg (min end beg)))
   1634   (let ((pos (point-min)))
   1635     (while (and (< pos beg)
   1636                 (setq pos (text-property-any pos beg 'csv--jit t)))
   1637       (jit-lock-refontify
   1638        pos (setq pos (or (text-property-any pos beg 'csv--jit nil) beg))))
   1639     (setq pos end)
   1640     (while (and (< pos (point-max))
   1641                 (setq pos (text-property-any pos (point-max) 'csv--jit t)))
   1642       (jit-lock-refontify
   1643        pos (setq pos (or (text-property-any pos (point-max) 'csv--jit nil)
   1644                          (point-max))))))
   1645   (csv--header-flush))
   1646 
   1647 (defun csv--ellipsis-width ()
   1648   (let ((ellipsis
   1649          (when standard-display-table
   1650            (display-table-slot standard-display-table
   1651                                'selective-display))))
   1652     (if ellipsis (length ellipsis) 3)))
   1653 
   1654 (defun csv-align--cursor-truncated (window oldpos dir)
   1655   ;; FIXME: Neither the `entered' nor the `left' event are guaranteed
   1656   ;; to be sent, and for the `left' case, even when we do get called,
   1657   ;; it may be unclear where the revealed text was (it's somewhere around
   1658   ;; `oldpos', but that position can be stale).
   1659   ;; Worse, if we have several windows displaying the buffer, when one
   1660   ;; cursor leaves we may need to keep the text revealed because of
   1661   ;; another window's cursor.
   1662   (let* ((prop (if (eq dir 'entered) 'invisible 'csv--revealed))
   1663          (pos (cond
   1664                ((eq dir 'entered) (window-point window))
   1665                (t (max (point-min)
   1666                        (min (point-max)
   1667                             (or oldpos (window-point window)))))))
   1668          (start (cond
   1669                  ((and (> pos (point-min))
   1670                        (eq (get-text-property (1- pos) prop) 'csv-truncate))
   1671                   (or (previous-single-property-change pos prop) (point-min)))
   1672                  (t pos)))
   1673          (end (if (eq (get-text-property pos prop) 'csv-truncate)
   1674                   (or (next-single-property-change pos prop) (point-max))
   1675                 pos)))
   1676     (unless (eql start end)
   1677       (with-silent-modifications
   1678         (put-text-property start end
   1679                            (if (eq dir 'entered) 'csv--revealed 'invisible)
   1680                            'csv-truncate)
   1681         (remove-text-properties start end (list prop))))))
   1682 
   1683 (defun csv--jit-align (beg end)
   1684   (save-excursion
   1685     ;; This is run with inhibit-modification-hooks set, so the overlays'
   1686     ;; modification-hook doesn't work :-(
   1687     (and csv--header-line
   1688          (<= beg (overlay-end csv--header-line))
   1689          (>= end (overlay-start csv--header-line))
   1690          (csv--header-flush))
   1691     ;; First, round up to a whole number of lines.
   1692     (goto-char end)
   1693     (unless (bolp) (forward-line 1) (setq end (point)))
   1694     (goto-char beg)
   1695     (unless (bolp) (forward-line 1) (setq beg (point)))
   1696     (csv--jit-unalign beg end)
   1697     (put-text-property beg end 'csv--jit t)
   1698 
   1699     (pcase-let* ((`(,column-widths ,field-widths) (csv--column-widths beg end))
   1700                  (changed (csv--jit-merge-columns column-widths))
   1701                  (ellipsis-width (csv--ellipsis-width)))
   1702       (when changed
   1703         ;; Do it after the current redisplay is over.
   1704         (run-with-timer jit-lock-context-time nil #'csv--jit-flush beg end))
   1705 
   1706       ;; Align fields:
   1707       (goto-char beg)
   1708       (while (< (point) end)
   1709 	(unless (csv-not-looking-at-record)
   1710           (let ((w csv--jit-columns)
   1711                 (widths-config csv--config-column-widths)
   1712                 (column 0))      ;Desired position of left-side of this column.
   1713             (while (and w (not (eolp)))
   1714               (let* ((field-beg (point))
   1715                      (width-config (pop widths-config))
   1716                      (align-padding (if (bolp) 0 csv-align-padding))
   1717                      (left-padding 0) (right-padding 0)
   1718                      (field-width (pop field-widths))
   1719                      (column-width
   1720                       (min (max csv-align-min-width
   1721                                 (car (pop w)))
   1722                            (or width-config
   1723                                ;; Don't apply csv-align-max-width
   1724                                ;; to the last field!
   1725                                (if w csv-align-max-width
   1726                                  most-positive-fixnum))))
   1727                      (x (- column-width field-width)) ; Required padding.
   1728                      (truncate nil))
   1729                 (csv-end-of-field)
   1730                 ;; beg = beginning of current field
   1731                 ;; end = (point) = end of current field
   1732                 (when (< x 0)
   1733                   (setq truncate (max column
   1734                                       (+ column column-width
   1735                                          align-padding (- ellipsis-width))))
   1736                   (setq x 0))
   1737                 ;; Compute required padding:
   1738                 (pcase csv-align-style
   1739                   ('left
   1740                    ;; Left align -- pad on the right:
   1741                    (setq left-padding align-padding
   1742                          right-padding x))
   1743                   ('right
   1744                    ;; Right align -- pad on the left:
   1745                    (setq left-padding (+ align-padding x)))
   1746                   ('auto
   1747                    ;; Auto align -- left align text, right align numbers:
   1748                    (if (string-match "\\`[-+.[:digit:]]+\\'"
   1749                                      (buffer-substring field-beg (point)))
   1750                        ;; Right align -- pad on the left:
   1751                        (setq left-padding (+ align-padding x))
   1752                      ;; Left align -- pad on the right:
   1753                      (setq left-padding align-padding
   1754                            right-padding x)))
   1755                   ('centre
   1756                    ;; Centre -- pad on both left and right:
   1757                    (let ((y (/ x 2)))   ; truncated integer quotient
   1758                      (setq left-padding (+ align-padding y)
   1759                            right-padding (- x y)))))
   1760 
   1761                 (cond
   1762 
   1763                  ((or (memq 'csv buffer-invisibility-spec)
   1764                       ;; For TSV, hidden or not doesn't make much difference,
   1765                       ;; but the behavior is slightly better when we "hide"
   1766                       ;; the TABs with a `display' property than if we add
   1767                       ;; before/after-strings.
   1768                       (tsv--mode-p))
   1769 
   1770                   ;; Hide separators...
   1771                   ;; Merge right-padding from previous field
   1772                   ;; with left-padding from this field:
   1773                   (if (zerop column)
   1774                       (when (> left-padding 0)
   1775                         ;; Display spaces before first field
   1776                         ;; by overlaying first character:
   1777 			(csv--make-overlay
   1778 			 field-beg (1+ field-beg) nil nil nil
   1779 			 `(before-string ,(make-string left-padding ?\ )
   1780 			                 csv--jit t)))
   1781                     ;; Display separator as spaces:
   1782                     (with-silent-modifications
   1783                       (put-text-property
   1784                        (1- field-beg) field-beg
   1785                        'display `(space :align-to
   1786                                         ,(+ left-padding column))))))
   1787 
   1788                  (t ;; Do not hide separators...
   1789                   (let ((overlay (csv--make-overlay field-beg (point)
   1790                                                     nil nil t
   1791                                                     '(csv--jit t))))
   1792                     (when (> left-padding 0) ; Pad on the left.
   1793                       ;; Display spaces before field:
   1794                       (overlay-put overlay 'before-string
   1795                                    (make-string left-padding ?\ )))
   1796                     (unless (eolp)
   1797                       (if (> right-padding 0) ; Pad on the right.
   1798                           ;; Display spaces after field:
   1799                           (overlay-put
   1800                            overlay
   1801                            'after-string (make-string right-padding ?\ )))))))
   1802                 (setq column (+ column column-width align-padding))
   1803                 ;; Do it after applying the property, so `move-to-column' can
   1804                 ;; take it into account.
   1805                 (when truncate
   1806                   (let ((trunc-pos
   1807                          (save-excursion
   1808                            ;; ¡¡ BIG UGLY HACK !!
   1809                            ;; `current-column' and `move-to-column' count
   1810                            ;; text hidden with an ellipsis "as if" it were
   1811                            ;; fully visible, which is completely wrong here,
   1812                            ;; so circumvent this by temporarily pretending
   1813                            ;; that `csv-truncate' is fully invisible (which
   1814                            ;; isn't quite right either, but should work
   1815                            ;; just well enough for us here).
   1816                            (let ((buffer-invisibility-spec
   1817                                   buffer-invisibility-spec))
   1818                              (add-to-invisibility-spec 'csv-truncate)
   1819                              (move-to-column truncate))
   1820                            (point))))
   1821                     (put-text-property trunc-pos (point)
   1822                                        'invisible 'csv-truncate)
   1823                     (when (> (- (point) trunc-pos) 1)
   1824                       ;; Arrange to temporarily untruncate the string when
   1825                       ;; cursor moves into it.
   1826                       ;; FIXME: This only works if
   1827                       ;; `global-disable-point-adjustment' is non-nil!
   1828                       ;; Arguably this should be fixed by making
   1829                       ;; point-adjustment code pay attention to
   1830                       ;; cursor-sensor-functions!
   1831                       (put-text-property
   1832                        (1+ trunc-pos) (point)
   1833                        'cursor-sensor-functions
   1834                        (list #'csv-align--cursor-truncated)))))
   1835                 (unless (eolp) (forward-char)) ; Skip separator.
   1836                 ))))
   1837 	(forward-line)))
   1838     `(jit-lock-bounds ,beg . ,end)))
   1839 
   1840 (define-minor-mode csv-align-mode
   1841   "Align columns on the fly."
   1842   :global nil
   1843   (csv-unalign-fields nil (point-min) (point-max)) ;Just in case.
   1844   (cond
   1845    (csv-align-mode
   1846     (add-to-invisibility-spec '(csv-truncate . t))
   1847     (kill-local-variable 'csv--jit-columns)
   1848     (cursor-sensor-mode 1)
   1849     (when (fboundp 'header-line-indent-mode)
   1850       (header-line-indent-mode))
   1851     (jit-lock-register #'csv--jit-align)
   1852     (jit-lock-refontify))
   1853    (t
   1854     (remove-from-invisibility-spec '(csv-truncate . t))
   1855     (jit-lock-unregister #'csv--jit-align)
   1856     (csv--jit-unalign (point-min) (point-max))))
   1857   (csv--header-flush))
   1858 
   1859 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1860 ;;;  Separator guessing
   1861 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1862 
   1863 (defvar csv--preferred-separators
   1864   '(?, ?\; ?\t)
   1865   "Preferred separator characters in case of a tied score.")
   1866 
   1867 (defun csv-guess-set-separator ()
   1868   "Guess and set the CSV separator of the current buffer.
   1869 
   1870 Add it to the mode hook to have CSV mode guess and set the
   1871 separator automatically when visiting a buffer:
   1872 
   1873   (add-hook \\='csv-mode-hook \\='csv-guess-set-separator)"
   1874   (interactive)
   1875   (let ((sep (csv-guess-separator
   1876               (buffer-substring-no-properties
   1877                (point-min)
   1878                ;; We're probably only going to look at the first 2048
   1879                ;; or so chars, but take more than we probably need to
   1880                ;; minimize the chance of breaking the input in the
   1881                ;; middle of a (long) row.
   1882                (min 8192 (point-max)))
   1883               2048)))
   1884     (when sep
   1885       (csv-set-separator sep))))
   1886 
   1887 (defun csv-guess-separator (text &optional cutoff)
   1888   "Return a guess of which character is the CSV separator in TEXT."
   1889   (let ((best-separator nil)
   1890         (best-score 0))
   1891     (dolist (candidate (csv--separator-candidates text cutoff))
   1892       (let ((candidate-score
   1893              (csv--separator-score candidate text cutoff)))
   1894         (when (or (> candidate-score best-score)
   1895                   (and (= candidate-score best-score)
   1896                        (member candidate csv--preferred-separators)))
   1897           (setq best-separator candidate)
   1898           (setq best-score candidate-score))))
   1899     best-separator))
   1900 
   1901 (defun csv--separator-candidates (text &optional cutoff)
   1902   "Return a list of candidate CSV separators in TEXT.
   1903 When CUTOFF is passed, look only at the first CUTOFF number of characters."
   1904   (let ((chars (make-hash-table)))
   1905     (dolist (c (string-to-list
   1906                 (if cutoff
   1907                     (substring text 0 (min cutoff (length text)))
   1908                   text)))
   1909       (when (and (not (gethash c chars))
   1910                  (or (= c ?\t)
   1911                      (= c ?\C-_)
   1912                      (and (not (member c '(?. ?/ ?\" ?')))
   1913                           (not (= c (string-to-char csv-comment-start)))
   1914                           (not (member (get-char-code-property c 'general-category)
   1915                                        '(Lu Ll Lt Lm Lo Nd Nl No Ps Pe Cc Co))))))
   1916         (puthash c t chars)))
   1917     (hash-table-keys chars)))
   1918 
   1919 (defun csv--separator-score (separator text &optional cutoff)
   1920   "Return a score on how likely SEPARATOR is a separator in TEXT.
   1921 
   1922 When CUTOFF is passed, stop the calculation at the next whole
   1923 line after having read CUTOFF number of characters.
   1924 
   1925 The scoring is based on the idea that most CSV data is tabular,
   1926 i.e. separators should appear equally often on each line.
   1927 Furthermore, more commonly appearing characters are scored higher
   1928 than those who appear less often.
   1929 
   1930 Adapted from the paper \"Wrangling Messy CSV Files by Detecting
   1931 Row and Type Patterns\" by Gerrit J.J. van den Burg , Alfredo
   1932 Nazábal, and Charles Sutton: https://arxiv.org/abs/1811.11242."
   1933   (let ((groups
   1934          (with-temp-buffer
   1935            (csv-set-separator separator)
   1936            (save-excursion
   1937              (insert text))
   1938            (let ((groups (make-hash-table))
   1939                  (chars-read 0))
   1940              (while (and (/= (point) (point-max))
   1941                          (or (not cutoff)
   1942                              (< chars-read cutoff)))
   1943                (let* ((lep (line-end-position))
   1944                       (nfields (length (csv--collect-fields lep))))
   1945                  (cl-incf (gethash nfields groups 0))
   1946                  (cl-incf chars-read (- lep (point)))
   1947                  (goto-char (+ lep 1))))
   1948              groups)))
   1949         (sum 0))
   1950     (maphash
   1951      (lambda (length num)
   1952        (cl-incf sum (* num (/ (- length 1) (float length)))))
   1953      groups)
   1954     (let ((unique-groups (hash-table-count groups)))
   1955       (if (= 0 unique-groups)
   1956           0
   1957         (/ sum unique-groups)))))
   1958 
   1959 ;;; TSV support
   1960 
   1961 ;; Since "the" CSV format is really a bunch of different formats, it includes
   1962 ;; TSV as a subcase, but this subcase is sufficiently interesting that it has
   1963 ;; its own mime-type and mostly standard file extension, also it suffers
   1964 ;; less from the usual quoting problems of CSV (because the only problematic
   1965 ;; chars are LF and TAB, really, which are much less common inside fields than
   1966 ;; commas, space, and semi-colons) so it's "better behaved".
   1967 
   1968 (defvar tsv-mode-syntax-table
   1969   ;; Inherit from `text-mode-syntax-table' rather than from
   1970   ;; `csv-mode-syntax-table' so as not to inherit the
   1971   ;; `csv-field-quotes' settings.
   1972   (let ((st (make-syntax-table text-mode-syntax-table)))
   1973     st))
   1974 
   1975 (defvar tsv-mode-map
   1976   (let ((map (make-sparse-keymap)))
   1977     ;; In `tsv-mode', the `csv-invisibility-default/csv-toggle-invisibility'
   1978     ;; business doesn't make much sense.
   1979     (define-key map [remap csv-toggle-invisibility] #'undefined)
   1980     map))
   1981 
   1982 ;;;###autoload
   1983 (add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode))
   1984 
   1985 (defun tsv--mode-p ()
   1986   (equal csv-separator-chars '(?\t)))
   1987 
   1988 ;;;###autoload
   1989 (define-derived-mode tsv-mode csv-mode "TSV"
   1990   "Major mode for editing files of tab-separated value type."
   1991   :group 'CSV
   1992   ;; In TSV we know TAB is the only possible separator.
   1993   (setq-local csv-separators '("\t"))
   1994   ;; FIXME: Copy&pasted from the `:set'ter of csv-separators!
   1995   (setq-local csv-separator-chars '(?\t))
   1996   (setq-local csv--skip-chars "^\n\t")
   1997   (setq-local csv-separator-regexp "\t")
   1998   (setq-local csv-font-lock-keywords
   1999 	      ;; NB: csv-separator-face variable evaluates to itself.
   2000 	      `((,csv-separator-regexp (0 'csv-separator-face))))
   2001 
   2002   ;; According to wikipedia, TSV doesn't use quotes but uses backslash escapes
   2003   ;; of the form \n, \t, \r, and \\ instead.
   2004   (setq-local csv-field-quotes nil))
   2005 
   2006 
   2007 (provide 'csv-mode)
   2008 
   2009 ;;; csv-mode.el ends here