From: Andreas Gerler Date: Thu, 23 Nov 2023 19:02:34 +0000 (+0100) Subject: update csv-mode X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=39bc27b66f154feec4fb80665e4fffdd1578645f;p=emacsconfig.git update csv-mode Signed-off-by: Andreas Gerler --- diff --git a/elpa/csv-mode-1.11/csv-mode-autoloads.el b/elpa/csv-mode-1.11/csv-mode-autoloads.el deleted file mode 100644 index 78d02945..00000000 --- a/elpa/csv-mode-1.11/csv-mode-autoloads.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; csv-mode-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "csv-mode" "csv-mode.el" (0 0 0 0)) -;;; Generated autoloads from csv-mode.el - -(autoload 'csv-mode "csv-mode" "\ -Major mode for editing files of comma-separated value type. - -CSV mode is derived from `text-mode', and runs `text-mode-hook' before -running `csv-mode-hook'. It turns `auto-fill-mode' off by default. -CSV mode can be customized by user options in the CSV customization -group. The separators are specified by the value of `csv-separators'. - -CSV mode commands ignore blank lines and comment lines beginning with -the value of `csv-comment-start', which delimit \"paragraphs\". -\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp' -\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields. -Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]). - -If `font-lock-mode' is enabled then separators, quoted values and -comment lines are highlighted using respectively `csv-separator-face', -`font-lock-string-face' and `font-lock-comment-face'. - -The user interface (UI) for CSV mode commands is similar to that of -the standard commands `sort-fields' and `sort-numeric-fields', except -that if there is no prefix argument then the UI prompts for the field -index or indices. In `transient-mark-mode' only: if the region is not -set then the UI attempts to set it to include all consecutive CSV -records around point, and prompts for confirmation; if there is no -prefix argument then the UI prompts for it, offering as a default the -index of the field containing point if the region was not set -explicitly. The region set automatically is delimited by blank lines -and comment lines, and the number of header lines at the beginning of -the region given by the value of `csv-header-lines' are skipped. - -Sort order is controlled by `csv-descending'. - -CSV mode provides the following specific keyboard key bindings: - -\\{csv-mode-map} - -\(fn)" t nil) - -(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) - -(add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode)) - -(autoload 'tsv-mode "csv-mode" "\ -Major mode for editing files of tab-separated value type. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "csv-mode" '("tsv-" "csv-"))) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; csv-mode-autoloads.el ends here diff --git a/elpa/csv-mode-1.11/csv-mode-pkg.el b/elpa/csv-mode-1.11/csv-mode-pkg.el deleted file mode 100644 index 656faee0..00000000 --- a/elpa/csv-mode-1.11/csv-mode-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "csv-mode" "1.11" "Major mode for editing comma/char separated values" '((emacs "24.1") (cl-lib "0.5")) :url "http://elpa.gnu.org/packages/csv-mode.html" :keywords '("convenience") :authors '(("\"Francis J. Wright\"" . "F.J.Wright@qmul.ac.uk")) :maintainer '(nil . "emacs-devel@gnu.org")) diff --git a/elpa/csv-mode-1.11/csv-mode.el b/elpa/csv-mode-1.11/csv-mode.el deleted file mode 100644 index 0db04445..00000000 --- a/elpa/csv-mode-1.11/csv-mode.el +++ /dev/null @@ -1,1975 +0,0 @@ -;;; csv-mode.el --- Major mode for editing comma/char separated values -*- lexical-binding: t -*- - -;; Copyright (C) 2003, 2004, 2012-2020 Free Software Foundation, Inc - -;; Author: "Francis J. Wright" -;; Maintainer: emacs-devel@gnu.org -;; Version: 1.11 -;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) -;; Keywords: convenience - -;; This package is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This package is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This package implements CSV mode, a major mode for editing records -;; in a generalized CSV (character-separated values) format. It binds -;; files with prefix ".csv" to `csv-mode' (and ".tsv" to `tsv-mode') in -;; `auto-mode-alist'. - -;; In CSV mode, the following commands are available: - -;; - C-c C-s (`csv-sort-fields') and C-c C-n (`csv-sort-numeric-fields') -;; respectively sort lexicographically and numerically on a -;; specified field or column. - -;; - C-c C-r (`csv-reverse-region') reverses the order. (These -;; commands are based closely on, and use, code in `sort.el'.) - -;; - C-c C-k (`csv-kill-fields') and C-c C-y (`csv-yank-fields') kill -;; and yank fields or columns, although they do not use the normal -;; kill ring. C-c C-k can kill more than one field at once, but -;; multiple killed fields can be yanked only as a fixed group -;; equivalent to a single field. - -;; - `csv-align-mode' keeps fields visually aligned, on-the-fly. -;; It truncates fields to a maximum width that can be changed per-column -;; with `csv-align-set-column-width'. -;; Alternatively, C-c C-a (`csv-align-fields') aligns fields into columns -;; and C-c C-u (`csv-unalign-fields') undoes such alignment; -;; separators can be hidden within aligned records (controlled by -;; `csv-invisibility-default' and `csv-toggle-invisibility'). - -;; - C-c C-t (`csv-transpose') interchanges rows and columns. For -;; details, see the documentation for the individual commands. - -;; CSV mode can recognize fields separated by any of several single -;; characters, specified by the value of the customizable user option -;; `csv-separators'. CSV data fields can be delimited by quote -;; characters (and must if they contain separator characters). This -;; implementation supports quoted fields, where the quote characters -;; allowed are specified by the value of the customizable user option -;; `csv-field-quotes'. By default, the both commas and tabs are considered -;; as separators and the only field quote is a double quote. -;; These user options can be changed ONLY by customizing them, e.g. via M-x -;; customize-variable. - -;; CSV mode commands ignore blank lines and comment lines beginning -;; with the value of the buffer local variable `csv-comment-start', -;; which by default is #. The user interface is similar to that of -;; the standard commands `sort-fields' and `sort-numeric-fields', but -;; see the major mode documentation below. - -;; The global minor mode `csv-field-index-mode' provides display of -;; the current field index in the mode line, cf. `line-number-mode' -;; and `column-number-mode'. It is on by default. - -;;; Installation: - -;; Put this file somewhere that Emacs can find it (i.e. in one of the -;; directories in your `load-path' such as `site-lisp'), optionally -;; byte-compile it (recommended), and put this in your .emacs file: -;; -;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) -;; (autoload 'csv-mode "csv-mode" -;; "Major mode for editing comma-separated value files." t) - -;;; History: - -;; Begun on 15 November 2003 to provide lexicographic sorting of -;; simple CSV data by field and released as csv.el. Facilities to -;; kill multiple fields and customize separator added on 9 April 2004. -;; Converted to a major mode and renamed csv-mode.el on 10 April 2004, -;; partly at the suggestion of Stefan Monnier to avoid conflict with csv.el by Ulf Jasper. -;; Field alignment, comment support and CSV mode customization group -;; added on 1 May 2004. Support for index ranges added on 6 June -;; 2004. Multiple field separators added on 12 June 2004. -;; Transposition added on 22 June 2004. Separator invisibility added -;; on 23 June 2004. - -;;; See also: - -;; the standard GNU Emacs 21 packages align.el, which will align -;; columns within a region, and delim-col.el, which helps to prettify -;; columns in a text region or rectangle; - -;; csv.el by Ulf Jasper , which provides -;; functions for reading/parsing comma-separated value files and is -;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in -;; the gnu.emacs.sources archives). - -;;; 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)) - -(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'." - ;; Suggested by Eckhard Neber - :type '(repeat string) - ;; FIXME: Character would be better, but in Emacs 21.3 does not display - ;; correctly in a customization buffer. - :set (lambda (variable value) - (mapc (lambda (x) - (if (/= (length x) 1) - (error "Non-single-char string %S" x)) - (if (and (boundp 'csv-field-quotes) - (member x csv-field-quotes)) - (error "%S is already a quote" x))) - value) - (custom-set-default variable value) - (setq csv-separator-chars (mapcar #'string-to-char value) - csv--skip-chars (apply #'concat "^\n" csv-separators) - csv-separator-regexp (apply #'concat `("[" ,@value "]")) - csv-font-lock-keywords - ;; NB: csv-separator-face variable evaluates to itself. - `((,csv-separator-regexp (0 'csv-separator-face)))))) - -(defcustom csv-field-quotes '("\"") - "Field quotes: a list of *single-character* strings. -For example: (\"\\\"\"), the default, or (\"\\\"\" \"\\='\" \"\\=`\"). -A field can be delimited by a pair of any of these characters. -All must be different from the field separators, `csv-separators'." - :type '(repeat string) - ;; Character would be better, but in Emacs 21 does not display - ;; correctly in a customization buffer. - :set (lambda (variable value) - (mapc (lambda (x) - (if (/= (length x) 1) - (error "Non-single-char string %S" x)) - (if (member x csv-separators) - (error "%S is already a separator" x))) - value) - (when (boundp 'csv-mode-syntax-table) - ;; FIRST remove old quote syntax: - (with-syntax-table text-mode-syntax-table - (mapc (lambda (x) - (modify-syntax-entry - (string-to-char x) - (string (char-syntax (string-to-char x))) - ;; symbol-value to avoid compiler warning: - (symbol-value 'csv-mode-syntax-table))) - csv-field-quotes)) - ;; THEN set new quote syntax: - (csv-set-quote-syntax value)) - ;; BEFORE setting new value of `csv-field-quotes': - (custom-set-default variable value))) - -(defun csv-set-quote-syntax (field-quotes) - "Set syntax for field quote characters FIELD-QUOTES to be \"string\". -FIELD-QUOTES should be a list of single-character strings." - (mapc (lambda (x) - (modify-syntax-entry - (string-to-char x) "\"" - ;; symbol-value to avoid compiler warning: - (symbol-value 'csv-mode-syntax-table))) - field-quotes)) - -(defvar csv-comment-start nil - "String that starts a comment line, or nil if no comment syntax. -Such comment lines are ignored by CSV mode commands. -This variable is buffer local\; its default value is that of -`csv-comment-start-default'. It is set by the function -`csv-set-comment-start' -- do not set it directly!") - -(make-variable-buffer-local 'csv-comment-start) - -(defcustom csv-comment-start-default "#" - "String that starts a comment line, or nil if no comment syntax. -Such comment lines are ignored by CSV mode commands. -Default value of buffer-local variable `csv-comment-start'. -Changing this variable does not affect any existing CSV mode buffer." - :type '(choice (const :tag "None" nil) string) - :set (lambda (variable value) - (custom-set-default variable value) - (setq-default csv-comment-start value))) - -(defcustom csv-align-style 'left - "Aligned field style: one of `left', `centre', `right' or `auto'. -Alignment style used by `csv-align-mode' and `csv-align-fields'. -Auto-alignment means left align text and right align numbers." - :type '(choice (const left) (const centre) - (const right) (const auto))) - -(defcustom csv-align-padding 1 - "Aligned field spacing: must be a positive integer. -Number of spaces used by `csv-align-mode' and `csv-align-fields' after separators." - :type 'integer) - -(defcustom csv-header-lines 0 - "Header lines to skip when setting region automatically." - :type 'integer) - -(defcustom csv-invisibility-default t - "If non-nil, make separators in aligned records invisible." - :type 'boolean) - -(defface csv-separator-face - '((t :inherit escape-glyph)) - "CSV mode face used to highlight separators.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) - -(defvar csv-descending nil - "If non-nil, CSV mode sort functions sort in order of descending sort key. -Usually they sort in order of ascending sort key.") - -(defun csv-toggle-descending () - "Toggle `csv-descending'." - (interactive) - (setq csv-descending (not csv-descending)) - (message "Sort order is %sscending" (if csv-descending "de" "a"))) - -(defun csv-toggle-invisibility () - ;; FIXME: Make it into a proper minor mode? - "Toggle `buffer-invisibility-spec'." - (interactive) - (if (memq 'csv buffer-invisibility-spec) - (remove-from-invisibility-spec 'csv) - (add-to-invisibility-spec 'csv)) - (message "Separators in aligned records will be %svisible \ -\(after re-aligning if soft\)" - (if (memq 'csv buffer-invisibility-spec) "in" "")) - (redraw-frame (selected-frame))) - -(easy-menu-define - csv-menu - csv-mode-map - "CSV major mode menu keymap" - '("CSV" - ["Sort By Field Lexicographically" csv-sort-fields :active t - :help "Sort lines in region lexicographically by the specified field"] - ["Sort By Field Numerically" csv-sort-numeric-fields :active t - :help "Sort lines in region numerically by the specified field"] - ["Reverse Order of Lines" csv-reverse-region :active t - :help "Reverse the order of the lines in the region"] - ["Use Descending Sort Order" csv-toggle-descending :active t - :style toggle :selected csv-descending - :help "If selected, use descending order when sorting"] - "--" - ["Kill Fields (Columns)" csv-kill-fields :active t - :help "Kill specified fields of each line in the region"] - ["Yank Fields (Columns)" csv-yank-fields :active t - :help "Yank killed fields as specified field of each line in region"] - ["Yank As New Table" csv-yank-as-new-table :active t - :help "Yank killed fields as a new table at point"] - ["Align Fields into Columns" csv-align-fields :active t - :help "Align the start of every field of each line in the region"] - ["Unalign Columns into Fields" csv-unalign-fields :active t - :help "Undo soft alignment and optionally remove redundant white space"] - ["Transpose Rows and Columns" csv-transpose :active t - :help "Rewrite rows (which may have different lengths) as columns"] - "--" - ["Forward Field" forward-sexp :active t - :help "Move forward across one field; with ARG, do it that many times"] - ["Backward Field" backward-sexp :active t - :help "Move backward across one field; with ARG, do it that many times"] - ["Kill Field Forward" kill-sexp :active t - :help "Kill field following cursor; with ARG, do it that many times"] - ["Kill Field Backward" backward-kill-sexp :active t - :help "Kill field preceding cursor; with ARG, do it that many times"] - "--" - ("Alignment Style" - ["Left" (setq csv-align-style 'left) :active t - :style radio :selected (eq csv-align-style 'left) - :help "If selected, `csv-align' left aligns fields"] - ["Centre" (setq csv-align-style 'centre) :active t - :style radio :selected (eq csv-align-style 'centre) - :help "If selected, `csv-align' centres fields"] - ["Right" (setq csv-align-style 'right) :active t - :style radio :selected (eq csv-align-style 'right) - :help "If selected, `csv-align' right aligns fields"] - ["Auto" (setq csv-align-style 'auto) :active t - :style radio :selected (eq csv-align-style 'auto) - :help "\ -If selected, `csv-align' left aligns text and right aligns numbers"] - ) - ["Set header line" csv-header-line :active t] - ["Auto-(re)align fields" csv-align-mode - :style toggle :selected csv-align-mode] - ["Show Current Field Index" csv-field-index-mode :active t - :style toggle :selected csv-field-index-mode - :help "If selected, display current field index in mode line"] - ["Make Separators Invisible" csv-toggle-invisibility :active t - :style toggle :selected (memq 'csv buffer-invisibility-spec) - :visible (not (tsv--mode-p)) - :help "If selected, separators in aligned records are invisible"] - ["Set Buffer's Comment Start" csv-set-comment-start :active t - :help "Set comment start string for this buffer"] - ["Customize CSV Mode" (customize-group 'CSV) :active t - :help "Open a customization buffer to change CSV mode options"] - )) - -(require 'sort) - -(defsubst csv-not-looking-at-record () - "Return t if looking at blank or comment line, nil otherwise. -Assumes point is at beginning of line." - (looking-at paragraph-separate)) - -(defun csv-interactive-args (&optional type) - "Get arg or field(s) and region interactively, offering sensible defaults. -Signal an error if the buffer is read-only. -If TYPE is noarg then return a list (beg end). -Otherwise, return a list (arg beg end), where arg is: - the raw prefix argument by default\; - a single field index if TYPE is single\; - a list of field indices or index ranges if TYPE is multiple. -Field defaults to the current prefix arg\; if not set, prompt user. - -A field index list consists of positive or negative integers or ranges, -separated by any non-integer characters. A range has the form m-n, -where m and n are positive or negative integers, m < n, and n defaults -to the last field index if omitted. - -In transient mark mode, if the mark is not active then automatically -select and highlight CSV records around point, and query user. -The default field when read interactively is the current field." - ;; Must be run interactively to activate mark! - (let* ((arg current-prefix-arg) (default-field 1) - (region - (if (not (use-region-p)) - ;; Set region automatically: - (save-excursion - (if arg - (beginning-of-line) - (let ((lbp (line-beginning-position))) - (while (re-search-backward csv-separator-regexp lbp 1) - ;; Move as far as possible, i.e. to beginning of line. - (setq default-field (1+ default-field))))) - (if (csv-not-looking-at-record) - (error "Point must be within CSV records")) - (let ((startline (point))) - ;; Set mark at beginning of region: - (while (not (or (bobp) (csv-not-looking-at-record))) - (forward-line -1)) - (if (csv-not-looking-at-record) (forward-line 1)) - ;; Skip header lines: - (forward-line csv-header-lines) - (set-mark (point)) ; OK since in save-excursion - ;; Move point to end of region: - (goto-char startline) - (beginning-of-line) - (while (not (or (eobp) (csv-not-looking-at-record))) - (forward-line 1)) - ;; Show mark briefly if necessary: - (unless (and (pos-visible-in-window-p) - (pos-visible-in-window-p (mark))) - (exchange-point-and-mark) - (sit-for 1) - (exchange-point-and-mark)) - (or (y-or-n-p "Region OK? ") - (error "Action aborted by user")) - (message nil) ; clear y-or-n-p message - (list (region-beginning) (region-end)))) - ;; Use region set by user: - (list (region-beginning) (region-end))))) - (setq default-field (number-to-string default-field)) - (cond - ((eq type 'multiple) - (if arg - ;; Ensure that field is a list: - (or (consp arg) - (setq arg (list (prefix-numeric-value arg)))) - ;; Read field interactively, ignoring non-integers: - (setq arg - (mapcar - (lambda (x) - (if (string-match "-" x 1) ; not first character - ;; Return a range as a pair - the cdr may be nil: - (let ((m (substring x 0 (match-beginning 0))) - (n (substring x (match-end 0)))) - (cons (car (read-from-string m)) - (and (not (string= n "")) - (car (read-from-string n))))) - ;; Return a number as a number: - (car (read-from-string x)))) - (split-string - (read-string - "Fields (sequence of integers or ranges): " default-field) - "[^-+0-9]+"))))) - ((eq type 'single) - (if arg - (setq arg (prefix-numeric-value arg)) - (while (not (integerp arg)) - (setq arg (eval-minibuffer "Field (integer): " default-field)))))) - (if (eq type 'noarg) region (cons arg region)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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 (memq (char-syntax (following-char)) csv-field-quotes) - (goto-char (scan-sexps (point) 1))) - (skip-chars-forward csv--skip-chars)) - -(defun csv-beginning-of-field () - "Skip backward over one field." - (skip-syntax-backward " ") - (if (memq (char-syntax (preceding-char)) csv-field-quotes) - (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 ((lbp (line-beginning-position)) (field 1)) - (while (re-search-backward csv-separator-regexp lbp 'move) - ;; Move as far as possible, i.e. to beginning of line. - (setq field (1+ field))) - (unless (csv-not-looking-at-record) 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-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 - (split-string - (buffer-substring-no-properties (point) lep) - csv-separator-regexp) - 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))))))) - -(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) - (setq header-line-format - '(: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 (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))))) - (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) - -(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-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) - (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 (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) - (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)) - -;;; 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)) - -;;;; ChangeLog: - -;; 2020-01-30 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: New TAB/backtab commands -;; -;; (csv-tab-command, csv-backtab-command): New commands. -;; (csv-mode-map): Bind them. -;; (csv-end-of-field, csv-beginning-of-field): Obey csv-field-quotes. -;; -;; 2019-10-22 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el (csv-align--cursor-truncated): Fix C-e -;; case -;; -;; 2019-10-22 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Auto-shorten columns as well -;; -;; (csv--column-widths): Also return the position of the widest field in -;; each column. -;; (csv-align-fields, csv--jit-align): Update accordingly. -;; (csv--jit-width-change): New function. -;; (csv--jit-merge-columns): Use it on overlays placed on the widest field -;; of each column, to detect when they're shortened. -;; -;; 2019-10-19 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: More cvs-align-mode improvements -;; -;; Rename csv-align-fields-* to cvs-align-*. -;; (csv-transpose): Use split-string. -;; (csv-split-string): Delete function. -;; (csv--config-column-widths): New var. -;; (csv-align--set-column): New function. -;; (csv-align-set-column-width): New command. -;; (csv--jit-align): Use them to obey the per-column width settings. Delay -;; context refresh by jit-lock-context-time. Set cursor-sensor-functions to -;; untruncate fields on-the-fly. -;; (csv-align--cursor-truncated): New function. -;; (csv-align-mode): Activate cursor-sensor-mode. -;; -;; 2019-10-19 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Fix incorrect truncation -;; -;; (csv--field-index): New function, extracted from csv-field-index. -;; (csv--jit-align): Don't apply csv-align-fields-max-width to the last -;; column. Fix move-to-column call. -;; -;; 2019-10-10 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Fix header-line's alignment -;; -;; (csv-header-line): Change csv--header-line into an overlay. Add a -;; modification-hooks to auto-refresh the header-line. -;; (csv--header-flush, csv--header-string): New functions. -;; (csv--compute-header-string): Make sure jit-lock was applied. -;; csv--header-hscroll can be nil sometimes somehow! -;; (csv--jit-flush, csv-align-fields-mode): Flush header-line as well. -;; (csv--jit-align): Flush header-line when applicable. Fix typo. -;; -;; 2019-10-09 Filipp Gunbin -;; -;; packages/csv-mode/csv-mode.el: Fix csv-align-fields doc -;; -;; (csv-align-fields): docstring mentioned csv-align-fields instead of -;; csv-align-padding -;; -;; 2019-09-29 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Remove Francis as maintainer -;; -;; (csv-unalign-fields): Also remove the `invisible` property since we use -;; it to truncate fields in csv--jit-align. -;; (csv-align-fields-max-width): Rename from csv-align-field-max-width to -;; match the "csv-align-fields" prefix. -;; (csv--ellipsis-width): New function. -;; (csv--jit-align): Use it to truncate more correctly. -;; -;; 2019-09-27 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el (csv-align-field-max-width): New var -;; -;; (csv--jit-unalign): Erase invisible property as well. -;; (csv--jit-align): Truncate field to fit within csv-align-field-max-width -;; when needed. -;; (csv-align-fields-mode): Add/remove `csv-truncate` to invisibility spec. -;; -;; 2019-09-27 Francis Wright -;; -;; * packages/csv-mode/csv-mode.el: Fix for customize-mode -;; -;; (csv-mode, tsv-mode): Specify :group explicitly for `customize-mode`s -;; benefit -;; -;; 2019-09-24 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Add tsv-mode and csv-align-fields-mode -;; -;; Require cl-lib. Don't set buffer-invisibility-spec directly. -;; (csv--skip-chars): Rename from misleading csv--skip-regexp. -;; (csv-mode): Set normal-auto-fill-function to really disable -;; auto-fill-mode. -;; (csv--column-widths): Only operate over new args beg..end. -;; (csv-align-fields): No need to narrow before csv--column-widths any -;; more. -;; (csv-align-fields-mode): New minor mode. -;; (tsv-mode): New major mode. -;; -;; 2019-09-18 Simen Heggestøyl -;; -;; Speed up 'csv-align-fields' -;; -;; * packages/csv-mode/csv-mode.el: Bump version number and make the -;; dependency on Emacs 24.1 or higher explicit. -;; (csv--column-widths): Return the field widths as well. -;; (csv-align-fields): Speed up by using the field widths already computed -;; by 'csv--column-widths' (bug#37393). -;; -;; 2017-12-05 Stefan Monnier -;; -;; * csv-mode/csv-mode.el (csv-header-line): New command -;; -;; (csv-menu): Add an entry for it. -;; (csv--header-line, csv--header-hscroll, csv--header-string): New vars. -;; (csv--compute-header-string): New function. -;; -;; 2016-07-11 Paul Eggert -;; -;; Fix some quoting problems in doc strings -;; -;; Most of these are minor issues involving, e.g., quoting `like this' -;; instead of 'like this'. A few involve escaping ` and ' with a preceding -;; \= when the characters should not be turned into curved single quotes. -;; -;; 2016-04-21 Leo Liu -;; -;; Fix csv-mode to delete its own overlays only -;; -;; * csv-mode/csv-mode.el (csv--make-overlay, csv--delete-overlay): New -;; functions. -;; (csv-align-fields, csv-unalign-fields, csv-transpose): Use them. -;; -;; 2016-03-04 Francis Wright -;; -;; * csv-mode/csv-mode.el: Remove out-of-date "URL:" header. -;; -;; 2016-03-03 Stefan Monnier -;; -;; * csv-mode, landmark: Fix maintainer's email -;; -;; 2015-07-09 Leo Liu -;; -;; Fix column width calculation in cvs-mode.el -;; -;; * csv-mode/cvs-mode.el (csv--column-widths, csv-align-fields): Fix -;; column width calculation. -;; -;; 2015-05-24 Leo Liu -;; -;; * csv-mode/cvs-mode.el (csv-set-comment-start): Handle nil. -;; -;; See also http://debbugs.gnu.org/20564. -;; -;; 2015-04-15 Stefan Monnier -;; -;; (csv-mode): Set mode-line-position rather than mode-line-format. -;; -;; Fixes: debbugs:20343 -;; -;; * csv-mode/csv-mode.el (csv-mode-line-format): Only keep the CSV part of -;; the mode line. -;; -;; 2014-01-15 Stefan Monnier -;; -;; * csv-mode (csv-mode-line-help-echo): Remove. -;; -;; 2013-04-24 Stefan Monnier -;; -;; * csv-mode.el (csv-kill-one-field): Check for presence before deleting -;; trailing separator. Remove last arg and turn into a function. -;; (csv-kill-one-column, csv-kill-many-columns): Adjust callers. -;; -;; 2012-10-22 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el (csv-end-of-field): Don't skip TABs. -;; (csv--skip-regexp): Rename from csv-skip-regexp. -;; -;; 2012-10-10 Stefan Monnier -;; -;; * csv-mode.el: Bump version number. -;; -;; 2012-10-10 Stefan Monnier -;; -;; * csv-mode.el: Use lexical-binding. Remove redundant :group args. -;; (csv-separators): Add TAB to the default. -;; (csv-invisibility-default): Change default to t. -;; (csv-separator-face): Inherit from escape-glyph. Remove variable. -;; (csv-mode-line-format): Remove trailing "--". Move next to line-number. -;; (csv-interactive-args): Use use-region-p. -;; (csv--column-widths): New function, extracted from csv-align-fields. -;; (csv-align-fields): Use it. Use whole buffer by default. Use :align-to -;; and text-properties when possible. -;; (csv-unalign-fields): Also remove properties. -;; (csv-mode): Truncate lines. -;; -;; 2012-03-24 Chong Yidong -;; -;; Commentary fix for quarter-plane.el. -;; -;; 2012-03-24 Chong Yidong -;; -;; Commentary tweaks for csv-mode, ioccur, and nhexl-mode packages. -;; -;; 2012-03-24 Chong Yidong -;; -;; csv-mode.el: Improve commentary. -;; -;; 2012-03-12 Stefan Monnier -;; -;; * packages/csv-mode/csv-mode.el: Minor installation cleanups. Fix up -;; copyright notice. Set version. -;; (csv-separators, csv-field-quotes): Fix calls to `error'. -;; (csv-mode-line-help-echo, csv-mode-line-format): Replace -;; mode-line-format for default-mode-line-format. -;; (csv-mode-map): Declare and initialize. -;; (csv-mode): Add autoload cookie. -;; (csv-set-comment-start): Make sure vars are made buffer-local. -;; (csv-field-index-mode, csv-field-index): Use derived-mode-p. -;; (csv-align-fields): Improve insertion types of overlay's markers. -;; -;; 2012-03-12 Stefan Monnier -;; -;; Add csv-mode.el. -;; - - - -(provide 'csv-mode) - -;;; csv-mode.el ends here diff --git a/elpa/csv-mode-1.22.signed b/elpa/csv-mode-1.22.signed new file mode 100644 index 00000000..1c32bfb9 --- /dev/null +++ b/elpa/csv-mode-1.22.signed @@ -0,0 +1 @@ +Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2023-02-08T23:05:02+0100 using RSA \ No newline at end of file diff --git a/elpa/csv-mode-1.22/csv-mode-autoloads.el b/elpa/csv-mode-1.22/csv-mode-autoloads.el new file mode 100644 index 00000000..2efe984a --- /dev/null +++ b/elpa/csv-mode-1.22/csv-mode-autoloads.el @@ -0,0 +1,81 @@ +;;; csv-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "csv-mode" "csv-mode.el" (0 0 0 0)) +;;; Generated autoloads from csv-mode.el + +(autoload 'csv-mode "csv-mode" "\ +Major mode for editing files of comma-separated value type. + +CSV mode is derived from `text-mode', and runs `text-mode-hook' before +running `csv-mode-hook'. It turns `auto-fill-mode' off by default. +CSV mode can be customized by user options in the CSV customization +group. The separators are specified by the value of `csv-separators'. + +CSV mode commands ignore blank lines and comment lines beginning with +the value of `csv-comment-start', which delimit \"paragraphs\". +\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp' +\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields. +Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]). + +If `font-lock-mode' is enabled then separators, quoted values and +comment lines are highlighted using respectively `csv-separator-face', +`font-lock-string-face' and `font-lock-comment-face'. + +The user interface (UI) for CSV mode commands is similar to that of +the standard commands `sort-fields' and `sort-numeric-fields', except +that if there is no prefix argument then the UI prompts for the field +index or indices. In `transient-mark-mode' only: if the region is not +set then the UI attempts to set it to include all consecutive CSV +records around point, and prompts for confirmation; if there is no +prefix argument then the UI prompts for it, offering as a default the +index of the field containing point if the region was not set +explicitly. The region set automatically is delimited by blank lines +and comment lines, and the number of header lines at the beginning of +the region given by the value of `csv-header-lines' are skipped. + +Sort order is controlled by `csv-descending'. + +CSV mode provides the following specific keyboard key bindings: + +\\{csv-mode-map} + +\(fn)" t nil) + +(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) + +(add-to-list 'auto-mode-alist '("\\.tsv\\'" . tsv-mode)) + +(autoload 'tsv-mode "csv-mode" "\ +Major mode for editing files of tab-separated value type. + +\(fn)" t nil) + +(register-definition-prefixes "csv-mode" '("csv-" "tsv-")) + +;;;*** + +;;;### (autoloads nil "csv-mode-tests" "csv-mode-tests.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from csv-mode-tests.el + +(register-definition-prefixes "csv-mode-tests" '("csv-tests--")) + +;;;*** + +;;;### (autoloads nil nil ("csv-mode-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; csv-mode-autoloads.el ends here diff --git a/elpa/csv-mode-1.22/csv-mode-pkg.el b/elpa/csv-mode-1.22/csv-mode-pkg.el new file mode 100644 index 00000000..e17c1a72 --- /dev/null +++ b/elpa/csv-mode-1.22/csv-mode-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from csv-mode.el -*- no-byte-compile: t -*- +(define-package "csv-mode" "1.22" "Major mode for editing comma/char separated values" '((emacs "27.1") (cl-lib "0.5")) :commit "db8a3e3aef31d35ce5bd1fd09127a3bbfdd0c340" :url "https://elpa.gnu.org/packages/csv-mode.html" :authors '(("\"Francis J. Wright\"" . "F.J.Wright@qmul.ac.uk")) :maintainer '(nil . "emacs-devel@gnu.org") :keywords '("convenience")) diff --git a/elpa/csv-mode-1.22/csv-mode-tests.el b/elpa/csv-mode-1.22/csv-mode-tests.el new file mode 100644 index 00000000..0caeab7d --- /dev/null +++ b/elpa/csv-mode-1.22/csv-mode-tests.el @@ -0,0 +1,148 @@ +;;; csv-mode-tests.el --- Tests for CSV mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc + +;; Author: Simen Heggestøyl +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'csv-mode) +(eval-when-compile (require 'subr-x)) + +(ert-deftest csv-tests-end-of-field () + (with-temp-buffer + (csv-mode) + (insert "aaa,bbb") + (goto-char (point-min)) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) "aaa")) + (forward-char) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) + "aaa,bbb")))) + +(ert-deftest csv-tests-end-of-field-with-quotes () + (with-temp-buffer + (csv-mode) + (insert "aaa,\"b,b\"") + (goto-char (point-min)) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) "aaa")) + (forward-char) + (csv-end-of-field) + (should (equal (buffer-substring (point-min) (point)) + "aaa,\"b,b\"")))) + +(ert-deftest csv-tests-beginning-of-field () + (with-temp-buffer + (csv-mode) + (insert "aaa,bbb") + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) "bbb")) + (backward-char) + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) + "aaa,bbb")))) + +(ert-deftest csv-tests-beginning-of-field-with-quotes () + (with-temp-buffer + (csv-mode) + (insert "aaa,\"b,b\"") + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) "\"b,b\"")) + (backward-char) + (csv-beginning-of-field) + (should (equal (buffer-substring (point) (point-max)) + "aaa,\"b,b\"")))) + +(defun csv-tests--align-fields (before after) + (with-temp-buffer + (insert (string-join before "\n")) + (csv-align-fields t (point-min) (point-max)) + (should (equal (buffer-string) (string-join after "\n"))))) + +(ert-deftest csv-tests-align-fields () + (csv-tests--align-fields + '("aaa,bbb,ccc" + "1,2,3") + '("aaa, bbb, ccc" + "1 , 2 , 3"))) + +(ert-deftest csv-tests-align-fields-with-quotes () + (csv-tests--align-fields + '("aaa,\"b,b\",ccc" + "1,2,3") + '("aaa, \"b,b\", ccc" + "1 , 2 , 3"))) + +;; Bug#14053 +(ert-deftest csv-tests-align-fields-double-quote-comma () + (csv-tests--align-fields + '("1,2,3" + "a,\"b\"\"c,\",d") + '("1, 2 , 3" + "a, \"b\"\"c,\", d"))) + +(defvar csv-tests--data + "1,4;Sun, 2022-04-10;4,12 +8;Mon, 2022-04-11;3,19 +3,2;Tue, 2022-04-12;1,00 +2;Wed, 2022-04-13;0,37 +9;Wed, 2022-04-13;0,37") + +(ert-deftest csv-tests-guess-separator () + (should-not (csv-guess-separator "")) + (should (= (csv-guess-separator csv-tests--data 3) ?,)) + (should (= (csv-guess-separator csv-tests--data) ?\;)) + (should (= (csv-guess-separator csv-tests--data) + (csv-guess-separator csv-tests--data + (length csv-tests--data))))) + +(ert-deftest csv-tests-separator-candidates () + (should-not (csv--separator-candidates "")) + (should-not (csv--separator-candidates csv-tests--data 0)) + (should + (equal (sort (csv--separator-candidates csv-tests--data 4) #'<) + '(?, ?\;))) + (should + (equal (sort (csv--separator-candidates csv-tests--data) #'<) + '(?\s ?, ?- ?\;))) + (should + (equal + (sort (csv--separator-candidates csv-tests--data) #'<) + (sort (csv--separator-candidates csv-tests--data + (length csv-tests--data)) + #'<)))) + +(ert-deftest csv-tests-separator-score () + (should (< (csv--separator-score ?, csv-tests--data) + (csv--separator-score ?\s csv-tests--data) + (csv--separator-score ?- csv-tests--data))) + (should (= (csv--separator-score ?- csv-tests--data) + (csv--separator-score ?\; csv-tests--data))) + (should (= 0 (csv--separator-score ?\; csv-tests--data 0))) + (should (= (csv--separator-score ?\; csv-tests--data) + (csv--separator-score ?\; csv-tests--data + (length csv-tests--data))))) + +(provide 'csv-mode-tests) +;;; csv-mode-tests.el ends here diff --git a/elpa/csv-mode-1.22/csv-mode.el b/elpa/csv-mode-1.22/csv-mode.el new file mode 100644 index 00000000..574050aa --- /dev/null +++ b/elpa/csv-mode-1.22/csv-mode.el @@ -0,0 +1,1959 @@ +;;; csv-mode.el --- Major mode for editing comma/char separated values -*- lexical-binding: t -*- + +;; Copyright (C) 2003-2023 Free Software Foundation, Inc + +;; Author: "Francis J. Wright" +;; Maintainer: emacs-devel@gnu.org +;; Version: 1.22 +;; Package-Requires: ((emacs "27.1") (cl-lib "0.5")) +;; Keywords: convenience + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package implements CSV mode, a major mode for editing records +;; in a generalized CSV (character-separated values) format. It binds +;; files with prefix ".csv" to `csv-mode' (and ".tsv" to `tsv-mode') in +;; `auto-mode-alist'. + +;; In CSV mode, the following commands are available: + +;; - C-c C-s (`csv-sort-fields') and C-c C-n (`csv-sort-numeric-fields') +;; respectively sort lexicographically and numerically on a +;; specified field or column. + +;; - C-c C-r (`csv-reverse-region') reverses the order. (These +;; commands are based closely on, and use, code in `sort.el'.) + +;; - C-c C-k (`csv-kill-fields') and C-c C-y (`csv-yank-fields') kill +;; and yank fields or columns, although they do not use the normal +;; kill ring. C-c C-k can kill more than one field at once, but +;; multiple killed fields can be yanked only as a fixed group +;; equivalent to a single field. + +;; - `csv-align-mode' keeps fields visually aligned, on-the-fly. +;; It truncates fields to a maximum width that can be changed per-column +;; with `csv-align-set-column-width'. +;; Alternatively, C-c C-a (`csv-align-fields') aligns fields into columns +;; and C-c C-u (`csv-unalign-fields') undoes such alignment; +;; separators can be hidden within aligned records (controlled by +;; `csv-invisibility-default' and `csv-toggle-invisibility'). + +;; - C-c C-t (`csv-transpose') interchanges rows and columns. For +;; details, see the documentation for the individual commands. + +;; - `csv-set-separator' sets the CSV separator of the current buffer, +;; while `csv-guess-set-separator' guesses and sets the separator +;; based on the current buffer's contents. +;; `csv-guess-set-separator' can be useful to add to the mode hook +;; to have CSV mode guess and set the separator automatically when +;; visiting a buffer: +;; +;; (add-hook 'csv-mode-hook 'csv-guess-set-separator) + +;; CSV mode can recognize fields separated by any of several single +;; characters, specified by the value of the customizable user option +;; `csv-separators'. CSV data fields can be delimited by quote +;; characters (and must if they contain separator characters). This +;; implementation supports quoted fields, where the quote characters +;; allowed are specified by the value of the customizable user option +;; `csv-field-quotes'. By default, the both commas and tabs are considered +;; as separators and the only field quote is a double quote. +;; These user options can be changed ONLY by customizing them, e.g. via M-x +;; customize-variable. + +;; CSV mode commands ignore blank lines and comment lines beginning +;; with the value of the buffer local variable `csv-comment-start', +;; which by default is #. The user interface is similar to that of +;; the standard commands `sort-fields' and `sort-numeric-fields', but +;; see the major mode documentation below. + +;; The global minor mode `csv-field-index-mode' provides display of +;; the current field index in the mode line, cf. `line-number-mode' +;; and `column-number-mode'. It is on by default. + +;;;; See also: + +;; the standard GNU Emacs 21 packages align.el, which will align +;; columns within a region, and delim-col.el, which helps to prettify +;; columns in a text region or rectangle; + +;; csv.el by Ulf Jasper , which provides +;; functions for reading/parsing comma-separated value files and is +;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in +;; the gnu.emacs.sources archives). + +;;; Installation: + +;; Put this file somewhere that Emacs can find it (i.e. in one of the +;; directories in your `load-path' such as `site-lisp'), optionally +;; byte-compile it (recommended), and put this in your .emacs file: +;; +;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) +;; (autoload 'csv-mode "csv-mode" +;; "Major mode for editing comma-separated value files." t) + +;;; News: + +;; Since 1.21: +;; - New command `csv-insert-column'. +;; - New config var `csv-align-min-width' for `csv-align-mode'. + +;; Since 1.9: +;; - `csv-align-mode' auto-aligns columns dynamically (on screen). + +;; Before that: +;; Begun on 15 November 2003 to provide lexicographic sorting of +;; simple CSV data by field and released as csv.el. Facilities to +;; kill multiple fields and customize separator added on 9 April 2004. +;; Converted to a major mode and renamed csv-mode.el on 10 April 2004, +;; partly at the suggestion of Stefan Monnier to avoid conflict with csv.el by Ulf Jasper. +;; Field alignment, comment support and CSV mode customization group +;; added on 1 May 2004. Support for index ranges added on 6 June +;; 2004. Multiple field separators added on 12 June 2004. +;; Transposition added on 22 June 2004. Separator invisibility added +;; on 23 June 2004. + +;;; To do (maybe): + +;; Make separators and quotes buffer-local and locally settable. +;; Support (La)TeX tables: set separator and comment; support record +;; end string. +;; Convert comma-separated to space- or tab-separated. + +;;; Code: + +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defgroup CSV nil + "Major mode for editing files of comma-separated value type." + :group 'convenience) + +(defvar csv-separator-chars nil + "Field separators as a list of character. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-separator-regexp nil + "Regexp to match a field separator. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv--skip-chars nil + "Char set used by `skip-chars-forward' etc. to skip fields. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-font-lock-keywords nil + "Font lock keywords to highlight the field separators in CSV mode. +Set by customizing `csv-separators' -- do not set directly!") + +(defcustom csv-separators '("," "\t") + "Field separators: a list of *single-character* strings. +For example: (\",\"), the default, or (\",\" \";\" \":\"). +Neighbouring fields may be separated by any one of these characters. +The first is used when inserting a field separator into the buffer. +All must be different from the field quote characters, `csv-field-quotes'. + +Changing this variable with `setq' won't affect the current Emacs +session. Use `customize-set-variable' instead if that is required." + ;; Suggested by Eckhard Neber + :type '(repeat string) + ;; FIXME: Character would be better, but in Emacs 21.3 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (/= (length x) 1) + (error "Non-single-char string %S" x)) + (if (and (boundp 'csv-field-quotes) + (member x csv-field-quotes)) + (error "%S is already a quote" x))) + value) + (custom-set-default variable value) + (setq csv-separator-chars (mapcar #'string-to-char value)) + (setq csv--skip-chars + (apply #'concat "^\n" + (mapcar (lambda (s) (concat "\\" s)) value))) + (setq csv-separator-regexp (regexp-opt value)) + (setq csv-font-lock-keywords + ;; NB: csv-separator-face variable evaluates to itself. + `((,csv-separator-regexp (0 'csv-separator-face)))))) + +(defcustom csv-field-quotes '("\"") + "Field quotes: a list of *single-character* strings. +For example: (\"\\\"\"), the default, or (\"\\\"\" \"\\='\" \"\\=`\"). +A field can be delimited by a pair of any of these characters. +All must be different from the field separators, `csv-separators'." + :type '(repeat string) + ;; Character would be better, but in Emacs 21 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (/= (length x) 1) + (error "Non-single-char string %S" x)) + (if (member x csv-separators) + (error "%S is already a separator" x))) + value) + (when (boundp 'csv-mode-syntax-table) + ;; FIRST remove old quote syntax: + (with-syntax-table text-mode-syntax-table + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) + (string (char-syntax (string-to-char x))) + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + csv-field-quotes)) + ;; THEN set new quote syntax: + (csv-set-quote-syntax value)) + ;; BEFORE setting new value of `csv-field-quotes': + (custom-set-default variable value))) + +(defun csv-set-quote-syntax (field-quotes) + "Set syntax for field quote characters FIELD-QUOTES to be \"string\". +FIELD-QUOTES should be a list of single-character strings." + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) "\"" + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + field-quotes)) + +(defvar csv-comment-start nil + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +This variable is buffer local; its default value is that of +`csv-comment-start-default'. It is set by the function +`csv-set-comment-start' -- do not set it directly!") + +(make-variable-buffer-local 'csv-comment-start) + +(defcustom csv-comment-start-default "#" + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +Default value of buffer-local variable `csv-comment-start'. +Changing this variable does not affect any existing CSV mode buffer." + :type '(choice (const :tag "None" nil) string) + :set (lambda (variable value) + (custom-set-default variable value) + (setq-default csv-comment-start value))) + +(defcustom csv-align-style 'left + "Aligned field style: one of `left', `centre', `right' or `auto'. +Alignment style used by `csv-align-mode' and `csv-align-fields'. +Auto-alignment means left align text and right align numbers." + :type '(choice (const left) (const centre) + (const right) (const auto))) + +(defcustom csv-align-padding 1 + "Aligned field spacing: must be a positive integer. +Number of spaces used by `csv-align-mode' and `csv-align-fields' +after separators." + :type 'integer) + +(defcustom csv-header-lines 0 + "Header lines to skip when setting region automatically." + :type 'integer) + +(defcustom csv-invisibility-default t + "If non-nil, make separators in aligned records invisible." + :type 'boolean) + +(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)) + (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))))) + +(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) + (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