* org table toggle narrowing and true column hiding
@ 2017-06-21 9:24 Uwe Brauer
2017-06-22 18:06 ` Nicolas Goaziou
2017-06-23 16:23 ` org table toggle narrowing and true column hiding Michael Brand
0 siblings, 2 replies; 17+ messages in thread
From: Uwe Brauer @ 2017-06-21 9:24 UTC (permalink / raw)
To: emacs-orgmode
Hi
Googling showed me that the question has been asked 2 years ago, so I
repeat it just in case:
Any plans to implement true column hiding for org tables?
Concerning narrowing (poor man version of hiding)
| Name | passport | Other |
| | <2> | |
| John Doe | 1234567 | |
In a org mode buffer (not here in a message buffer even with orgtbl-mode
enabled)
C-c C-C gives
| Name | <2> | Other |
| | <2> | |
| John Doe | <2> | |
The question is simple: how can a toggle narrowing?
thanks
Uwe Brauer
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-21 9:24 org table toggle narrowing and true column hiding Uwe Brauer
@ 2017-06-22 18:06 ` Nicolas Goaziou
2017-06-23 9:49 ` Uwe Brauer
2017-06-23 16:23 ` org table toggle narrowing and true column hiding Michael Brand
1 sibling, 1 reply; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-22 18:06 UTC (permalink / raw)
To: emacs-orgmode
Hello,
Uwe Brauer <oub@mat.ucm.es> writes:
> Googling showed me that the question has been asked 2 years ago, so I
> repeat it just in case:
>
> Any plans to implement true column hiding for org tables?
What is true column hiding? What is the question you are referring to?
> In a org mode buffer (not here in a message buffer even with orgtbl-mode
> enabled)
>
> C-c C-C gives
>
> | Name | <2> | Other |
> | | <2> | |
> | John Doe | <2> | |
>
>
> The question is simple: how can a toggle narrowing?
I don't understand your question.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-22 18:06 ` Nicolas Goaziou
@ 2017-06-23 9:49 ` Uwe Brauer
2017-06-24 8:48 ` Nicolas Goaziou
0 siblings, 1 reply; 17+ messages in thread
From: Uwe Brauer @ 2017-06-23 9:49 UTC (permalink / raw)
To: emacs-orgmode
> Hello,
> Uwe Brauer <oub@mat.ucm.es> writes:
> What is true column hiding? What is the question you are referring to?
Most of the spreadsheet application I know allow you
- to mark a column
- and to hide it (it is still there and can be displayed of course)
That question was asked for example in
https://www.reddit.com/r/emacs/comments/2blff3/is_it_possible_to_hide_some_columns_from_an_org
I now that I can hide regions in emacs but I am not sure about rectangles.
> I don't understand your question.
- Well part one:
Original table
| Name | Passport | other |
| | <2> | |
| Joe | 123456 | |
| John | 456789 | |
- part two: narrow the second column
| Name | =>> | other |
| | =>> | |
| Joe | =>> | |
| John | ==> | |
- part three missing: how can I recover the original table (something like
widening)?????
The only solution I came up with is rather cumbersome
(defun org-table-turn-narrowing-off ()
(interactive)
(setq org-table-do-narrow nil)
(message "Now table narrowing is off!"))
(defun org-table-turn-narrowing-on ()
(interactive)
(setq org-table-do-narrow t)
(message "Now table narrowing is on!"))
(defun org-table-toggle-narrowing ()
"Toggle function between New subject is in same thread or not."
(interactive)
(make-repeat-command 'org-table-toggle-narrowing
'(org-table-turn-narrowing-on
org-table-turn-narrowing-off)))
Turning narrowing of and run C-c C-c again.
I hope there are more comfortable solutions.
Uwe Brauer
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-21 9:24 org table toggle narrowing and true column hiding Uwe Brauer
2017-06-22 18:06 ` Nicolas Goaziou
@ 2017-06-23 16:23 ` Michael Brand
2017-06-23 21:21 ` Uwe Brauer
1 sibling, 1 reply; 17+ messages in thread
From: Michael Brand @ 2017-06-23 16:23 UTC (permalink / raw)
To: Org Mode
Hi Uwe
On Wed, Jun 21, 2017 at 11:24 AM, Uwe Brauer <oub@mat.ucm.es> wrote:
> Any plans to implement true column hiding for org tables?
Not that I know of. How would you select a hidden column to unhide it?
> Concerning narrowing (poor man version of hiding)
>
> | Name | passport | Other |
> | | <2> | |
> | John Doe | 1234567 | |
This is a good idea for your use case.
> The question is simple: how can a toggle narrowing?
To view all columns at once you can temporarily "C-c SPC C-c C-c" on
<2> and double undo.
To view only one field at a time and optionally edit it you can use
"C-c `" with zero, one or -- the coolest -- two C-u prefixes:
(info "(org) Built-in table editor")
`C-c ` (`org-table-edit-field')'
Edit the current field in a separate window. This is useful for
fields that are not fully visible (*note Column width and
alignment::). When called with a `C-u' prefix, just make the full
field visible, so that it can be edited in place. When called
with two `C-u' prefixes, make the editor window follow the cursor
through the table and always show the current field. The follow
mode exits automatically when the cursor leaves the table, or when
you repeat this command with `C-u C-u C-c `'.
Michael
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-23 16:23 ` org table toggle narrowing and true column hiding Michael Brand
@ 2017-06-23 21:21 ` Uwe Brauer
0 siblings, 0 replies; 17+ messages in thread
From: Uwe Brauer @ 2017-06-23 21:21 UTC (permalink / raw)
To: emacs-orgmode
>>> "Michael" == Michael Brand <michael.ch.brand@gmail.com> writes:
> Hi Uwe
> On Wed, Jun 21, 2017 at 11:24 AM, Uwe Brauer <oub@mat.ucm.es> wrote:
>> Any plans to implement true column hiding for org tables?
> Not that I know of. How would you select a hidden column to unhide it?
Similar as in LO/OO excel and friends, I would need to have
org-table-toggle-coordinate-overlays on
and so columns are indicated by $1, $2 etc
and hidden columns would correspond to missing numbers
|$1-+|$6
so $2, $3 $4 $5 are hidden
> To view only one field at a time and optionally edit it you can use
> "C-c `" with zero, one or -- the coolest -- two C-u prefixes:
That is indeed cool thanks
Uwe
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-23 9:49 ` Uwe Brauer
@ 2017-06-24 8:48 ` Nicolas Goaziou
2017-06-24 21:06 ` Uwe Brauer
0 siblings, 1 reply; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-24 8:48 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1063 bytes --]
Hello,
Uwe Brauer <oub@mat.ucm.es> writes:
> > Hello,
> > Uwe Brauer <oub@mat.ucm.es> writes:
>
>
> > What is true column hiding? What is the question you are referring to?
>
> Most of the spreadsheet application I know allow you
>
> - to mark a column
>
> - and to hide it (it is still there and can be displayed of course)
>
> That question was asked for example in
> https://www.reddit.com/r/emacs/comments/2blff3/is_it_possible_to_hide_some_columns_from_an_org
I toyed with the idea, and came up with a proof-of-concept, attached to
this message.
Basically, it defines two user-facing functions: `org-table-hide-column'
and `org-table-show-column'. Whenever the contents of an hidden column
is changed by the user, the column is shown automatically.
It is probably full of bugs, and I'm not sure it's really worth it, but
here we go. Note that the implementation uses overlays rather than text
properties, so hidden columns are not preserved upon closing and opening
a document.
Feedback welcome.
Regards,
--
Nicolas Goaziou
[-- Attachment #2: 0001-org-table-Implement-hidden-columns.patch --]
[-- Type: text/x-diff, Size: 33562 bytes --]
From f1c858cad711d367e43ba118dc6e3d111705a6d1 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Sat, 24 Jun 2017 10:37:39 +0200
Subject: [PATCH] org-table: Implement hidden columns
* lisp/org-table.el (org-table-with-hidden-columns): New macro.
(org-table--hidden-field):
(org-table--list-hidden-columns):
(org-table--hide-field):
(org-table--show-field):
(org-table-hide-column):
(org-table-show-column): New functions.
(org-table-align): Use new macro.
(org-table-get-field):
(org-table-delete-column):
(org-table-move-column):
(org-table-move-row):
(org-table-insert-row): Use new function.
(org-table-kill-row): Tiny refactoring.
(org-table-overlay-coordinates): Skip hidden columns when displaying
coordinates.
---
lisp/org-table.el | 650 ++++++++++++++++++++++++++++++++++--------------------
1 file changed, 407 insertions(+), 243 deletions(-)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 595c4e9e1..092754502 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -510,6 +510,18 @@ Field is restored even in case of abnormal exit."
(org-table-goto-column ,column)
(set-marker ,line nil)))))
+(defmacro org-table-with-hidden-columns (&rest body)
+ "Show all columns before executing BODY, then restore them."
+ (declare (debug (body)))
+ (org-with-gensyms (hidden-columns begin)
+ `(let ((,hidden-columns (org-table--list-hidden-columns))
+ (,begin (org-table-begin)))
+ (org-table-show-column 'all)
+ ,@body
+ (save-excursion
+ (goto-char ,begin)
+ (mapc #'org-table-hide-column ,hidden-columns)))))
+
;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
@@ -758,163 +770,164 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(interactive)
- (let* ((beg (org-table-begin))
- (end (copy-marker (org-table-end))))
- (org-table-save-field
- ;; Make sure invisible characters in the table are at the right
- ;; place since column widths take them into account.
- (font-lock-fontify-region beg end)
- (move-marker org-table-aligned-begin-marker beg)
- (move-marker org-table-aligned-end-marker end)
- (goto-char beg)
- (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
- ;; Table's rows. Separators are replaced by nil. Trailing
- ;; spaces are also removed.
- (lines (mapcar (lambda (l)
- (and (not (string-match-p "\\`[ \t]*|-" l))
- (let ((l (org-trim l)))
- (remove-text-properties
- 0 (length l) '(display t org-cwidth t) l)
- l)))
- (org-split-string (buffer-substring beg end) "\n")))
- ;; Get the data fields by splitting the lines.
- (fields (mapcar (lambda (l) (org-split-string l " *| *"))
- (remq nil lines)))
- ;; Compute number of fields in the longest line. If the
- ;; table contains no field, create a default table.
- (maxfields (if fields (apply #'max (mapcar #'length fields))
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
- ;; A list of empty strings to fill any short rows on output.
- (emptycells (make-list maxfields ""))
- lengths typenums)
- ;; Check for special formatting.
- (dotimes (i maxfields)
- (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
- fmax falign)
- ;; Look for an explicit width or alignment.
- (when (save-excursion
- (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
- (and org-table-do-narrow
- (re-search-forward
- "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
- (catch :exit
- (dolist (cell column)
- (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
- (when (match-end 1) (setq falign (match-string 1 cell)))
- (when (and org-table-do-narrow (match-end 2))
- (setq fmax (string-to-number (match-string 2 cell))))
- (when (or falign fmax) (throw :exit nil)))))
- ;; Find fields that are wider than FMAX, and shorten them.
- (when fmax
- (dolist (x column)
- (when (> (org-string-width x) fmax)
- (org-add-props x nil
- 'help-echo
- (concat
- "Clipped table field, use `\\[org-table-edit-field]' to \
+ (let ((beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
+ (org-table-with-hidden-columns
+ (org-table-save-field
+ ;; Make sure invisible characters in the table are at the right
+ ;; place since column widths take them into account.
+ (font-lock-fontify-region beg end)
+ (move-marker org-table-aligned-begin-marker beg)
+ (move-marker org-table-aligned-end-marker end)
+ (goto-char beg)
+ (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
+ ;; Table's rows. Separators are replaced by nil. Trailing
+ ;; spaces are also removed.
+ (lines (mapcar (lambda (l)
+ (and (not (string-match-p "\\`[ \t]*|-" l))
+ (let ((l (org-trim l)))
+ (remove-text-properties
+ 0 (length l) '(display t org-cwidth t) l)
+ l)))
+ (org-split-string (buffer-substring beg end) "\n")))
+ ;; Get the data fields by splitting the lines.
+ (fields (mapcar (lambda (l) (org-split-string l " *| *"))
+ (remq nil lines)))
+ ;; Compute number of fields in the longest line. If the
+ ;; table contains no field, create a default table.
+ (maxfields (if fields (apply #'max (mapcar #'length fields))
+ (kill-region beg end)
+ (org-table-create org-table-default-size)
+ (user-error "Empty table - created default table")))
+ ;; A list of empty strings to fill any short rows on output.
+ (emptycells (make-list maxfields ""))
+ lengths typenums)
+ ;; Check for special formatting.
+ (dotimes (i maxfields)
+ (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
+ fmax falign)
+ ;; Look for an explicit width or alignment.
+ (when (save-excursion
+ (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
+ (and org-table-do-narrow
+ (re-search-forward
+ "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
+ (catch :exit
+ (dolist (cell column)
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
+ (when (match-end 1) (setq falign (match-string 1 cell)))
+ (when (and org-table-do-narrow (match-end 2))
+ (setq fmax (string-to-number (match-string 2 cell))))
+ (when (or falign fmax) (throw :exit nil)))))
+ ;; Find fields that are wider than FMAX, and shorten them.
+ (when fmax
+ (dolist (x column)
+ (when (> (org-string-width x) fmax)
+ (org-add-props x nil
+ 'help-echo
+ (concat
+ "Clipped table field, use `\\[org-table-edit-field]' to \
edit. Full value is:\n"
- (substring-no-properties x)))
- (let ((l (length x))
- (f1 (min fmax
- (or (string-match org-bracket-link-regexp x)
- fmax)))
- (f2 1))
- (unless (> f1 1)
- (user-error
- "Cannot narrow field starting with wide link \"%s\""
- (match-string 0 x)))
- (if (= (org-string-width x) l) (setq f2 f1)
- (setq f2 1)
- (while (< (org-string-width (substring x 0 f2)) f1)
- (cl-incf f2)))
- (add-text-properties f2 l (list 'org-cwidth t) x)
- (add-text-properties
- (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
- (- f2 2))
- f2
- (list 'display org-narrow-column-arrow)
- x))))))
- ;; Get the maximum width for each column
- (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
- lengths)
- ;; Get the fraction of numbers among non-empty cells to
- ;; decide about alignment of the column.
- (if falign (push (equal (downcase falign) "r") typenums)
- (let ((cnt 0)
- (frac 0.0))
- (dolist (x column)
- (unless (equal x "")
- (setq frac
- (/ (+ (* frac cnt)
- (if (string-match-p org-table-number-regexp x)
- 1
- 0))
- (cl-incf cnt)))))
- (push (>= frac org-table-number-fraction) typenums)))))
- (setq lengths (nreverse lengths))
- (setq typenums (nreverse typenums))
- ;; Store alignment of this table, for later editing of single
- ;; fields.
- (setq org-table-last-alignment typenums)
- (setq org-table-last-column-widths lengths)
- ;; With invisible characters, `format' does not get the field
- ;; width right So we need to make these fields wide by hand.
- ;; Invisible characters may be introduced by fontified links,
- ;; emphasis, macros or sub/superscripts.
- (when (or (text-property-any beg end 'invisible 'org-link)
- (text-property-any beg end 'invisible t))
- (dotimes (i maxfields)
- (let ((len (nth i lengths)))
- (dotimes (j (length fields))
- (let* ((c (nthcdr i (nth j fields)))
- (cell (car c)))
- (when (and
- (stringp cell)
- (let ((l (length cell)))
- (or (text-property-any 0 l 'invisible 'org-link cell)
- (text-property-any beg end 'invisible t)))
- (< (org-string-width cell) len))
- (let ((s (make-string (- len (org-string-width cell)) ?\s)))
- (setcar c (if (nth i typenums) (concat s cell)
- (concat cell s))))))))))
-
- ;; Compute the formats needed for output of the table.
- (let ((hfmt (concat indent "|"))
- (rfmt (concat indent "|"))
- (rfmt1 " %%%s%ds |")
- (hfmt1 "-%s-+"))
- (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
- (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
- (setq rfmt (concat rfmt (format rfmt1 ty l)))
- (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
- ;; Replace modified lines only. Check not only contents, but
- ;; also columns' width.
- (dolist (l lines)
- (let ((line
- (if l (apply #'format rfmt (append (pop fields) emptycells))
- hfmt))
- (previous (buffer-substring (point) (line-end-position))))
- (if (and (equal previous line)
- (let ((a 0)
- (b 0))
- (while (and (progn
- (setq a (next-single-property-change
- a 'org-cwidth previous))
- (setq b (next-single-property-change
- b 'org-cwidth line)))
- (eq a b)))
- (eq a b)))
- (forward-line)
- (insert line "\n")
- (delete-region (point) (line-beginning-position 2))))))
- (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
- (goto-char org-table-aligned-begin-marker)
- (while (org-hide-wide-columns org-table-aligned-end-marker)))
- (set-marker end nil)
- (when org-table-overlay-coordinates (org-table-overlay-coordinates))
- (setq org-table-may-need-update nil)))))
+ (substring-no-properties x)))
+ (let ((l (length x))
+ (f1 (min fmax
+ (or (string-match org-bracket-link-regexp x)
+ fmax)))
+ (f2 1))
+ (unless (> f1 1)
+ (user-error
+ "Cannot narrow field starting with wide link \"%s\""
+ (match-string 0 x)))
+ (if (= (org-string-width x) l) (setq f2 f1)
+ (setq f2 1)
+ (while (< (org-string-width (substring x 0 f2)) f1)
+ (cl-incf f2)))
+ (add-text-properties f2 l (list 'org-cwidth t) x)
+ (add-text-properties
+ (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
+ (- f2 2))
+ f2
+ (list 'display org-narrow-column-arrow)
+ x))))))
+ ;; Get the maximum width for each column
+ (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
+ lengths)
+ ;; Get the fraction of numbers among non-empty cells to
+ ;; decide about alignment of the column.
+ (if falign (push (equal (downcase falign) "r") typenums)
+ (let ((cnt 0)
+ (frac 0.0))
+ (dolist (x column)
+ (unless (equal x "")
+ (setq frac
+ (/ (+ (* frac cnt)
+ (if (string-match-p org-table-number-regexp x)
+ 1
+ 0))
+ (cl-incf cnt)))))
+ (push (>= frac org-table-number-fraction) typenums)))))
+ (setq lengths (nreverse lengths))
+ (setq typenums (nreverse typenums))
+ ;; Store alignment of this table, for later editing of single
+ ;; fields.
+ (setq org-table-last-alignment typenums)
+ (setq org-table-last-column-widths lengths)
+ ;; With invisible characters, `format' does not get the field
+ ;; width right So we need to make these fields wide by hand.
+ ;; Invisible characters may be introduced by fontified links,
+ ;; emphasis, macros or sub/superscripts.
+ (when (or (text-property-any beg end 'invisible 'org-link)
+ (text-property-any beg end 'invisible t))
+ (dotimes (i maxfields)
+ (let ((len (nth i lengths)))
+ (dotimes (j (length fields))
+ (let* ((c (nthcdr i (nth j fields)))
+ (cell (car c)))
+ (when (and
+ (stringp cell)
+ (let ((l (length cell)))
+ (or (text-property-any 0 l 'invisible 'org-link cell)
+ (text-property-any beg end 'invisible t)))
+ (< (org-string-width cell) len))
+ (let ((s (make-string (- len (org-string-width cell)) ?\s)))
+ (setcar c (if (nth i typenums) (concat s cell)
+ (concat cell s))))))))))
+
+ ;; Compute the formats needed for output of the table.
+ (let ((hfmt (concat indent "|"))
+ (rfmt (concat indent "|"))
+ (rfmt1 " %%%s%ds |")
+ (hfmt1 "-%s-+"))
+ (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
+ (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
+ (setq rfmt (concat rfmt (format rfmt1 ty l)))
+ (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
+ ;; Replace modified lines only. Check not only contents, but
+ ;; also columns' width.
+ (dolist (l lines)
+ (let ((line
+ (if l (apply #'format rfmt (append (pop fields) emptycells))
+ hfmt))
+ (previous (buffer-substring (point) (line-end-position))))
+ (if (and (equal previous line)
+ (let ((a 0)
+ (b 0))
+ (while (and (progn
+ (setq a (next-single-property-change
+ a 'org-cwidth previous))
+ (setq b (next-single-property-change
+ b 'org-cwidth line)))
+ (eq a b)))
+ (eq a b)))
+ (forward-line)
+ (insert line "\n")
+ (delete-region (point) (line-beginning-position 2))))))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
+ (goto-char org-table-aligned-begin-marker)
+ (while (org-hide-wide-columns org-table-aligned-end-marker)))
+ (set-marker end nil)
+ (when org-table-overlay-coordinates (org-table-overlay-coordinates))
+ (setq org-table-may-need-update nil))))))
;;;###autoload
(defun org-table-begin (&optional table-type)
@@ -1275,7 +1288,13 @@ value."
(let* ((pos (match-beginning 0))
(val (buffer-substring pos (match-end 0))))
(when replace
- (replace-match (if (equal replace "") " " replace) t t))
+ ;; Since we are going to remove any hidden field, do not relay
+ ;; on `org-table--hidden-field' as it could be GC'ed before
+ ;; second check.
+ (let ((hidden? (and (org-table--hidden-field) t)))
+ (when hidden? (org-table--show-field))
+ (replace-match (if (equal replace "") " " replace) t t)
+ (when hidden? (org-table--hide-field))))
(goto-char (min (line-end-position) (1+ pos)))
val)))
@@ -1443,6 +1462,7 @@ non-nil, the one above is used."
(unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
+ (org-table-show-column)
(let ((col (org-table-current-column))
(beg (org-table-begin))
(end (copy-marker (org-table-end))))
@@ -1470,6 +1490,7 @@ non-nil, the one above is used."
"Move column to the right."
(interactive)
(org-table-move-column nil))
+
;;;###autoload
(defun org-table-move-column-left ()
"Move column to the left."
@@ -1492,33 +1513,45 @@ non-nil, the one above is used."
(user-error "Cannot move column further left"))
(when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
(user-error "Cannot move column further right"))
- (org-table-save-field
- (goto-char beg)
- (while (< (point) end)
- (unless (org-at-table-hline-p)
- (org-table-goto-column col1 t)
- (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
- (transpose-regions
- (match-beginning 1) (match-end 1)
- (match-beginning 2) (match-end 2))))
- (forward-line)))
- (set-marker end nil)
- (org-table-goto-column colpos)
- (org-table-align)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas
- "$" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col)))))))
+ (let ((hidden-columns (org-table--list-hidden-columns)))
+ (org-table-show-column 'all)
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col1 t)
+ (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
+ (transpose-regions
+ (match-beginning 1) (match-end 1)
+ (match-beginning 2) (match-end 2))))
+ (forward-line)))
+ (set-marker end nil)
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas
+ "$" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col))))
+ (org-table-fix-formulas
+ "$LR" (list
+ (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col)))))
+ (mapc #'org-table-hide-column
+ (mapcar (lambda (c)
+ (cond ((and (= col c) left) (1- c))
+ ((= col c) (1+ c))
+ ((and (= col (1+ c)) left) (1+ c))
+ ((and (= col (1- c)) (not left) (1- c)))
+ (t c)))
+ hidden-columns)))))
;;;###autoload
(defun org-table-move-row-down ()
"Move table row down."
(interactive)
(org-table-move-row nil))
+
;;;###autoload
(defun org-table-move-row-up ()
"Move table row up."
@@ -1541,23 +1574,25 @@ non-nil, the one above is used."
(unless (org-at-table-p)
(goto-char pos)
(user-error "Cannot move row further"))
- (setq hline2p (looking-at org-table-hline-regexp))
- (goto-char pos)
- (beginning-of-line 1)
- (setq pos (point))
- (setq txt (buffer-substring (point) (1+ (point-at-eol))))
- (delete-region (point) (1+ (point-at-eol)))
- (beginning-of-line tonew)
- (insert txt)
- (beginning-of-line 0)
- (org-move-to-column col)
- (unless (or hline1p hline2p
- (not (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm
- "Fix formulas? "))))
- (org-table-fix-formulas
- "@" (list (cons (number-to-string dline1) (number-to-string dline2))
- (cons (number-to-string dline2) (number-to-string dline1)))))))
+ (org-table-with-hidden-columns
+ (setq hline2p (looking-at org-table-hline-regexp))
+ (goto-char pos)
+ (beginning-of-line 1)
+ (setq pos (point))
+ (setq txt (buffer-substring (point) (1+ (point-at-eol))))
+ (delete-region (point) (1+ (point-at-eol)))
+ (beginning-of-line tonew)
+ (insert txt)
+ (beginning-of-line 0)
+ (org-move-to-column col)
+ (unless (or hline1p hline2p
+ (not (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
+ (org-table-fix-formulas
+ "@" (list
+ (cons (number-to-string dline1) (number-to-string dline2))
+ (cons (number-to-string dline2) (number-to-string dline1))))))))
;;;###autoload
(defun org-table-insert-row (&optional arg)
@@ -1565,47 +1600,48 @@ non-nil, the one above is used."
With prefix ARG, insert below the current line."
(interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
- (new (org-table-clean-line line)))
- ;; Fix the first field if necessary
- (if (string-match "^[ \t]*| *[#$] *|" line)
- (setq new (replace-match (match-string 0 line) t t new)))
- (beginning-of-line (if arg 2 1))
- ;; Buffer may not end of a newline character, so ensure
- ;; (beginning-of-line 2) moves point to a new line.
- (unless (bolp) (insert "\n"))
- (let (org-table-may-need-update) (insert-before-markers new "\n"))
- (beginning-of-line 0)
- (re-search-forward "| ?" (line-end-position) t)
- (when (or org-table-may-need-update org-table-overlay-coordinates)
- (org-table-align))
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
+ (org-table-with-hidden-columns
+ (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
+ (new (org-table-clean-line line)))
+ ;; Fix the first field if necessary
+ (when (string-match "^[ \t]*| *[#$] *|" line)
+ (setq new (replace-match (match-string 0 line) t t new)))
+ (beginning-of-line (if arg 2 1))
+ ;; Buffer may not end of a newline character, so ensure
+ ;; (beginning-of-line 2) moves point to a new line.
+ (unless (bolp) (insert "\n"))
+ (let (org-table-may-need-update) (insert-before-markers new "\n"))
+ (beginning-of-line 0)
+ (re-search-forward "| ?" (line-end-position) t)
+ (when (or org-table-may-need-update org-table-overlay-coordinates)
+ (org-table-align))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))))
;;;###autoload
(defun org-table-insert-hline (&optional above)
"Insert a horizontal-line below the current line into the table.
With prefix ABOVE, insert above the current line."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (when (eobp) (insert "\n") (backward-char 1))
- (if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
- (org-table-align))
- (let ((line (org-table-clean-line
- (buffer-substring (point-at-bol) (point-at-eol))))
- (col (current-column)))
- (while (string-match "|\\( +\\)|" line)
- (setq line (replace-match
- (concat "+" (make-string (- (match-end 1) (match-beginning 1))
- ?-) "|") t t line)))
- (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
- (beginning-of-line (if above 1 2))
- (insert line "\n")
- (beginning-of-line (if above 1 -1))
- (org-move-to-column col)
- (and org-table-overlay-coordinates (org-table-align))))
+ (unless (org-at-table-p) (user-error "Not at a table"))
+ (when (eobp) (save-excursion (insert "\n")))
+ (unless (string-match-p "|[ \t]*$" (org-current-line-string))
+ (org-table-align))
+ (org-table-with-hidden-columns
+ (let ((line (org-table-clean-line
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ (col (current-column)))
+ (while (string-match "|\\( +\\)|" line)
+ (setq line (replace-match
+ (concat "+" (make-string (- (match-end 1) (match-beginning 1))
+ ?-) "|") t t line)))
+ (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
+ (beginning-of-line (if above 1 2))
+ (insert line "\n")
+ (beginning-of-line (if above 1 -1))
+ (org-move-to-column col)
+ (when org-table-overlay-coordinates (org-table-align)))))
;;;###autoload
(defun org-table-hline-and-move (&optional same-column)
@@ -1638,8 +1674,7 @@ In particular, this does handle wide and invisible characters."
(defun org-table-kill-row ()
"Delete the current row or horizontal line from the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(let ((col (current-column))
(dline (org-table-current-dline)))
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
@@ -3783,6 +3818,132 @@ minutes or seconds."
secs0)))))
(if (< secs 0) (concat "-" res) res)))
+
+\f
+;;; Columns hiding
+
+(defun org-table--hidden-field (&optional beg end)
+ "Non-nil if current field is narrowed.
+When non-nil, return the overlay narrowing the field.
+The function assumes point is already in an Org table."
+ (let ((overlays (overlays-in (or beg (1- (point))) (or end (1+ (point)))))
+ (filter (lambda (o)
+ (and (eq 'org-table-narrow (overlay-get o 'org-overlay-type))
+ o))))
+ (funcall (if (and beg end) #'cl-remove-if-not #'cl-some) filter overlays)))
+
+(defun org-table--list-hidden-columns ()
+ "List currently hidden columns in table at point.
+The function assumes point is already in an Org table."
+ (let ((separator-re (if (org-at-table-hline-p) "[|+]" "|"))
+ (end (line-end-position))
+ (column 0)
+ (columns nil))
+ (save-excursion
+ (beginning-of-line)
+ (while (re-search-forward separator-re end t)
+ (cl-incf column)
+ (when (org-table--hidden-field) (push column columns)))
+ (nreverse columns))))
+
+(defun org-table--hide-field ()
+ "Hide current field."
+ (unless (org-table--hidden-field)
+ (let* ((separator-re (if (org-at-table-hline-p) "[|+]" "|"))
+ (beg (save-excursion
+ (if (re-search-backward separator-re (line-beginning-position) t)
+ (match-end 0)
+ (point))))
+ (end (1- (re-search-forward separator-re (line-end-position) 'move)))
+ (field (org-trim (buffer-substring-no-properties beg end)))
+ (isearch-display (lambda (_)
+ (save-match-data (org-table-show-column))))
+ (show-before-edit (list (lambda (_o before? &rest _)
+ (when before?
+ (save-match-data
+ (org-table-show-column))))))
+ (o (make-overlay beg end)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'help-echo field)
+ (overlay-put o 'insert-behind-hooks show-before-edit)
+ (overlay-put o 'insert-in-front-hooks show-before-edit)
+ (overlay-put o 'isearch-open-invisible isearch-display)
+ (overlay-put o 'modification-hooks show-before-edit)
+ (overlay-put o 'org-overlay-type 'org-table-narrow)
+ (org-overlay-display o "↔" 'org-table))))
+
+(defun org-table--show-field ()
+ "Show current field."
+ (let ((o (org-table--hidden-field)))
+ (when o (delete-overlay o))))
+
+;;;###autoload
+(defun org-table-hide-column (&optional n)
+ "Hide column under point in an Org table.
+When N is a number, hide that column instead."
+ (interactive "P")
+ (unless (org-at-table-p) (user-error "Not in a table"))
+ (let* ((pos (point))
+ (column (cond (n) ;get current column
+ ((org-at-table-hline-p)
+ (beginning-of-line)
+ (if (not (search-forward "|" pos t)) 0
+ (let ((column 1))
+ (while (search-forward "+" pos t)
+ (cl-incf column))
+ column)))
+ (t (org-table-current-column)))))
+ (when (= column 0) (user-error "Not in a valid column"))
+ (org-with-point-at (org-table-begin)
+ (let ((end (org-table-end)))
+ (while (< (point) end)
+ (search-forward "|")
+ ;; Move to COLUMN.
+ (cond ((= column 1)) ;already there
+ ((org-at-table-hline-p)
+ (search-forward "+" (line-end-position) t (1- column)))
+ (t (org-table-goto-column column)))
+ (org-table--hide-field)
+ (forward-line))))
+ ;; Move before overlay if point is under it.
+ (let ((o (org-table--hidden-field)))
+ (when o (goto-char (overlay-start o))))))
+
+;;;###autoload
+(defun org-table-show-column (&optional all)
+ "Show column under point in an Org table.
+When optional argument ALL is non-nil, show all columns."
+ (interactive "P")
+ (unless (org-at-table-p) (user-error "Not in a table"))
+ (let* ((pos (point))
+ (column (if (not (org-at-table-hline-p))
+ (org-table-current-column)
+ (beginning-of-line)
+ (if (not (search-forward "|" pos t)) 0
+ (let ((column 1))
+ (while (search-forward "+" pos t)
+ (cl-incf column))
+ column)))))
+ (when (= column 0) (user-error "Not in a valid column"))
+ (org-with-point-at (org-table-begin)
+ (if all
+ (mapc #'delete-overlay
+ (org-table--hidden-field (point) (org-table-end)))
+ (let ((end (org-table-end)))
+ (while (< (point) end)
+ (search-forward "|")
+ ;; Move to COLUMN.
+ (cond ((= column 1)) ;already there
+ ((org-at-table-hline-p)
+ (search-forward "+" (line-end-position) t (1- column)))
+ (t (org-table-goto-column column)))
+ (org-table--show-field)
+ (forward-line)))))))
+
+
+\f
+;;; Formula editing
+
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
(let ((origin (copy-marker (line-beginning-position))))
@@ -4213,7 +4374,7 @@ FACE, when non-nil, for the highlight."
(mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)
(save-excursion
- (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
+ (let ((id 0) (ih 0) hline eol str ov)
(goto-char (org-table-begin))
(while (org-at-table-p)
(setq eol (point-at-eol))
@@ -4224,16 +4385,19 @@ FACE, when non-nil, for the highlight."
(format "%4d" (setq id (1+ id)))))
(org-overlay-before-string ov str 'org-special-keyword 'evaporate)
(when hline
- (setq ic 0)
- (while (re-search-forward "[+|]\\(-+\\)" eol t)
- (setq beg (1+ (match-beginning 0))
- ic (1+ ic)
- s1 (concat "$" (int-to-string ic))
- s2 (org-number-to-letters ic)
- str (if (eq org-table-use-standard-references t) s2 s1))
- (setq ov (make-overlay beg (+ beg (length str))))
- (push ov org-table-coordinate-overlays)
- (org-overlay-display ov str 'org-special-keyword 'evaporate)))
+ (let ((ic 0))
+ (while (re-search-forward "[+|]\\(-+\\)" eol t)
+ (cl-incf ic)
+ ;; Do not show coordinates for hidden columns.
+ (unless (org-table--hidden-field)
+ (let* ((beg (1+ (match-beginning 0)))
+ (s1 (format "$%d" ic))
+ (s2 (org-number-to-letters ic))
+ (str (if (eq t org-table-use-standard-references) s2 s1))
+ (ov (make-overlay beg (+ beg (length str)))))
+ (push ov org-table-coordinate-overlays)
+ (org-overlay-display ov str
+ 'org-special-keyword 'evaporate))))))
(beginning-of-line 2)))))
;;;###autoload
--
2.13.1
^ permalink raw reply related [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-24 8:48 ` Nicolas Goaziou
@ 2017-06-24 21:06 ` Uwe Brauer
2017-06-24 23:10 ` Nicolas Goaziou
0 siblings, 1 reply; 17+ messages in thread
From: Uwe Brauer @ 2017-06-24 21:06 UTC (permalink / raw)
To: emacs-orgmode
> Hello,
> Uwe Brauer <oub@mat.ucm.es> writes:
> I toyed with the idea, and came up with a proof-of-concept, attached to
> this message.
> Basically, it defines two user-facing functions: `org-table-hide-column'
> and `org-table-show-column'. Whenever the contents of an hidden column
> is changed by the user, the column is shown automatically.
Great thanks I will test this now, I presume this patch is against the
latest stable version?
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-24 21:06 ` Uwe Brauer
@ 2017-06-24 23:10 ` Nicolas Goaziou
2017-06-25 17:12 ` Uwe Brauer
0 siblings, 1 reply; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-24 23:10 UTC (permalink / raw)
To: emacs-orgmode
Hello,
Uwe Brauer <oub@mat.ucm.es> writes:
> Great thanks I will test this now, I presume this patch is against the
> latest stable version?
No, it is against development version, aka "master" branch.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-24 23:10 ` Nicolas Goaziou
@ 2017-06-25 17:12 ` Uwe Brauer
2017-06-27 21:46 ` Nicolas Goaziou
0 siblings, 1 reply; 17+ messages in thread
From: Uwe Brauer @ 2017-06-25 17:12 UTC (permalink / raw)
To: emacs-orgmode
>>> "Nicolas" == Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:
> Hello,
> Uwe Brauer <oub@mat.ucm.es> writes:
>> Great thanks I will test this now, I presume this patch is against the
>> latest stable version?
> No, it is against development version, aka "master" branch.
Ok I cloned that branch, applied your patch and run some tests, (using
GNU emacs 26)
Here are my impressions.
- (org-table-hide-column nil) works nicely! I can hide several columns: I
start with the first, hide it, move to the second hide etc
- however (org-table-hide-column 1) etc did not work as expected,
the first column was hidden but when I called
(org-table-hide-column 2) that column was not hidden! Then I
found out the culprit. I had the cursor on a different column. So
(org-table-hide-column 1) seems to work best if the cursor is not
on the table!
- would it be possible to hide various column on the fly. Either by
marking them or running (org-table-hide-column 1 2 3) or
something like this.
Thanks very much for this, I would it very useful and think it should be
included at some point in master.
Uwe Brauer
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-25 17:12 ` Uwe Brauer
@ 2017-06-27 21:46 ` Nicolas Goaziou
2017-06-28 9:46 ` Uwe Brauer
2017-06-29 8:00 ` [rows?] (was: org table toggle narrowing and true column hiding) Uwe Brauer
0 siblings, 2 replies; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-27 21:46 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 2019 bytes --]
Hello,
Uwe Brauer <oub@mat.ucm.es> writes:
> Here are my impressions.
>
>
> - (org-table-hide-column nil) works nicely! I can hide several columns: I
> start with the first, hide it, move to the second hide etc
>
> - however (org-table-hide-column 1) etc did not work as expected,
> the first column was hidden but when I called
> (org-table-hide-column 2) that column was not hidden! Then I
> found out the culprit. I had the cursor on a different column. So
> (org-table-hide-column 1) seems to work best if the cursor is not
> on the table!
>
> - would it be possible to hide various column on the fly. Either by
> marking them or running (org-table-hide-column 1 2 3) or
> something like this.
>
> Thanks very much for this, I would it very useful and think it should be
> included at some point in master.
I toyed a bit further with the idea, and re-designed the whole thing.
The new implementation provides a single user-facing function:
`org-table-toggle-column-visibility'. Here is its docstring:
Shrink or expand current column in an Org table.
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:
N column N only
N-M every column between N and M (both inclusive)
N- every column between N (inclusive) and the last column
-M every column between the first one and M (inclusive)
- every column
When called with `C-u' prefix, ask for the range specification.
When called with `C-u C-u' prefix, expand all columns.
In particular, when called with a prefix argument, it allows you to
type, e.g., "1-3 5 6-" and have columns 1, 2, 3, 5, 6 and onward shrunk
or expanded, according to their current state. I find it quite
efficient.
I imagine it can be useful when handling wide tables, but so can "<cX>"
cookies.
Anyway, feedback welcome.
Regards,
--
Nicolas Goaziou
[-- Attachment #2: 0001-org-table-Implement-shrunk-columns.patch --]
[-- Type: text/x-diff, Size: 40592 bytes --]
From 893393d728b0d6bf90a1e01a0a699b0dec7051c2 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Tue, 27 Jun 2017 23:06:02 +0200
Subject: [PATCH] org-table: Implement shrunk columns
* lisp/org-table.el (org-table-shrunk-column-display): New variable.
(org-table-with-shrunk-columns): New macro.
(org-table--shrunk-field):
(org-table--list-shrunk-columns):
(org-table--shrink-field):
(org-table--read-column-selection):
(org-table--expand-all-columns):
(org-table-toggle-column-visibility): New functions.
(org-table-align):
(org-table-get-field):
(org-table-insert-column):
(org-table-delete-column):
(org-table-move-column):
(org-table-move-row):
(org-table-insert-row):
(org-table-insert-hline): Use new functions.
(org-table-kill-row):
(org-table-overlay-coordinates):
(org-table-toggle-coordinate-overlays): Tiny refactoring.
---
lisp/org-table.el | 777 +++++++++++++++++++++++++++++++++++++-----------------
1 file changed, 530 insertions(+), 247 deletions(-)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 595c4e9e1..818917c79 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -423,6 +423,14 @@ prevents it from hanging emacs."
:version "26.1"
:package-version '(Org . "8.3"))
+(defcustom org-table-shrunk-column-display "…"
+ "String used to display a shrunk column."
+ :group 'org-table-import-export
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe (lambda (v) (and (stringp v) (not (equal v "")))))
+
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
"Regexp matching a line marked for automatic recalculation.")
@@ -510,6 +518,20 @@ Field is restored even in case of abnormal exit."
(org-table-goto-column ,column)
(set-marker ,line nil)))))
+(defmacro org-table-with-shrunk-columns (&rest body)
+ "Expand all columns before executing BODY, then shrink them again."
+ (declare (debug (body)))
+ (org-with-gensyms (shrunk-columns begin end)
+ `(let ((,begin (copy-marker (org-table-begin)))
+ (,end (copy-marker (org-table-end) t))
+ (,shrunk-columns (org-table--list-shrunk-columns)))
+ (org-with-point-at ,begin (org-table--expand-all-columns ,begin ,end))
+ (unwind-protect
+ (progn ,@body)
+ (org-table--shrink-columns ,shrunk-columns ,begin ,end)
+ (set-marker ,begin nil)
+ (set-marker ,end nil)))))
+
;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
@@ -758,8 +780,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(interactive)
- (let* ((beg (org-table-begin))
- (end (copy-marker (org-table-end))))
+ (let ((beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
(org-table-save-field
;; Make sure invisible characters in the table are at the right
;; place since column widths take them into account.
@@ -767,154 +789,155 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(move-marker org-table-aligned-begin-marker beg)
(move-marker org-table-aligned-end-marker end)
(goto-char beg)
- (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
- ;; Table's rows. Separators are replaced by nil. Trailing
- ;; spaces are also removed.
- (lines (mapcar (lambda (l)
- (and (not (string-match-p "\\`[ \t]*|-" l))
- (let ((l (org-trim l)))
- (remove-text-properties
- 0 (length l) '(display t org-cwidth t) l)
- l)))
- (org-split-string (buffer-substring beg end) "\n")))
- ;; Get the data fields by splitting the lines.
- (fields (mapcar (lambda (l) (org-split-string l " *| *"))
- (remq nil lines)))
- ;; Compute number of fields in the longest line. If the
- ;; table contains no field, create a default table.
- (maxfields (if fields (apply #'max (mapcar #'length fields))
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
- ;; A list of empty strings to fill any short rows on output.
- (emptycells (make-list maxfields ""))
- lengths typenums)
- ;; Check for special formatting.
- (dotimes (i maxfields)
- (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
- fmax falign)
- ;; Look for an explicit width or alignment.
- (when (save-excursion
- (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
- (and org-table-do-narrow
- (re-search-forward
- "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
- (catch :exit
- (dolist (cell column)
- (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
- (when (match-end 1) (setq falign (match-string 1 cell)))
- (when (and org-table-do-narrow (match-end 2))
- (setq fmax (string-to-number (match-string 2 cell))))
- (when (or falign fmax) (throw :exit nil)))))
- ;; Find fields that are wider than FMAX, and shorten them.
- (when fmax
- (dolist (x column)
- (when (> (org-string-width x) fmax)
- (org-add-props x nil
- 'help-echo
- (concat
- "Clipped table field, use `\\[org-table-edit-field]' to \
+ (org-table-with-shrunk-columns
+ (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
+ ;; Table's rows. Separators are replaced by nil. Trailing
+ ;; spaces are also removed.
+ (lines (mapcar (lambda (l)
+ (and (not (string-match-p "\\`[ \t]*|-" l))
+ (let ((l (org-trim l)))
+ (remove-text-properties
+ 0 (length l) '(display t org-cwidth t) l)
+ l)))
+ (org-split-string (buffer-substring beg end) "\n")))
+ ;; Get the data fields by splitting the lines.
+ (fields (mapcar (lambda (l) (org-split-string l " *| *"))
+ (remq nil lines)))
+ ;; Compute number of fields in the longest line. If the
+ ;; table contains no field, create a default table.
+ (maxfields (if fields (apply #'max (mapcar #'length fields))
+ (kill-region beg end)
+ (org-table-create org-table-default-size)
+ (user-error "Empty table - created default table")))
+ ;; A list of empty strings to fill any short rows on output.
+ (emptycells (make-list maxfields ""))
+ lengths typenums)
+ ;; Check for special formatting.
+ (dotimes (i maxfields)
+ (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
+ fmax falign)
+ ;; Look for an explicit width or alignment.
+ (when (save-excursion
+ (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
+ (and org-table-do-narrow
+ (re-search-forward
+ "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
+ (catch :exit
+ (dolist (cell column)
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
+ (when (match-end 1) (setq falign (match-string 1 cell)))
+ (when (and org-table-do-narrow (match-end 2))
+ (setq fmax (string-to-number (match-string 2 cell))))
+ (when (or falign fmax) (throw :exit nil)))))
+ ;; Find fields that are wider than FMAX, and shorten them.
+ (when fmax
+ (dolist (x column)
+ (when (> (org-string-width x) fmax)
+ (org-add-props x nil
+ 'help-echo
+ (concat
+ "Clipped table field, use `\\[org-table-edit-field]' to \
edit. Full value is:\n"
- (substring-no-properties x)))
- (let ((l (length x))
- (f1 (min fmax
- (or (string-match org-bracket-link-regexp x)
- fmax)))
- (f2 1))
- (unless (> f1 1)
- (user-error
- "Cannot narrow field starting with wide link \"%s\""
- (match-string 0 x)))
- (if (= (org-string-width x) l) (setq f2 f1)
- (setq f2 1)
- (while (< (org-string-width (substring x 0 f2)) f1)
- (cl-incf f2)))
- (add-text-properties f2 l (list 'org-cwidth t) x)
- (add-text-properties
- (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
- (- f2 2))
- f2
- (list 'display org-narrow-column-arrow)
- x))))))
- ;; Get the maximum width for each column
- (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
- lengths)
- ;; Get the fraction of numbers among non-empty cells to
- ;; decide about alignment of the column.
- (if falign (push (equal (downcase falign) "r") typenums)
- (let ((cnt 0)
- (frac 0.0))
- (dolist (x column)
- (unless (equal x "")
- (setq frac
- (/ (+ (* frac cnt)
- (if (string-match-p org-table-number-regexp x)
- 1
- 0))
- (cl-incf cnt)))))
- (push (>= frac org-table-number-fraction) typenums)))))
- (setq lengths (nreverse lengths))
- (setq typenums (nreverse typenums))
- ;; Store alignment of this table, for later editing of single
- ;; fields.
- (setq org-table-last-alignment typenums)
- (setq org-table-last-column-widths lengths)
- ;; With invisible characters, `format' does not get the field
- ;; width right So we need to make these fields wide by hand.
- ;; Invisible characters may be introduced by fontified links,
- ;; emphasis, macros or sub/superscripts.
- (when (or (text-property-any beg end 'invisible 'org-link)
- (text-property-any beg end 'invisible t))
- (dotimes (i maxfields)
- (let ((len (nth i lengths)))
- (dotimes (j (length fields))
- (let* ((c (nthcdr i (nth j fields)))
- (cell (car c)))
- (when (and
- (stringp cell)
- (let ((l (length cell)))
- (or (text-property-any 0 l 'invisible 'org-link cell)
- (text-property-any beg end 'invisible t)))
- (< (org-string-width cell) len))
- (let ((s (make-string (- len (org-string-width cell)) ?\s)))
- (setcar c (if (nth i typenums) (concat s cell)
- (concat cell s))))))))))
-
- ;; Compute the formats needed for output of the table.
- (let ((hfmt (concat indent "|"))
- (rfmt (concat indent "|"))
- (rfmt1 " %%%s%ds |")
- (hfmt1 "-%s-+"))
- (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
- (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
- (setq rfmt (concat rfmt (format rfmt1 ty l)))
- (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
- ;; Replace modified lines only. Check not only contents, but
- ;; also columns' width.
- (dolist (l lines)
- (let ((line
- (if l (apply #'format rfmt (append (pop fields) emptycells))
- hfmt))
- (previous (buffer-substring (point) (line-end-position))))
- (if (and (equal previous line)
- (let ((a 0)
- (b 0))
- (while (and (progn
- (setq a (next-single-property-change
- a 'org-cwidth previous))
- (setq b (next-single-property-change
- b 'org-cwidth line)))
- (eq a b)))
- (eq a b)))
- (forward-line)
- (insert line "\n")
- (delete-region (point) (line-beginning-position 2))))))
- (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
- (goto-char org-table-aligned-begin-marker)
- (while (org-hide-wide-columns org-table-aligned-end-marker)))
- (set-marker end nil)
- (when org-table-overlay-coordinates (org-table-overlay-coordinates))
- (setq org-table-may-need-update nil)))))
+ (substring-no-properties x)))
+ (let ((l (length x))
+ (f1 (min fmax
+ (or (string-match org-bracket-link-regexp x)
+ fmax)))
+ (f2 1))
+ (unless (> f1 1)
+ (user-error
+ "Cannot narrow field starting with wide link \"%s\""
+ (match-string 0 x)))
+ (if (= (org-string-width x) l) (setq f2 f1)
+ (setq f2 1)
+ (while (< (org-string-width (substring x 0 f2)) f1)
+ (cl-incf f2)))
+ (add-text-properties f2 l (list 'org-cwidth t) x)
+ (add-text-properties
+ (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
+ (- f2 2))
+ f2
+ (list 'display org-narrow-column-arrow)
+ x))))))
+ ;; Get the maximum width for each column
+ (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
+ lengths)
+ ;; Get the fraction of numbers among non-empty cells to
+ ;; decide about alignment of the column.
+ (if falign (push (equal (downcase falign) "r") typenums)
+ (let ((cnt 0)
+ (frac 0.0))
+ (dolist (x column)
+ (unless (equal x "")
+ (setq frac
+ (/ (+ (* frac cnt)
+ (if (string-match-p org-table-number-regexp x)
+ 1
+ 0))
+ (cl-incf cnt)))))
+ (push (>= frac org-table-number-fraction) typenums)))))
+ (setq lengths (nreverse lengths))
+ (setq typenums (nreverse typenums))
+ ;; Store alignment of this table, for later editing of single
+ ;; fields.
+ (setq org-table-last-alignment typenums)
+ (setq org-table-last-column-widths lengths)
+ ;; With invisible characters, `format' does not get the field
+ ;; width right So we need to make these fields wide by hand.
+ ;; Invisible characters may be introduced by fontified links,
+ ;; emphasis, macros or sub/superscripts.
+ (when (or (text-property-any beg end 'invisible 'org-link)
+ (text-property-any beg end 'invisible t))
+ (dotimes (i maxfields)
+ (let ((len (nth i lengths)))
+ (dotimes (j (length fields))
+ (let* ((c (nthcdr i (nth j fields)))
+ (cell (car c)))
+ (when (and
+ (stringp cell)
+ (let ((l (length cell)))
+ (or (text-property-any 0 l 'invisible 'org-link cell)
+ (text-property-any beg end 'invisible t)))
+ (< (org-string-width cell) len))
+ (let ((s (make-string (- len (org-string-width cell)) ?\s)))
+ (setcar c (if (nth i typenums) (concat s cell)
+ (concat cell s))))))))))
+
+ ;; Compute the formats needed for output of the table.
+ (let ((hfmt (concat indent "|"))
+ (rfmt (concat indent "|"))
+ (rfmt1 " %%%s%ds |")
+ (hfmt1 "-%s-+"))
+ (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
+ (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
+ (setq rfmt (concat rfmt (format rfmt1 ty l)))
+ (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
+ ;; Replace modified lines only. Check not only contents, but
+ ;; also columns' width.
+ (dolist (l lines)
+ (let ((line
+ (if l (apply #'format rfmt (append (pop fields) emptycells))
+ hfmt))
+ (previous (buffer-substring (point) (line-end-position))))
+ (if (and (equal previous line)
+ (let ((a 0)
+ (b 0))
+ (while (and (progn
+ (setq a (next-single-property-change
+ a 'org-cwidth previous))
+ (setq b (next-single-property-change
+ b 'org-cwidth line)))
+ (eq a b)))
+ (eq a b)))
+ (forward-line)
+ (insert line "\n")
+ (delete-region (point) (line-beginning-position 2))))))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
+ (goto-char org-table-aligned-begin-marker)
+ (while (org-hide-wide-columns org-table-aligned-end-marker)))
+ (set-marker end nil)
+ (when org-table-overlay-coordinates (org-table-overlay-coordinates))
+ (setq org-table-may-need-update nil))))))
;;;###autoload
(defun org-table-begin (&optional table-type)
@@ -1275,7 +1298,16 @@ value."
(let* ((pos (match-beginning 0))
(val (buffer-substring pos (match-end 0))))
(when replace
- (replace-match (if (equal replace "") " " replace) t t))
+ ;; Since we are going to remove any hidden field, do not relay
+ ;; 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)))))))
(goto-char (min (line-end-position) (1+ pos)))
val)))
@@ -1377,9 +1409,11 @@ However, when FORCE is non-nil, create new columns if necessary."
(interactive)
(unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
- (let* ((col (max 1 (org-table-current-column)))
- (beg (org-table-begin))
- (end (copy-marker (org-table-end))))
+ (let ((col (max 1 (org-table-current-column)))
+ (beg (org-table-begin))
+ (end (copy-marker (org-table-end)))
+ (shrunk-columns (org-table--list-shrunk-columns)))
+ (org-table--expand-all-columns beg end)
(org-table-save-field
(goto-char beg)
(while (< (point) end)
@@ -1387,8 +1421,14 @@ However, when FORCE is non-nil, create new columns if necessary."
(org-table-goto-column col t)
(insert "| "))
(forward-line)))
- (set-marker end nil)
(org-table-align)
+ ;; Shift appropriately stored shrunk column numbers, then hide the
+ ;; columns again.
+ (org-table--shrink-columns (mapcar (lambda (c) (if (< c col) c (1+ c)))
+ shrunk-columns)
+ beg end)
+ (set-marker end nil)
+ ;; Fix TBLFM formulas, if desirable.
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "$" nil (1- col) 1)
@@ -1443,9 +1483,11 @@ non-nil, the one above is used."
(unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
- (let ((col (org-table-current-column))
- (beg (org-table-begin))
- (end (copy-marker (org-table-end))))
+ (let* ((col (org-table-current-column))
+ (beg (org-table-begin))
+ (end (copy-marker (org-table-end)))
+ (shrunk-columns (remq col (org-table--list-shrunk-columns))))
+ (org-table--expand-all-columns beg end)
(org-table-save-field
(goto-char beg)
(while (< (point) end)
@@ -1455,9 +1497,15 @@ non-nil, the one above is used."
(and (looking-at "|[^|\n]+|")
(replace-match "|")))
(forward-line)))
- (set-marker end nil)
(org-table-goto-column (max 1 (1- col)))
(org-table-align)
+ ;; Shift appropriately stored shrunk column numbers, then hide the
+ ;; columns again.
+ (org-table--shrink-columns (mapcar (lambda (c) (if (< c col) c (1+ c)))
+ shrunk-columns)
+ beg end)
+ (set-marker end nil)
+ ;; Fix TBLFM formulas, if desirable.
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas
@@ -1470,6 +1518,7 @@ non-nil, the one above is used."
"Move column to the right."
(interactive)
(org-table-move-column nil))
+
;;;###autoload
(defun org-table-move-column-left ()
"Move column to the left."
@@ -1492,33 +1541,49 @@ non-nil, the one above is used."
(user-error "Cannot move column further left"))
(when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
(user-error "Cannot move column further right"))
- (org-table-save-field
- (goto-char beg)
- (while (< (point) end)
- (unless (org-at-table-hline-p)
- (org-table-goto-column col1 t)
- (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
- (transpose-regions
- (match-beginning 1) (match-end 1)
- (match-beginning 2) (match-end 2))))
- (forward-line)))
- (set-marker end nil)
- (org-table-goto-column colpos)
- (org-table-align)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas
- "$" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col)))))))
+ (let ((shrunk-columns (org-table--list-shrunk-columns)))
+ (org-table--expand-all-columns beg end)
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col1 t)
+ (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
+ (transpose-regions
+ (match-beginning 1) (match-end 1)
+ (match-beginning 2) (match-end 2))))
+ (forward-line)))
+ (org-table-goto-column colpos)
+ (org-table-align)
+ ;; Shift appropriately stored shrunk column numbers, then shrink
+ ;; the columns again.
+ (org-table--shrink-columns
+ (mapcar (lambda (c)
+ (cond ((and (= col c) left) (1- c))
+ ((= col c) (1+ c))
+ ((and (= col (1+ c)) left) (1+ c))
+ ((and (= col (1- c)) (not left) (1- c)))
+ (t c)))
+ shrunk-columns)
+ beg end)
+ (set-marker end nil)
+ ;; Fix TBLFM formulas, if desirable.
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas
+ "$" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col))))
+ (org-table-fix-formulas
+ "$LR" (list
+ (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col))))))))
;;;###autoload
(defun org-table-move-row-down ()
"Move table row down."
(interactive)
(org-table-move-row nil))
+
;;;###autoload
(defun org-table-move-row-up ()
"Move table row up."
@@ -1541,23 +1606,25 @@ non-nil, the one above is used."
(unless (org-at-table-p)
(goto-char pos)
(user-error "Cannot move row further"))
- (setq hline2p (looking-at org-table-hline-regexp))
- (goto-char pos)
- (beginning-of-line 1)
- (setq pos (point))
- (setq txt (buffer-substring (point) (1+ (point-at-eol))))
- (delete-region (point) (1+ (point-at-eol)))
- (beginning-of-line tonew)
- (insert txt)
- (beginning-of-line 0)
- (org-move-to-column col)
- (unless (or hline1p hline2p
- (not (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm
- "Fix formulas? "))))
- (org-table-fix-formulas
- "@" (list (cons (number-to-string dline1) (number-to-string dline2))
- (cons (number-to-string dline2) (number-to-string dline1)))))))
+ (org-table-with-shrunk-columns
+ (setq hline2p (looking-at org-table-hline-regexp))
+ (goto-char pos)
+ (beginning-of-line 1)
+ (setq pos (point))
+ (setq txt (buffer-substring (point) (1+ (point-at-eol))))
+ (delete-region (point) (1+ (point-at-eol)))
+ (beginning-of-line tonew)
+ (insert txt)
+ (beginning-of-line 0)
+ (org-move-to-column col)
+ (unless (or hline1p hline2p
+ (not (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
+ (org-table-fix-formulas
+ "@" (list
+ (cons (number-to-string dline1) (number-to-string dline2))
+ (cons (number-to-string dline2) (number-to-string dline1))))))))
;;;###autoload
(defun org-table-insert-row (&optional arg)
@@ -1565,47 +1632,48 @@ non-nil, the one above is used."
With prefix ARG, insert below the current line."
(interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
- (new (org-table-clean-line line)))
- ;; Fix the first field if necessary
- (if (string-match "^[ \t]*| *[#$] *|" line)
- (setq new (replace-match (match-string 0 line) t t new)))
- (beginning-of-line (if arg 2 1))
- ;; Buffer may not end of a newline character, so ensure
- ;; (beginning-of-line 2) moves point to a new line.
- (unless (bolp) (insert "\n"))
- (let (org-table-may-need-update) (insert-before-markers new "\n"))
- (beginning-of-line 0)
- (re-search-forward "| ?" (line-end-position) t)
- (when (or org-table-may-need-update org-table-overlay-coordinates)
- (org-table-align))
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
+ (org-table-with-shrunk-columns
+ (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
+ (new (org-table-clean-line line)))
+ ;; Fix the first field if necessary
+ (when (string-match "^[ \t]*| *[#$] *|" line)
+ (setq new (replace-match (match-string 0 line) t t new)))
+ (beginning-of-line (if arg 2 1))
+ ;; Buffer may not end of a newline character, so ensure
+ ;; (beginning-of-line 2) moves point to a new line.
+ (unless (bolp) (insert "\n"))
+ (let (org-table-may-need-update) (insert-before-markers new "\n"))
+ (beginning-of-line 0)
+ (re-search-forward "| ?" (line-end-position) t)
+ (when (or org-table-may-need-update org-table-overlay-coordinates)
+ (org-table-align))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))))
;;;###autoload
(defun org-table-insert-hline (&optional above)
"Insert a horizontal-line below the current line into the table.
With prefix ABOVE, insert above the current line."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (when (eobp) (insert "\n") (backward-char 1))
- (if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
- (org-table-align))
- (let ((line (org-table-clean-line
- (buffer-substring (point-at-bol) (point-at-eol))))
- (col (current-column)))
- (while (string-match "|\\( +\\)|" line)
- (setq line (replace-match
- (concat "+" (make-string (- (match-end 1) (match-beginning 1))
- ?-) "|") t t line)))
- (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
- (beginning-of-line (if above 1 2))
- (insert line "\n")
- (beginning-of-line (if above 1 -1))
- (org-move-to-column col)
- (and org-table-overlay-coordinates (org-table-align))))
+ (unless (org-at-table-p) (user-error "Not at a table"))
+ (when (eobp) (save-excursion (insert "\n")))
+ (unless (string-match-p "|[ \t]*$" (org-current-line-string))
+ (org-table-align))
+ (org-table-with-shrunk-columns
+ (let ((line (org-table-clean-line
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ (col (current-column)))
+ (while (string-match "|\\( +\\)|" line)
+ (setq line (replace-match
+ (concat "+" (make-string (- (match-end 1) (match-beginning 1))
+ ?-) "|") t t line)))
+ (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
+ (beginning-of-line (if above 1 2))
+ (insert line "\n")
+ (beginning-of-line (if above 1 -1))
+ (org-move-to-column col)
+ (when org-table-overlay-coordinates (org-table-align)))))
;;;###autoload
(defun org-table-hline-and-move (&optional same-column)
@@ -1638,8 +1706,7 @@ In particular, this does handle wide and invisible characters."
(defun org-table-kill-row ()
"Delete the current row or horizontal line from the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(let ((col (current-column))
(dline (org-table-current-dline)))
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
@@ -3783,6 +3850,222 @@ minutes or seconds."
secs0)))))
(if (< secs 0) (concat "-" res) res)))
+
+\f
+;;; Columns shrinking
+
+(defun org-table--shrunk-field ()
+ "Non-nil if current field is narrowed.
+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)))))
+
+(defun org-table--list-shrunk-columns ()
+ "List currently shrunk columns in table at point."
+ (save-excursion
+ ;; We really check shrunk columns in current row only. It could
+ ;; be wrong if all rows do not contain the same number of columns
+ ;; (i.e. the table is not properly aligned). As a consequence,
+ ;; some columns may not be shrunk again upon aligning the table.
+ ;;
+ ;; For example, in the following table, cursor is on first row and
+ ;; "<>» indicates a shrunk column.
+ ;;
+ ;; | |
+ ;; | | <> |
+ ;;
+ ;; Aligning table from the first row will not shrink again the
+ ;; second row, which was not visible initially.
+ ;;
+ ;; However, fixing it requires to check every row, which may be
+ ;; slow on large tables. Moreover, the hindrance of this
+ ;; pathological case is very limited.
+ (beginning-of-line)
+ (search-forward "|")
+ (let ((separator (if (org-at-table-hline-p) "+" "|"))
+ (column 1)
+ (shrunk (and (org-table--shrunk-field) (list 1)))
+ (end (line-end-position)))
+ (while (search-forward separator end t)
+ (cl-incf column)
+ (when (org-table--shrunk-field) (push column shrunk)))
+ (nreverse shrunk))))
+
+(defun org-table--shrink-field ()
+ "Shrink current field.
+
+Field is shrunk under a one character large overlay. The latter
+has the following properties:
+
+ `org-overlay-type'
+
+ Set to `table-column-hide'. Used to identify overlays
+ responsible for the task.
+
+ `org-table-column-overlays'
+
+ It is a list with the pattern (siblings . COLUMN-OVERLAYS)
+ where COLUMN-OVERLAYS is the list of all overlays hiding the
+ same column.
+
+Whenever the text behind or next the overlay is modified, all the
+overlays in the column are deleted, effectively displaying the
+column again.
+
+Return overlay used to hide the field."
+ (unless (org-table--shrunk-field)
+ (let* ((separator-re (if (org-at-table-hline-p) "[|+]" "|"))
+ (beg
+ (save-excursion
+ (if (re-search-backward separator-re (line-beginning-position) t)
+ (match-end 0)
+ (point))))
+ (end (if (re-search-forward separator-re (line-end-position) 'move)
+ (1- (point))
+ (point))) ;no closing "|" in last column
+ (field (org-trim (buffer-substring-no-properties beg end)))
+ (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 beg end)))
+ (overlay-put o 'help-echo field)
+ (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)
+ (overlay-put o 'org-overlay-type 'table-column-hide)
+ ;; Make sure overlays stays on top of table coordinates
+ ;; overlays. See `org-table-overlay-coordinates'.
+ (overlay-put o 'priority 1)
+ (org-overlay-display o org-table-shrunk-column-display 'org-table t)
+ o)))
+
+(defun org-table--read-column-selection (select max)
+ "Read column selection select as a list of numbers.
+
+SELECT is a string containing column ranges, separated by white
+space characters, see `org-table-hide-column' for details. MAX
+is the maximum column number.
+
+Return value is a sorted list of numbers. Ignore any number
+outside of the [1;MAX] range."
+ (catch :all
+ (sort
+ (delete-dups
+ (cl-mapcan
+ (lambda (s)
+ (cond
+ ((member s '("-" "1-")) (throw :all (number-sequence 1 max)))
+ ((string-match-p "\\`[0-9]+\\'" s)
+ (let ((n (string-to-number s)))
+ (and (> n 0) (<= n max) (list n))))
+ ((string-match "\\`\\([0-9]+\\)?-\\([0-9]+\\)?\\'" s)
+ (let ((n (match-string 1 s))
+ (m (match-string 2 s)))
+ (number-sequence (if n (max 1 (string-to-number n))
+ 1)
+ (if m (min max (string-to-number m))
+ max))))
+ (t nil))) ;invalid specification
+ (split-string select)))
+ #'<)))
+
+(defun org-table--shrink-columns (columns beg end)
+ "Shrink COLUMNS in an Org table.
+COLUMNS is a sorted list of column numbers. BEG and END are,
+respectively, the beginning position and the end position of the
+table."
+ (org-with-wide-buffer
+ (dolist (c columns)
+ (goto-char beg)
+ (let ((chain (list 'siblings)))
+ (while (< (point) end)
+ ;; Move to COLUMN.
+ (catch :continue
+ (let ((separator (if (org-at-table-hline-p) "+" "|")))
+ (search-forward "|")
+ (or (= c 1) ;already there
+ (search-forward separator (line-end-position) t (1- c))
+ (throw :continue nil))) ;skip invalid columns
+ ;; Link overlay to the other overlays in the same column.
+ (let ((new-overlay (org-table--shrink-field)))
+ (push new-overlay (cdr chain))
+ (overlay-put new-overlay 'org-table-column-overlays chain)))
+ (forward-line))))))
+
+(defun org-table--expand-all-columns (beg end)
+ "Expand all columns in an Org table.
+BEG and END are, respectively, the beginning position and the end
+position of the table."
+ (remove-overlays beg end 'org-overlay-type 'table-column-hide))
+
+;;;###autoload
+(defun org-table-toggle-column-visibility (&optional arg)
+ "Shrink or expand current column in an Org table.
+
+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:
+
+ N column N only
+ N-M every column between N and M (both inclusive)
+ N- every column between N (inclusive) and the last column
+ -M every column between the first one and M (inclusive)
+ - every column
+
+When called with `\\[universal-argument]' prefix, ask for the \
+range specification.
+
+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")))
+ (let* ((pos (point))
+ (begin (org-table-begin))
+ (end (org-table-end))
+ ;; Compute an upper bound for the number of 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)))))))
+
+
+\f
+;;; Formula editing
+
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
(let ((origin (copy-marker (line-beginning-position))))
@@ -4213,7 +4496,7 @@ FACE, when non-nil, for the highlight."
(mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)
(save-excursion
- (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
+ (let ((id 0) (ih 0) hline eol str ov)
(goto-char (org-table-begin))
(while (org-at-table-p)
(setq eol (point-at-eol))
@@ -4224,17 +4507,17 @@ FACE, when non-nil, for the highlight."
(format "%4d" (setq id (1+ id)))))
(org-overlay-before-string ov str 'org-special-keyword 'evaporate)
(when hline
- (setq ic 0)
- (while (re-search-forward "[+|]\\(-+\\)" eol t)
- (setq beg (1+ (match-beginning 0))
- ic (1+ ic)
- s1 (concat "$" (int-to-string ic))
- s2 (org-number-to-letters ic)
- str (if (eq org-table-use-standard-references t) s2 s1))
- (setq ov (make-overlay beg (+ beg (length str))))
- (push ov org-table-coordinate-overlays)
- (org-overlay-display ov str 'org-special-keyword 'evaporate)))
- (beginning-of-line 2)))))
+ (let ((ic 0))
+ (while (re-search-forward "[+|]\\(-+\\)" eol t)
+ (cl-incf ic)
+ (let* ((beg (1+ (match-beginning 0)))
+ (s1 (format "$%d" ic))
+ (s2 (org-number-to-letters ic))
+ (str (if (eq t org-table-use-standard-references) s2 s1))
+ (ov (make-overlay beg (+ beg (length str)))))
+ (push ov org-table-coordinate-overlays)
+ (org-overlay-display ov str 'org-special-keyword 'evaporate)))))
+ (forward-line)))))
;;;###autoload
(defun org-table-toggle-coordinate-overlays ()
@@ -4243,8 +4526,8 @@ FACE, when non-nil, for the highlight."
(setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
(message "Tables Row/Column numbers display turned %s"
(if org-table-overlay-coordinates "on" "off"))
- (if (and (org-at-table-p) org-table-overlay-coordinates)
- (org-table-align))
+ (when (and (org-at-table-p) org-table-overlay-coordinates)
+ (org-table-align))
(unless org-table-overlay-coordinates
(mapc 'delete-overlay org-table-coordinate-overlays)
(setq org-table-coordinate-overlays nil)))
--
2.13.1
^ permalink raw reply related [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-27 21:46 ` Nicolas Goaziou
@ 2017-06-28 9:46 ` Uwe Brauer
2017-06-28 19:35 ` Samuel Wales
2017-06-29 8:00 ` [rows?] (was: org table toggle narrowing and true column hiding) Uwe Brauer
1 sibling, 1 reply; 17+ messages in thread
From: Uwe Brauer @ 2017-06-28 9:46 UTC (permalink / raw)
To: emacs-orgmode
Hello
> Hello,
> Uwe Brauer <oub@mat.ucm.es> writes:
> I toyed a bit further with the idea, and re-designed the whole thing.
I just applied the patch and installed it and run a quick test. Great!
A huge improvement. I will test it during the day and report back if I
see something worth to mention.
Thanks again
Uwe
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-28 9:46 ` Uwe Brauer
@ 2017-06-28 19:35 ` Samuel Wales
2017-06-28 19:39 ` Nicolas Goaziou
0 siblings, 1 reply; 17+ messages in thread
From: Samuel Wales @ 2017-06-28 19:35 UTC (permalink / raw)
To: emacs-orgmode
good ideas.
i'd want it to be stored in the table, not in the user's head.
more radical ideas:
- toggle: remove spc and | and use a minimal column -t or align.el type setup
- edit: similar to c-c ' for babel blocks, but opens up a really
nice ses type spreadsheet
--
The Kafka Pandemic: <http://thekafkapandemic.blogspot.com>
The disease DOES progress. MANY people have died from it. And ANYBODY
can get it at any time.
"You’ve really gotta quit this and get moving, because this is murder
by neglect." ---
<http://www.meaction.net/2017/02/03/pwme-people-with-me-are-being-murdered-by-neglect>.
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-28 19:35 ` Samuel Wales
@ 2017-06-28 19:39 ` Nicolas Goaziou
2017-06-28 20:53 ` Samuel Wales
0 siblings, 1 reply; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-28 19:39 UTC (permalink / raw)
To: Samuel Wales; +Cc: emacs-orgmode
Hello,
Samuel Wales <samologist@gmail.com> writes:
> good ideas.
>
> i'd want it to be stored in the table, not in the user's head.
I don't understand.
> more radical ideas:
>
> - toggle: remove spc and | and use a minimal column -t or align.el
> type setup
I don't understand.
> - edit: similar to c-c ' for babel blocks, but opens up a really
> nice ses type spreadsheet
This is unrelated to column narrowing, isn't it?
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-28 19:39 ` Nicolas Goaziou
@ 2017-06-28 20:53 ` Samuel Wales
2017-06-28 21:51 ` Nicolas Goaziou
0 siblings, 1 reply; 17+ messages in thread
From: Samuel Wales @ 2017-06-28 20:53 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: emacs-orgmode
On 6/28/17, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:
>> i'd want it to be stored in the table, not in the user's head.
never mind. just would not want only on the fly.
>> - toggle: remove spc and | and use a minimal column -t or align.el
>> type setup
spc and | waste space. i am saying toggle minimal presentation of table.
>> - edit: similar to c-c ' for babel blocks, but opens up a really
>> nice ses type spreadsheet
>
> This is unrelated to column narrowing, isn't it?
for me, column narrowing is to preserve space. a c-c ' for a nice ses
type spreadsheet might be a better truncation scheme for some. for
example, you go to a cell and [formula and contents] shows in
minibuffer. also intuitive imo.
so it's tangential.
never mind these ideas if they are too radical.
--
The Kafka Pandemic: <http://thekafkapandemic.blogspot.com>
The disease DOES progress. MANY people have died from it. And ANYBODY
can get it at any time.
"You’ve really gotta quit this and get moving, because this is murder
by neglect." ---
<http://www.meaction.net/2017/02/03/pwme-people-with-me-are-being-murdered-by-neglect>.
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: org table toggle narrowing and true column hiding
2017-06-28 20:53 ` Samuel Wales
@ 2017-06-28 21:51 ` Nicolas Goaziou
0 siblings, 0 replies; 17+ messages in thread
From: Nicolas Goaziou @ 2017-06-28 21:51 UTC (permalink / raw)
To: Samuel Wales; +Cc: emacs-orgmode
Samuel Wales <samologist@gmail.com> writes:
> never mind. just would not want only on the fly.
Actually, from an Model-View-Controller point of view, storing narrowing
cookies in the table is mixing Model and View. Narrowing a new column
requires to change the data, which is bad.
Furthermore, narrowing cookies influence export, so this is not
gratuitous at all.
IMO, dynamic narrowing makes much more sense than static one.
>>> - toggle: remove spc and | and use a minimal column -t or align.el
>>> type setup
>
> spc and | waste space. i am saying toggle minimal presentation of table.
There is no space in shrunk columns. Such a column looks like this: |…|
True, there are still "|", but removing them would be ambiguous:
| and so on…until |
vs
| and so on |…| until |
Expanded columns still have to be readable.
>>> - edit: similar to c-c ' for babel blocks, but opens up a really
>>> nice ses type spreadsheet
>>
>> This is unrelated to column narrowing, isn't it?
>
> for me, column narrowing is to preserve space. a c-c ' for a nice ses
> type spreadsheet might be a better truncation scheme for some.
Since I don't know what is a "nice SES type spreadsheet", I cannot
comment on this. Do you mean that C-c ' should open the table as an SES
spreadsheet?
If so, converting the data would be easy, converting the formulas more
difficult.
> for example, you go to a cell and [formula and contents] shows in
> minibuffer. also intuitive imo.
How is this an example for the above idea? SES is a spreadsheet whereas
the above is about using minibuffer to display fields.
This can be implemented independently of columns narrowing so this is
orthogonal to the current patch.
Regards,
^ permalink raw reply [flat|nested] 17+ messages in thread
* [rows?] (was: org table toggle narrowing and true column hiding)
2017-06-27 21:46 ` Nicolas Goaziou
2017-06-28 9:46 ` Uwe Brauer
@ 2017-06-29 8:00 ` Uwe Brauer
2017-07-01 9:57 ` [rows?] Nicolas Goaziou
1 sibling, 1 reply; 17+ messages in thread
From: Uwe Brauer @ 2017-06-29 8:00 UTC (permalink / raw)
To: emacs-orgmode
> Hello,
> Uwe Brauer <oub@mat.ucm.es> writes:
> I toyed a bit further with the idea, and re-designed the whole thing.
I tested it quite a bit yesterday. There was only one problem concerning
pabbrev mode which scans the buffer periodically and this scanning did
widen the columns at some point. One can try this out by running
(pabbrev-scavenge-buffer) in an org buffer with columns being narrowed:
the columns will widen. But I am not sure whether this is a bug of your
implementation. I am happy with turning pabbrev mode off in org buffers
with large table where I need to narrow.
BTW what's about hiding rows? For very long tables (~100 and more rows)
hiding can be convenient. I do that by running hide-region (a third
package found in elpa). But maybe that feature could be included in org
mode as well?
Thanks
Uwe Brauer
^ permalink raw reply [flat|nested] 17+ messages in thread
* Re: [rows?]
2017-06-29 8:00 ` [rows?] (was: org table toggle narrowing and true column hiding) Uwe Brauer
@ 2017-07-01 9:57 ` Nicolas Goaziou
0 siblings, 0 replies; 17+ messages in thread
From: Nicolas Goaziou @ 2017-07-01 9:57 UTC (permalink / raw)
To: emacs-orgmode
Hello,
Uwe Brauer <oub@mat.ucm.es> writes:
> I tested it quite a bit yesterday. There was only one problem concerning
> pabbrev mode which scans the buffer periodically and this scanning did
> widen the columns at some point. One can try this out by running
> (pabbrev-scavenge-buffer) in an org buffer with columns being narrowed:
> the columns will widen. But I am not sure whether this is a bug of your
> implementation. I am happy with turning pabbrev mode off in org buffers
> with large table where I need to narrow.
I could not reproduce it. Columns are automatically expanded whenever
contents change in a field (and change is not wrapped within
`org-table-with-shrunk-columns'). AFAICT, `pabbrev-scavenge-buffer' uses
`with-silent-modifications' so that shouldn't happen.
> BTW what's about hiding rows? For very long tables (~100 and more rows)
> hiding can be convenient. I do that by running hide-region (a third
> package found in elpa). But maybe that feature could be included in org
> mode as well?
Hiding rows is a different beast. For example, it doesn't make sense to
have a feature to hide current row since Org rows are already
1 character high. So, we would only want to hide contiguous rows.
But then, the problem is that hlines may disappear and the formulas
could be more difficult to write (without using
`org-table-toggle-coordinate-overlays'). Perhaps we could only allow to
hide columns between 2 hlines.
Do you have any idea about the interface of such functionality?
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 17+ messages in thread
end of thread, other threads:[~2017-07-01 9:57 UTC | newest]
Thread overview: 17+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-06-21 9:24 org table toggle narrowing and true column hiding Uwe Brauer
2017-06-22 18:06 ` Nicolas Goaziou
2017-06-23 9:49 ` Uwe Brauer
2017-06-24 8:48 ` Nicolas Goaziou
2017-06-24 21:06 ` Uwe Brauer
2017-06-24 23:10 ` Nicolas Goaziou
2017-06-25 17:12 ` Uwe Brauer
2017-06-27 21:46 ` Nicolas Goaziou
2017-06-28 9:46 ` Uwe Brauer
2017-06-28 19:35 ` Samuel Wales
2017-06-28 19:39 ` Nicolas Goaziou
2017-06-28 20:53 ` Samuel Wales
2017-06-28 21:51 ` Nicolas Goaziou
2017-06-29 8:00 ` [rows?] (was: org table toggle narrowing and true column hiding) Uwe Brauer
2017-07-01 9:57 ` [rows?] Nicolas Goaziou
2017-06-23 16:23 ` org table toggle narrowing and true column hiding Michael Brand
2017-06-23 21:21 ` Uwe Brauer
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).