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