array.el 33.6 KB
Newer Older
1
;;; array.el --- array editing commands for GNU Emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1987, 2000-2013 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

5
;; Author: David M. Brown
Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Keywords: extensions
Jim Blandy's avatar
Jim Blandy committed
8 9 10

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
23

Eric S. Raymond's avatar
Eric S. Raymond committed
24 25
;;; Commentary:

26 27 28 29 30 31 32 33 34 35 36 37
;; Commands for editing a buffer interpreted as a rectangular array
;; or matrix of whitespace-separated strings.  You specify the array
;; dimensions and some other parameters at startup time.

;;  Written by dmb%morgoth@harvard.harvard.edu (address is old)
;;   (David M. Brown at Goldberg-Zoino & Associates, Inc.)
;;  Thanks to cph@kleph.ai.mit.edu for assistance

;; To do:
;;   Smooth initialization process by grokking local variables list
;;     at end of buffer or parsing buffer using whitespace as delimiters.
;;   Make 'array-copy-column-right faster.
Jim Blandy's avatar
Jim Blandy committed
38 39


Eric S. Raymond's avatar
Eric S. Raymond committed
40
;;; Code:
Jim Blandy's avatar
Jim Blandy committed
41

42 43 44 45 46 47 48 49 50 51 52 53 54
(defvar array-max-column nil "Number of columns in the array.")
(defvar array-columns-per-line nil "Number of array columns per line.")
(defvar array-buffer-column nil "Current column number of point in the buffer.")
(defvar array-line-length nil "Length of a line in the array.")
(defvar array-buffer-line nil "Current line number of point in the buffer.")
(defvar array-lines-per-row nil "Number of lines per array row.")
(defvar array-max-row nil "Number of rows in the array.")
(defvar array-field-width nil "Width of a field in the array.")
(defvar array-row nil "Current array row location of point.")
(defvar array-column nil "Current array column location of point.")
(defvar array-rows-numbered nil "Are rows numbered in the buffer?")
(defvar array-copy-string nil "Current field string being copied.")
(defvar array-respect-tabs nil "Should TAB conversion be prevented?")
55

Jim Blandy's avatar
Jim Blandy committed
56
;;; Internal information functions.
57

Jim Blandy's avatar
Jim Blandy committed
58
(defun array-cursor-in-array-range ()
59
  "Return t if the cursor is in a valid array cell.
Jim Blandy's avatar
Jim Blandy committed
60
Its ok to be on a row number line."
61 62
  (let ((columns-last-line (% array-max-column array-columns-per-line)))
    ;; Requires array-buffer-line and array-buffer-column to be current.
Jim Blandy's avatar
Jim Blandy committed
63 64
    (not (or
	  ;; The cursor is too far to the right.
65
	  (>= array-buffer-column array-line-length)
Jim Blandy's avatar
Jim Blandy committed
66
	  ;; The cursor is below the last row.
67
	  (>= array-buffer-line (* array-lines-per-row array-max-row))
Jim Blandy's avatar
Jim Blandy committed
68 69 70
	  ;; The cursor is on the last line of the row, the line is smaller
	  ;;  than the others, and the cursor is after the last array column
	  ;;  on the line.
71
	  (and (zerop (% (1+ array-buffer-line) array-lines-per-row))
Jim Blandy's avatar
Jim Blandy committed
72
	       (not (zerop columns-last-line))
73
	       (>= array-buffer-column (* columns-last-line array-field-width)))))))
Jim Blandy's avatar
Jim Blandy committed
74 75 76

(defun array-current-row ()
  "Return the array row of the field in which the cursor is located."
77
  ;; Requires array-buffer-line and array-buffer-column to be current.
Jim Blandy's avatar
Jim Blandy committed
78
  (and (array-cursor-in-array-range)
79
       (1+ (floor array-buffer-line array-lines-per-row))))
Jim Blandy's avatar
Jim Blandy committed
80 81 82

(defun array-current-column ()
  "Return the array column of the field in which the cursor is located."
83
  ;; Requires array-buffer-line and array-buffer-column to be current.
Jim Blandy's avatar
Jim Blandy committed
84 85
  (and (array-cursor-in-array-range)
       ;; It's not okay to be on a row number line.
86 87
       (not (and array-rows-numbered
		 (zerop (% array-buffer-line array-lines-per-row))))
Jim Blandy's avatar
Jim Blandy committed
88 89
       (+
	;; Array columns due to line differences.
90 91 92 93
	(* array-columns-per-line
	   (if array-rows-numbered
	       (1- (% array-buffer-line array-lines-per-row))
	     (% array-buffer-line array-lines-per-row)))
Jim Blandy's avatar
Jim Blandy committed
94
	;; Array columns on the current line.
95
	(1+ (floor array-buffer-column array-field-width)))))
Jim Blandy's avatar
Jim Blandy committed
96 97

(defun array-update-array-position (&optional a-row a-column)
98 99 100
  "Set `array-row' and `array-column' to their current values.
Set them to the optional arguments A-ROW and A-COLUMN if those are supplied."
  ;; Requires that array-buffer-line and array-buffer-column be current.
Jim Blandy's avatar
Jim Blandy committed
101 102 103 104
  (setq array-row (or a-row (array-current-row))
	array-column (or a-column (array-current-column))))

(defun array-update-buffer-position ()
105
  "Set `array-buffer-line' and `array-buffer-column' to their current values."
106 107
  (setq array-buffer-line (current-line)
	array-buffer-column (current-column)))
Jim Blandy's avatar
Jim Blandy committed
108 109 110 111 112 113 114 115



;;; Information commands.

(defun array-what-position ()
  "Display the row and column in which the cursor is positioned."
  (interactive)
116 117 118
  (let ((array-buffer-line (current-line))
	(array-buffer-column (current-column)))
    (message "Array row: %s  Array column: %s"
119 120
	     (prin1-to-string (array-current-row))
	     (prin1-to-string (array-current-column)))))
Jim Blandy's avatar
Jim Blandy committed
121 122 123 124 125 126 127 128 129 130

(defun array-display-local-variables ()
  "Display the current state of the local variables in the minibuffer."
  (interactive)
  (let ((buf (buffer-name (current-buffer))))
    (with-output-to-temp-buffer "*Local Variables*"
      (buffer-disable-undo standard-output)
      (terpri)
      (princ (format " Buffer:             %s\n\n" buf))
      (princ (format "  max-row:           %s\n"
131
		     (prin1-to-string array-max-row)))
Jim Blandy's avatar
Jim Blandy committed
132
      (princ (format "  max-column:        %s\n"
133
		     (prin1-to-string array-max-column)))
Jim Blandy's avatar
Jim Blandy committed
134
      (princ (format "  columns-per-line:  %s\n"
135
		     (prin1-to-string array-columns-per-line)))
Jim Blandy's avatar
Jim Blandy committed
136
      (princ (format "  field-width:       %s\n"
137
		     (prin1-to-string array-field-width)))
Jim Blandy's avatar
Jim Blandy committed
138
      (princ (format "  rows-numbered:     %s\n"
139
		     (prin1-to-string array-rows-numbered)))
Jim Blandy's avatar
Jim Blandy committed
140
      (princ (format "  lines-per-row:     %s\n"
141
		     (prin1-to-string array-lines-per-row)))
Jim Blandy's avatar
Jim Blandy committed
142
      (princ (format "  line-length:       %s\n"
143
		     (prin1-to-string array-line-length))))))
Jim Blandy's avatar
Jim Blandy committed
144 145 146 147 148 149 150 151



;;; Internal movement functions.

(defun array-beginning-of-field (&optional go-there)
   "Return the column of the beginning of the current field.
Optional argument GO-THERE, if non-nil, means go there too."
152 153
   ;; Requires that array-buffer-column be current.
   (let ((goal-column (- array-buffer-column (% array-buffer-column array-field-width))))
Jim Blandy's avatar
Jim Blandy committed
154 155 156 157 158 159 160
     (if go-there
	 (move-to-column-untabify goal-column)
       goal-column)))

(defun array-end-of-field (&optional go-there)
  "Return the column of the end of the current array field.
If optional argument GO-THERE is non-nil, go there too."
161 162 163
  ;; Requires that array-buffer-column be current.
  (let ((goal-column (+ (- array-buffer-column (% array-buffer-column array-field-width))
			array-field-width)))
Jim Blandy's avatar
Jim Blandy committed
164 165 166 167 168
    (if go-there
	(move-to-column-untabify goal-column)
      goal-column)))

(defun array-move-to-cell (a-row a-column)
169
  "Move to array row A-ROW and array column A-COLUMN.
Jim Blandy's avatar
Jim Blandy committed
170
Leave point at the beginning of the field and return the new buffer column."
171 172 173 174
  (let ((goal-line (+ (* array-lines-per-row (1- a-row))
		      (if array-rows-numbered 1 0)
		      (floor (1- a-column) array-columns-per-line)))
	(goal-column (* array-field-width (% (1- a-column) array-columns-per-line))))
Jim Blandy's avatar
Jim Blandy committed
175 176 177 178 179 180 181
    (goto-char (point-min))
    (forward-line goal-line)
    (move-to-column-untabify goal-column)))

(defun array-move-to-row (a-row)
  "Move to array row A-ROW preserving the current array column.
Leave point at the beginning of the field and return the new array row."
182 183 184 185 186
  ;; Requires that array-buffer-line and array-buffer-column be current.
  (let ((goal-line (+ (* array-lines-per-row (1- a-row))
		      (% array-buffer-line array-lines-per-row)))
	(goal-column (- array-buffer-column (% array-buffer-column array-field-width))))
    (forward-line (- goal-line array-buffer-line))
Jim Blandy's avatar
Jim Blandy committed
187 188 189 190 191 192
    (move-to-column-untabify goal-column)
    a-row))

(defun array-move-to-column (a-column)
  "Move to array column A-COLUMN preserving the current array row.
Leave point at the beginning of the field and return the new array column."
193 194 195 196 197 198
  ;; Requires that array-buffer-line and array-buffer-column be current.
  (let ((goal-line (+ (- array-buffer-line (% array-buffer-line array-lines-per-row))
		      (if array-rows-numbered 1 0)
		      (floor (1- a-column) array-columns-per-line)))
	(goal-column (* array-field-width (% (1- a-column) array-columns-per-line))))
    (forward-line (- goal-line array-buffer-line))
Jim Blandy's avatar
Jim Blandy committed
199 200 201 202 203 204 205
    (move-to-column-untabify goal-column)
    a-column))

(defun array-move-one-row (sign)
  "Move one array row in direction SIGN (1 or -1).
Leave point at the beginning of the field and return the new array row.
If requested to move beyond the array bounds, signal an error."
206
  ;; Requires that array-buffer-line and array-buffer-column be current.
Jim Blandy's avatar
Jim Blandy committed
207 208
  (let ((goal-column (array-beginning-of-field))
	(array-row (or (array-current-row)
209 210 211
		       (error "Cursor is not in a valid array cell"))))
    (cond ((and (= array-row array-max-row) (= sign 1))
	   (error "End of array"))
Jim Blandy's avatar
Jim Blandy committed
212
	  ((and (= array-row 1) (= sign -1))
213
	   (error "Beginning of array"))
Jim Blandy's avatar
Jim Blandy committed
214 215
	  (t
	   (progn
216
	     (forward-line (* sign array-lines-per-row))
Jim Blandy's avatar
Jim Blandy committed
217 218 219 220 221 222 223
	     (move-to-column-untabify goal-column)
	     (+ array-row sign))))))

(defun array-move-one-column (sign)
  "Move one array column in direction SIGN (1 or -1).
Leave point at the beginning of the field and return the new array column.
If requested to move beyond the array bounds, signal an error."
224
  ;; Requires that array-buffer-line and array-buffer-column be current.
Jim Blandy's avatar
Jim Blandy committed
225
  (let ((array-column (or (array-current-column)
226 227 228
		      (error "Cursor is not in a valid array cell"))))
    (cond ((and (= array-column array-max-column) (= sign 1))
	   (error "End of array"))
Jim Blandy's avatar
Jim Blandy committed
229
	  ((and (= array-column 1) (= sign -1))
230
	   (error "Beginning of array"))
Jim Blandy's avatar
Jim Blandy committed
231
	  (t
232
	   (cond
Jim Blandy's avatar
Jim Blandy committed
233
	    ;; Going backward from first column on the line.
234
	    ((and (= sign -1) (= 1 (% array-column array-columns-per-line)))
Jim Blandy's avatar
Jim Blandy committed
235 236
	     (forward-line -1)
	     (move-to-column-untabify
237
	      (* array-field-width (1- array-columns-per-line))))
Jim Blandy's avatar
Jim Blandy committed
238
	    ;; Going forward from last column on the line.
239
	    ((and (= sign 1) (zerop (% array-column array-columns-per-line)))
Jim Blandy's avatar
Jim Blandy committed
240 241 242 243
	     (forward-line 1))
	    ;; Somewhere in the middle of the line.
	    (t
	     (move-to-column-untabify (+ (array-beginning-of-field)
244
					 (* array-field-width sign)))))
Jim Blandy's avatar
Jim Blandy committed
245 246 247
	   (+ array-column sign)))))

(defun array-normalize-cursor ()
248 249
  "Move the cursor to the first non-whitespace character in the field.
If necessary, scroll horizontally to keep the cursor in view."
Jim Blandy's avatar
Jim Blandy committed
250
  ;; Assumes point is at the beginning of the field.
251
  (let ((array-buffer-column (current-column)))
Jim Blandy's avatar
Jim Blandy committed
252 253 254 255 256 257 258
    (skip-chars-forward " \t"
			(1- (save-excursion (array-end-of-field t) (point))))
    (array-maybe-scroll-horizontally)))

(defun array-maybe-scroll-horizontally ()
  "If necessary, scroll horizontally to keep the cursor in view."
  ;; This is only called from array-normalize-cursor so
259
  ;;  array-buffer-column will always be current.
Jim Blandy's avatar
Jim Blandy committed
260 261 262
  (let ((w-hscroll (window-hscroll))
	(w-width (window-width)))
    (cond
263 264
     ((and (>= array-buffer-column w-hscroll)
	   (<= array-buffer-column (+ w-hscroll w-width)))
Jim Blandy's avatar
Jim Blandy committed
265 266
      ;; It's already visible.  Do nothing.
      nil)
267
     ((> array-buffer-column (+ w-hscroll w-width))
Jim Blandy's avatar
Jim Blandy committed
268
      ;; It's to the right.  Scroll left.
269
      (scroll-left (- (- array-buffer-column w-hscroll)
Jim Blandy's avatar
Jim Blandy committed
270 271 272
		      (/ w-width 2))))
     (t
      ;; It's to the left.  Scroll right.
273
      (scroll-right (+ (- w-hscroll array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
274 275 276 277 278 279 280 281 282 283
		       (/ w-width 2)))))))



;;; Movement commands.

(defun array-next-row (&optional arg)
  "Move down one array row, staying in the current array column.
If optional ARG is given, move down ARG array rows."
  (interactive "p")
284 285
  (let ((array-buffer-line (current-line))
	(array-buffer-column (current-column)))
Jim Blandy's avatar
Jim Blandy committed
286 287 288 289
    (if (= (abs arg) 1)
	(array-move-one-row arg)
      (array-move-to-row
       (limit-index (+ (or (array-current-row)
290
			   (error "Cursor is not in an array cell"))
Jim Blandy's avatar
Jim Blandy committed
291
		       arg)
292
		    array-max-row))))
Jim Blandy's avatar
Jim Blandy committed
293 294 295 296 297 298 299 300 301 302 303 304 305
  (array-normalize-cursor))

(defun array-previous-row (&optional arg)
  "Move up one array row, staying in the current array column.
If optional ARG is given, move up ARG array rows."
  (interactive "p")
  (array-next-row (- arg)))

(defun array-forward-column (&optional arg)
  "Move forward one field, staying in the current array row.
If optional ARG is given, move forward ARG array columns.
If necessary, keep the cursor in the window by scrolling right or left."
  (interactive "p")
306 307
  (let ((array-buffer-line (current-line))
	(array-buffer-column (current-column)))
Jim Blandy's avatar
Jim Blandy committed
308 309 310 311
    (if (= (abs arg) 1)
	(array-move-one-column arg)
      (array-move-to-column
       (limit-index (+ (or (array-current-column)
312
			   (error "Cursor is not in an array cell"))
Jim Blandy's avatar
Jim Blandy committed
313
		       arg)
314
		    array-max-column))))
Jim Blandy's avatar
Jim Blandy committed
315 316 317 318 319 320 321 322 323 324 325 326 327
  (array-normalize-cursor))

(defun array-backward-column (&optional arg)
  "Move backward one field, staying in the current array row.
If optional ARG is given, move backward ARG array columns.
If necessary, keep the cursor in the window by scrolling right or left."
  (interactive "p")
  (array-forward-column (- arg)))

(defun array-goto-cell (a-row a-column)
  "Go to array row A-ROW and array column A-COLUMN."
  (interactive "nArray row: \nnArray column: ")
  (array-move-to-cell
328 329
   (limit-index a-row array-max-row)
   (limit-index a-column array-max-column))
Jim Blandy's avatar
Jim Blandy committed
330 331 332 333 334 335 336 337
  (array-normalize-cursor))



;;; Internal copying functions.

(defun array-field-string ()
  "Return the field string at the current cursor location."
338
  ;; Requires that array-buffer-column be current.
Jim Blandy's avatar
Jim Blandy committed
339 340 341 342 343 344 345 346
  (buffer-substring
   (save-excursion (array-beginning-of-field t) (point))
   (save-excursion (array-end-of-field t) (point))))

(defun array-copy-once-vertically (sign)
  "Copy the current field into one array row in direction SIGN (1 or -1).
Leave point at the beginning of the field and return the new array row.
If requested to move beyond the array bounds, signal an error."
347
  ;; Requires that array-buffer-line, array-buffer-column, and array-copy-string be current.
Jim Blandy's avatar
Jim Blandy committed
348 349 350
  (let ((a-row (array-move-one-row sign)))
    (let ((inhibit-quit t))
      (delete-region (point) (save-excursion (array-end-of-field t) (point)))
351 352
      (insert array-copy-string))
    (move-to-column array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
353 354 355 356 357 358
    a-row))

(defun array-copy-once-horizontally (sign)
  "Copy the current field into one array column in direction SIGN (1 or -1).
Leave point at the beginning of the field and return the new array column.
If requested to move beyond the array bounds, signal an error."
359
  ;; Requires that array-buffer-line, array-buffer-column, and array-copy-string be current.
Jim Blandy's avatar
Jim Blandy committed
360 361 362 363
  (let ((a-column (array-move-one-column sign)))
    (array-update-buffer-position)
    (let ((inhibit-quit t))
      (delete-region (point) (save-excursion (array-end-of-field t) (point)))
364 365
      (insert array-copy-string))
    (move-to-column array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
366 367 368 369 370
    a-column))

(defun array-copy-to-row (a-row)
  "Copy the current field vertically into every cell up to and including A-ROW.
Leave point at the beginning of the field."
371 372
  ;; Requires that array-buffer-line, array-buffer-column, array-row, and
  ;;  array-copy-string be current.
Jim Blandy's avatar
Jim Blandy committed
373 374 375 376 377 378 379 380
  (let* ((num (- a-row array-row))
	 (count (abs num))
	 (sign (if (zerop count) () (/ num count))))
    (while (> count 0)
      (array-move-one-row sign)
      (array-update-buffer-position)
      (let ((inhibit-quit t))
	(delete-region (point) (save-excursion (array-end-of-field t) (point)))
381 382
	(insert array-copy-string))
      (move-to-column array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
383
      (setq count (1- count)))))
384

Jim Blandy's avatar
Jim Blandy committed
385
(defun array-copy-to-column (a-column)
386 387 388 389
  "Copy current field horizontally into every cell up to and including A-COLUMN.
Leave point at the beginning of the field."
  ;; Requires that array-buffer-line, array-buffer-column, array-column, and
  ;;  array-copy-string be current.
Jim Blandy's avatar
Jim Blandy committed
390 391 392 393 394 395 396 397
  (let* ((num (- a-column array-column))
	 (count (abs num))
	 (sign (if (zerop count) () (/ num count))))
    (while (> count 0)
      (array-move-one-column sign)
      (array-update-buffer-position)
      (let ((inhibit-quit t))
	(delete-region (point) (save-excursion (array-end-of-field t) (point)))
398 399
	(insert array-copy-string))
      (move-to-column array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
400 401 402 403 404
      (setq count (1- count)))))

(defun array-copy-to-cell (a-row a-column)
  "Copy the current field into the cell at A-ROW, A-COLUMN.
Leave point at the beginning of the field."
405
  ;; Requires that array-copy-string be current.
Jim Blandy's avatar
Jim Blandy committed
406 407 408
  (array-move-to-cell a-row a-column)
  (array-update-buffer-position)
  (delete-region (point) (save-excursion (array-end-of-field t) (point)))
409 410
  (insert array-copy-string)
  (move-to-column array-buffer-column))
Jim Blandy's avatar
Jim Blandy committed
411 412 413 414 415 416 417 418 419



;;; Commands for copying.

(defun array-copy-down (&optional arg)
  "Copy the current field one array row down.
If optional ARG is given, copy down through ARG array rows."
  (interactive "p")
420 421
  (let* ((array-buffer-line (current-line))
	 (array-buffer-column (current-column))
Jim Blandy's avatar
Jim Blandy committed
422
	 (array-row (or (array-current-row)
423 424
			   (error "Cursor is not in a valid array cell")))
	 (array-copy-string (array-field-string)))
Jim Blandy's avatar
Jim Blandy committed
425 426 427
    (if (= (abs arg) 1)
	(array-copy-once-vertically arg)
      (array-copy-to-row
428
       (limit-index (+ array-row arg) array-max-row))))
Jim Blandy's avatar
Jim Blandy committed
429 430 431 432 433 434 435 436 437 438 439 440
  (array-normalize-cursor))

(defun array-copy-up (&optional arg)
  "Copy the current field one array row up.
If optional ARG is given, copy up through ARG array rows."
  (interactive "p")
  (array-copy-down (- arg)))

(defun array-copy-forward (&optional arg)
  "Copy the current field one array column to the right.
If optional ARG is given, copy through ARG array columns to the right."
  (interactive "p")
441 442
  (let* ((array-buffer-line (current-line))
	 (array-buffer-column (current-column))
Jim Blandy's avatar
Jim Blandy committed
443
	 (array-column (or (array-current-column)
444 445
			   (error "Cursor is not in a valid array cell")))
	 (array-copy-string (array-field-string)))
Jim Blandy's avatar
Jim Blandy committed
446 447 448
    (if (= (abs arg) 1)
	(array-copy-once-horizontally arg)
      (array-copy-to-column
449
       (limit-index (+ array-column arg) array-max-column))))
Jim Blandy's avatar
Jim Blandy committed
450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
  (array-normalize-cursor))

(defun array-copy-backward (&optional arg)
  "Copy the current field one array column to the left.
If optional ARG is given, copy through ARG array columns to the left."
  (interactive "p")
  (array-copy-forward (- arg)))

(defun array-copy-column-forward (&optional arg)
  "Copy the entire current column in to the column to the right.
If optional ARG is given, copy through ARG array columns to the right."
  (interactive "p")
  (array-update-buffer-position)
  (array-update-array-position)
  (if (not array-column)
465
      (error "Cursor is not in a valid array cell"))
Jim Blandy's avatar
Jim Blandy committed
466 467
  (message "Working...")
  (let ((this-row 0))
468
    (while (< this-row array-max-row)
Jim Blandy's avatar
Jim Blandy committed
469 470 471
      (setq this-row (1+ this-row))
      (array-move-to-cell this-row array-column)
      (array-update-buffer-position)
472
      (let ((array-copy-string (array-field-string)))
Jim Blandy's avatar
Jim Blandy committed
473 474 475
	(if (= (abs arg) 1)
	    (array-copy-once-horizontally arg)
	  (array-copy-to-column
476
	   (limit-index (+ array-column arg) array-max-column))))))
Jim Blandy's avatar
Jim Blandy committed
477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
  (message "Working...done")
  (array-move-to-row array-row)
  (array-normalize-cursor))

(defun array-copy-column-backward (&optional arg)
  "Copy the entire current column one column to the left.
If optional ARG is given, copy through ARG columns to the left."
  (interactive "p")
  (array-copy-column-forward (- arg)))

(defun array-copy-row-down (&optional arg)
  "Copy the entire current row one row down.
If optional ARG is given, copy through ARG rows down."
  (interactive "p")
  (array-update-buffer-position)
  (array-update-array-position)
  (if (not array-row)
494
      (error "Cursor is not in a valid array cell"))
Jim Blandy's avatar
Jim Blandy committed
495 496
  (cond
   ((and (= array-row 1) (= arg -1))
497 498 499
    (error "Beginning of array"))
   ((and (= array-row array-max-row) (= arg 1))
    (error "End of array"))
Jim Blandy's avatar
Jim Blandy committed
500
   (t
501
    (let* ((array-copy-string
Jim Blandy's avatar
Jim Blandy committed
502 503 504
	    (buffer-substring
	     (save-excursion (array-move-to-cell array-row 1)
			     (point))
505
	     (save-excursion (array-move-to-cell array-row array-max-column)
Jim Blandy's avatar
Jim Blandy committed
506 507 508
			     (forward-line 1)
			     (point))))
	   (this-row array-row)
509
	   (goal-row (limit-index (+ this-row arg) array-max-row))
Jim Blandy's avatar
Jim Blandy committed
510 511 512 513 514 515 516 517 518
	   (num (- goal-row this-row))
	   (count (abs num))
	   (sign (if (not (zerop count)) (/ num count))))
      (while (> count 0)
	(setq this-row (+ this-row sign))
	(array-move-to-cell this-row 1)
	(let ((inhibit-quit t))
	  (delete-region (point)
			 (save-excursion
519
			   (array-move-to-cell this-row array-max-column)
Jim Blandy's avatar
Jim Blandy committed
520 521
			   (forward-line 1)
			   (point)))
522
	  (insert array-copy-string))
Jim Blandy's avatar
Jim Blandy committed
523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538
	(setq count (1- count)))
      (array-move-to-cell goal-row (or array-column 1)))))
  (array-normalize-cursor))

(defun array-copy-row-up (&optional arg)
  "Copy the entire current array row into the row above.
If optional ARG is given, copy through ARG rows up."
  (interactive "p")
  (array-copy-row-down (- arg)))

(defun array-fill-rectangle ()
  "Copy the field at mark into every cell between mark and point."
  (interactive)
  ;; Bind arguments.
  (array-update-buffer-position)
  (let ((p-row (or (array-current-row)
539
		   (error "Cursor is not in a valid array cell")))
Jim Blandy's avatar
Jim Blandy committed
540
	(p-column (or (array-current-column)
541
		      (error "Cursor is not in a valid array cell")))
Jim Blandy's avatar
Jim Blandy committed
542 543 544 545 546
	(m-row
	 (save-excursion
	   (exchange-point-and-mark)
	   (array-update-buffer-position)
	   (or (array-current-row)
547 548
	       (error "Mark is not in a valid array cell"))))
	(m-column
Jim Blandy's avatar
Jim Blandy committed
549 550 551 552
	 (save-excursion
	   (exchange-point-and-mark)
	   (array-update-buffer-position)
	   (or (array-current-column)
553
	       (error "Mark is not in a valid array cell")))))
Jim Blandy's avatar
Jim Blandy committed
554 555 556 557 558 559
    (message "Working...")
    (let ((top-row (min m-row p-row))
	  (bottom-row (max m-row p-row))
	  (left-column (min m-column p-column))
	  (right-column (max m-column p-column)))
      ;; Do the first row.
560
      (let ((array-copy-string
Jim Blandy's avatar
Jim Blandy committed
561 562 563 564 565 566 567 568 569 570
	     (save-excursion
	       (array-move-to-cell m-row m-column)
	       (array-update-buffer-position)
	       (array-field-string))))
	(array-copy-to-cell top-row left-column)
	(array-update-array-position top-row left-column)
	(array-update-buffer-position)
	(array-copy-to-column right-column))
      ;; Do the rest of the rows.
      (array-move-to-cell top-row left-column)
571
      (let ((array-copy-string
Jim Blandy's avatar
Jim Blandy committed
572 573 574 575
	     (buffer-substring
	      (point)
	      (save-excursion
		(array-move-to-cell top-row right-column)
576
		(setq array-buffer-column (current-column))
Jim Blandy's avatar
Jim Blandy committed
577 578 579 580 581 582 583 584 585 586 587
		(array-end-of-field t)
		(point))))
	    (this-row top-row))
	(while (/= this-row bottom-row)
	  (setq this-row (1+ this-row))
	  (array-move-to-cell this-row left-column)
	  (let ((inhibit-quit t))
	    (delete-region
	     (point)
	     (save-excursion
	       (array-move-to-cell this-row right-column)
588
	       (setq array-buffer-column (current-column))
Jim Blandy's avatar
Jim Blandy committed
589 590
	       (array-end-of-field t)
	       (point)))
591
	    (insert array-copy-string)))))
Jim Blandy's avatar
Jim Blandy committed
592 593 594 595 596 597 598 599 600 601
    (message "Working...done")
    (array-goto-cell p-row p-column)))



;;; Reconfiguration of the array.

(defun array-make-template ()
  "Create the template of an array."
  (interactive)
602
  ;; If there is a conflict between array-field-width and init-string, resolve it.
Jim Blandy's avatar
Jim Blandy committed
603
  (let ((check t)
604 605
	(len)
        init-field)
Jim Blandy's avatar
Jim Blandy committed
606
    (while check
607 608
      (setq init-field (read-string "Initial field value: "))
      (setq len (length init-field))
609
      (if (/= len array-field-width)
Jim Blandy's avatar
Jim Blandy committed
610
	  (if (y-or-n-p (format "Change field width to %d? " len))
611
	      (progn (setq array-field-width len)
Jim Blandy's avatar
Jim Blandy committed
612
		     (setq check nil)))
613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631
	(setq check nil)))
    (goto-char (point-min))
    (message "Working...")
    (let ((this-row 1))
      ;; Loop through the rows.
      (while (<= this-row array-max-row)
        (if array-rows-numbered
            (insert (format "%d:\n" this-row)))
        (let ((this-column 1))
          ;; Loop through the columns.
          (while (<= this-column array-max-column)
            (insert init-field)
            (if (and (zerop (% this-column array-columns-per-line))
                     (/= this-column array-max-column))
                (newline))
            (setq this-column (1+ this-column))))
        (setq this-row (1+ this-row))
        (newline)))
    (message "Working...done"))
Jim Blandy's avatar
Jim Blandy committed
632 633 634
  (array-goto-cell 1 1))

(defun array-reconfigure-rows (new-columns-per-line new-rows-numbered)
635 636
  "Reconfigure the state of `array-rows-numbered' and `array-columns-per-line'.
NEW-COLUMNS-PER-LINE is the desired value of `array-columns-per-line' and
Jim Blandy's avatar
Jim Blandy committed
637
NEW-ROWS-NUMBERED (a character, either ?y or ?n) is the desired value
638
of `array-rows-numbered'."
Jim Blandy's avatar
Jim Blandy committed
639 640 641 642 643
  (interactive "nColumns per line: \ncRows numbered? (y or n) ")
  ;; Check on new-columns-per-line
  (let ((check t))
    (while check
      (if (and (>= new-columns-per-line 1)
644
	       (<= new-columns-per-line array-max-column))
Jim Blandy's avatar
Jim Blandy committed
645 646
	  (setq check nil)
	(setq new-columns-per-line
647
	      (string-to-number
648
	       (read-string
649
		(format "Columns per line (1 - %d): " array-max-column)))))))
Jim Blandy's avatar
Jim Blandy committed
650 651 652 653 654 655 656 657 658 659 660 661
  ;; Check on new-rows-numbered.  It has to be done this way
  ;;  because interactive does not have y-or-n-p.
  (cond
   ((eq new-rows-numbered ?y)
    (setq new-rows-numbered t))
   ((eq new-rows-numbered ?n)
    (setq new-rows-numbered nil))
   (t
    (setq new-rows-numbered (y-or-n-p "Rows numbered? "))))
  (message "Working...")
  (array-update-buffer-position)
  (let* ((main-buffer (buffer-name (current-buffer)))
662
	 (temp-buffer (generate-new-buffer " *Array*"))
663 664 665 666 667 668 669
	 (temp-max-row array-max-row)
	 (temp-max-column array-max-column)
	 (old-rows-numbered array-rows-numbered)
	 (old-columns-per-line array-columns-per-line)
	 (old-lines-per-row array-lines-per-row)
	 (old-field-width array-field-width)
	 (old-line-length array-line-length)
Jim Blandy's avatar
Jim Blandy committed
670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687
	 (this-row 1))
    (array-update-array-position)
    ;; Do the cutting in a temporary buffer.
    (copy-to-buffer temp-buffer (point-min) (point-max))
    (set-buffer temp-buffer)
    (goto-char (point-min))
    (while (<= this-row temp-max-row)
      ;; Deal with row number.
      (cond
       ((or (and old-rows-numbered new-rows-numbered)
	    (and (not old-rows-numbered) (not new-rows-numbered)))
	;; Nothing is changed.
	())
       ((and old-rows-numbered (not new-rows-numbered))
	;; Delete the row number.
	(kill-line 1))
       (t
	;; Add the row number.
688
	(insert (format "%d:\n" this-row))))
Jim Blandy's avatar
Jim Blandy committed
689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716
      ;; Deal with the array columns in this row.
      (cond
       ((= old-columns-per-line new-columns-per-line)
	;; Nothing is changed.  Go to the next row.
	(forward-line (- old-lines-per-row (if old-rows-numbered 1 0))))
       (t
	;; First expand the row.  Then cut it up into new pieces.
	(let ((newlines-to-be-removed
	       (floor (1- temp-max-column) old-columns-per-line))
	      (newlines-removed 0)
	      (newlines-to-be-added
	       (floor (1- temp-max-column) new-columns-per-line))
	      (newlines-added 0))
	  (while (< newlines-removed newlines-to-be-removed)
	    (move-to-column-untabify
	     (* (1+ newlines-removed) old-line-length))
	    (kill-line 1)
	    (setq newlines-removed (1+ newlines-removed)))
	  (beginning-of-line)
	  (while (< newlines-added newlines-to-be-added)
	    (move-to-column-untabify (* old-field-width new-columns-per-line))
	    (newline)
	    (setq newlines-added (1+ newlines-added)))
	  (forward-line 1))))
      (setq this-row (1+ this-row)))
    (let ((inhibit-quit t))
      (set-buffer main-buffer)
      (erase-buffer)
717
      (insert-buffer-substring temp-buffer)
Jim Blandy's avatar
Jim Blandy committed
718
      ;; Update local variables.
719 720 721 722
      (setq array-columns-per-line new-columns-per-line)
      (setq array-rows-numbered new-rows-numbered)
      (setq array-line-length (* old-field-width new-columns-per-line))
      (setq array-lines-per-row
723 724
	    (+ (floor (1- temp-max-column) new-columns-per-line)
	       (if new-rows-numbered 2 1)))
Jim Blandy's avatar
Jim Blandy committed
725 726 727 728 729 730 731
      (array-goto-cell (or array-row 1) (or array-column 1)))
    (kill-buffer temp-buffer))
  (message "Working...done"))

(defun array-expand-rows ()
  "Expand the rows so each fits on one line and remove row numbers."
  (interactive)
732
  (array-reconfigure-rows array-max-column ?n))
Jim Blandy's avatar
Jim Blandy committed
733 734 735 736 737 738 739 740 741 742 743



;;; Utilities.

(defun limit-index (index limit)
  (cond ((< index 1) 1)
	((> index limit) limit)
	(t index)))

(defun xor (pred1 pred2)
744
  "Return the logical exclusive or of predicates PRED1 and PRED2."
Jim Blandy's avatar
Jim Blandy committed
745 746 747 748
  (and (or pred1 pred2)
       (not (and pred1 pred2))))

(defun current-line ()
749
  "Return the current buffer line at point.  The first line is 0."
750
  (count-lines (point-min) (line-beginning-position)))
Jim Blandy's avatar
Jim Blandy committed
751 752 753 754 755 756 757

(defun move-to-column-untabify (column)
  "Move to COLUMN on the current line, untabifying if necessary.
Return COLUMN."
  (or (and (= column (move-to-column column))
	   column)
      ;; There is a tab in the way.
758 759
      (if array-respect-tabs
	  (error "There is a TAB character in the way")
Jim Blandy's avatar
Jim Blandy committed
760 761 762 763 764
	(progn
	  (untabify-backward)
	  (move-to-column column)))))

(defun untabify-backward ()
765
  "Untabify the preceding TAB."
Jim Blandy's avatar
Jim Blandy committed
766 767 768 769 770 771 772 773 774
  (save-excursion
    (let ((start (point)))
      (backward-char 1)
      (untabify (point) start))))



;;; Array mode.

775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796
(defvar array-mode-map
  (let ((map (make-keymap)))
    (define-key map "\M-ad"   'array-display-local-variables)
    (define-key map "\M-am"   'array-make-template)
    (define-key map "\M-ae"   'array-expand-rows)
    (define-key map "\M-ar"   'array-reconfigure-rows)
    (define-key map "\M-a="   'array-what-position)
    (define-key map "\M-ag"   'array-goto-cell)
    (define-key map "\M-af"   'array-fill-rectangle)
    (define-key map "\C-n"    'array-next-row)
    (define-key map "\C-p"    'array-previous-row)
    (define-key map "\C-f"    'array-forward-column)
    (define-key map "\C-b"    'array-backward-column)
    (define-key map "\M-n"    'array-copy-down)
    (define-key map "\M-p"    'array-copy-up)
    (define-key map "\M-f"    'array-copy-forward)
    (define-key map "\M-b"    'array-copy-backward)
    (define-key map "\M-\C-n" 'array-copy-row-down)
    (define-key map "\M-\C-p" 'array-copy-row-up)
    (define-key map "\M-\C-f" 'array-copy-column-forward)
    (define-key map "\M-\C-b" 'array-copy-column-backward)
    map)
Jim Blandy's avatar
Jim Blandy committed
797 798 799 800 801
  "Keymap used in array mode.")


(put 'array-mode 'mode-class 'special)

Dave Love's avatar
Dave Love committed
802
;;;###autoload
803
(define-derived-mode array-mode fundamental-mode "Array"
Jim Blandy's avatar
Jim Blandy committed
804 805 806 807 808 809
  "Major mode for editing arrays.

  Array mode is a specialized mode for editing arrays.  An array is
considered to be a two-dimensional set of strings.  The strings are
NOT recognized as integers or real numbers.

810
  The array MUST reside at the top of the buffer.
Jim Blandy's avatar
Jim Blandy committed
811 812

  TABs are not respected, and may be converted into spaces at any time.
813
Setting the variable `array-respect-tabs' to non-nil will prevent TAB conversion,
Jim Blandy's avatar
Jim Blandy committed
814 815 816 817
but will cause many functions to give errors if they encounter one.

  Upon entering array mode, you will be prompted for the values of
several variables.  Others will be calculated based on the values you
Pavel Janík's avatar
Pavel Janík committed
818
supply.  These variables are all local to the buffer.  Other buffer
Jim Blandy's avatar
Jim Blandy committed
819 820 821 822
in array mode may have different values assigned to the variables.
The variables are:

Variables you assign:
823 824 825 826 827
     array-max-row:          The number of rows in the array.
     array-max-column:       The number of columns in the array.
     array-columns-per-line: The number of columns in the array per line of buffer.
     array-field-width:      The width of each field, in characters.
     array-rows-numbered:    A logical variable describing whether to ignore
Jim Blandy's avatar
Jim Blandy committed
828 829 830
                       row numbers in the buffer.

Variables which are calculated:
831 832
     array-line-length:      The number of characters in a buffer line.
     array-lines-per-row:    The number of buffer lines used to display each row.
Jim Blandy's avatar
Jim Blandy committed
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865

  The following commands are available (an asterisk indicates it may
take a numeric prefix argument):

    *  	\\<array-mode-map>\\[array-forward-column]	  Move forward one column.
    *  	\\[array-backward-column]	  Move backward one column.
    *  	\\[array-next-row]	  Move down one row.
    *  	\\[array-previous-row]	  Move up one row.

    *   \\[array-copy-forward]	  Copy the current field into the column to the right.
    *   \\[array-copy-backward]	  Copy the current field into the column to the left.
    *   \\[array-copy-down]	  Copy the current field into the row below.
    *   \\[array-copy-up]	  Copy the current field into the row above.

    *   \\[array-copy-column-forward]   Copy the current column into the column to the right.
    *   \\[array-copy-column-backward]   Copy the current column into the column to the left.
    *   \\[array-copy-row-down]   Copy the current row into the row below.
    *   \\[array-copy-row-up]   Copy the current row into the row above.

        \\[array-fill-rectangle]   Copy the field at mark into every cell with row and column
                  between that of point and mark.

	\\[array-what-position]	  Display the current array row and column.
	\\[array-goto-cell]	  Go to a particular array cell.

	\\[array-make-template]	  Make a template for a new array.
	\\[array-reconfigure-rows]	  Reconfigure the array.
        \\[array-expand-rows]   Expand the array (remove row numbers and
                  newlines inside rows)

        \\[array-display-local-variables]   Display the current values of local variables.

Entering array mode calls the function `array-mode-hook'."
866 867
  (make-local-variable 'array-buffer-line)
  (make-local-variable 'array-buffer-column)
Jim Blandy's avatar
Jim Blandy committed
868 869
  (make-local-variable 'array-row)
  (make-local-variable 'array-column)
870
  (make-local-variable 'array-copy-string)
871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887
  (set (make-local-variable 'array-respect-tabs) nil)
  (set (make-local-variable 'array-max-row)
       (read-number "Number of array rows: "))
  (set (make-local-variable 'array-max-column)
       (read-number "Number of array columns: "))
  (set (make-local-variable 'array-columns-per-line)
       (read-number "Array columns per line: "))
  (set (make-local-variable 'array-field-width)
       (read-number "Field width: "))
  (set (make-local-variable 'array-rows-numbered)
       (y-or-n-p "Rows numbered? "))
  (set (make-local-variable 'array-line-length)
       (* array-field-width array-columns-per-line))
  (set (make-local-variable 'array-lines-per-row)
       (+ (floor (1- array-max-column) array-columns-per-line)
          (if array-rows-numbered 2 1)))
  (message "")
888
  (force-mode-line-update)
889
  (set (make-local-variable 'truncate-lines) t)
890
  (setq overwrite-mode 'overwrite-mode-textual))
Jim Blandy's avatar
Jim Blandy committed
891 892 893



Karl Heuer's avatar
Karl Heuer committed
894 895
(provide 'array)

Eric S. Raymond's avatar
Eric S. Raymond committed
896
;;; array.el ends here