summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-08-19 14:09:50 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-09-06 15:18:37 +0200
commit882f3f3fc0c376668cf0c27bfcf66aabda4b2f0a (patch)
tree6e534e13cb5adba91294b55b8d5e5010750e7107
parent73bf9b88875c98c01e0760eacc0b6832dc4ddb31 (diff)
downloadorg-mode-882f3f3fc0c376668cf0c27bfcf66aabda4b2f0a.tar.gz
org-table: Change behavior of `org-table-toggle-column-width'
* lisp/org-table.el (org-table-toggle-column-width): Change behavior of `org-table-toggle-column-width'. (org-table-shrink): Allow optional arguments. * testing/lisp/test-org-table.el (test-org-table/toggle-column-width): Update tests.
-rw-r--r--lisp/org-table.el91
-rw-r--r--testing/lisp/test-org-table.el24
2 files changed, 67 insertions, 48 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el
index fe9efca..951915f 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -4006,9 +4006,9 @@ If a width cookie specifies a width W for the column, the first
W visible characters are displayed. Otherwise, the column is
shrunk to a single character.
-When optional argument ARG is a string, use it as white space
-separated list of column ranges. A column range can be one of
-the following patterns:
+When point is before the first column or after the last one, ask
+for the columns to shrink or expand, as a list of ranges.
+A column range can be one of the following patterns:
N column N only
N-M every column between N and M (both inclusive)
@@ -4016,19 +4016,17 @@ the following patterns:
-M every column between the first one and M (inclusive)
- every column
-When called with `\\[universal-argument]' prefix, ask for the \
-range specification.
+When optional argument ARG is a string, use it as white space
+separated list of column ranges.
+
+When called with `\\[universal-argument]' prefix, call \
+`org-table-shrink', i.e.,
+shrink columns with a width cookie and expand the others.
When called with `\\[universal-argument] \\[universal-argument]' \
prefix, expand all columns."
(interactive "P")
- (cond ((not (org-at-table-p)) (user-error "Not in a table"))
- ((and (not arg)
- (save-excursion
- (skip-chars-backward "^|" (line-beginning-position))
- (or (bolp) (looking-at-p "[ \t]*$"))))
- ;; Point is either before first column or past last one.
- (user-error "Not in a valid column")))
+ (unless (org-at-table-p) (user-error "Not in a table"))
(let* ((pos (point))
(begin (org-table-begin))
(end (org-table-end))
@@ -4036,40 +4034,51 @@ prefix, expand all columns."
;; Nonexistent columns are ignored anyway.
(max-columns (/ (- (line-end-position) (line-beginning-position)) 2))
(shrunk (org-table--list-shrunk-columns))
- (columns (pcase arg
- (`nil
- ;; Find current column, even when on a hline.
- (let ((separator (if (org-at-table-hline-p) "+" "|"))
- (c 1))
- (save-excursion
- (beginning-of-line)
- (search-forward "|" pos t)
- (while (search-forward separator pos t) (cl-incf c)))
- (list c)))
- ((pred stringp)
- (org-table--read-column-selection arg max-columns))
- (`(4)
- (org-table--read-column-selection
- (read-string "Column ranges (e.g. 2-4 6-): ")
- max-columns))
- (`(16) nil)
- (_ (user-error "Invalid argument: %S" arg)))))
- (org-table--expand-all-columns begin end)
- (unless (equal arg '(16))
- (org-table--shrink-columns (cl-set-exclusive-or columns shrunk) begin end)
- ;; Move before overlay if point is under it.
- (let ((o (org-table--shrunk-field)))
- (when o (goto-char (overlay-start o)))))))
+ (columns
+ (pcase arg
+ (`nil
+ (if (save-excursion
+ (skip-chars-backward "^|" (line-beginning-position))
+ (or (bolp) (looking-at-p "[ \t]*$")))
+ ;; Point is either before first column or past last
+ ;; one. Ask for columns to operate on.
+ (org-table--read-column-selection
+ (read-string "Column ranges (e.g. 2-4 6-): ")
+ max-columns)
+ ;; Find current column, even when on a hline.
+ (let ((separator (if (org-at-table-hline-p) "+" "|"))
+ (c 1))
+ (save-excursion
+ (beginning-of-line)
+ (search-forward "|" pos t)
+ (while (search-forward separator pos t) (cl-incf c)))
+ (list c))))
+ ((pred stringp) (org-table--read-column-selection arg max-columns))
+ ((or `(4) `(16)) nil)
+ (_ (user-error "Invalid argument: %S" arg)))))
+ (pcase arg
+ (`(4) (org-table-shrink begin end))
+ (`(16) (org-table--expand-all-columns begin end))
+ (_
+ (org-table--expand-all-columns begin end)
+ (org-table--shrink-columns (cl-set-exclusive-or columns shrunk) begin end)
+ ;; Move before overlay if point is under it.
+ (let ((o (org-table--shrunk-field)))
+ (when o (goto-char (overlay-start o))))))))
;;;###autoload
-(defun org-table-shrink ()
+(defun org-table-shrink (&optional begin end)
"Shrink all columns with a width cookie in the table at point.
-Columns without a width cookie are expanded."
+
+Columns without a width cookie are expanded.
+
+Optional arguments BEGIN and END, when non-nil, specify the
+beginning and end position of the current table."
(interactive)
- (unless (org-at-table-p) (user-error "Not at a table"))
+ (unless (or begin (org-at-table-p)) (user-error "Not at a table"))
(org-with-wide-buffer
- (let ((begin (org-table-begin))
- (end (org-table-end))
+ (let ((begin (or begin (org-table-begin)))
+ (end (or end (org-table-end)))
(regexp "|[ \t]*<[lrc]?[0-9]+>[ \t]*\\(|\\|$\\)")
(columns))
(goto-char begin)
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index fb782bd..1f322d8 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -2240,12 +2240,6 @@ is t, then new columns should be added as needed"
(should-error
(org-test-with-temp-text "<point>a"
(org-table-toggle-column-width)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-toggle-column-width)))
- (should-error
- (org-test-with-temp-text "| a |<point>"
- (org-table-toggle-column-width)))
;; A shrunk columns is overlaid with
;; `org-table-shrunk-column-indicator'.
(should
@@ -2296,7 +2290,23 @@ is t, then new columns should be added as needed"
(org-test-with-temp-text "| <3> |\n| <point>[[http://orgmode.org]] |"
(org-table-toggle-column-width)
(overlay-get (car (overlays-at (point))) 'display))))
- ;; With optional argument ARG, toggle specified columns.
+ ;; Before the first column or after the last one, ask for columns
+ ;; ranges.
+ (should
+ (catch :exit
+ (org-test-with-temp-text "| a |"
+ (cl-letf (((symbol-function 'read-string)
+ (lambda (&rest_) (throw :exit t))))
+ (org-table-toggle-column-width)
+ nil))))
+ (should
+ (catch :exit
+ (org-test-with-temp-text "| a |<point>"
+ (cl-letf (((symbol-function 'read-string)
+ (lambda (&rest_) (throw :exit t))))
+ (org-table-toggle-column-width)
+ nil))))
+ ;; When optional argument ARG is a string, toggle specified columns.
(should
(equal org-table-shrunk-column-indicator
(org-test-with-temp-text "| <point>a | b |"