auto-install/csv-mode.el

   1 ;;; csv-mode.el --- major mode for editing comma-separated value files
   2
   3 ;; Copyright (C) 2003, 2004 Francis J. Wright
   4
   5 ;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk>
   6 ;; Time-stamp: <23 August 2004>
   7 ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/
   8 ;; Version: $Id: csv-mode.el,v 1.50 2004/08/23 17:51:26 fjw Exp $
   9 ;; Keywords: convenience
  10
  11 ;; This file is not part of GNU Emacs.
  12
  13 ;; This package is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This package is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This package is intended for use with GNU Emacs 21 (only) and
  31 ;; implements the following commands to process records of CSV
  32 ;; (comma-separated value) type: `csv-sort-fields' and
  33 ;; `csv-sort-numeric-fields' sort respectively lexicographically and
  34 ;; numerically on a specified field or column; `csv-reverse-region'
  35 ;; reverses the order.  They are based closely on, and use, code in
  36 ;; `sort.el'.  `csv-kill-fields' and `csv-yank-fields' respectively
  37 ;; kill and yank fields or columns, although they do not use the
  38 ;; normal kill ring.  `csv-kill-fields' can kill more than one field
  39 ;; at once, but multiple killed fields can be yanked only as a fixed
  40 ;; group equivalent to a single field.  `csv-align-fields' aligns
  41 ;; fields into columns; `csv-unalign-fields' undoes such alignment;
  42 ;; separators can be hidden within aligned records.  `csv-transpose'
  43 ;; interchanges rows and columns.  For details, see the documentation
  44 ;; for the individual commands.
  45
  46 ;; CSV mode supports a generalised comma-separated values format
  47 ;; (character-separated values) in which the fields can be separated
  48 ;; by any of several single characters, specified by the value of the
  49 ;; customizable user option `csv-separators'.  CSV data fields can be
  50 ;; delimited by quote characters (and must if they contain separator
  51 ;; characters).  This implementation supports quoted fields, where the
  52 ;; quote characters allowed are specified by the value of the
  53 ;; customizable user option `csv-field-quotes'.  By default, the only
  54 ;; separator is a comma and the only field quote is a double quote.
  55 ;; These user options can be changed ONLY by CUSTOMIZING them,
  56 ;; e.g. via the command `customize-variable'.
  57
  58 ;; CSV mode commands ignore blank lines and comment lines beginning
  59 ;; with the value of the buffer local variable `csv-comment-start',
  60 ;; which by default is #.  The user interface is similar to that of
  61 ;; the standard commands `sort-fields' and `sort-numeric-fields', but
  62 ;; see the major mode documentation below.
  63
  64 ;; The global minor mode `csv-field-index-mode' provides display of
  65 ;; the current field index in the mode line, cf. `line-number-mode'
  66 ;; and `column-number-mode'.  It is on by default.
  67
  68 ;;; Installation:
  69
  70 ;; Put this file somewhere that Emacs can find it (i.e. in one of the
  71 ;; directories in your `load-path' such as `site-lisp'), optionally
  72 ;; byte-compile it (recommended), and put this in your .emacs file:
  73 ;;
  74 ;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
  75 ;; (autoload 'csv-mode "csv-mode"
  76 ;;   "Major mode for editing comma-separated value files." t)
  77
  78 ;;; History:
  79
  80 ;; Begun on 15 November 2003 to provide lexicographic sorting of
  81 ;; simple CSV data by field and released as csv.el.  Facilities to
  82 ;; kill multiple fields and customize separator added on 9 April 2004.
  83 ;; Converted to a major mode and renamed csv-mode.el on 10 April 2004,
  84 ;; partly at the suggestion of Stefan Monnier <monnier at
  85 ;; IRO.UMontreal.CA> to avoid conflict with csv.el by Ulf Jasper.
  86 ;; Field alignment, comment support and CSV mode customization group
  87 ;; added on 1 May 2004.  Support for index ranges added on 6 June
  88 ;; 2004.  Multiple field separators added on 12 June 2004.
  89 ;; Transposition added on 22 June 2004.  Separator invisibility added
  90 ;; on 23 June 2004.
  91
  92 ;;; See also:
  93
  94 ;; the standard GNU Emacs 21 packages align.el, which will align
  95 ;; columns within a region, and delim-col.el, which helps to prettify
  96 ;; columns in a text region or rectangle;
  97
  98 ;; csv.el by Ulf Jasper <ulf.jasper at web.de>, which provides
  99 ;; functions for reading/parsing comma-separated value files and is
 100 ;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in
 101 ;; the gnu.emacs.sources archives).
 102
 103 ;;; To do (maybe):
 104
 105 ;; Make separators and quotes buffer-local and locally settable.
 106 ;; Support (La)TeX tables: set separator and comment; support record
 107 ;; end string.
 108 ;; Convert comma-separated to space- or tab-separated.
 109
 110 ;;; Code:
 111
 112 (defgroup CSV nil
 113   "Major mode for editing files of comma-separated value type."
 114   :group 'convenience)
 115
 116 (defvar csv-separator-chars nil
 117   "Field separators as a list of character.
 118 Set by customizing `csv-separators' -- do not set directly!")
 119
 120 (defvar csv-separator-regexp nil
 121   "Regexp to match a field separator.
 122 Set by customizing `csv-separators' -- do not set directly!")
 123
 124 (defvar csv-skip-regexp nil
 125   "Regexp used by `skip-chars-forward' etc. to skip fields.
 126 Set by customizing `csv-separators' -- do not set directly!")
 127
 128 (defvar csv-font-lock-keywords nil
 129   "Font lock keywords to highlight the field separators in CSV mode.
 130 Set by customizing `csv-separators' -- do not set directly!")
 131
 132 (defcustom csv-separators '(",")
 133   "Field separators: a list of *single-character* strings.
 134 For example: (\",\"), the default, or (\",\" \";\" \":\").
 135 Neighbouring fields may be separated by any one of these characters.
 136 The first is used when inserting a field separator into the buffer.
 137 All must be different from the field quote characters, `csv-field-quotes'."
 138   ;; Suggested by Eckhard Neber <neber@mwt.e-technik.uni-ulm.de>
 139   :group 'CSV
 140   :type '(repeat string)
 141   ;; Character would be better, but in Emacs 21.3 does not display
 142   ;; correctly in a customization buffer.
 143   :set (lambda (variable value)
 144          (mapc (lambda (x)
 145                  (if (or (/= (length x) 1)
 146                          (and (boundp 'csv-field-quotes)
 147                               (member x csv-field-quotes)))
 148                      (error)))
 149                value)
 150          (custom-set-default variable value)
 151          (setq csv-separator-chars (mapcar 'string-to-char value)
 152                csv-skip-regexp (apply 'concat "^\n" csv-separators)
 153                csv-separator-regexp (apply 'concat `("[" ,@value "]"))
 154                csv-font-lock-keywords
 155                ;; NB: csv-separator-face variable evaluates to itself.
 156                `((,csv-separator-regexp . csv-separator-face)))))
 157
 158 (defcustom csv-field-quotes '("\"")
 159   "Field quotes: a list of *single-character* strings.
 160 For example: (\"\\\"\"), the default, or (\"\\\"\" \"'\" \"`\").
 161 A field can be delimited by a pair of any of these characters.
 162 All must be different from the field separators, `csv-separators'."
 163   :group 'CSV
 164   :type '(repeat string)
 165   ;; Character would be better, but in Emacs 21 does not display
 166   ;; correctly in a customization buffer.
 167   :set (lambda (variable value)
 168          (mapc (lambda (x)
 169                  (if (or (/= (length x) 1)
 170                          (member x csv-separators))
 171                      (error)))
 172                value)
 173          (when (boundp 'csv-mode-syntax-table)
 174            ;; FIRST remove old quote syntax:
 175            (with-syntax-table text-mode-syntax-table
 176              (mapc (lambda (x)
 177                      (modify-syntax-entry
 178                       (string-to-char x)
 179                       (string (char-syntax (string-to-char x)))
 180                       ;; symbol-value to avoid compiler warning:
 181                       (symbol-value 'csv-mode-syntax-table)))
 182                    csv-field-quotes))
 183            ;; THEN set new quote syntax:
 184            (csv-set-quote-syntax value))
 185          ;; BEFORE setting new value of `csv-field-quotes':
 186          (custom-set-default variable value)))
 187
 188 (defun csv-set-quote-syntax (field-quotes)
 189   "Set syntax for field quote characters FIELD-QUOTES to be \"string\".
 190 FIELD-QUOTES should be a list of single-character strings."
 191   (mapc (lambda (x)
 192           (modify-syntax-entry
 193            (string-to-char x) "\""
 194            ;; symbol-value to avoid compiler warning:
 195            (symbol-value 'csv-mode-syntax-table)))
 196         field-quotes))
 197
 198 (defvar csv-comment-start nil
 199   "String that starts a comment line, or nil if no comment syntax.
 200 Such comment lines are ignored by CSV mode commands.
 201 This variable is buffer local\; its default value is that of
 202 `csv-comment-start-default'.  It is set by the function
 203 `csv-set-comment-start' -- do not set it directly!")
 204
 205 (make-variable-buffer-local 'csv-comment-start)
 206
 207 (defcustom csv-comment-start-default "#"
 208   "String that starts a comment line, or nil if no comment syntax.
 209 Such comment lines are ignored by CSV mode commands.
 210 Default value of buffer-local variable `csv-comment-start'.
 211 Changing this variable does not affect any existing CSV mode buffer."
 212   :group 'CSV
 213   :type '(choice (const :tag "None" nil) string)
 214   :set (lambda (variable value)
 215          (custom-set-default variable value)
 216          (set-default 'csv-comment-start value)))
 217
 218 (defcustom csv-align-style 'left
 219   "Aligned field style: one of 'left, 'centre, 'right or 'auto.
 220 Alignment style used by `csv-align-fields'.
 221 Auto-alignment means left align text and right align numbers."
 222   :group 'CSV
 223   :type '(choice (const left) (const centre)
 224                  (const right) (const auto)))
 225
 226 (defcustom csv-align-padding 1
 227   "Aligned field spacing: must be a positive integer.
 228 Number of spaces used by `csv-align-fields' after separators."
 229   :group 'CSV
 230   :type 'integer)
 231
 232 (defcustom csv-header-lines 0
 233   "Header lines to skip when setting region automatically."
 234   :group 'CSV
 235   :type 'integer)
 236
 237 (defcustom csv-invisibility-default nil
 238   "If non-nil, make separators in aligned records invisible."
 239   :group 'CSV
 240   :type 'boolean)
 241
 242 (defface csv-separator-face
 243   '((((class color)) (:foreground "red"))
 244     (t (:weight bold)))
 245   "CSV mode face used to highlight separators."
 246   :group 'CSV)
 247
 248 ;; This mechanism seems to keep XEmacs happy:
 249 (defvar csv-separator-face 'csv-separator-face
 250   "Face name to use to highlight separators.")
 251
 252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 253 ;;;  Mode definition, key bindings and menu
 254 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 255
 256 (defconst csv-mode-line-help-echo
 257   ;; See bindings.el for details of `mode-line-format' construction.
 258   (get-text-property 0 'help-echo (car default-mode-line-format))
 259   "Primary default mode line help echo text.")
 260
 261 (defconst csv-mode-line-format
 262   ;; See bindings.el for details of `mode-line-format' construction.
 263   (append (butlast default-mode-line-format 2)
 264           (cons `(csv-field-index-string
 265                   ("" csv-field-index-string
 266                    ,(propertize "--" 'help-echo csv-mode-line-help-echo)))
 267                 (last default-mode-line-format 2)))
 268   "Mode line format string for CSV mode.")
 269
 270 (define-derived-mode csv-mode text-mode "CSV"
 271   "Major mode for editing files of comma-separated value type.
 272
 273 CSV mode is derived from `text-mode', and runs `text-mode-hook' before
 274 running `csv-mode-hook'.  It turns `auto-fill-mode' off by default.
 275 CSV mode can be customized by user options in the CSV customization
 276 group.  The separators are specified by the value of `csv-separators'.
 277
 278 CSV mode commands ignore blank lines and comment lines beginning with
 279 the value of `csv-comment-start', which delimit \"paragraphs\".
 280 \"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp'
 281 \(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields.
 282 Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]).
 283
 284 If `font-lock-mode' is enabled then separators, quoted values and
 285 comment lines are highlighted using respectively `csv-separator-face',
 286 `font-lock-string-face' and `font-lock-comment-face'.
 287
 288 The user interface (UI) for CSV mode commands is similar to that of
 289 the standard commands `sort-fields' and `sort-numeric-fields', except
 290 that if there is no prefix argument then the UI prompts for the field
 291 index or indices.  In `transient-mark-mode' only: if the region is not
 292 set then the UI attempts to set it to include all consecutive CSV
 293 records around point, and prompts for confirmation; if there is no
 294 prefix argument then the UI prompts for it, offering as a default the
 295 index of the field containing point if the region was not set
 296 explicitly.  The region set automatically is delimited by blank lines
 297 and comment lines, and the number of header lines at the beginning of
 298 the region given by the value of `csv-header-lines' are skipped.
 299
 300 Sort order is controlled by `csv-descending'.
 301
 302 CSV mode provides the following specific keyboard key bindings:
 303
 304 \\{csv-mode-map}"
 305   (turn-off-auto-fill)
 306   ;; Set syntax for field quotes:
 307   (csv-set-quote-syntax csv-field-quotes)
 308   ;; Make sexp functions apply to fields:
 309   (set (make-local-variable 'forward-sexp-function) 'csv-forward-field)
 310   ;; Paragraph means a group of contiguous records:
 311   (make-local-variable 'paragraph-separate)
 312   (make-local-variable 'paragraph-start)
 313   ;; Comment support:
 314   (make-local-variable 'comment-start)
 315   (csv-set-comment-start csv-comment-start)
 316   (setq
 317    ;; Font locking -- separator plus syntactic:
 318    font-lock-defaults '(csv-font-lock-keywords)
 319    buffer-invisibility-spec csv-invisibility-default
 320    ;; Mode line to support `csv-field-index-mode':
 321    mode-line-format csv-mode-line-format)
 322   ;; Enable or disable `csv-field-index-mode' (could probably do this
 323   ;; a bit more efficiently):
 324   (csv-field-index-mode (symbol-value 'csv-field-index-mode)))
 325
 326 (defun csv-set-comment-start (string)
 327   "Set comment start for this CSV mode buffer to STRING.
 328 It must be either a string or nil."
 329   (interactive
 330    (list (edit-and-eval-command
 331           "Comment start (string or nil): " csv-comment-start)))
 332   (setq csv-comment-start string
 333         paragraph-separate "[:space:]*$" ; white space
 334         paragraph-start "\n")           ; must include \n explicitly!
 335   (if string
 336       (progn
 337         (setq paragraph-separate (concat paragraph-separate "\\|" string)
 338               paragraph-start (concat paragraph-start "\\|" string)
 339               comment-start string)
 340         (modify-syntax-entry
 341          (string-to-char string) "<" csv-mode-syntax-table)
 342         (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
 343     (with-syntax-table text-mode-syntax-table
 344       (modify-syntax-entry (string-to-char string)
 345                            (string (char-syntax (string-to-char string)))
 346                            csv-mode-syntax-table)
 347       (modify-syntax-entry ?\n
 348                            (string (char-syntax ?\n))
 349                            csv-mode-syntax-table))))
 350
 351 (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
 352
 353 (define-key csv-mode-map [(control ?c) (control ?v)] 'csv-toggle-invisibility)
 354 (define-key csv-mode-map [(control ?c) (control ?t)] 'csv-transpose)
 355 (define-key csv-mode-map [(control ?c) (control ?c)] 'csv-set-comment-start)
 356 (define-key csv-mode-map [(control ?c) (control ?u)] 'csv-unalign-fields)
 357 (define-key csv-mode-map [(control ?c) (control ?a)] 'csv-align-fields)
 358 (define-key csv-mode-map [(control ?c) (control ?z)] 'csv-yank-as-new-table)
 359 (define-key csv-mode-map [(control ?c) (control ?y)] 'csv-yank-fields)
 360 (define-key csv-mode-map [(control ?c) (control ?k)] 'csv-kill-fields)
 361 (define-key csv-mode-map [(control ?c) (control ?d)] 'csv-toggle-descending)
 362 (define-key csv-mode-map [(control ?c) (control ?r)] 'csv-reverse-region)
 363 (define-key csv-mode-map [(control ?c) (control ?n)] 'csv-sort-numeric-fields)
 364 (define-key csv-mode-map [(control ?c) (control ?s)] 'csv-sort-fields)
 365
 366 (defvar csv-descending nil
 367   "If non-nil, CSV mode sort functions sort in order of descending sort key.
 368 Usually they sort in order of ascending sort key.")
 369
 370 (defun csv-toggle-descending ()
 371   "Toggle `csv-descending'."
 372   (interactive)
 373   (setq csv-descending (not csv-descending))
 374   (message "Sort order is %sscending" (if csv-descending "de" "a")))
 375
 376 (defun csv-toggle-invisibility ()
 377   "Toggle `buffer-invisibility-spec'."
 378   (interactive)
 379   (setq buffer-invisibility-spec (not buffer-invisibility-spec))
 380   (message "Separators in aligned records will be %svisible \
 381 \(after re-aligning if soft\)"
 382            (if buffer-invisibility-spec "in" ""))
 383   (redraw-frame (selected-frame)))
 384
 385 (easy-menu-define
 386   csv-menu
 387   csv-mode-map
 388   "CSV major mode menu keymap"
 389   '("CSV"
 390     ["Sort By Field Lexicographically" csv-sort-fields :active t
 391      :help "Sort lines in region lexicographically by the specified field"]
 392     ["Sort By Field Numerically" csv-sort-numeric-fields :active t
 393      :help "Sort lines in region numerically by the specified field"]
 394     ["Reverse Order of Lines" csv-reverse-region :active t
 395      :help "Reverse the order of the lines in the region"]
 396     ["Use Descending Sort Order" csv-toggle-descending :active t
 397      :style toggle :selected csv-descending
 398      :help "If selected, use descending order when sorting"]
 399     "--"
 400     ["Kill Fields (Columns)" csv-kill-fields :active t
 401      :help "Kill specified fields of each line in the region"]
 402     ["Yank Fields (Columns)" csv-yank-fields :active t
 403      :help "Yank killed fields as specified field of each line in region"]
 404     ["Yank As New Table" csv-yank-as-new-table :active t
 405      :help "Yank killed fields as a new table at point"]
 406     ["Align Fields into Columns" csv-align-fields :active t
 407      :help "Align the start of every field of each line in the region"]
 408     ["Unalign Columns into Fields" csv-unalign-fields :active t
 409      :help "Undo soft alignment and optionally remove redundant white space"]
 410     ["Transpose Rows and Columns" csv-transpose :active t
 411      :help "Rewrite rows (which may have different lengths) as columns"]
 412     "--"
 413     ["Forward Field" forward-sexp :active t
 414      :help "Move forward across one field\; with ARG, do it that many times"]
 415     ["Backward Field" backward-sexp :active t
 416      :help "Move backward across one field\; with ARG, do it that many times"]
 417     ["Kill Field Forward" kill-sexp :active t
 418      :help "Kill field following cursor\; with ARG, do it that many times"]
 419     ["Kill Field Backward" backward-kill-sexp :active t
 420      :help "Kill field preceding cursor\; with ARG, do it that many times"]
 421     "--"
 422     ("Alignment Style"
 423      ["Left" (setq csv-align-style 'left) :active t
 424       :style radio :selected (eq csv-align-style 'left)
 425       :help "If selected, `csv-align-fields' left aligns fields"]
 426      ["Centre" (setq csv-align-style 'centre) :active t
 427       :style radio :selected (eq csv-align-style 'centre)
 428       :help "If selected, `csv-align-fields' centres fields"]
 429      ["Right" (setq csv-align-style 'right) :active t
 430       :style radio :selected (eq csv-align-style 'right)
 431       :help "If selected, `csv-align-fields' right aligns fields"]
 432      ["Auto" (setq csv-align-style 'auto) :active t
 433       :style radio :selected (eq csv-align-style 'auto)
 434       :help "\
 435 If selected, `csv-align-fields' left aligns text and right aligns numbers"]
 436      )
 437     ["Show Current Field Index" csv-field-index-mode :active t
 438      :style toggle :selected csv-field-index-mode
 439      :help "If selected, display current field index in mode line"]
 440     ["Make Separators Invisible" csv-toggle-invisibility :active t
 441      :style toggle :selected buffer-invisibility-spec
 442      :help "If selected, separators in aligned records are invisible"]
 443     ["Set Buffer's Comment Start" csv-set-comment-start :active t
 444      :help "Set comment start string for this buffer"]
 445     ["Customize CSV Mode" (customize-group 'CSV) :active t
 446      :help "Open a customization buffer to change CSV mode options"]
 447     ))
 448
 449 (require 'sort)
 450
 451 (defsubst csv-not-looking-at-record ()
 452   "Return t if looking at blank or comment line, nil otherwise.
 453 Assumes point is at beginning of line."
 454   (looking-at paragraph-separate))
 455
 456 (defun csv-interactive-args (&optional type)
 457   "Get arg or field(s) and region interactively, offering sensible defaults.
 458 Signal an error if the buffer is read-only.
 459 If TYPE is noarg then return a list `(beg end)'.
 460 Otherwise, return a list `(arg beg end)', where arg is:
 461   the raw prefix argument by default\;
 462   a single field index if TYPE is single\;
 463   a list of field indices or index ranges if TYPE is multiple.
 464 Field defaults to the current prefix arg\; if not set, prompt user.
 465
 466 A field index list consists of positive or negative integers or ranges,
 467 separated by any non-integer characters.  A range has the form m-n,
 468 where m and n are positive or negative integers, m < n, and n defaults
 469 to the last field index if omitted.
 470
 471 In transient mark mode, if the mark is not active then automatically
 472 select and highlight CSV records around point, and query user.
 473 The default field when read interactively is the current field."
 474   ;; Must be run interactively to activate mark!
 475   (let* ((arg current-prefix-arg) (default-field 1)
 476          (region
 477           (if (and transient-mark-mode (not mark-active))
 478               ;; Set region automatically:
 479               (save-excursion
 480                 (let (startline lbp)
 481                   (if arg
 482                       (beginning-of-line)
 483                     (setq lbp (line-beginning-position))
 484                     (while (re-search-backward csv-separator-regexp lbp 1)
 485                       ;; Move as far as possible, i.e. to beginning of line.
 486                       (setq default-field (1+ default-field))))
 487                   (if (csv-not-looking-at-record)
 488                       (error "Point may not be within CSV records"))
 489                   (setq startline (point))
 490                   ;; Set mark at beginning of region:
 491                   (while (not (or (bobp) (csv-not-looking-at-record)))
 492                     (forward-line -1))
 493                   (if (csv-not-looking-at-record) (forward-line 1))
 494                   ;; Skip header lines:
 495                   (forward-line csv-header-lines)
 496                   (set-mark (point))    ; OK since in save-excursion
 497                   ;; Move point to end of region:
 498                   (goto-char startline)
 499                   (beginning-of-line)
 500                   (while (not (or (eobp) (csv-not-looking-at-record)))
 501                     (forward-line 1))
 502                   ;; Show mark briefly if necessary:
 503                   (unless (and (pos-visible-in-window-p)
 504                                (pos-visible-in-window-p (mark)))
 505                     (exchange-point-and-mark)
 506                     (sit-for 1)
 507                     (exchange-point-and-mark))
 508                   (or (y-or-n-p "Region OK? ")
 509                       (error "Action aborted by user"))
 510                   (message nil)         ; clear y-or-n-p message
 511                   (list (region-beginning) (region-end))))
 512             ;; Use region set by user:
 513             (list (region-beginning) (region-end)))))
 514     (setq default-field (number-to-string default-field))
 515     (cond
 516      ((eq type 'multiple)
 517       (if arg
 518           ;; Ensure that field is a list:
 519           (or (consp arg)
 520               (setq arg (list (prefix-numeric-value arg))))
 521         ;; Read field interactively, ignoring non-integers:
 522         (setq arg
 523               (mapcar
 524                (lambda (x)
 525                  (if (string-match "-" x 1) ; not first character
 526                      ;; Return a range as a pair - the cdr may be nil:
 527                      (let ((m (substring x 0 (match-beginning 0)))
 528                            (n (substring x (match-end 0))))
 529                        (cons (car (read-from-string m))
 530                              (and (not (string= n ""))
 531                                   (car (read-from-string n)))))
 532                    ;; Return a number as a number:
 533                    (car (read-from-string x))))
 534                (split-string
 535                 (read-string
 536                  "Fields (sequence of integers or ranges): " default-field)
 537                 "[^-+0-9]+")))))
 538      ((eq type 'single)
 539       (if arg
 540           (setq arg (prefix-numeric-value arg))
 541         (while (not (integerp arg))
 542           (setq arg (eval-minibuffer "Field (integer): " default-field))))))
 543     (if (eq type 'noarg) region (cons arg region))))
 544
 545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 546 ;;;  Sorting by field
 547 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 548
 549 (defun csv-nextrecfun ()
 550   "Called by `csv-sort-fields-1' with point at end of previous record.
 551 It moves point to the start of the next record.
 552 It should move point to the end of the buffer if there are no more records."
 553   (forward-line)
 554   (while (and (not (eobp)) (csv-not-looking-at-record))
 555     (forward-line)))
 556
 557 (defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun)
 558   "Modified version of `sort-fields-1' that skips blank or comment lines.
 559
 560 FIELD is a single field index, and BEG and END specify the region to
 561 sort.
 562
 563 STARTKEYFUN moves from the start of the record to the start of the key.
 564 It may return either a non-nil value to be used as the key, or
 565 else the key is the substring between the values of point after
 566 STARTKEYFUN and ENDKEYFUN are called.  If STARTKEYFUN is nil, the key
 567 starts at the beginning of the record.
 568
 569 ENDKEYFUN moves from the start of the sort key to the end of the sort key.
 570 ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
 571 same as ENDRECFUN."
 572   (let ((tbl (syntax-table)))
 573     (if (zerop field) (setq field 1))
 574     (unwind-protect
 575         (save-excursion
 576           (save-restriction
 577             (narrow-to-region beg end)
 578             (goto-char (point-min))
 579             (set-syntax-table sort-fields-syntax-table)
 580             (sort-subr csv-descending
 581                        'csv-nextrecfun 'end-of-line
 582                        startkeyfun endkeyfun)))
 583       (set-syntax-table tbl))))
 584
 585 (defun csv-sort-fields (field beg end)
 586   "Sort lines in region lexicographically by the ARGth field of each line.
 587 If not set, the region defaults to the CSV records around point.
 588 Fields are separated by `csv-separators' and null fields are allowed anywhere.
 589 Field indices increase from 1 on the left or decrease from -1 on the right.
 590 A prefix argument specifies a single field, otherwise prompt for field index.
 591 Ignore blank and comment lines.  The variable `sort-fold-case'
 592 determines whether alphabetic case affects the sort order.
 593 When called non-interactively, FIELD is a single field index\;
 594 BEG and END specify the region to sort."
 595   ;; (interactive "*P\nr")
 596   (interactive (csv-interactive-args 'single))
 597   (barf-if-buffer-read-only)
 598   (csv-sort-fields-1 field beg end
 599                      (lambda () (csv-sort-skip-fields field) nil)
 600                      (lambda () (skip-chars-forward csv-skip-regexp))))
 601
 602 (defun csv-sort-numeric-fields (field beg end)
 603   "Sort lines in region numerically by the ARGth field of each line.
 604 If not set, the region defaults to the CSV records around point.
 605 Fields are separated by `csv-separators'.
 606 Null fields are allowed anywhere and sort as zeros.
 607 Field indices increase from 1 on the left or decrease from -1 on the right.
 608 A prefix argument specifies a single field, otherwise prompt for field index.
 609 Specified non-null field must contain a number in each line of the region,
 610 which may begin with \"0x\" or \"0\" for hexadecimal and octal values.
 611 Otherwise, the number is interpreted according to sort-numeric-base.
 612 Ignore blank and comment lines.
 613 When called non-interactively, FIELD is a single field index\;
 614 BEG and END specify the region to sort."
 615   ;; (interactive "*P\nr")
 616   (interactive (csv-interactive-args 'single))
 617   (barf-if-buffer-read-only)
 618   (csv-sort-fields-1 field beg end
 619                  (lambda ()
 620                    (csv-sort-skip-fields field)
 621                    (let* ((case-fold-search t)
 622                           (base
 623                            (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
 624                                (cond ((match-beginning 1)
 625                                       (goto-char (match-end 1))
 626                                       16)
 627                                      ((match-beginning 2)
 628                                       (goto-char (match-end 2))
 629                                       8)
 630                                      (t nil)))))
 631                      (string-to-number (buffer-substring (point)
 632                                                          (save-excursion
 633                                                            (forward-sexp 1)
 634                                                            (point)))
 635                                        (or base sort-numeric-base))))
 636                  nil))
 637
 638 (defun csv-reverse-region (beg end)
 639   "Reverse the order of the lines in the region.
 640 This is just a CSV-mode style interface to `reverse-region', which is
 641 the function that should be used non-interactively.  It takes two
 642 point or marker arguments, BEG and END, delimiting the region."
 643   ;; (interactive "*P\nr")
 644   (interactive (csv-interactive-args 'noarg))
 645   (barf-if-buffer-read-only)
 646   (reverse-region beg end))
 647
 648 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 649 ;;;  Moving by field
 650 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 651
 652 (defsubst csv-end-of-field ()
 653   "Skip forward over one field."
 654   (skip-syntax-forward " ")
 655   (if (eq (char-syntax (following-char)) ?\")
 656       (goto-char (scan-sexps (point) 1)))
 657   (skip-chars-forward csv-skip-regexp))
 658
 659 (defsubst csv-beginning-of-field ()
 660   "Skip backward over one field."
 661   (skip-syntax-backward " ")
 662   (if (eq (char-syntax (preceding-char)) ?\")
 663       (goto-char (scan-sexps (point) -1)))
 664   (skip-chars-backward csv-skip-regexp))
 665
 666 (defun csv-forward-field (arg)
 667   "Move forward across one field, cf. `forward-sexp'.
 668 With ARG, do it that many times.  Negative arg -N means
 669 move backward across N fields."
 670   (interactive "p")
 671   (if (< arg 0)
 672       (csv-backward-field (- arg))
 673     (while (>= (setq arg (1- arg)) 0)
 674       (if (or (bolp)
 675               (when (and (not (eobp)) (eolp)) (forward-char) t))
 676           (while (and (not (eobp)) (csv-not-looking-at-record))
 677             (forward-line 1)))
 678       (if (memq (following-char) csv-separator-chars) (forward-char))
 679       (csv-end-of-field))))
 680
 681 (defun csv-backward-field (arg)
 682   "Move backward across one field, cf. `backward-sexp'.
 683 With ARG, do it that many times.  Negative arg -N means
 684 move forward across N fields."
 685   (interactive "p")
 686   (if (< arg 0)
 687       (csv-forward-field (- arg))
 688     (while (>= (setq arg (1- arg)) 0)
 689       (when (or (eolp)
 690                 (when (and (not (bobp)) (bolp)) (backward-char) t))
 691         (while (progn
 692                  (beginning-of-line)
 693                  (csv-not-looking-at-record))
 694           (backward-char))
 695         (end-of-line))
 696       (if (memq (preceding-char) csv-separator-chars) (backward-char))
 697       (csv-beginning-of-field))))
 698
 699 (defun csv-sort-skip-fields (n &optional yank)
 700   "Position point at the beginning of field N on the current line.
 701 Fields are separated by `csv-separators'\; null terminal field allowed.
 702 Assumes point is initially at the beginning of the line.
 703 YANK non-nil allows N to be greater than the number of fields, in
 704 which case extend the record as necessary."
 705   (if (> n 0)
 706       ;; Skip across N - 1 fields.
 707       (let ((i (1- n)))
 708         (while (> i 0)
 709           (csv-end-of-field)
 710           (if (eolp)
 711               (if yank
 712                   (if (> i 1) (insert (car csv-separators)))
 713                 (error "Line has too few fields: %s"
 714                        (buffer-substring
 715                         (save-excursion (beginning-of-line) (point))
 716                         (save-excursion (end-of-line) (point)))))
 717             (forward-char))             ; skip separator
 718           (setq i (1- i))))
 719     (end-of-line)
 720     ;; Skip back across -N - 1 fields.
 721     (let ((i (1- (- n))))
 722       (while (> i 0)
 723         (csv-beginning-of-field)
 724         (if (bolp)
 725             (error "Line has too few fields: %s"
 726                    (buffer-substring
 727                     (save-excursion (beginning-of-line) (point))
 728                     (save-excursion (end-of-line) (point)))))
 729         (backward-char)                 ; skip separator
 730         (setq i (1- i)))
 731       ;; Position at the front of the field
 732       ;; even if moving backwards.
 733       (csv-beginning-of-field))))
 734
 735 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 736 ;;;  Field index mode
 737 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 738
 739 ;; Based partly on paren.el
 740
 741 (defcustom csv-field-index-delay 0.125
 742   "Time in seconds to delay before updating field index display."
 743   :group 'CSV
 744   :type '(number :tag "seconds"))
 745
 746 (defvar csv-field-index-idle-timer nil)
 747
 748 (defvar csv-field-index-string nil)
 749 (make-variable-buffer-local 'csv-field-index-string)
 750
 751 (defvar csv-field-index-old nil)
 752 (make-variable-buffer-local 'csv-field-index-old)
 753
 754 (define-minor-mode csv-field-index-mode
 755   "Toggle CSV-Field-Index mode.
 756 With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive.
 757 Returns the new status of CSV-Field-Index mode (non-nil means on).
 758 When CSV-Field-Index mode is enabled, the current field index appears in
 759 the mode line after `csv-field-index-delay' seconds of Emacs idle time."
 760   :group 'CSV
 761   :global t
 762   :init-value t                ; for documentation, since default is t
 763   ;; This macro generates a function that first sets the mode
 764   ;; variable, then runs the following code, runs the mode hooks,
 765   ;; displays a message if interactive, updates the mode line and
 766   ;; finally returns the variable value.
 767
 768   ;; First, always disable the mechanism (to avoid having two timers):
 769   (when csv-field-index-idle-timer
 770     (cancel-timer csv-field-index-idle-timer)
 771     (setq csv-field-index-idle-timer nil))
 772   ;; Now, if the mode is on and any buffer is in CSV mode then
 773   ;; re-initialize and enable the mechanism by setting up a new timer:
 774   (if csv-field-index-mode
 775       (if (memq t (mapcar (lambda (buffer)
 776                             (with-current-buffer buffer
 777                               (when (eq major-mode 'csv-mode)
 778                                 (setq csv-field-index-string nil
 779                                       csv-field-index-old nil)
 780                                 t)))
 781                           (buffer-list)))
 782           (setq csv-field-index-idle-timer
 783                 (run-with-idle-timer csv-field-index-delay t
 784                                      'csv-field-index)))
 785     ;; but if the mode is off then remove the display from the mode
 786     ;; lines of all CSV buffers:
 787     (mapc (lambda (buffer)
 788             (with-current-buffer buffer
 789               (when (eq major-mode 'csv-mode)
 790                 (setq csv-field-index-string nil
 791                       csv-field-index-old nil)
 792                 (force-mode-line-update))))
 793             (buffer-list))))
 794
 795 (defun csv-field-index ()
 796   "Construct `csv-field-index-string' to display in mode line.
 797 Called by `csv-field-index-idle-timer'."
 798   (if (eq major-mode 'csv-mode)
 799       (save-excursion
 800         (let ((lbp (line-beginning-position)) (field 1))
 801           (while (re-search-backward csv-separator-regexp lbp 1)
 802             ;; Move as far as possible, i.e. to beginning of line.
 803             (setq field (1+ field)))
 804           (if (csv-not-looking-at-record) (setq field nil))
 805           (when (not (eq field csv-field-index-old))
 806             (setq csv-field-index-old field
 807                   csv-field-index-string
 808                   (and field (propertize (format "F%d" field)
 809                                          'help-echo csv-mode-line-help-echo)))
 810             (force-mode-line-update))))))
 811
 812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 813 ;;;  Killing and yanking fields
 814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 815
 816 (defvar csv-killed-fields nil
 817   "A list of the fields or sub-records last killed by `csv-kill-fields'.")
 818
 819 (defun csv-kill-fields (fields beg end)
 820   "Kill specified fields of each line in the region.
 821 If not set, the region defaults to the CSV records around point.
 822 Fields are separated by `csv-separators' and null fields are allowed anywhere.
 823 Field indices increase from 1 on the left or decrease from -1 on the right.
 824 The fields are stored for use by `csv-yank-fields'.  Fields can be
 825 specified in any order but are saved in increasing index order.
 826 Ignore blank and comment lines.
 827
 828 When called interactively, a prefix argument specifies a single field,
 829 otherwise prompt for a field list, which may include ranges in the form
 830 m-n, where m < n and n defaults to the last field index if omitted.
 831
 832 When called non-interactively, FIELDS is a single field index or a
 833 list of field indices, with ranges specified as (m.n) or (m), and BEG
 834 and END specify the region to process."
 835   ;; (interactive "*P\nr")
 836   (interactive (csv-interactive-args 'multiple))
 837   (barf-if-buffer-read-only)
 838   ;; Kill the field(s):
 839   (setq csv-killed-fields nil)
 840   (save-excursion
 841     (save-restriction
 842       (narrow-to-region beg end)
 843       (goto-char (point-min))
 844       (if (or (cdr fields) (consp (car fields)))
 845           (csv-kill-many-columns fields)
 846         (csv-kill-one-column (car fields)))))
 847   (setq csv-killed-fields (nreverse csv-killed-fields)))
 848
 849 (defmacro csv-kill-one-field (field killed-fields)
 850   "Kill field with index FIELD in current line.
 851 Save killed field by `push'ing onto KILLED-FIELDS.
 852 Assumes point is at beginning of line.
 853 Called by `csv-kill-one-column' and `csv-kill-many-columns'."
 854   `(progn
 855      ;; Move to start of field to kill:
 856      (csv-sort-skip-fields ,field)
 857      ;; Kill to end of field (cf. `kill-region'):
 858      (push (delete-and-extract-region
 859             (point)
 860             (progn (csv-end-of-field) (point)))
 861            ,killed-fields)
 862      (if (eolp) (delete-char -1)    ; delete trailing separator at eol
 863        (delete-char 1))))           ; or following separator otherwise
 864
 865 (defun csv-kill-one-column (field)
 866   "Kill field with index FIELD in all lines in (narrowed) buffer.
 867 Save killed fields in `csv-killed-fields'.
 868 Assumes point is at `point-min'.  Called by `csv-kill-fields'.
 869 Ignore blank and comment lines."
 870   (while (not (eobp))
 871     (or (csv-not-looking-at-record)
 872         (csv-kill-one-field field csv-killed-fields))
 873     (forward-line)))
 874
 875 (defun csv-kill-many-columns (fields)
 876   "Kill several fields in all lines in (narrowed) buffer.
 877 FIELDS is an unordered list of field indices.
 878 Save killed fields in increasing index order in `csv-killed-fields'.
 879 Assumes point is at `point-min'.  Called by `csv-kill-fields'.
 880 Ignore blank and comment lines."
 881   (if (eolp) (error "First record is empty"))
 882   ;; Convert non-positive to positive field numbers:
 883   (let ((last 1) (f fields))
 884     (csv-end-of-field)
 885     (while (not (eolp))
 886       (forward-char)                    ; skip separator
 887       (csv-end-of-field)
 888       (setq last (1+ last)))         ; last = # fields in first record
 889     (while f
 890       (cond ((consp (car f))
 891              ;; Expand a field range: (m.n) -> m m+1 ... n-1 n.
 892              ;; If n is nil then it defaults to the number of fields.
 893              (let* ((range (car f)) (cdrf (cdr f))
 894                     (m (car range)) (n (cdr range)))
 895                (if (< m 0) (setq m (+ m last 1)))
 896                (if n
 897                    (if (< n 0) (setq n (+ n last 1)))
 898                  (setq n last))
 899                (setq range (list n))
 900                (while (> n m) (push (setq n (1- n)) range))
 901                (setcar f (car range))
 902                (setcdr f (cdr range))
 903                (setcdr (setq f (last range)) cdrf)))
 904             ((zerop (car f)) (setcar f 1))
 905             ((< (car f) 0) (setcar f (+ f last 1))))
 906       (setq f (cdr f))))
 907   (goto-char (point-min))
 908   ;; Kill from right to avoid miscounting:
 909   (setq fields (sort fields '>))
 910   (while (not (eobp))
 911     (or (csv-not-looking-at-record)
 912         (let ((fields fields) killed-fields field)
 913           (while fields
 914             (setq field (car fields)
 915                   fields (cdr fields))
 916             (beginning-of-line)
 917             (csv-kill-one-field field killed-fields))
 918           (push (mapconcat 'identity killed-fields (car csv-separators))
 919                 csv-killed-fields)))
 920     (forward-line)))
 921
 922 (defun csv-yank-fields (field beg end)
 923   "Yank fields as the ARGth field of each line in the region.
 924 ARG may be arbitrarily large and records are extended as necessary.
 925 If not set, the region defaults to the CSV records around point\;
 926 if point is not in a CSV record then offer to yank as a new table.
 927 The fields yanked are those last killed by `csv-kill-fields'.
 928 Fields are separated by `csv-separators' and null fields are allowed anywhere.
 929 Field indices increase from 1 on the left or decrease from -1 on the right.
 930 A prefix argument specifies a single field, otherwise prompt for field index.
 931 Ignore blank and comment lines.  When called non-interactively, FIELD
 932 is a single field index\; BEG and END specify the region to process."
 933   ;; (interactive "*P\nr")
 934   (interactive (condition-case err
 935                    (csv-interactive-args 'single)
 936                  (error (list nil nil err))))
 937   (barf-if-buffer-read-only)
 938   (if (null beg)
 939       (if (y-or-n-p (concat (error-message-string end)
 940                             ".  Yank as a new table? "))
 941           (csv-yank-as-new-table)
 942         (error (error-message-string end)))
 943     (if (<= field 0) (setq field (1+ field)))
 944     (save-excursion
 945       (save-restriction
 946         (narrow-to-region beg end)
 947         (goto-char (point-min))
 948         (let ((fields csv-killed-fields))
 949           (while (not (eobp))
 950             (unless (csv-not-looking-at-record)
 951               ;; Yank at start of specified field if possible,
 952               ;; otherwise yank at end of record:
 953               (if (zerop field)
 954                   (end-of-line)
 955                 (csv-sort-skip-fields field 'yank))
 956               (and (eolp) (insert (car csv-separators)))
 957               (when fields
 958                 (insert (car fields))
 959                 (setq fields (cdr fields)))
 960               (or (eolp) (insert (car csv-separators))))
 961             (forward-line)))))))
 962
 963 (defun csv-yank-as-new-table ()
 964   "Yank fields as a new table starting at point.
 965 The fields yanked are those last killed by `csv-kill-fields'."
 966   (interactive "*")
 967   (let ((fields csv-killed-fields))
 968     (while fields
 969       (insert (car fields) ?\n)
 970       (setq fields (cdr fields)))))
 971
 972 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 973 ;;;  Aligning fields
 974 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 975
 976 (defun csv-align-fields (hard beg end)
 977   "Align all the fields in the region to form columns.
 978 The alignment style is specified by `csv-align-style'.  The number of
 979 spaces specified by `csv-align-fields' appears after each separator.
 980 Use soft alignment done by displaying virtual white space after the
 981 separators unless invoked with an argument, in which case insert real
 982 space characters into the buffer after the separators.
 983 Unalign first (see `csv-unalign-fields').  Ignore blank and comment lines.
 984
 985 In hard-aligned records, separators become invisible whenever
 986 `buffer-invisibility-spec' is non-nil.  In soft-aligned records, make
 987 separators invisible if and only if `buffer-invisibility-spec' is
 988 non-nil when the records are aligned\; this can be changed only by
 989 re-aligning.  \(Unaligning always makes separators visible.)
 990
 991 When called non-interactively, use hard alignment if HARD is non-nil\;
 992 BEG and END specify the region to align."
 993   (interactive (csv-interactive-args))
 994   (setq end (set-marker (make-marker) end))
 995   (csv-unalign-fields hard beg end) ; if hard then barfs if buffer read only
 996   (save-excursion
 997     (save-restriction
 998       (narrow-to-region beg end)
 999       (set-marker end nil)
1000       (goto-char (point-min))
1001       (let (widths)
1002         ;; Construct list of column widths:
1003         (while (not (eobp))             ; for each record...
1004           (or (csv-not-looking-at-record)
1005               (let ((w widths) x)
1006                 (setq beg (point))      ; beginning of current field
1007                 (while (not (eolp))
1008                   (csv-end-of-field)
1009                   (setq x (- (point) beg)) ; field width
1010                   (if w
1011                       (if (> x (car w)) (setcar w x))
1012                     (setq w (list x)
1013                           widths (nconc widths w)))
1014                   (or (eolp) (forward-char)) ; skip separator
1015                   (setq w (cdr w)
1016                         beg (point)))))
1017           (forward-line))
1018
1019         ;; Align fields:
1020         (goto-char (point-min))
1021         (while (not (eobp))             ; for each record...
1022           (or (csv-not-looking-at-record)
1023               (let ((w widths) (padding 0) x)
1024                 (setq beg (point))      ; beginning of current field
1025                 (while (and w (not (eolp)))
1026                   (let ((left-padding 0) (right-padding 0) overlay)
1027                     (csv-end-of-field)
1028                     (set-marker end (point)) ; end of current field
1029                     (setq x (- (point) beg) ; field width
1030                           x (- (car w) x)) ; required padding
1031
1032                     ;; beg = beginning of current field
1033                     ;; end = (point) = end of current field
1034
1035                     ;; Compute required padding:
1036                     (cond
1037                      ((eq csv-align-style 'left)
1038                       ;; Left align -- pad on the right:
1039                       (setq left-padding csv-align-padding
1040                             right-padding x))
1041                      ((eq csv-align-style 'right)
1042                       ;; Right align -- pad on the left:
1043                       (setq left-padding (+ csv-align-padding x)))
1044                      ((eq csv-align-style 'auto)
1045                       ;; Auto align -- left align text, right align numbers:
1046                       (if (string-match "\\`[-+.[:digit:]]+\\'"
1047                                         (buffer-substring beg (point)))
1048                           ;; Right align -- pad on the left:
1049                           (setq left-padding (+ csv-align-padding x))
1050                         ;; Left align -- pad on the right:
1051                         (setq left-padding csv-align-padding
1052                               right-padding x)))
1053                      ((eq csv-align-style 'centre)
1054                       ;; Centre -- pad on both left and right:
1055                       (let ((y (/ x 2))) ; truncated integer quotient
1056                         (setq left-padding (+ csv-align-padding y)
1057                               right-padding (- x y)))))
1058
1059                     (if hard
1060                         ;; Hard alignment...
1061                         (progn
1062                           (when (> left-padding 0) ; pad on the left
1063                             ;; Insert spaces before field:
1064                             (if (= beg end) ; null field
1065                                 (insert (make-string left-padding ?\ ))
1066                               (goto-char beg) ; beginning of current field
1067                               (insert (make-string left-padding ?\ ))
1068                               (goto-char end))) ; end of current field
1069                           (unless (eolp)
1070                             (if (> right-padding 0) ; pad on the right
1071                                 ;; Insert spaces after field:
1072                                 (insert (make-string right-padding ?\ )))
1073                             ;; Make separator (potentially) invisible;
1074                             ;; in Emacs 21.3, neighbouring overlays
1075                             ;; conflict, so use the following only
1076                             ;; with hard alignment:
1077                             (overlay-put (make-overlay (point) (1+ (point)))
1078                                          ;; 'face 'secondary-selection) ; test
1079                                          'invisible t)
1080                             (forward-char))) ; skip separator
1081
1082                       ;; Soft alignment...
1083
1084                       (if buffer-invisibility-spec ; csv-hide-separators
1085
1086                           ;; Hide separators...
1087                           (progn
1088                             ;; Merge right-padding from previous field
1089                             ;; with left-padding from this field:
1090                             (setq padding (+ padding left-padding))
1091                             (when (> padding 0)
1092                               (goto-char beg) ; beginning of current field
1093                               (if (bolp)
1094                                   ;; Display spaces before first field
1095                                   ;; by overlaying first character:
1096                                   (overlay-put
1097                                    (make-overlay (point) (1+ (point)))
1098                                    'before-string
1099                                    (make-string padding ?\ ))
1100                                 ;; Display separator as spaces:
1101                                 (overlay-put
1102                                    (make-overlay (1- (point)) (point))
1103                                    ;; 'face 'secondary-selection)) ; test
1104                                    ;; 'display (make-string padding ?\ )))
1105                                    ;; Above 'display mangles buffer
1106                                    ;; horribly if any string is empty!
1107                                    'display `(space :width ,padding)))
1108                               (goto-char end)) ; end of current field
1109                             (unless (eolp)
1110                               (setq padding right-padding)
1111                               (forward-char))) ; skip separator
1112
1113                         ;; Do not hide separators...
1114                         (when (> left-padding 0) ; pad on the left
1115                           ;; Display spaces before field:
1116                           (setq overlay (make-overlay beg (point)))
1117                           (overlay-put overlay 'before-string
1118                                        (make-string left-padding ?\ )))
1119                         (unless (eolp)
1120                           (if (> right-padding 0) ; pad on the right
1121                               ;; Display spaces after field:
1122                               (overlay-put
1123                                (or overlay
1124                                    (make-overlay beg (point)))
1125                                'after-string (make-string right-padding ?\ )))
1126                           (forward-char))) ; skip separator
1127
1128                       ))
1129
1130                   (setq w (cdr w)
1131                         beg (point)))))
1132           (forward-line)))))
1133   (set-marker end nil))
1134
1135 (defun csv-unalign-fields (hard beg end)
1136   "Undo soft alignment and optionally remove redundant white space.
1137 Undo soft alignment introduced by `csv-align-fields'.  If invoked with
1138 an argument then also remove all spaces and tabs around separators.
1139 Also make all invisible separators visible again.
1140 Ignore blank and comment lines.  When called non-interactively, remove
1141 spaces and tabs if HARD non-nil\; BEG and END specify region to unalign."
1142   (interactive (csv-interactive-args))
1143   ;; Remove any soft alignment:
1144   (mapc 'delete-overlay (overlays-in beg end))
1145   (when hard
1146     (barf-if-buffer-read-only)
1147     ;; Remove any white-space padding around separators:
1148     (save-excursion
1149       (save-restriction
1150         (narrow-to-region beg end)
1151         (goto-char (point-min))
1152         (while (not (eobp))
1153           (or (csv-not-looking-at-record)
1154               (while (not (eolp))
1155                 ;; Delete horizontal white space forward:
1156                 ;; (delete-horizontal-space)
1157                 ;; This relies on left-to-right argument evaluation;
1158                 ;; see info node (elisp) Function Forms.
1159                 (delete-region (point)
1160                                (+ (point) (skip-chars-forward " \t")))
1161                 (csv-end-of-field)
1162                 ;; Delete horizontal white space backward:
1163                 ;; (delete-horizontal-space t)
1164                 (delete-region (point)
1165                                (+ (point) (skip-chars-backward " \t")))
1166                 (or (eolp) (forward-char))))
1167           (forward-line))))))
1168
1169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1170 ;;;  Transposing rows and columns
1171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1172
1173 (defun csv-transpose (beg end)
1174   "Rewrite rows (which may have different lengths) as columns.
1175 Null fields are introduced as necessary within records but are
1176 stripped from the ends of records.  Preserve soft alignment.
1177 This function is its own inverse.  Ignore blank and comment lines.
1178 When called non-interactively, BEG and END specify region to process."
1179   ;; (interactive "*P\nr")
1180   (interactive (csv-interactive-args 'noarg))
1181   (barf-if-buffer-read-only)
1182   (save-excursion
1183     (save-restriction
1184       (narrow-to-region beg end)
1185       (goto-char (point-min))
1186       ;; Delete rows and collect them as a reversed list of lists of
1187       ;; fields, skipping comment and blank lines:
1188       (let ((sep (car csv-separators))
1189             (align (overlays-in beg end))
1190             rows columns)
1191         ;; Remove soft alignment if necessary:
1192         (when align
1193           (mapc 'delete-overlay align)
1194           (setq align t))
1195         (while (not (eobp))
1196           (if (csv-not-looking-at-record)
1197               ;; Skip blank and comment lines:
1198               (forward-line)
1199             (let ((lep (line-end-position)))
1200               (push
1201                (csv-split-string
1202                 (buffer-substring-no-properties (point) lep)
1203                 csv-separator-regexp nil t)
1204                rows)
1205               (delete-region (point) lep)
1206               (or (eobp) (delete-char 1)))))
1207         ;; Rows must have monotonic decreasing lengths to be
1208         ;; transposable, so ensure this by padding with null fields.
1209         ;; rows is currently a reversed list of field lists, which
1210         ;; must therefore have monotonic increasing lengths.
1211         (let ((oldlen (length (car rows))) newlen
1212               (r (cdr rows)))
1213           (while r
1214             (setq newlen (length (car r)))
1215             (if (< newlen oldlen)
1216                 (nconc (car r) (make-list (- oldlen newlen) nil))
1217               (setq oldlen newlen))
1218             (setq r (cdr r))))
1219         ;; Collect columns as a reversed list of lists of fields:
1220         (while rows
1221           (let (column (r rows) row)
1222             (while r
1223               (setq row (car r))
1224               ;; Provided it would not be a trailing null field, push
1225               ;; field onto column:
1226               (if (or column (string< "" (car row)))
1227                   (push (car row) column))
1228               ;; Pop field off row:
1229               (setcar r (cdr row))
1230               ;; If row is now empty then remove it:
1231               (or (car r) (setq rows (cdr rows)))
1232               (setq r (cdr r)))
1233             (push column columns)))
1234         ;; Insert columns into buffer as rows:
1235         (setq columns (nreverse columns))
1236         (while columns
1237           (insert (mapconcat 'identity (car columns) sep) ?\n)
1238           (setq columns (cdr columns)))
1239         ;; Re-do soft alignment if necessary:
1240         (if align (csv-align-fields nil (point-min) (point-max)))))))
1241
1242 ;; The following generalised version of `split-string' is taken from
1243 ;; the development version of WoMan and should probably replace the
1244 ;; standard version in subr.el.  However, CSV mode (currently) needs
1245 ;; only the `allowbeg' option.
1246
1247 (defun csv-split-string
1248   (string &optional separators subexp allowbeg allowend)
1249   "Splits STRING into substrings where there are matches for SEPARATORS.
1250 Each match for SEPARATORS is a splitting point.
1251 The substrings between the splitting points are made into a list
1252 which is returned.
1253 If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
1254 SUBEXP specifies a subexpression of SEPARATORS to be the splitting
1255 point\; it defaults to 0.
1256
1257 If there is a match for SEPARATORS at the beginning of STRING, we do
1258 not include a null substring for that, unless ALLOWBEG is non-nil.
1259 Likewise, if there is a match at the end of STRING, we do not include
1260 a null substring for that, unless ALLOWEND is non-nil.
1261
1262 Modifies the match data; use `save-match-data' if necessary."
1263   (or subexp (setq subexp 0))
1264   (let ((rexp (or separators "[ \f\t\n\r\v]+"))
1265         (start 0)
1266         notfirst
1267         (list nil))
1268     (while (and (string-match rexp string
1269                               (if (and notfirst
1270                                        (= start (match-beginning subexp))
1271                                        (< start (length string)))
1272                                   (1+ start) start))
1273                 (< (match-beginning subexp) (length string)))
1274       (setq notfirst t)
1275       (or (and (not allowbeg) (eq (match-beginning subexp) 0))
1276           (and (eq (match-beginning subexp) (match-end subexp))
1277                (eq (match-beginning subexp) start))
1278           (push (substring string start (match-beginning subexp)) list))
1279       (setq start (match-end subexp)))
1280     (or (and (not allowend) (eq start (length string)))
1281         (push (substring string start) list))
1282     (nreverse list)))
1283
1284 (provide 'csv-mode)
1285
1286 ;;; csv-mode.el ends here