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