diff options
Diffstat (limited to 'lisp/array.el')
| -rw-r--r-- | lisp/array.el | 87 |
1 files changed, 45 insertions, 42 deletions
diff --git a/lisp/array.el b/lisp/array.el index 08c5ff45ddd..aed93ffb65b 100644 --- a/lisp/array.el +++ b/lisp/array.el | |||
| @@ -103,7 +103,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." | |||
| 103 | 103 | ||
| 104 | (defun array-update-buffer-position () | 104 | (defun array-update-buffer-position () |
| 105 | "Set `array-buffer-line' and `array-buffer-column' to their current values." | 105 | "Set `array-buffer-line' and `array-buffer-column' to their current values." |
| 106 | (setq array-buffer-line (current-line) | 106 | (setq array-buffer-line (array-current-line) |
| 107 | array-buffer-column (current-column))) | 107 | array-buffer-column (current-column))) |
| 108 | 108 | ||
| 109 | 109 | ||
| @@ -113,7 +113,7 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." | |||
| 113 | (defun array-what-position () | 113 | (defun array-what-position () |
| 114 | "Display the row and column in which the cursor is positioned." | 114 | "Display the row and column in which the cursor is positioned." |
| 115 | (interactive) | 115 | (interactive) |
| 116 | (let ((array-buffer-line (current-line)) | 116 | (let ((array-buffer-line (array-current-line)) |
| 117 | (array-buffer-column (current-column))) | 117 | (array-buffer-column (current-column))) |
| 118 | (message "Array row: %s Array column: %s" | 118 | (message "Array row: %s Array column: %s" |
| 119 | (prin1-to-string (array-current-row)) | 119 | (prin1-to-string (array-current-row)) |
| @@ -147,13 +147,13 @@ Set them to the optional arguments A-ROW and A-COLUMN if those are supplied." | |||
| 147 | ;;; Internal movement functions. | 147 | ;;; Internal movement functions. |
| 148 | 148 | ||
| 149 | (defun array-beginning-of-field (&optional go-there) | 149 | (defun array-beginning-of-field (&optional go-there) |
| 150 | "Return the column of the beginning of the current field. | 150 | "Return the column of the beginning of the current field. |
| 151 | Optional argument GO-THERE, if non-nil, means go there too." | 151 | Optional argument GO-THERE, if non-nil, means go there too." |
| 152 | ;; Requires that array-buffer-column be current. | 152 | ;; Requires that array-buffer-column be current. |
| 153 | (let ((goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) | 153 | (let ((goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) |
| 154 | (if go-there | 154 | (if go-there |
| 155 | (move-to-column-untabify goal-column) | 155 | (array-move-to-column-untabify goal-column) |
| 156 | goal-column))) | 156 | goal-column))) |
| 157 | 157 | ||
| 158 | (defun array-end-of-field (&optional go-there) | 158 | (defun array-end-of-field (&optional go-there) |
| 159 | "Return the column of the end of the current array field. | 159 | "Return the column of the end of the current array field. |
| @@ -162,7 +162,7 @@ If optional argument GO-THERE is non-nil, go there too." | |||
| 162 | (let ((goal-column (+ (- array-buffer-column (% array-buffer-column array-field-width)) | 162 | (let ((goal-column (+ (- array-buffer-column (% array-buffer-column array-field-width)) |
| 163 | array-field-width))) | 163 | array-field-width))) |
| 164 | (if go-there | 164 | (if go-there |
| 165 | (move-to-column-untabify goal-column) | 165 | (array-move-to-column-untabify goal-column) |
| 166 | goal-column))) | 166 | goal-column))) |
| 167 | 167 | ||
| 168 | (defun array-move-to-cell (a-row a-column) | 168 | (defun array-move-to-cell (a-row a-column) |
| @@ -174,7 +174,7 @@ Leave point at the beginning of the field and return the new buffer column." | |||
| 174 | (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) | 174 | (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) |
| 175 | (goto-char (point-min)) | 175 | (goto-char (point-min)) |
| 176 | (forward-line goal-line) | 176 | (forward-line goal-line) |
| 177 | (move-to-column-untabify goal-column))) | 177 | (array-move-to-column-untabify goal-column))) |
| 178 | 178 | ||
| 179 | (defun array-move-to-row (a-row) | 179 | (defun array-move-to-row (a-row) |
| 180 | "Move to array row A-ROW preserving the current array column. | 180 | "Move to array row A-ROW preserving the current array column. |
| @@ -184,7 +184,7 @@ Leave point at the beginning of the field and return the new array row." | |||
| 184 | (% array-buffer-line array-lines-per-row))) | 184 | (% array-buffer-line array-lines-per-row))) |
| 185 | (goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) | 185 | (goal-column (- array-buffer-column (% array-buffer-column array-field-width)))) |
| 186 | (forward-line (- goal-line array-buffer-line)) | 186 | (forward-line (- goal-line array-buffer-line)) |
| 187 | (move-to-column-untabify goal-column) | 187 | (array-move-to-column-untabify goal-column) |
| 188 | a-row)) | 188 | a-row)) |
| 189 | 189 | ||
| 190 | (defun array-move-to-column (a-column) | 190 | (defun array-move-to-column (a-column) |
| @@ -196,7 +196,7 @@ Leave point at the beginning of the field and return the new array column." | |||
| 196 | (floor (1- a-column) array-columns-per-line))) | 196 | (floor (1- a-column) array-columns-per-line))) |
| 197 | (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) | 197 | (goal-column (* array-field-width (% (1- a-column) array-columns-per-line)))) |
| 198 | (forward-line (- goal-line array-buffer-line)) | 198 | (forward-line (- goal-line array-buffer-line)) |
| 199 | (move-to-column-untabify goal-column) | 199 | (array-move-to-column-untabify goal-column) |
| 200 | a-column)) | 200 | a-column)) |
| 201 | 201 | ||
| 202 | (defun array-move-one-row (sign) | 202 | (defun array-move-one-row (sign) |
| @@ -214,7 +214,7 @@ If requested to move beyond the array bounds, signal an error." | |||
| 214 | (t | 214 | (t |
| 215 | (progn | 215 | (progn |
| 216 | (forward-line (* sign array-lines-per-row)) | 216 | (forward-line (* sign array-lines-per-row)) |
| 217 | (move-to-column-untabify goal-column) | 217 | (array-move-to-column-untabify goal-column) |
| 218 | (+ array-row sign)))))) | 218 | (+ array-row sign)))))) |
| 219 | 219 | ||
| 220 | (defun array-move-one-column (sign) | 220 | (defun array-move-one-column (sign) |
| @@ -233,15 +233,15 @@ If requested to move beyond the array bounds, signal an error." | |||
| 233 | ;; Going backward from first column on the line. | 233 | ;; Going backward from first column on the line. |
| 234 | ((and (= sign -1) (= 1 (% array-column array-columns-per-line))) | 234 | ((and (= sign -1) (= 1 (% array-column array-columns-per-line))) |
| 235 | (forward-line -1) | 235 | (forward-line -1) |
| 236 | (move-to-column-untabify | 236 | (array-move-to-column-untabify |
| 237 | (* array-field-width (1- array-columns-per-line)))) | 237 | (* array-field-width (1- array-columns-per-line)))) |
| 238 | ;; Going forward from last column on the line. | 238 | ;; Going forward from last column on the line. |
| 239 | ((and (= sign 1) (zerop (% array-column array-columns-per-line))) | 239 | ((and (= sign 1) (zerop (% array-column array-columns-per-line))) |
| 240 | (forward-line 1)) | 240 | (forward-line 1)) |
| 241 | ;; Somewhere in the middle of the line. | 241 | ;; Somewhere in the middle of the line. |
| 242 | (t | 242 | (t |
| 243 | (move-to-column-untabify (+ (array-beginning-of-field) | 243 | (array-move-to-column-untabify (+ (array-beginning-of-field) |
| 244 | (* array-field-width sign))))) | 244 | (* array-field-width sign))))) |
| 245 | (+ array-column sign))))) | 245 | (+ array-column sign))))) |
| 246 | 246 | ||
| 247 | (defun array-normalize-cursor () | 247 | (defun array-normalize-cursor () |
| @@ -281,15 +281,15 @@ If necessary, scroll horizontally to keep the cursor in view." | |||
| 281 | "Move down one array row, staying in the current array column. | 281 | "Move down one array row, staying in the current array column. |
| 282 | If optional ARG is given, move down ARG array rows." | 282 | If optional ARG is given, move down ARG array rows." |
| 283 | (interactive "p") | 283 | (interactive "p") |
| 284 | (let ((array-buffer-line (current-line)) | 284 | (let ((array-buffer-line (array-current-line)) |
| 285 | (array-buffer-column (current-column))) | 285 | (array-buffer-column (current-column))) |
| 286 | (if (= (abs arg) 1) | 286 | (if (= (abs arg) 1) |
| 287 | (array-move-one-row arg) | 287 | (array-move-one-row arg) |
| 288 | (array-move-to-row | 288 | (array-move-to-row |
| 289 | (limit-index (+ (or (array-current-row) | 289 | (array--limit-index (+ (or (array-current-row) |
| 290 | (error "Cursor is not in an array cell")) | 290 | (error "Cursor is not in an array cell")) |
| 291 | arg) | 291 | arg) |
| 292 | array-max-row)))) | 292 | array-max-row)))) |
| 293 | (array-normalize-cursor)) | 293 | (array-normalize-cursor)) |
| 294 | 294 | ||
| 295 | (defun array-previous-row (&optional arg) | 295 | (defun array-previous-row (&optional arg) |
| @@ -303,15 +303,15 @@ If optional ARG is given, move up ARG array rows." | |||
| 303 | If optional ARG is given, move forward ARG array columns. | 303 | If optional ARG is given, move forward ARG array columns. |
| 304 | If necessary, keep the cursor in the window by scrolling right or left." | 304 | If necessary, keep the cursor in the window by scrolling right or left." |
| 305 | (interactive "p") | 305 | (interactive "p") |
| 306 | (let ((array-buffer-line (current-line)) | 306 | (let ((array-buffer-line (array-current-line)) |
| 307 | (array-buffer-column (current-column))) | 307 | (array-buffer-column (current-column))) |
| 308 | (if (= (abs arg) 1) | 308 | (if (= (abs arg) 1) |
| 309 | (array-move-one-column arg) | 309 | (array-move-one-column arg) |
| 310 | (array-move-to-column | 310 | (array-move-to-column |
| 311 | (limit-index (+ (or (array-current-column) | 311 | (array--limit-index (+ (or (array-current-column) |
| 312 | (error "Cursor is not in an array cell")) | 312 | (error "Cursor is not in an array cell")) |
| 313 | arg) | 313 | arg) |
| 314 | array-max-column)))) | 314 | array-max-column)))) |
| 315 | (array-normalize-cursor)) | 315 | (array-normalize-cursor)) |
| 316 | 316 | ||
| 317 | (defun array-backward-column (&optional arg) | 317 | (defun array-backward-column (&optional arg) |
| @@ -325,8 +325,8 @@ If necessary, keep the cursor in the window by scrolling right or left." | |||
| 325 | "Go to array row A-ROW and array column A-COLUMN." | 325 | "Go to array row A-ROW and array column A-COLUMN." |
| 326 | (interactive "nArray row: \nnArray column: ") | 326 | (interactive "nArray row: \nnArray column: ") |
| 327 | (array-move-to-cell | 327 | (array-move-to-cell |
| 328 | (limit-index a-row array-max-row) | 328 | (array--limit-index a-row array-max-row) |
| 329 | (limit-index a-column array-max-column)) | 329 | (array--limit-index a-column array-max-column)) |
| 330 | (array-normalize-cursor)) | 330 | (array-normalize-cursor)) |
| 331 | 331 | ||
| 332 | 332 | ||
| @@ -417,7 +417,7 @@ Leave point at the beginning of the field." | |||
| 417 | "Copy the current field one array row down. | 417 | "Copy the current field one array row down. |
| 418 | If optional ARG is given, copy down through ARG array rows." | 418 | If optional ARG is given, copy down through ARG array rows." |
| 419 | (interactive "p") | 419 | (interactive "p") |
| 420 | (let* ((array-buffer-line (current-line)) | 420 | (let* ((array-buffer-line (array-current-line)) |
| 421 | (array-buffer-column (current-column)) | 421 | (array-buffer-column (current-column)) |
| 422 | (array-row (or (array-current-row) | 422 | (array-row (or (array-current-row) |
| 423 | (error "Cursor is not in a valid array cell"))) | 423 | (error "Cursor is not in a valid array cell"))) |
| @@ -425,7 +425,7 @@ If optional ARG is given, copy down through ARG array rows." | |||
| 425 | (if (= (abs arg) 1) | 425 | (if (= (abs arg) 1) |
| 426 | (array-copy-once-vertically arg) | 426 | (array-copy-once-vertically arg) |
| 427 | (array-copy-to-row | 427 | (array-copy-to-row |
| 428 | (limit-index (+ array-row arg) array-max-row)))) | 428 | (array--limit-index (+ array-row arg) array-max-row)))) |
| 429 | (array-normalize-cursor)) | 429 | (array-normalize-cursor)) |
| 430 | 430 | ||
| 431 | (defun array-copy-up (&optional arg) | 431 | (defun array-copy-up (&optional arg) |
| @@ -438,7 +438,7 @@ If optional ARG is given, copy up through ARG array rows." | |||
| 438 | "Copy the current field one array column to the right. | 438 | "Copy the current field one array column to the right. |
| 439 | If optional ARG is given, copy through ARG array columns to the right." | 439 | If optional ARG is given, copy through ARG array columns to the right." |
| 440 | (interactive "p") | 440 | (interactive "p") |
| 441 | (let* ((array-buffer-line (current-line)) | 441 | (let* ((array-buffer-line (array-current-line)) |
| 442 | (array-buffer-column (current-column)) | 442 | (array-buffer-column (current-column)) |
| 443 | (array-column (or (array-current-column) | 443 | (array-column (or (array-current-column) |
| 444 | (error "Cursor is not in a valid array cell"))) | 444 | (error "Cursor is not in a valid array cell"))) |
| @@ -446,7 +446,7 @@ If optional ARG is given, copy through ARG array columns to the right." | |||
| 446 | (if (= (abs arg) 1) | 446 | (if (= (abs arg) 1) |
| 447 | (array-copy-once-horizontally arg) | 447 | (array-copy-once-horizontally arg) |
| 448 | (array-copy-to-column | 448 | (array-copy-to-column |
| 449 | (limit-index (+ array-column arg) array-max-column)))) | 449 | (array--limit-index (+ array-column arg) array-max-column)))) |
| 450 | (array-normalize-cursor)) | 450 | (array-normalize-cursor)) |
| 451 | 451 | ||
| 452 | (defun array-copy-backward (&optional arg) | 452 | (defun array-copy-backward (&optional arg) |
| @@ -473,7 +473,7 @@ If optional ARG is given, copy through ARG array columns to the right." | |||
| 473 | (if (= (abs arg) 1) | 473 | (if (= (abs arg) 1) |
| 474 | (array-copy-once-horizontally arg) | 474 | (array-copy-once-horizontally arg) |
| 475 | (array-copy-to-column | 475 | (array-copy-to-column |
| 476 | (limit-index (+ array-column arg) array-max-column)))))) | 476 | (array--limit-index (+ array-column arg) array-max-column)))))) |
| 477 | (message "Working...done") | 477 | (message "Working...done") |
| 478 | (array-move-to-row array-row) | 478 | (array-move-to-row array-row) |
| 479 | (array-normalize-cursor)) | 479 | (array-normalize-cursor)) |
| @@ -506,7 +506,7 @@ If optional ARG is given, copy through ARG rows down." | |||
| 506 | (forward-line 1) | 506 | (forward-line 1) |
| 507 | (point)))) | 507 | (point)))) |
| 508 | (this-row array-row) | 508 | (this-row array-row) |
| 509 | (goal-row (limit-index (+ this-row arg) array-max-row)) | 509 | (goal-row (array--limit-index (+ this-row arg) array-max-row)) |
| 510 | (num (- goal-row this-row)) | 510 | (num (- goal-row this-row)) |
| 511 | (count (abs num)) | 511 | (count (abs num)) |
| 512 | (sign (if (not (zerop count)) (/ num count)))) | 512 | (sign (if (not (zerop count)) (/ num count)))) |
| @@ -700,13 +700,13 @@ of `array-rows-numbered'." | |||
| 700 | (floor (1- temp-max-column) new-columns-per-line)) | 700 | (floor (1- temp-max-column) new-columns-per-line)) |
| 701 | (newlines-added 0)) | 701 | (newlines-added 0)) |
| 702 | (while (< newlines-removed newlines-to-be-removed) | 702 | (while (< newlines-removed newlines-to-be-removed) |
| 703 | (move-to-column-untabify | 703 | (array-move-to-column-untabify |
| 704 | (* (1+ newlines-removed) old-line-length)) | 704 | (* (1+ newlines-removed) old-line-length)) |
| 705 | (kill-line 1) | 705 | (kill-line 1) |
| 706 | (setq newlines-removed (1+ newlines-removed))) | 706 | (setq newlines-removed (1+ newlines-removed))) |
| 707 | (beginning-of-line) | 707 | (beginning-of-line) |
| 708 | (while (< newlines-added newlines-to-be-added) | 708 | (while (< newlines-added newlines-to-be-added) |
| 709 | (move-to-column-untabify (* old-field-width new-columns-per-line)) | 709 | (array-move-to-column-untabify (* old-field-width new-columns-per-line)) |
| 710 | (newline) | 710 | (newline) |
| 711 | (setq newlines-added (1+ newlines-added))) | 711 | (setq newlines-added (1+ newlines-added))) |
| 712 | (forward-line 1)))) | 712 | (forward-line 1)))) |
| @@ -735,16 +735,16 @@ of `array-rows-numbered'." | |||
| 735 | 735 | ||
| 736 | ;;; Utilities. | 736 | ;;; Utilities. |
| 737 | 737 | ||
| 738 | (defun limit-index (index limit) | 738 | (defun array--limit-index (index limit) |
| 739 | (cond ((< index 1) 1) | 739 | (cond ((< index 1) 1) |
| 740 | ((> index limit) limit) | 740 | ((> index limit) limit) |
| 741 | (t index))) | 741 | (t index))) |
| 742 | 742 | ||
| 743 | (defun current-line () | 743 | (defun array-current-line () |
| 744 | "Return the current buffer line at point. The first line is 0." | 744 | "Return the current buffer line at point. The first line is 0." |
| 745 | (count-lines (point-min) (line-beginning-position))) | 745 | (count-lines (point-min) (line-beginning-position))) |
| 746 | 746 | ||
| 747 | (defun move-to-column-untabify (column) | 747 | (defun array-move-to-column-untabify (column) |
| 748 | "Move to COLUMN on the current line, untabifying if necessary. | 748 | "Move to COLUMN on the current line, untabifying if necessary. |
| 749 | Return COLUMN." | 749 | Return COLUMN." |
| 750 | (or (and (= column (move-to-column column)) | 750 | (or (and (= column (move-to-column column)) |
| @@ -753,10 +753,10 @@ Return COLUMN." | |||
| 753 | (if array-respect-tabs | 753 | (if array-respect-tabs |
| 754 | (error "There is a TAB character in the way") | 754 | (error "There is a TAB character in the way") |
| 755 | (progn | 755 | (progn |
| 756 | (untabify-backward) | 756 | (array--untabify-backward) |
| 757 | (move-to-column column))))) | 757 | (move-to-column column))))) |
| 758 | 758 | ||
| 759 | (defun untabify-backward () | 759 | (defun array--untabify-backward () |
| 760 | "Untabify the preceding TAB." | 760 | "Untabify the preceding TAB." |
| 761 | (save-excursion | 761 | (save-excursion |
| 762 | (let ((start (point))) | 762 | (let ((start (point))) |
| @@ -885,7 +885,10 @@ Entering array mode calls the function `array-mode-hook'." | |||
| 885 | (setq-local truncate-lines t) | 885 | (setq-local truncate-lines t) |
| 886 | (setq overwrite-mode 'overwrite-mode-textual)) | 886 | (setq overwrite-mode 'overwrite-mode-textual)) |
| 887 | 887 | ||
| 888 | 888 | (define-obsolete-function-alias 'limit-index #'array--limit-index "29.1") | |
| 889 | (define-obsolete-function-alias 'current-line #'array-current-line "29.1") | ||
| 890 | (define-obsolete-function-alias 'move-to-column-untabify #'array-move-to-column-untabify "29.1") | ||
| 891 | (define-obsolete-function-alias 'untabify-backward #'array--untabify-backward "29.1") | ||
| 889 | 892 | ||
| 890 | (provide 'array) | 893 | (provide 'array) |
| 891 | 894 | ||