From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
To: emacs-orgmode@gnu.org
Subject: Re: org table toggle narrowing and true column hiding
Date: Sat, 24 Jun 2017 10:48:39 +0200 [thread overview]
Message-ID: <87r2y94vq0.fsf@nicolasgoaziou.fr> (raw)
In-Reply-To: <87podvowxl.fsf@mat.ucm.es> (Uwe Brauer's message of "Fri, 23 Jun 2017 09:49:58 +0000")
[-- 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
next prev parent reply other threads:[~2017-06-24 8:48 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87r2y94vq0.fsf@nicolasgoaziou.fr \
--to=mail@nicolasgoaziou.fr \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).