From f1c858cad711d367e43ba118dc6e3d111705a6d1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou 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))) + + +;;; 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))))))) + + + +;;; 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