(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."
:type '(repeat string)
: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
`((,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)
: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)
(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 'csv-mode-syntax-table)))
csv-field-quotes))
(csv-set-quote-syntax value))
(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 'csv-mode-syntax-table)))
field-quotes))
(defvar csv-comment-start nil
"String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
This variable is buffer local; its default value is that of
`csv-comment-start-default'. It is set by the function
`csv-set-comment-start' -- do not set it directly!")
(make-variable-buffer-local 'csv-comment-start)
(defcustom csv-comment-start-default "#"
"String that starts a comment line, or nil if no comment syntax.
Such comment lines are ignored by CSV mode commands.
Default value of buffer-local variable `csv-comment-start'.
Changing this variable does not affect any existing CSV mode buffer."
:type '(choice (const :tag "None" nil) string)
:set (lambda (variable value)
(custom-set-default variable value)
(setq-default csv-comment-start value)))
(defcustom csv-align-style 'left
"Aligned field style: one of `left', `centre', `right' or `auto'.
Alignment style used by `csv-align-mode' and `csv-align-fields'.
Auto-alignment means left align text and right align numbers."
:type '(choice (const left) (const centre)
(const right) (const auto)))
(defcustom csv-align-padding 1
"Aligned field spacing: must be a positive integer.
Number of spaces used by `csv-align-mode' and `csv-align-fields'
after separators."
:type 'integer)
(defcustom csv-header-lines 0
"Header lines to skip when setting region automatically."
:type 'integer)
(defcustom csv-invisibility-default t
"If non-nil, make separators in aligned records invisible."
:type 'boolean)
(defface csv-separator-face
'((t :inherit escape-glyph))
"CSV mode face used to highlight separators.")
(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))
(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
(setq-local normal-auto-fill-function nil)
(csv-set-quote-syntax csv-field-quotes)
(set (make-local-variable 'forward-sexp-function) #'csv-forward-field)
(csv-set-comment-start csv-comment-start)
(setq font-lock-defaults '(csv-font-lock-keywords))
(setq-local jit-lock-contextually nil) (if csv-invisibility-default (add-to-invisibility-spec 'csv))
(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)
(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)))
(set (make-local-variable 'paragraph-separate) "[[:space:]]*$") (set (make-local-variable 'paragraph-start) "\n") (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))
(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 ()
"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."
(let* ((arg current-prefix-arg) (default-field 1)
(region
(if (not (use-region-p))
(save-excursion
(if arg
(beginning-of-line)
(let ((lbp (line-beginning-position)))
(while (re-search-backward csv-separator-regexp lbp 1)
(setq default-field (1+ default-field)))))
(if (csv-not-looking-at-record)
(error "Point must be within CSV records"))
(let ((startline (point)))
(while (not (or (bobp) (csv-not-looking-at-record)))
(forward-line -1))
(if (csv-not-looking-at-record) (forward-line 1))
(forward-line csv-header-lines)
(set-mark (point)) (goto-char startline)
(beginning-of-line)
(while (not (or (eobp) (csv-not-looking-at-record)))
(forward-line 1))
(unless (and (pos-visible-in-window-p)
(pos-visible-in-window-p (mark)))
(exchange-point-and-mark)
(sit-for 1)
(exchange-point-and-mark))
(or (y-or-n-p "Region OK? ")
(error "Action aborted by user"))
(message nil) (list (region-beginning) (region-end))))
(list (region-beginning) (region-end)))))
(setq default-field (number-to-string default-field))
(cond
((eq type 'multiple)
(if arg
(or (consp arg)
(setq arg (list (prefix-numeric-value arg))))
(setq arg
(mapcar
(lambda (x)
(if (string-match "-" x 1) (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)))))
(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))))
(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 (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 (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 (csv-interactive-args 'noarg))
(barf-if-buffer-read-only)
(reverse-region beg end))
(defun csv-end-of-field ()
"Skip forward over one field."
(skip-chars-forward " ")
(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'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 pointif 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 (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)
(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)))))
(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)
(while (< (point) end) (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)) (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)))))
(setq end (copy-marker end))
(csv-unalign-fields hard beg end) (save-excursion
(pcase-let ((`(,column-widths ,field-widths) (csv--column-widths beg end)))
(save-restriction
(narrow-to-region beg end)
(set-marker end nil)
(goto-char (point-min))
(while (not (eobp)) (unless (csv-not-looking-at-record)
(let ((w column-widths)
(column 0)) (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))) (csv-end-of-field)
(set-marker end (point))
(cond
((eq csv-align-style 'left)
(setq left-padding align-padding
right-padding x))
((eq csv-align-style 'right)
(setq left-padding (+ align-padding x)))
((eq csv-align-style 'auto)
(if (string-match "\\`[-+.[:digit:]]+\\'"
(buffer-substring beg (point)))
(setq left-padding (+ align-padding x))
(setq left-padding align-padding
right-padding x)))
((eq csv-align-style 'centre)
(let ((y (/ x 2))) (setq left-padding (+ align-padding y)
right-padding (- x y)))))
(cond
(hard (when (> left-padding 0) (if (= beg end) (insert (make-string left-padding ?\ ))
(goto-char beg) (insert (make-string left-padding ?\ ))
(goto-char end))) (unless (eolp)
(if (> right-padding 0) (insert (make-string right-padding ?\ )))
(csv--make-overlay (point) (1+ (point)) nil t nil
'(invisible csv evaporate t))
(forward-char)))
((or (memq 'csv buffer-invisibility-spec)
(tsv--mode-p))
(if (zerop column)
(when (> left-padding 0)
(csv--make-overlay
beg (1+ beg) nil nil nil
`(before-string ,(make-string left-padding ?\ ))))
(with-silent-modifications
(put-text-property
(1- beg) beg
'display `(space :align-to
,(+ left-padding column)))))
(unless (eolp) (forward-char)) (setq column (+ column column-width align-padding)))
(t (let ((overlay (csv--make-overlay beg (point) nil nil t)))
(when (> left-padding 0) (overlay-put overlay 'before-string
(make-string left-padding ?\ )))
(unless (eolp)
(if (> right-padding 0) (overlay-put
overlay
'after-string (make-string right-padding ?\ )))
(forward-char))))
)))))
(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)))))
(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)
(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-region (point)
(+ (point) (skip-chars-forward " \t")))
(csv-end-of-field)
(delete-region (point)
(+ (point) (skip-chars-backward " \t")))
(or (eolp) (forward-char))))
(forward-line))))))
(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 (csv-interactive-args 'noarg))
(barf-if-buffer-read-only)
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(let ((sep (car csv-separators))
(align (overlays-in beg end))
rows columns)
(when align
(mapc #'csv--delete-overlay align)
(setq align t))
(while (not (eobp))
(if (csv-not-looking-at-record)
(forward-line)
(let ((lep (line-end-position)))
(push
(csv--collect-fields lep)
rows)
(delete-region (point) lep)
(or (eobp) (delete-char 1)))))
(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))))
(while rows
(let (column (r rows) row)
(while r
(setq row (car r))
(if (or column (string< "" (car row)))
(push (car row) column))
(setcar r (cdr row))
(or (car r) (setq rows (cdr rows)))
(setq r (cdr r)))
(push column columns)))
(setq columns (nreverse columns))
(while columns
(insert (mapconcat #'identity (car columns) sep) ?\n)
(setq columns (cdr columns)))
(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)
(unless (memq (following-char) csv-separator-chars)
(csv-forward-field 1))
(push
(buffer-substring-no-properties field-start (point))
fields)
(if (memq (following-char) csv-separator-chars)
(forward-char)))
(nreverse fields)))))
(defvar-local csv--header-line nil)
(defvar-local csv--header-hscroll nil)
(defvar-local csv--header-string nil)
(defun csv-header-line (&optional use-current-line)
"Set/unset the header line.
If the optional prefix arg USE-CURRENT-LINE is nil, use the first line
as the header line.
If there is already a header line, then unset the header line."
(interactive "P")
(if csv--header-line
(progn
(delete-overlay csv--header-line)
(setq csv--header-line nil)
(kill-local-variable 'header-line-format))
(save-excursion
(unless use-current-line (goto-char (point-min)))
(setq csv--header-line (make-overlay (line-beginning-position)
(line-end-position)
nil nil t))
(overlay-put csv--header-line 'modification-hooks
'(csv--header-flush)))
(csv--header-flush)
(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 _)
(setq csv--header-hscroll nil))
(defun csv--header-string ()
(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))
(move-overlay csv--header-line (point) (line-end-position))
(jit-lock-fontify-now (point) (line-end-position))
(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)))))
(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."
(setq csv--jit-columns nil))
(defun csv--jit-merge-columns (column-widths)
(let ((old-columns csv--jit-columns)
(changed nil))
(while (and old-columns column-widths)
(when (or (> (caar column-widths) (caar old-columns))
(null (overlay-buffer (cdar old-columns))))
(setq changed t) (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
(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))
(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))
(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)
(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
(and csv--header-line
(<= beg (overlay-end csv--header-line))
(>= end (overlay-start csv--header-line))
(csv--header-flush))
(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
(run-with-timer jit-lock-context-time nil #'csv--jit-flush beg end))
(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)) (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
(if w csv-align-max-width
most-positive-fixnum))))
(x (- column-width field-width)) (truncate nil))
(csv-end-of-field)
(when (< x 0)
(setq truncate (max column
(+ column column-width
align-padding (- ellipsis-width))))
(setq x 0))
(pcase csv-align-style
('left
(setq left-padding align-padding
right-padding x))
('right
(setq left-padding (+ align-padding x)))
('auto
(if (string-match "\\`[-+.[:digit:]]+\\'"
(buffer-substring field-beg (point)))
(setq left-padding (+ align-padding x))
(setq left-padding align-padding
right-padding x)))
('centre
(let ((y (/ x 2))) (setq left-padding (+ align-padding y)
right-padding (- x y)))))
(cond
((or (memq 'csv buffer-invisibility-spec)
(tsv--mode-p))
(if (zerop column)
(when (> left-padding 0)
(csv--make-overlay
field-beg (1+ field-beg) nil nil nil
`(before-string ,(make-string left-padding ?\ )
csv--jit t)))
(with-silent-modifications
(put-text-property
(1- field-beg) field-beg
'display `(space :align-to
,(+ left-padding column))))))
(t (let ((overlay (csv--make-overlay field-beg (point)
nil nil t
'(csv--jit t))))
(when (> left-padding 0) (overlay-put overlay 'before-string
(make-string left-padding ?\ )))
(unless (eolp)
(if (> right-padding 0) (overlay-put
overlay
'after-string (make-string right-padding ?\ )))))))
(setq column (+ column column-width align-padding))
(when truncate
(let ((trunc-pos
(save-excursion
(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)
(put-text-property
(1+ trunc-pos) (point)
'cursor-sensor-functions
(list #'csv-align--cursor-truncated)))))
(unless (eolp) (forward-char)) ))))
(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)) (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))
(defvar csv--preferred-separators
'(?, ?\ "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)
(min 8192 (point-max)))
2048)))
(when sep
(csv-set-separator sep))))
(defun csv-guess-separator (text &optional cutoff)
"Return a guess of which character is the CSV separator in TEXT."
(let ((best-separator nil)
(best-score 0))
(dolist (candidate (csv--separator-candidates text cutoff))
(let ((candidate-score
(csv--separator-score candidate text cutoff)))
(when (or (> candidate-score best-score)
(and (= candidate-score best-score)
(member candidate csv--preferred-separators)))
(setq best-separator candidate)
(setq best-score candidate-score))))
best-separator))
(defun csv--separator-candidates (text &optional cutoff)
"Return a list of candidate CSV separators in TEXT.
When CUTOFF is passed, look only at the first CUTOFF number of characters."
(let ((chars (make-hash-table)))
(dolist (c (string-to-list
(if cutoff
(substring text 0 (min cutoff (length text)))
text)))
(when (and (not (gethash c chars))
(or (= c ?\t)
(and (not (member c '(?. ?/ ?\" ?')))
(not (member (get-char-code-property c 'general-category)
'(Lu Ll Lt Lm Lo Nd Nl No Ps Pe Cc Co))))))
(puthash c t chars)))
(hash-table-keys chars)))
(defun csv--separator-score (separator text &optional cutoff)
"Return a score on how likely SEPARATOR is a separator in TEXT.
When CUTOFF is passed, stop the calculation at the next whole
line after having read CUTOFF number of characters.
The scoring is based on the idea that most CSV data is tabular,
i.e. separators should appear equally often on each line.
Furthermore, more commonly appearing characters are scored higher
than those who appear less often.
Adapted from the paper \"Wrangling Messy CSV Files by Detecting
Row and Type Patterns\" by Gerrit J.J. van den Burg , Alfredo
Nazábal, and Charles Sutton: https://arxiv.org/abs/1811.11242."
(let ((groups
(with-temp-buffer
(csv-set-separator separator)
(save-excursion
(insert text))
(let ((groups (make-hash-table))
(chars-read 0))
(while (and (/= (point) (point-max))
(or (not cutoff)
(< chars-read cutoff)))
(let* ((lep (line-end-position))
(nfields (length (csv--collect-fields lep))))
(cl-incf (gethash nfields groups 0))
(cl-incf chars-read (- lep (point)))
(goto-char (+ lep 1))))
groups)))
(sum 0))
(maphash
(lambda (length num)
(cl-incf sum (* num (/ (- length 1) (float length)))))
groups)
(let ((unique-groups (hash-table-count groups)))
(if (= 0 unique-groups)
0
(/ sum unique-groups)))))
(defvar tsv-mode-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
st))
(defvar tsv-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [remap csv-toggle-invisibility] #'undefined)
map))
(add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode))
(defun tsv--mode-p ()
(equal csv-separator-chars '(?\t)))
(define-derived-mode tsv-mode csv-mode "TSV"
"Major mode for editing files of tab-separated value type."
:group 'CSV
(setq-local csv-separators '("\t"))
(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
`((,csv-separator-regexp (0 'csv-separator-face))))
(setq-local csv-field-quotes nil))
(provide 'csv-mode)