summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-01-25 23:43:37 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-01-25 23:57:11 +0100
commit33a9eef11ffad3f2b2a21d2eac1e34bb72978db8 (patch)
treedadf8f0ab7fff5f43dbc35b0097035aacd74e5fc
parent54114356331fed85d69b2e5c31c03cdf81ea22ef (diff)
downloadorg-mode-33a9eef11ffad3f2b2a21d2eac1e34bb72978db8.tar.gz
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.
-rw-r--r--lisp/org-table.el95
-rw-r--r--lisp/org.el78
-rw-r--r--testing/lisp/test-org-table.el31
3 files changed, 110 insertions, 94 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 05bdf09..b9b895b 100644
--- a/lisp/org-table.el
+++ b/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)
diff --git a/lisp/org.el b/lisp/org.el
index 1f66c1f..c3711df 100644
--- a/lisp/org.el
+++ b/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
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 7c078d9..87b5c1f 100644
--- a/testing/lisp/test-org-table.el
+++ b/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