From 6f50526fa642ea74716dd4668e2b36b0ff9c6134 Mon Sep 17 00:00:00 2001 From: Chris Kauffman Date: Sun, 23 Jul 2017 00:13:11 -0400 Subject: [PATCH 1/8] org-table: Adding single cell movement functions and tests. * org-mode/lisp/org-table.el: New functions for single table cell movement such as (org-table-move-single-cell-down) * testing/lisp/test-org-table.el: Added tests for single table cell movement such as (test-org-table/move-single-cell-down) --- lisp/org-table.el | 71 ++++++ testing/lisp/test-org-table.el | 385 +++++++++++++++++++++++++++++++++ 2 files changed, 456 insertions(+) diff --git a/lisp/org-table.el b/lisp/org-table.el index 37e40de1e..2b80bfc3a 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1436,6 +1436,77 @@ non-nil, the one above is used." (t (setq min mean))))) (if above min max)))))) +;;;###autoload +(defun org-table-max-line-col () + "Return the maximum line and column of the current table as a +list of two numbers" + (when (not (org-at-table-p)) + (user-error "Not in an org-table")) + (let ((table-end (org-table-end))) + (save-mark-and-excursion + (goto-char table-end) + (org-table-previous-field) + (list (org-table-current-line) (org-table-current-column))))) + +;;;###autoload +(defun org-table-swap-cells (row1 col1 row2 col2) + "Swap two cells indicated by the coordinates provided" + (let ((content1 (org-table-get row1 col1)) + (content2 (org-table-get row2 col2))) + (org-table-put row1 col1 content2) + (org-table-put row2 col2 content1) + (org-table-align))) + +;;;###autoload +(defun org-table-move-single-cell (direction) + "Move the current cell in a cardinal direction according to the +parameter symbol: 'up 'down 'left 'right. Swaps contents of +adjacent cell with current one." + (unless (org-at-table-p) + (error "No table at point")) + (let ((drow 0) (dcol 0)) + (cond ((equal direction 'up) (setq drow -1)) + ((equal direction 'down) (setq drow +1)) + ((equal direction 'left) (setq dcol -1)) + ((equal direction 'right) (setq dcol +1)) + (t (error "Not a valid direction, must be one of 'up 'down 'left 'right"))) + (let* ((row1 (org-table-current-line)) + (col1 (org-table-current-column)) + (row2 (+ row1 drow)) + (col2 (+ col1 dcol)) + (max-row-col (org-table-max-line-col)) + (max-row (car max-row-col)) + (max-col (cadr max-row-col))) + (when (or (< col1 1) (< col2 1) (> col2 max-col) (< row2 1) (> row2 max-row)) + (user-error "Cannot move cell further")) + (org-table-swap-cells row1 col1 row2 col2) + (org-table-goto-line row2) + (org-table-goto-column col2)))) + +;;;###autoload +(defun org-table-move-single-cell-up () + "Move a single cell up in a table; swap with anything in target cell" + (interactive) + (org-table-move-single-cell 'up)) + +;;;###autoload +(defun org-table-move-single-cell-down () + "Move a single cell down in a table; swap with anything in target cell" + (interactive) + (org-table-move-single-cell 'down)) + +;;;###autoload +(defun org-table-move-single-cell-left () + "Move a single cell left in a table; swap with anything in target cell" + (interactive) + (org-table-move-single-cell 'left)) + +;;;###autoload +(defun org-table-move-single-cell-right () + "Move a single cell right in a table; swap with anything in target cell" + (interactive) + (org-table-move-single-cell 'right)) + ;;;###autoload (defun org-table-delete-column () "Delete a column from the table." diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el index 99f593c25..de9a1ad4b 100644 --- a/testing/lisp/test-org-table.el +++ b/testing/lisp/test-org-table.el @@ -2102,6 +2102,391 @@ is t, then new columns should be added as needed" +;;; Moving single cells +(ert-deftest test-org-table/move-single-cell-down () + "Test `org-table-move-single-cell-down' specifications." + ;; Error out when cell cannot be moved due to not in table, + ;; in the last row of the table, or is on a hline + (should-error + (org-test-with-temp-text "not in\na table\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a |" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a |\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a | b |\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a | b |\n| c | d |\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a | b |\n| c | d |\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "| a |\n|---|\n" + (org-table-move-single-cell-down))) + (should-error + (org-test-with-temp-text "|---|\n| a |\n" + (org-table-move-single-cell-down))) + ;; Check for correct cell movement + (should (equal (concat "| c | b |\n" + "| a | d |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (buffer-string)))) + (should (equal (concat "| a | d |\n" + "| c | b |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (buffer-string)))) + (should (equal (concat "| a | b |\n" + "| e | d |\n" + "| c | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (buffer-string)))) + (should (equal (concat "| a | d |\n" + "| c | f |\n" + "| e | b |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (org-table-move-single-cell-down) + (buffer-string)))) + ;; Check for correct handling of hlines which should not change + ;; position on single cell moves + (should (equal (concat "| c | b |\n" + "|---+---|\n" + "| a | d |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (buffer-string)))) + (should (equal (concat "| a | d |\n" + "|---+---|\n" + "| c | f |\n" + "| e | b |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (org-table-move-single-cell-down) + (buffer-string)))) + (should (equal (concat "| a | b |\n" + "|---+---|\n" + "| c | f |\n" + "| e | d |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-down) + (buffer-string)))) + + ;; Move single cell even without a final newline. Seems that some + (should (equal (concat "| a | d |\n" + "|---+---|\n" + "| c | f |\n" + "| e | b |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |") + (org-table-move-single-cell-down) + (org-table-move-single-cell-down) + (buffer-string))))) +(ert-deftest test-org-table/move-single-cell-up () + "Test `org-table-move-single-cell-up' specifications." + ;; Error out when cell cannot be moved due to not in table, + ;; in the last row of the table, or is on a hline + (should-error + (org-test-with-temp-text "not in\na table\n" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "| a |" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "| a |\n" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "| a | b |\n" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "| a | b |\n| c | d |\n" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "| a |\n|---|\n" + (org-table-move-single-cell-up))) + (should-error + (org-test-with-temp-text "|---|\n| a |\n" + (org-table-move-single-cell-up))) + ;; Check for correct cell movement + (should (equal (concat "| c | b |\n" + "| a | d |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (buffer-string)))) + (should (equal (concat "| a | d |\n" + "| c | b |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (buffer-string)))) + (should (equal (concat "| a | b |\n" + "| e | d |\n" + "| c | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (buffer-string)))) + (should (equal (concat "| a | f |\n" + "| c | b |\n" + "| e | d |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (org-table-move-single-cell-up) + (buffer-string)))) + ;; Check for correct handling of hlines which should not change + ;; position on single cell moves + (should (equal (concat "| c | b |\n" + "|---+---|\n" + "| a | d |\n" + "| e | f |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (buffer-string)))) + (should (equal (concat "| a | f |\n" + "|---+---|\n" + "| c | b |\n" + "| e | d |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (org-table-move-single-cell-up) + (buffer-string)))) + (should (equal (concat "| a | b |\n" + "|---+---|\n" + "| c | f |\n" + "| e | d |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |\n") + (org-table-move-single-cell-up) + (buffer-string)))) + + ;; Move single cell even without a final newline. Seems that some + (should (equal (concat "| a | f |\n" + "|---+---|\n" + "| c | b |\n" + "| e | d |\n") + (org-test-with-temp-text + (concat "| a | b |\n" + "|---+---|\n" + "| c | d |\n" + "| e | f |") + (org-table-move-single-cell-up) + (org-table-move-single-cell-up) + (buffer-string))))) +(ert-deftest test-org-table/move-single-cell-right () + "Test `org-table-move-single-cell-right' specifications." + ;; Error out when cell cannot be moved due to not in table, + ;; in the last col of the table, or is on a hline + (should-error + (org-test-with-temp-text "not in\na table\n" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "| a |" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "| a |\n" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "| a |\n| b |\n" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "| a | b |\n| c | d |\n" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "| a |\n|---|\n" + (org-table-move-single-cell-right))) + (should-error + (org-test-with-temp-text "|---|\n| a |\n" + (org-table-move-single-cell-right))) + ;; Check for correct cell movement + (should (equal (concat "| b | a | c |\n" + "| d | e | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-right) + (buffer-string)))) + (should (equal (concat "| b | c | a |\n" + "| d | e | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-right) + (org-table-move-single-cell-right) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "| e | f | d |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-right) + (org-table-move-single-cell-right) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "| d | f | e |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-right) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "|---+---+---|\n" + "| e | f | d |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "|---+---+---|\n" + "| d | e | f |\n") + (org-table-move-single-cell-right) + (org-table-move-single-cell-right) + (buffer-string)))) + ;; Move single cell even without a final newline. Seems that some + (should (equal (concat "| a | b | c |\n" + "|---+---+---|\n" + "| e | d | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "|---+---+---|\n" + "| d | e | f |") + (org-table-move-single-cell-right) + (buffer-string))))) +(ert-deftest test-org-table/move-single-cell-left () + "Test `org-table-move-single-cell-left' specifications." + ;; Error out when cell cannot be moved due to not in table, + ;; in the last col of the table, or is on a hline + (should-error + (org-test-with-temp-text "not in\na table\n" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "| a |" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "| a |\n" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "| a |\n| b |\n" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "| a | b |\n| c | d |\n" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "| a |\n|---|\n" + (org-table-move-single-cell-left))) + (should-error + (org-test-with-temp-text "|---|\n| a |\n" + (org-table-move-single-cell-left))) + ;; Check for correct cell movement + (should (equal (concat "| b | a | c |\n" + "| d | e | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-left) + (buffer-string)))) + (should (equal (concat "| c | a | b |\n" + "| d | e | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-left) + (org-table-move-single-cell-left) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "| f | d | e |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-left) + (org-table-move-single-cell-left) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "| d | f | e |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "| d | e | f |\n") + (org-table-move-single-cell-left) + (buffer-string)))) + (should (equal (concat "| a | b | c |\n" + "|---+---+---|\n" + "| f | d | e |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "|---+---+---|\n" + "| d | e | f |\n") + (org-table-move-single-cell-left) + (org-table-move-single-cell-left) + (buffer-string)))) + ;; Move single cell even without a final newline. Seems that some + (should (equal (concat "| a | b | c |\n" + "|---+---+---|\n" + "| e | d | f |\n") + (org-test-with-temp-text + (concat "| a | b | c |\n" + "|---+---+---|\n" + "| d | e | f |") + (org-table-move-single-cell-left) + (buffer-string)))) + ) + + ;;; Moving rows, moving columns (ert-deftest test-org-table/move-row-down () -- 2.17.0