]> code.delx.au - gnu-emacs-elpa/blob - packages/csv-mode/csv-mode.el
dbc6182b42eb4e691b120034cf4349fa0c2557f6
[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, 2013 Free Software Foundation, Inc
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: 1.2
9 ;; Keywords: convenience
10
11 ;; This package is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; any later version.
15
16 ;; This package is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This package implements CSV mode, a major mode for editing records
27 ;; in a generalized CSV (character-separated values) format. It binds
28 ;; finds with prefix ".csv" to `csv-mode' in `auto-mode-alist'.
29
30 ;; In CSV mode, the following commands are available:
31
32 ;; - C-c C-s (`csv-sort-fields') and C-c C-n (`csv-sort-numeric-fields')
33 ;; respectively sort lexicographically and numerically on a
34 ;; specified field or column.
35
36 ;; - C-c C-r (`csv-reverse-region') reverses the order. (These
37 ;; commands are based closely on, and use, code in `sort.el'.)
38
39 ;; - C-c C-k (`csv-kill-fields') and C-c C-y (`csv-yank-fields') kill
40 ;; and yank fields or columns, although they do not use the normal
41 ;; kill ring. C-c C-k can kill more than one field at once, but
42 ;; multiple killed fields can be yanked only as a fixed group
43 ;; equivalent to a single field.
44
45 ;; - C-c C-a (`csv-align-fields') aligns fields into columns
46
47 ;; - C-c C-u (`csv-unalign-fields') undoes such alignment; separators
48 ;; can be hidden within aligned records.
49
50 ;; - C-c C-t (`csv-transpose') interchanges rows and columns. For
51 ;; details, see the documentation for the individual commands.
52
53 ;; CSV mode can recognize fields separated by any of several single
54 ;; characters, specified by the value of the customizable user option
55 ;; `csv-separators'. CSV data fields can be delimited by quote
56 ;; characters (and must if they contain separator characters). This
57 ;; implementation supports quoted fields, where the quote characters
58 ;; allowed are specified by the value of the customizable user option
59 ;; `csv-field-quotes'. By default, the only separator is a comma and
60 ;; the only field quote is a double quote. These user options can be
61 ;; changed ONLY by customizing them, e.g. via M-x customize-variable.
62
63 ;; CSV mode commands ignore blank lines and comment lines beginning
64 ;; with the value of the buffer local variable `csv-comment-start',
65 ;; which by default is #. The user interface is similar to that of
66 ;; the standard commands `sort-fields' and `sort-numeric-fields', but
67 ;; see the major mode documentation below.
68
69 ;; The global minor mode `csv-field-index-mode' provides display of
70 ;; the current field index in the mode line, cf. `line-number-mode'
71 ;; and `column-number-mode'. It is on by default.
72
73 ;;; Installation:
74
75 ;; Put this file somewhere that Emacs can find it (i.e. in one of the
76 ;; directories in your `load-path' such as `site-lisp'), optionally
77 ;; byte-compile it (recommended), and put this in your .emacs file:
78 ;;
79 ;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
80 ;; (autoload 'csv-mode "csv-mode"
81 ;; "Major mode for editing comma-separated value files." t)
82
83 ;;; History:
84
85 ;; Begun on 15 November 2003 to provide lexicographic sorting of
86 ;; simple CSV data by field and released as csv.el. Facilities to
87 ;; kill multiple fields and customize separator added on 9 April 2004.
88 ;; Converted to a major mode and renamed csv-mode.el on 10 April 2004,
89 ;; partly at the suggestion of Stefan Monnier <monnier at
90 ;; IRO.UMontreal.CA> to avoid conflict with csv.el by Ulf Jasper.
91 ;; Field alignment, comment support and CSV mode customization group
92 ;; added on 1 May 2004. Support for index ranges added on 6 June
93 ;; 2004. Multiple field separators added on 12 June 2004.
94 ;; Transposition added on 22 June 2004. Separator invisibility added
95 ;; on 23 June 2004.
96
97 ;;; See also:
98
99 ;; the standard GNU Emacs 21 packages align.el, which will align
100 ;; columns within a region, and delim-col.el, which helps to prettify
101 ;; columns in a text region or rectangle;
102
103 ;; csv.el by Ulf Jasper <ulf.jasper at web.de>, which provides
104 ;; functions for reading/parsing comma-separated value files and is
105 ;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in
106 ;; the gnu.emacs.sources archives).
107
108 ;;; To do (maybe):
109
110 ;; Make separators and quotes buffer-local and locally settable.
111 ;; Support (La)TeX tables: set separator and comment; support record
112 ;; end string.
113 ;; Convert comma-separated to space- or tab-separated.
114
115 ;;; Code:
116
117 (defgroup CSV nil
118 "Major mode for editing files of comma-separated value type."
119 :group 'convenience)
120
121 (defvar csv-separator-chars nil
122 "Field separators as a list of character.
123 Set by customizing `csv-separators' -- do not set directly!")
124
125 (defvar csv-separator-regexp nil
126 "Regexp to match a field separator.
127 Set by customizing `csv-separators' -- do not set directly!")
128
129 (defvar csv--skip-regexp nil
130 "Regexp used by `skip-chars-forward' etc. to skip fields.
131 Set by customizing `csv-separators' -- do not set directly!")
132
133 (defvar csv-font-lock-keywords nil
134 "Font lock keywords to highlight the field separators in CSV mode.
135 Set by customizing `csv-separators' -- do not set directly!")
136
137 (defcustom csv-separators '("," "\t")
138 "Field separators: a list of *single-character* strings.
139 For example: (\",\"), the default, or (\",\" \";\" \":\").
140 Neighbouring fields may be separated by any one of these characters.
141 The first is used when inserting a field separator into the buffer.
142 All must be different from the field quote characters, `csv-field-quotes'."
143 ;; Suggested by Eckhard Neber <neber@mwt.e-technik.uni-ulm.de>
144 :type '(repeat string)
145 ;; FIXME: Character would be better, but in Emacs 21.3 does not display
146 ;; correctly in a customization buffer.
147 :set (lambda (variable value)
148 (mapc (lambda (x)
149 (if (/= (length x) 1)
150 (error "Non-single-char string %S" x))
151 (if (and (boundp 'csv-field-quotes)
152 (member x csv-field-quotes))
153 (error "%S is already a quote" x)))
154 value)
155 (custom-set-default variable value)
156 (setq csv-separator-chars (mapcar 'string-to-char value)
157 csv--skip-regexp (apply 'concat "^\n" csv-separators)
158 csv-separator-regexp (apply 'concat `("[" ,@value "]"))
159 csv-font-lock-keywords
160 ;; NB: csv-separator-face variable evaluates to itself.
161 `((,csv-separator-regexp (0 'csv-separator-face))))))
162
163 (defcustom csv-field-quotes '("\"")
164 "Field quotes: a list of *single-character* strings.
165 For example: (\"\\\"\"), the default, or (\"\\\"\" \"'\" \"`\").
166 A field can be delimited by a pair of any of these characters.
167 All must be different from the field separators, `csv-separators'."
168 :type '(repeat string)
169 ;; Character would be better, but in Emacs 21 does not display
170 ;; correctly in a customization buffer.
171 :set (lambda (variable value)
172 (mapc (lambda (x)
173 (if (/= (length x) 1)
174 (error "Non-single-char string %S" x))
175 (if (member x csv-separators)
176 (error "%S is already a separator" x)))
177 value)
178 (when (boundp 'csv-mode-syntax-table)
179 ;; FIRST remove old quote syntax:
180 (with-syntax-table text-mode-syntax-table
181 (mapc (lambda (x)
182 (modify-syntax-entry
183 (string-to-char x)
184 (string (char-syntax (string-to-char x)))
185 ;; symbol-value to avoid compiler warning:
186 (symbol-value 'csv-mode-syntax-table)))
187 csv-field-quotes))
188 ;; THEN set new quote syntax:
189 (csv-set-quote-syntax value))
190 ;; BEFORE setting new value of `csv-field-quotes':
191 (custom-set-default variable value)))
192
193 (defun csv-set-quote-syntax (field-quotes)
194 "Set syntax for field quote characters FIELD-QUOTES to be \"string\".
195 FIELD-QUOTES should be a list of single-character strings."
196 (mapc (lambda (x)
197 (modify-syntax-entry
198 (string-to-char x) "\""
199 ;; symbol-value to avoid compiler warning:
200 (symbol-value 'csv-mode-syntax-table)))
201 field-quotes))
202
203 (defvar csv-comment-start nil
204 "String that starts a comment line, or nil if no comment syntax.
205 Such comment lines are ignored by CSV mode commands.
206 This variable is buffer local\; its default value is that of
207 `csv-comment-start-default'. It is set by the function
208 `csv-set-comment-start' -- do not set it directly!")
209
210 (make-variable-buffer-local 'csv-comment-start)
211
212 (defcustom csv-comment-start-default "#"
213 "String that starts a comment line, or nil if no comment syntax.
214 Such comment lines are ignored by CSV mode commands.
215 Default value of buffer-local variable `csv-comment-start'.
216 Changing this variable does not affect any existing CSV mode buffer."
217 :type '(choice (const :tag "None" nil) string)
218 :set (lambda (variable value)
219 (custom-set-default variable value)
220 (set-default 'csv-comment-start value)))
221
222 (defcustom csv-align-style 'left
223 "Aligned field style: one of 'left, 'centre, 'right or 'auto.
224 Alignment style used by `csv-align-fields'.
225 Auto-alignment means left align text and right align numbers."
226 :type '(choice (const left) (const centre)
227 (const right) (const auto)))
228
229 (defcustom csv-align-padding 1
230 "Aligned field spacing: must be a positive integer.
231 Number of spaces used by `csv-align-fields' after separators."
232 :type 'integer)
233
234 (defcustom csv-header-lines 0
235 "Header lines to skip when setting region automatically."
236 :type 'integer)
237
238 (defcustom csv-invisibility-default t
239 "If non-nil, make separators in aligned records invisible."
240 :type 'boolean)
241
242 (defface csv-separator-face
243 '((t :inherit escape-glyph))
244 "CSV mode face used to highlight separators.")
245 \f
246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
247 ;;; Mode definition, key bindings and menu
248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
249
250 (defconst csv-mode-line-help-echo
251 ;; See bindings.el for details of `mode-line-format' construction.
252 (get-text-property 0 'help-echo (car (default-value 'mode-line-format)))
253 "Primary default mode line help echo text.")
254
255 (defconst csv-mode-line-format
256 ;; See bindings.el for details of `mode-line-format' construction.
257 (let* ((ml (copy-sequence (default-value 'mode-line-format)))
258 (x (or (memq 'mode-line-position ml) (last 3 ml))))
259 (when x
260 (setcdr x (cons
261 `(csv-field-index-string
262 ("" csv-field-index-string
263 ;; ,(propertize "--" 'help-echo csv-mode-line-help-echo)
264 ))
265 (cdr x))))
266 ml)
267 "Mode line format string for CSV mode.")
268
269 (defvar csv-mode-map
270 (let ((map (make-sparse-keymap)))
271 (define-key map [(control ?c) (control ?v)] 'csv-toggle-invisibility)
272 (define-key map [(control ?c) (control ?t)] 'csv-transpose)
273 (define-key map [(control ?c) (control ?c)] 'csv-set-comment-start)
274 (define-key map [(control ?c) (control ?u)] 'csv-unalign-fields)
275 (define-key map [(control ?c) (control ?a)] 'csv-align-fields)
276 (define-key map [(control ?c) (control ?z)] 'csv-yank-as-new-table)
277 (define-key map [(control ?c) (control ?y)] 'csv-yank-fields)
278 (define-key map [(control ?c) (control ?k)] 'csv-kill-fields)
279 (define-key map [(control ?c) (control ?d)] 'csv-toggle-descending)
280 (define-key map [(control ?c) (control ?r)] 'csv-reverse-region)
281 (define-key map [(control ?c) (control ?n)] 'csv-sort-numeric-fields)
282 (define-key map [(control ?c) (control ?s)] 'csv-sort-fields)
283 map))
284
285 ;;;###autoload
286 (define-derived-mode csv-mode text-mode "CSV"
287 "Major mode for editing files of comma-separated value type.
288
289 CSV mode is derived from `text-mode', and runs `text-mode-hook' before
290 running `csv-mode-hook'. It turns `auto-fill-mode' off by default.
291 CSV mode can be customized by user options in the CSV customization
292 group. The separators are specified by the value of `csv-separators'.
293
294 CSV mode commands ignore blank lines and comment lines beginning with
295 the value of `csv-comment-start', which delimit \"paragraphs\".
296 \"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp'
297 \(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields.
298 Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]).
299
300 If `font-lock-mode' is enabled then separators, quoted values and
301 comment lines are highlighted using respectively `csv-separator-face',
302 `font-lock-string-face' and `font-lock-comment-face'.
303
304 The user interface (UI) for CSV mode commands is similar to that of
305 the standard commands `sort-fields' and `sort-numeric-fields', except
306 that if there is no prefix argument then the UI prompts for the field
307 index or indices. In `transient-mark-mode' only: if the region is not
308 set then the UI attempts to set it to include all consecutive CSV
309 records around point, and prompts for confirmation; if there is no
310 prefix argument then the UI prompts for it, offering as a default the
311 index of the field containing point if the region was not set
312 explicitly. The region set automatically is delimited by blank lines
313 and comment lines, and the number of header lines at the beginning of
314 the region given by the value of `csv-header-lines' are skipped.
315
316 Sort order is controlled by `csv-descending'.
317
318 CSV mode provides the following specific keyboard key bindings:
319
320 \\{csv-mode-map}"
321 (turn-off-auto-fill)
322 ;; Set syntax for field quotes:
323 (csv-set-quote-syntax csv-field-quotes)
324 ;; Make sexp functions apply to fields:
325 (set (make-local-variable 'forward-sexp-function) 'csv-forward-field)
326 (csv-set-comment-start csv-comment-start)
327 (setq
328 ;; Font locking -- separator plus syntactic:
329 font-lock-defaults '(csv-font-lock-keywords)
330 buffer-invisibility-spec csv-invisibility-default
331 ;; Mode line to support `csv-field-index-mode':
332 mode-line-format csv-mode-line-format)
333 (set (make-local-variable 'truncate-lines) t)
334 ;; Enable or disable `csv-field-index-mode' (could probably do this
335 ;; a bit more efficiently):
336 (csv-field-index-mode (symbol-value 'csv-field-index-mode)))
337
338 (defun csv-set-comment-start (string)
339 "Set comment start for this CSV mode buffer to STRING.
340 It must be either a string or nil."
341 (interactive
342 (list (edit-and-eval-command
343 "Comment start (string or nil): " csv-comment-start)))
344 ;; Paragraph means a group of contiguous records:
345 (setq csv-comment-start string)
346 (set (make-local-variable 'paragraph-separate) "[:space:]*$") ; White space.
347 (set (make-local-variable 'paragraph-start) "\n");Must include \n explicitly!
348 (if string
349 (progn
350 (setq paragraph-separate (concat paragraph-separate "\\|" string)
351 paragraph-start (concat paragraph-start "\\|" string))
352 (set (make-local-variable 'comment-start) string)
353 (modify-syntax-entry
354 (string-to-char string) "<" csv-mode-syntax-table)
355 (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
356 (with-syntax-table text-mode-syntax-table
357 (modify-syntax-entry (string-to-char string)
358 (string (char-syntax (string-to-char string)))
359 csv-mode-syntax-table)
360 (modify-syntax-entry ?\n
361 (string (char-syntax ?\n))
362 csv-mode-syntax-table))))
363
364 ;;;###autoload
365 (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
366
367 (defvar csv-descending nil
368 "If non-nil, CSV mode sort functions sort in order of descending sort key.
369 Usually they sort in order of ascending sort key.")
370
371 (defun csv-toggle-descending ()
372 "Toggle `csv-descending'."
373 (interactive)
374 (setq csv-descending (not csv-descending))
375 (message "Sort order is %sscending" (if csv-descending "de" "a")))
376
377 (defun csv-toggle-invisibility ()
378 "Toggle `buffer-invisibility-spec'."
379 (interactive)
380 (setq buffer-invisibility-spec (not buffer-invisibility-spec))
381 (message "Separators in aligned records will be %svisible \
382 \(after re-aligning if soft\)"
383 (if buffer-invisibility-spec "in" ""))
384 (redraw-frame (selected-frame)))
385
386 (easy-menu-define
387 csv-menu
388 csv-mode-map
389 "CSV major mode menu keymap"
390 '("CSV"
391 ["Sort By Field Lexicographically" csv-sort-fields :active t
392 :help "Sort lines in region lexicographically by the specified field"]
393 ["Sort By Field Numerically" csv-sort-numeric-fields :active t
394 :help "Sort lines in region numerically by the specified field"]
395 ["Reverse Order of Lines" csv-reverse-region :active t
396 :help "Reverse the order of the lines in the region"]
397 ["Use Descending Sort Order" csv-toggle-descending :active t
398 :style toggle :selected csv-descending
399 :help "If selected, use descending order when sorting"]
400 "--"
401 ["Kill Fields (Columns)" csv-kill-fields :active t
402 :help "Kill specified fields of each line in the region"]
403 ["Yank Fields (Columns)" csv-yank-fields :active t
404 :help "Yank killed fields as specified field of each line in region"]
405 ["Yank As New Table" csv-yank-as-new-table :active t
406 :help "Yank killed fields as a new table at point"]
407 ["Align Fields into Columns" csv-align-fields :active t
408 :help "Align the start of every field of each line in the region"]
409 ["Unalign Columns into Fields" csv-unalign-fields :active t
410 :help "Undo soft alignment and optionally remove redundant white space"]
411 ["Transpose Rows and Columns" csv-transpose :active t
412 :help "Rewrite rows (which may have different lengths) as columns"]
413 "--"
414 ["Forward Field" forward-sexp :active t
415 :help "Move forward across one field\; with ARG, do it that many times"]
416 ["Backward Field" backward-sexp :active t
417 :help "Move backward across one field\; with ARG, do it that many times"]
418 ["Kill Field Forward" kill-sexp :active t
419 :help "Kill field following cursor\; with ARG, do it that many times"]
420 ["Kill Field Backward" backward-kill-sexp :active t
421 :help "Kill field preceding cursor\; with ARG, do it that many times"]
422 "--"
423 ("Alignment Style"
424 ["Left" (setq csv-align-style 'left) :active t
425 :style radio :selected (eq csv-align-style 'left)
426 :help "If selected, `csv-align-fields' left aligns fields"]
427 ["Centre" (setq csv-align-style 'centre) :active t
428 :style radio :selected (eq csv-align-style 'centre)
429 :help "If selected, `csv-align-fields' centres fields"]
430 ["Right" (setq csv-align-style 'right) :active t
431 :style radio :selected (eq csv-align-style 'right)
432 :help "If selected, `csv-align-fields' right aligns fields"]
433 ["Auto" (setq csv-align-style 'auto) :active t
434 :style radio :selected (eq csv-align-style 'auto)
435 :help "\
436 If selected, `csv-align-fields' left aligns text and right aligns numbers"]
437 )
438 ["Show Current Field Index" csv-field-index-mode :active t
439 :style toggle :selected csv-field-index-mode
440 :help "If selected, display current field index in mode line"]
441 ["Make Separators Invisible" csv-toggle-invisibility :active t
442 :style toggle :selected buffer-invisibility-spec
443 :help "If selected, separators in aligned records are invisible"]
444 ["Set Buffer's Comment Start" csv-set-comment-start :active t
445 :help "Set comment start string for this buffer"]
446 ["Customize CSV Mode" (customize-group 'CSV) :active t
447 :help "Open a customization buffer to change CSV mode options"]
448 ))
449
450 (require 'sort)
451
452 (defsubst csv-not-looking-at-record ()
453 "Return t if looking at blank or comment line, nil otherwise.
454 Assumes point is at beginning of line."
455 (looking-at paragraph-separate))
456
457 (defun csv-interactive-args (&optional type)
458 "Get arg or field(s) and region interactively, offering sensible defaults.
459 Signal an error if the buffer is read-only.
460 If TYPE is noarg then return a list `(beg end)'.
461 Otherwise, return a list `(arg beg end)', where arg is:
462 the raw prefix argument by default\;
463 a single field index if TYPE is single\;
464 a list of field indices or index ranges if TYPE is multiple.
465 Field defaults to the current prefix arg\; if not set, prompt user.
466
467 A field index list consists of positive or negative integers or ranges,
468 separated by any non-integer characters. A range has the form m-n,
469 where m and n are positive or negative integers, m < n, and n defaults
470 to the last field index if omitted.
471
472 In transient mark mode, if the mark is not active then automatically
473 select and highlight CSV records around point, and query user.
474 The default field when read interactively is the current field."
475 ;; Must be run interactively to activate mark!
476 (let* ((arg current-prefix-arg) (default-field 1)
477 (region
478 (if (not (use-region-p))
479 ;; Set region automatically:
480 (save-excursion
481 (if arg
482 (beginning-of-line)
483 (let ((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 must be within CSV records"))
489 (let ((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 \f
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 \f
648 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
649 ;;; Moving by field
650 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
651
652 (defsubst csv-end-of-field ()
653 "Skip forward over one field."
654 (skip-chars-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 \f
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 :type '(number :tag "seconds"))
744
745 (defvar csv-field-index-idle-timer nil)
746
747 (defvar csv-field-index-string nil)
748 (make-variable-buffer-local 'csv-field-index-string)
749
750 (defvar csv-field-index-old nil)
751 (make-variable-buffer-local 'csv-field-index-old)
752
753 (define-minor-mode csv-field-index-mode
754 "Toggle CSV-Field-Index mode.
755 With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive.
756 Returns the new status of CSV-Field-Index mode (non-nil means on).
757 When CSV-Field-Index mode is enabled, the current field index appears in
758 the mode line after `csv-field-index-delay' seconds of Emacs idle time."
759 :global t
760 :init-value t ; for documentation, since default is t
761 ;; This macro generates a function that first sets the mode
762 ;; variable, then runs the following code, runs the mode hooks,
763 ;; displays a message if interactive, updates the mode line and
764 ;; finally returns the variable value.
765
766 ;; First, always disable the mechanism (to avoid having two timers):
767 (when csv-field-index-idle-timer
768 (cancel-timer csv-field-index-idle-timer)
769 (setq csv-field-index-idle-timer nil))
770 ;; Now, if the mode is on and any buffer is in CSV mode then
771 ;; re-initialize and enable the mechanism by setting up a new timer:
772 (if csv-field-index-mode
773 (if (memq t (mapcar (lambda (buffer)
774 (with-current-buffer buffer
775 (when (derived-mode-p 'csv-mode)
776 (setq csv-field-index-string nil
777 csv-field-index-old nil)
778 t)))
779 (buffer-list)))
780 (setq csv-field-index-idle-timer
781 (run-with-idle-timer csv-field-index-delay t
782 'csv-field-index)))
783 ;; but if the mode is off then remove the display from the mode
784 ;; lines of all CSV buffers:
785 (mapc (lambda (buffer)
786 (with-current-buffer buffer
787 (when (derived-mode-p 'csv-mode)
788 (setq csv-field-index-string nil
789 csv-field-index-old nil)
790 (force-mode-line-update))))
791 (buffer-list))))
792
793 (defun csv-field-index ()
794 "Construct `csv-field-index-string' to display in mode line.
795 Called by `csv-field-index-idle-timer'."
796 (if (derived-mode-p 'csv-mode)
797 (save-excursion
798 (let ((lbp (line-beginning-position)) (field 1))
799 (while (re-search-backward csv-separator-regexp lbp 1)
800 ;; Move as far as possible, i.e. to beginning of line.
801 (setq field (1+ field)))
802 (if (csv-not-looking-at-record) (setq field nil))
803 (when (not (eq field csv-field-index-old))
804 (setq csv-field-index-old field
805 csv-field-index-string
806 (and field (propertize (format "F%d" field)
807 'help-echo csv-mode-line-help-echo)))
808 (force-mode-line-update))))))
809 \f
810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
811 ;;; Killing and yanking fields
812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
813
814 (defvar csv-killed-fields nil
815 "A list of the fields or sub-records last killed by `csv-kill-fields'.")
816
817 (defun csv-kill-fields (fields beg end)
818 "Kill specified fields of each line in the region.
819 If not set, the region defaults to the CSV records around point.
820 Fields are separated by `csv-separators' and null fields are allowed anywhere.
821 Field indices increase from 1 on the left or decrease from -1 on the right.
822 The fields are stored for use by `csv-yank-fields'. Fields can be
823 specified in any order but are saved in increasing index order.
824 Ignore blank and comment lines.
825
826 When called interactively, a prefix argument specifies a single field,
827 otherwise prompt for a field list, which may include ranges in the form
828 m-n, where m < n and n defaults to the last field index if omitted.
829
830 When called non-interactively, FIELDS is a single field index or a
831 list of field indices, with ranges specified as (m.n) or (m), and BEG
832 and END specify the region to process."
833 ;; (interactive "*P\nr")
834 (interactive (csv-interactive-args 'multiple))
835 (barf-if-buffer-read-only)
836 ;; Kill the field(s):
837 (setq csv-killed-fields nil)
838 (save-excursion
839 (save-restriction
840 (narrow-to-region beg end)
841 (goto-char (point-min))
842 (if (or (cdr fields) (consp (car fields)))
843 (csv-kill-many-columns fields)
844 (csv-kill-one-column (car fields)))))
845 (setq csv-killed-fields (nreverse csv-killed-fields)))
846
847 (defun csv-kill-one-field (field)
848 "Kill field with index FIELD in current line.
849 Return killed text. Assumes point is at beginning of line."
850 ;; Move to start of field to kill:
851 (csv-sort-skip-fields field)
852 ;; Kill to end of field (cf. `kill-region'):
853 (prog1 (delete-and-extract-region
854 (point)
855 (progn (csv-end-of-field) (point)))
856 (if (eolp)
857 (unless (bolp) (delete-char -1)) ; Delete trailing separator at eol
858 (delete-char 1)))) ; or following separator otherwise.
859
860 (defun csv-kill-one-column (field)
861 "Kill field with index FIELD in all lines in (narrowed) buffer.
862 Save killed fields in `csv-killed-fields'.
863 Assumes point is at `point-min'. Called by `csv-kill-fields'.
864 Ignore blank and comment lines."
865 (while (not (eobp))
866 (or (csv-not-looking-at-record)
867 (push (csv-kill-one-field field) csv-killed-fields))
868 (forward-line)))
869
870 (defun csv-kill-many-columns (fields)
871 "Kill several fields in all lines in (narrowed) buffer.
872 FIELDS is an unordered list of field indices.
873 Save killed fields in increasing index order in `csv-killed-fields'.
874 Assumes point is at `point-min'. Called by `csv-kill-fields'.
875 Ignore blank and comment lines."
876 (if (eolp) (error "First record is empty"))
877 ;; Convert non-positive to positive field numbers:
878 (let ((last 1) (f fields))
879 (csv-end-of-field)
880 (while (not (eolp))
881 (forward-char) ; skip separator
882 (csv-end-of-field)
883 (setq last (1+ last))) ; last = # fields in first record
884 (while f
885 (cond ((consp (car f))
886 ;; Expand a field range: (m.n) -> m m+1 ... n-1 n.
887 ;; If n is nil then it defaults to the number of fields.
888 (let* ((range (car f)) (cdrf (cdr f))
889 (m (car range)) (n (cdr range)))
890 (if (< m 0) (setq m (+ m last 1)))
891 (if n
892 (if (< n 0) (setq n (+ n last 1)))
893 (setq n last))
894 (setq range (list n))
895 (while (> n m) (push (setq n (1- n)) range))
896 (setcar f (car range))
897 (setcdr f (cdr range))
898 (setcdr (setq f (last range)) cdrf)))
899 ((zerop (car f)) (setcar f 1))
900 ((< (car f) 0) (setcar f (+ f last 1))))
901 (setq f (cdr f))))
902 (goto-char (point-min))
903 ;; Kill from right to avoid miscounting:
904 (setq fields (sort fields '>))
905 (while (not (eobp))
906 (or (csv-not-looking-at-record)
907 (let ((fields fields) killed-fields field)
908 (while fields
909 (setq field (car fields)
910 fields (cdr fields))
911 (beginning-of-line)
912 (push (csv-kill-one-field field) killed-fields))
913 (push (mapconcat 'identity killed-fields (car csv-separators))
914 csv-killed-fields)))
915 (forward-line)))
916
917 (defun csv-yank-fields (field beg end)
918 "Yank fields as the ARGth field of each line in the region.
919 ARG may be arbitrarily large and records are extended as necessary.
920 If not set, the region defaults to the CSV records around point\;
921 if point is not in a CSV record then offer to yank as a new table.
922 The fields yanked are those last killed by `csv-kill-fields'.
923 Fields are separated by `csv-separators' and null fields are allowed anywhere.
924 Field indices increase from 1 on the left or decrease from -1 on the right.
925 A prefix argument specifies a single field, otherwise prompt for field index.
926 Ignore blank and comment lines. When called non-interactively, FIELD
927 is a single field index\; BEG and END specify the region to process."
928 ;; (interactive "*P\nr")
929 (interactive (condition-case err
930 (csv-interactive-args 'single)
931 (error (list nil nil err))))
932 (barf-if-buffer-read-only)
933 (if (null beg)
934 (if (y-or-n-p (concat (error-message-string end)
935 ". Yank as a new table? "))
936 (csv-yank-as-new-table)
937 (error (error-message-string end)))
938 (if (<= field 0) (setq field (1+ field)))
939 (save-excursion
940 (save-restriction
941 (narrow-to-region beg end)
942 (goto-char (point-min))
943 (let ((fields csv-killed-fields))
944 (while (not (eobp))
945 (unless (csv-not-looking-at-record)
946 ;; Yank at start of specified field if possible,
947 ;; otherwise yank at end of record:
948 (if (zerop field)
949 (end-of-line)
950 (csv-sort-skip-fields field 'yank))
951 (and (eolp) (insert (car csv-separators)))
952 (when fields
953 (insert (car fields))
954 (setq fields (cdr fields)))
955 (or (eolp) (insert (car csv-separators))))
956 (forward-line)))))))
957
958 (defun csv-yank-as-new-table ()
959 "Yank fields as a new table starting at point.
960 The fields yanked are those last killed by `csv-kill-fields'."
961 (interactive "*")
962 (let ((fields csv-killed-fields))
963 (while fields
964 (insert (car fields) ?\n)
965 (setq fields (cdr fields)))))
966 \f
967 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
968 ;;; Aligning fields
969 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
970
971 (defun csv--column-widths ()
972 (let ((widths '()))
973 ;; Construct list of column widths:
974 (while (not (eobp)) ; for each record...
975 (or (csv-not-looking-at-record)
976 (let ((w widths)
977 (beg (point)) ; Beginning of current field.
978 x)
979 (while (not (eolp))
980 (csv-end-of-field)
981 (setq x (- (point) beg)) ; Field width.
982 (if w
983 (if (> x (car w)) (setcar w x))
984 (setq w (list x)
985 widths (nconc widths w)))
986 (or (eolp) (forward-char)) ; Skip separator.
987 (setq w (cdr w)
988 beg (point)))))
989 (forward-line))
990 widths))
991
992 (defun csv-align-fields (hard beg end)
993 "Align all the fields in the region to form columns.
994 The alignment style is specified by `csv-align-style'. The number of
995 spaces specified by `csv-align-fields' appears after each separator.
996 Use soft alignment done by displaying virtual white space after the
997 separators unless invoked with an argument, in which case insert real
998 space characters into the buffer after the separators.
999 Unalign first (see `csv-unalign-fields'). Ignore blank and comment lines.
1000
1001 In hard-aligned records, separators become invisible whenever
1002 `buffer-invisibility-spec' is non-nil. In soft-aligned records, make
1003 separators invisible if and only if `buffer-invisibility-spec' is
1004 non-nil when the records are aligned\; this can be changed only by
1005 re-aligning. \(Unaligning always makes separators visible.)
1006
1007 When called non-interactively, use hard alignment if HARD is non-nil\;
1008 BEG and END specify the region to align.
1009 If there is no selected region, default to the whole buffer."
1010 (interactive (cons current-prefix-arg
1011 (if (use-region-p)
1012 (list (region-beginning) (region-end))
1013 (list (point-min) (point-max)))))
1014 (setq end (copy-marker end))
1015 (csv-unalign-fields hard beg end) ; If hard then barfs if buffer read only.
1016 (save-excursion
1017 (save-restriction
1018 (narrow-to-region beg end)
1019 (set-marker end nil)
1020 (goto-char (point-min))
1021 (let ((widths (csv--column-widths)))
1022
1023 ;; Align fields:
1024 (goto-char (point-min))
1025 (while (not (eobp)) ; for each record...
1026 (unless (csv-not-looking-at-record)
1027 (let ((w widths)
1028 (column 0)) ;Desired position of left-side of this column.
1029 (while (and w (not (eolp)))
1030 (let* ((beg (point))
1031 (align-padding (if (bolp) 0 csv-align-padding))
1032 (left-padding 0) (right-padding 0)
1033 (field-width
1034 ;; FIXME: Don't assume length=string-width!
1035 (progn (csv-end-of-field) (- (point) beg)))
1036 (column-width (pop w))
1037 (x (- column-width field-width))) ; Required padding.
1038 (set-marker end (point)) ; End of current field.
1039 ;; beg = beginning of current field
1040 ;; end = (point) = end of current field
1041
1042 ;; Compute required padding:
1043 (cond
1044 ((eq csv-align-style 'left)
1045 ;; Left align -- pad on the right:
1046 (setq left-padding align-padding
1047 right-padding x))
1048 ((eq csv-align-style 'right)
1049 ;; Right align -- pad on the left:
1050 (setq left-padding (+ align-padding x)))
1051 ((eq csv-align-style 'auto)
1052 ;; Auto align -- left align text, right align numbers:
1053 (if (string-match "\\`[-+.[:digit:]]+\\'"
1054 (buffer-substring beg (point)))
1055 ;; Right align -- pad on the left:
1056 (setq left-padding (+ align-padding x))
1057 ;; Left align -- pad on the right:
1058 (setq left-padding align-padding
1059 right-padding x)))
1060 ((eq csv-align-style 'centre)
1061 ;; Centre -- pad on both left and right:
1062 (let ((y (/ x 2))) ; truncated integer quotient
1063 (setq left-padding (+ align-padding y)
1064 right-padding (- x y)))))
1065
1066 (cond
1067 (hard ;; Hard alignment...
1068 (when (> left-padding 0) ; Pad on the left.
1069 ;; Insert spaces before field:
1070 (if (= beg end) ; null field
1071 (insert (make-string left-padding ?\ ))
1072 (goto-char beg) ; beginning of current field
1073 (insert (make-string left-padding ?\ ))
1074 (goto-char end))) ; end of current field
1075 (unless (eolp)
1076 (if (> right-padding 0) ; pad on the right
1077 ;; Insert spaces after field:
1078 (insert (make-string right-padding ?\ )))
1079 ;; Make separator (potentially) invisible;
1080 ;; in Emacs 21.3, neighbouring overlays
1081 ;; conflict, so use the following only
1082 ;; with hard alignment:
1083 (let ((ol (make-overlay (point) (1+ (point)) nil t)))
1084 (overlay-put ol 'invisible t)
1085 (overlay-put ol 'evaporate t))
1086 (forward-char))) ; skip separator
1087
1088 ;; Soft alignment...
1089 (buffer-invisibility-spec ; csv-invisibility-default
1090
1091 ;; Hide separators...
1092 ;; Merge right-padding from previous field
1093 ;; with left-padding from this field:
1094 (if (zerop column)
1095 (when (> left-padding 0)
1096 ;; Display spaces before first field
1097 ;; by overlaying first character:
1098 (overlay-put
1099 (make-overlay beg (1+ beg))
1100 'before-string
1101 (make-string left-padding ?\ )))
1102 ;; Display separator as spaces:
1103 (with-silent-modifications
1104 (put-text-property
1105 (1- beg) beg
1106 'display `(space :align-to
1107 ,(+ left-padding column)))))
1108 (unless (eolp) (forward-char)) ; Skip separator.
1109 (setq column (+ column column-width align-padding)))
1110
1111 (t ;; Do not hide separators...
1112 (let ((overlay (make-overlay beg (point) nil nil t)))
1113 (when (> left-padding 0) ; Pad on the left.
1114 ;; Display spaces before field:
1115 (overlay-put overlay 'before-string
1116 (make-string left-padding ?\ )))
1117 (unless (eolp)
1118 (if (> right-padding 0) ; Pad on the right.
1119 ;; Display spaces after field:
1120 (overlay-put
1121 overlay
1122 'after-string (make-string right-padding ?\ )))
1123 (forward-char)))) ; Skip separator.
1124
1125 )))))
1126 (forward-line)))))
1127 (set-marker end nil))
1128
1129 (defun csv-unalign-fields (hard beg end)
1130 "Undo soft alignment and optionally remove redundant white space.
1131 Undo soft alignment introduced by `csv-align-fields'. If invoked with
1132 an argument then also remove all spaces and tabs around separators.
1133 Also make all invisible separators visible again.
1134 Ignore blank and comment lines. When called non-interactively, remove
1135 spaces and tabs if HARD non-nil\; BEG and END specify region to unalign.
1136 If there is no selected region, default to the whole buffer."
1137 (interactive (cons current-prefix-arg
1138 (if (use-region-p)
1139 (list (region-beginning) (region-end))
1140 (list (point-min) (point-max)))))
1141 ;; Remove any soft alignment:
1142 (mapc 'delete-overlay (overlays-in beg end))
1143 (with-silent-modifications
1144 (remove-list-of-text-properties beg end '(display)))
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 \f
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