Allow editing partially shrunk columns

* lisp/org-table.el (org-table-with-shrunk-field): New macro.
(org-table-get-field):
(org-table-toggle-column-width): Use new macro.
(org-table--shrunk-field): Update function.
(org-table--shrink-field): When there is a width cookie, leave first
characters editable.

* lisp/org.el (org-self-insert-command):
(org-delete-backward-char):
(org-delete-char): Small refactoring.  Handle shrink overlays.

* testing/lisp/test-org-table.el (test-org-table/toggle-column-width):
  Update tests.

lisp/org-table.el

@@ -526,6 +526,17 @@ Field is restored even in case of abnormal exit."
 	 (org-table-goto-column ,column)
 	 (set-marker ,line nil)))))
 
+(defmacro org-table-with-shrunk-field (&rest body)
+  "Save field shrunk state, execute BODY and restore state."
+  (declare (debug (body)))
+  (org-with-gensyms (end shrunk size)
+    `(let* ((,shrunk (save-match-data (org-table--shrunk-field)))
+	    (,end (and ,shrunk (copy-marker (overlay-end ,shrunk) t)))
+	    (,size (and ,shrunk (- ,end (overlay-start ,shrunk)))))
+       (when ,shrunk (delete-overlay ,shrunk))
+       (unwind-protect (progn ,@body)
+	 (when ,shrunk (move-overlay ,shrunk (- ,end ,size) ,end))))))
+
 (defmacro org-table-with-shrunk-columns (&rest body)
   "Expand all columns before executing BODY, then shrink them again."
   (declare (debug (body)))
@@ -1265,16 +1276,8 @@ value."
     (let* ((pos (match-beginning 0))
 	   (val (buffer-substring pos (match-end 0))))
       (when replace
-	;; Since we are going to remove any hidden field, do not rely
-	;; on `org-table--hidden-field' as it could be GC'ed before
-	;; second check.
-	(let* ((hide-overlay (org-table--shrunk-field))
-	       (begin (and hide-overlay (overlay-start hide-overlay))))
-	  (when hide-overlay (delete-overlay hide-overlay))
-	  (replace-match (if (equal replace "") " " replace) t t)
-	  (when hide-overlay
-	    (move-overlay hide-overlay
-			  begin (+ begin (min 1 (length replace)))))))
+	(org-table-with-shrunk-field
+	 (replace-match (if (equal replace "") " " replace) t t)))
       (goto-char (min (line-end-position) (1+ pos)))
       val)))
 
@@ -3838,7 +3841,9 @@ When non-nil, return the overlay narrowing the field."
   (cl-some (lambda (o)
 	     (and (eq 'table-column-hide (overlay-get o 'org-overlay-type))
 		  o))
-	   (overlays-in (1- (point)) (1+ (point)))))
+	   (overlays-at (save-excursion
+			  (skip-chars-forward "^|" (line-end-position))
+			  (1- (point))))))
 
 (defun org-table--list-shrunk-columns ()
   "List currently shrunk columns in table at point."
@@ -3898,38 +3903,38 @@ Whenever the text behind or next to the overlay is modified, all
 the overlays in the column are deleted, effectively displaying
 the column again.
 
-Return overlay used to hide the field."
+Return overlay hiding the field."
   (unless (org-table--shrunk-field)
-    (let ((display
-	   (cond
-	    ((= width 0) org-table-shrunk-column-indicator)
-	    ((eq contents 'hline)
-	     (concat (make-string (1+ width) ?-)
-		     org-table-shrunk-column-indicator))
-	    (t
-	     ;; Remove invisible parts from links in CONTENTS.  Since
-	     ;; shrinking could happen before first fontification
-	     ;; (e.g., using a #+STARTUP keyword), this cannot be done
-	     ;; using text properties.
-	     (let* ((contents (org-string-display contents))
-		    (field-width (string-width contents)))
-	       (if (>= width field-width)
-		   ;; Expand field.
-		   (format " %s%s%s"
-			   contents
-			   (make-string (- width field-width) ?\s)
-			   org-table-shrunk-column-indicator)
-		 ;; Truncate field.
-		 (format " %s%s"
-			 (substring contents 0 width)
-			 org-table-shrunk-column-indicator))))))
-	  (show-before-edit
-	   (list (lambda (o &rest _)
-		   ;; Removing one overlay removes all other overlays
-		   ;; in the same column.
-		   (mapc #'delete-overlay
-			 (cdr (overlay-get o 'org-table-column-overlays))))))
-	  (o (make-overlay start end)))
+    (let* ((overlay-start
+	    (cond
+	     ((= 0 width) start)		 ;hide everything
+	     ((<= (- end start) 1) start)	 ;column too short
+	     ((>= width (- end start)) (1- end)) ;enough room
+	     ((eq contents 'hline) (+ start width))
+	     (t
+	      ;; Find cut location so that WIDTH characters are
+	      ;; visible.
+	      (let* ((begin start)
+		     (lower begin)
+		     (upper (1- end)))
+		(catch :exit
+		  (while (> (- upper lower) 1)
+		    (let ((mean (+ (ash lower -1)
+				   (ash upper -1)
+				   (logand lower upper 1))))
+		      (pcase (org-string-width (buffer-substring begin mean))
+			((pred (= width)) (throw :exit mean))
+			((pred (< width)) (setq upper mean))
+			(_ (setq lower mean)))))
+		  upper)))))
+	   (display org-table-shrunk-column-indicator)
+	   (show-before-edit
+	    (list (lambda (o &rest _)
+		    ;; Removing one overlay removes all other overlays
+		    ;; in the same column.
+		    (mapc #'delete-overlay
+			  (cdr (overlay-get o 'org-table-column-overlays))))))
+	   (o (make-overlay overlay-start end)))
       (overlay-put o 'insert-behind-hooks show-before-edit)
       (overlay-put o 'insert-in-front-hooks show-before-edit)
       (overlay-put o 'modification-hooks show-before-edit)
@@ -4069,10 +4074,8 @@ prefix, expand all columns."
       (`(16) (org-table-expand begin end))
       (_
        (org-table-expand 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))))))))
+       (org-table--shrink-columns
+	(cl-set-exclusive-or columns shrunk) begin end)))))
 
 ;;;###autoload
 (defun org-table-shrink (&optional begin end)

lisp/org.el

@@ -19235,12 +19235,13 @@ overwritten, and the table is not marked as requiring realignment."
      (t (let (org-use-speed-commands)
 	  (call-interactively 'org-self-insert-command)))))
    ((and
-     (org-at-table-p)
-     (eq N 1)
+     (= N 1)
      (not (org-region-active-p))
+     (org-at-table-p)
      (progn
        ;; Check if we blank the field, and if that triggers align.
-       (and (featurep 'org-table) org-table-auto-blank-field
+       (and (featurep 'org-table)
+	    org-table-auto-blank-field
 	    (memq last-command
 		  '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
 	    (if (or (eq (char-after) ?\s) (looking-at "[^|\n]*  |"))
@@ -19251,10 +19252,16 @@ overwritten, and the table is not marked as requiring realignment."
 	      ;; width.
 	      (org-table-blank-field)))
        t)
-     (looking-at "[^|\n]* \\( \\)|"))
+     (looking-at "[^|\n]*  |"))
     ;; There is room for insertion without re-aligning the table.
-    (delete-region (match-beginning 1) (match-end 1))
-    (self-insert-command N))
+    (self-insert-command N)
+    (org-table-with-shrunk-field
+     (save-excursion
+       (skip-chars-forward "^|")
+       ;; Do not delete last space, which is
+       ;; `org-table-separator-space', but the regular space before
+       ;; it.
+       (delete-region (- (point) 2) (1- (point))))))
    (t
     (setq org-table-may-need-update t)
     (self-insert-command N)
@@ -19355,22 +19362,14 @@ because, in this case the deletion might narrow the column."
   (interactive "p")
   (save-match-data
     (org-check-before-invisible-edit 'delete-backward)
-    (if (and (org-at-table-p)
-	     (eq N 1)
+    (if (and (= N 1)
+	     (not overwrite-mode)
 	     (not (org-region-active-p))
-	     (string-match "|" (buffer-substring (point-at-bol) (point)))
-	     (looking-at ".*?|"))
-	(let ((pos (point))
-	      (noalign (looking-at "[^|\n\r]*  |"))
-	      (c org-table-may-need-update))
-	  (backward-delete-char N)
-	  (unless overwrite-mode
-	    (skip-chars-forward "^|")
-	    (insert " ")
-	    (goto-char (1- pos)))
-	  ;; noalign: if there were two spaces at the end, this field
-	  ;; does not determine the width of the column.
-	  (when noalign (setq org-table-may-need-update c)))
+	     (not (eq (char-before) ?|))
+	     (save-excursion (skip-chars-backward " \t") (not (bolp)))
+	     (looking-at-p ".*?|")
+	     (org-at-table-p))
+	(progn (forward-char -1) (org-delete-char 1))
       (backward-delete-char N)
       (org-fix-tags-on-the-fly))))
 
@@ -19383,23 +19382,28 @@ because, in this case the deletion might narrow the column."
   (interactive "p")
   (save-match-data
     (org-check-before-invisible-edit 'delete)
-    (if (and (org-at-table-p)
-	     (not (bolp))
-	     (not (= (char-after) ?|))
-	     (eq N 1))
-	(if (looking-at ".*?|")
-	    (let ((pos (point))
-		  (noalign (looking-at "[^|\n\r]*  |"))
-		  (c org-table-may-need-update))
-	      (replace-match
-	       (concat (substring (match-string 0) 1 -1) " |") nil t)
-	      (goto-char pos)
-	      ;; noalign: if there were two spaces at the end, this field
-	      ;; does not determine the width of the column.
-	      (when noalign (setq org-table-may-need-update c)))
-	  (delete-char N))
+    (cond
+     ((or (/= N 1)
+	  (eq (char-after) ?|)
+	  (save-excursion (skip-chars-backward " \t") (bolp))
+	  (not (org-at-table-p)))
       (delete-char N)
-      (org-fix-tags-on-the-fly))))
+      (org-fix-tags-on-the-fly))
+     ((looking-at ".\\(.*?\\)|")
+      (let* ((update? org-table-may-need-update)
+	     (noalign (looking-at-p ".*?  |")))
+	(delete-char 1)
+	(org-table-with-shrunk-field
+	 (save-excursion
+	   ;; Last space is `org-table-separator-space', so insert
+	   ;; a regular one before it instead.
+	   (goto-char (- (match-end 0) 2))
+	   (insert " ")))
+	;; If there were two spaces at the end, this field does not
+	;; determine the width of the column.
+	(when noalign (setq org-table-may-need-update update?))))
+     (t
+      (delete-char N)))))
 
 ;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
 (put 'org-self-insert-command 'delete-selection

testing/lisp/test-org-table.el

@@ -2401,21 +2401,30 @@ See also `test-org-table/copy-field'."
   ;; With a column width cookie, limit overlay to the specified number
   ;; of characters.
   (should
-   (equal (concat " abc" org-table-shrunk-column-indicator)
-	  (org-test-with-temp-text "| <3> |\n| <point>abcd |"
+   (equal "| ab"
+	  (org-test-with-temp-text "| <3>  |\n| <point>abcd |"
 	    (org-table-toggle-column-width)
-	    (overlay-get (car (overlays-at (point))) 'display))))
+	    (buffer-substring (line-beginning-position)
+			      (overlay-start
+			       (car (overlays-in (line-beginning-position)
+						 (line-end-position))))))))
   (should
-   (equal (concat " a  " org-table-shrunk-column-indicator)
-	  (org-test-with-temp-text "| <3> |\n| <point>a |"
+   (equal "| a "
+	  (org-test-with-temp-text "| <3>  |\n| <point>a   |"
 	    (org-table-toggle-column-width)
-	    (overlay-get (car (overlays-at (point))) 'display))))
-  ;; Only overlay visible characters of the field.
-  (should
-   (equal (concat " htt" org-table-shrunk-column-indicator)
-	  (org-test-with-temp-text "| <3> |\n| <point>[[http://orgmode.org]] |"
+	    (buffer-substring (line-beginning-position)
+			      (overlay-start
+			       (car (overlays-in (line-beginning-position)
+						 (line-end-position))))))))
+  ;; Width only takes into account visible characters.
+  (should
+   (equal "| [[htt"
+	  (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
 	    (org-table-toggle-column-width)
-	    (overlay-get (car (overlays-at (point))) 'display))))
+	    (buffer-substring (line-beginning-position)
+			      (overlay-start
+			       (car (overlays-in (line-beginning-position)
+						 (line-end-position))))))))
   ;; Before the first column or after the last one, ask for columns
   ;; ranges.
   (should