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.

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
+When point is before the first column or after the last one, ask
-separated list of column ranges.  A column range can be one of
+for the columns to shrink or expand, as a list of ranges.
-the following patterns:
+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 \
+When optional argument ARG is a string, use it as white space
-range specification.
+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"))
+  (unless (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")))
   (let* ((pos (point))
 	 (begin (org-table-begin))
 	 (end (org-table-end))
@@ -4036,8 +4034,17 @@ 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
+	 (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))
@@ -4045,31 +4052,33 @@ prefix, expand all columns."
 		   (beginning-of-line)
 		   (search-forward "|" pos t)
 		   (while (search-forward separator pos t) (cl-incf c)))
-		       (list c)))
+		 (list c))))
-		    ((pred stringp)
+	    ((pred stringp) (org-table--read-column-selection arg max-columns))
-		     (org-table--read-column-selection arg max-columns))
+	    ((or `(4) `(16)) nil)
-		    (`(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)))))
+    (pcase arg
+      (`(4) (org-table-shrink begin end))
+      (`(16) (org-table--expand-all-columns begin end))
+      (_
        (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)))))))
+	 (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))
+   (let ((begin (or begin (org-table-begin)))
-	 (end (org-table-end))
+	 (end (or end (org-table-end)))
 	 (regexp "|[ \t]*<[lrc]?[0-9]+>[ \t]*\\(|\\|$\\)")
 	 (columns))
      (goto-char begin)

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 |"