Remove visual effect of width cookies in tables

* lisp/org-colview.el (org-dblock-write:columnview): Remove :width
  parameter.

* lisp/org-table.el (org-narrow-column-arrow): Remove variable.
(org-table-cleanup-narrow-column-properties): Remove function.
(org-table-align): Ignore width cookies when aligning table.
(org-table-justify-field-maybe):
(org-table-finish-edit-field):
(org-table-follow-fields-with-editor):
(orgtbl-setup): Remove reference to `org-cwidth' property.

* lisp/org.el (org-mode):
(org-hide-wide-columns): Remove function.
(org-set-font-lock-defaults): Apply previous removal.
(org-shorten-string): Ignore `org-cwidth' property.

* testing/lisp/test-org-colview.el (test-org-colview/dblock): Remove
  a test.

Export back-ends may still use width cookie to alter table's output.
This commit is contained in:
Nicolas Goaziou 2017-07-10 13:35:00 +02:00
parent 6d6a30d4cd
commit 23a2fde6fe
4 changed files with 32 additions and 134 deletions

View File

@ -1372,7 +1372,6 @@ PARAMS is a property list of parameters:
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use."
(let ((table
(let ((id (plist-get params :id))
@ -1428,14 +1427,6 @@ PARAMS is a property list of parameters:
(concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
item))))
(push (cdr row) new-table))))
(when (plist-get params :width)
(setq table
(append table
(list
(mapcar (lambda (spec)
(let ((w (nth 2 spec)))
(if w (format "<%d>" (max 3 w)) "")))
org-columns-current-fmt-compiled)))))
(when (plist-get params :vlines)
(setq table
(let ((size (length org-columns-current-fmt-compiled)))

View File

@ -771,9 +771,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
"Overlay coordinates after each align of a table.")
(defvar org-last-recalc-line nil)
(defvar org-table-do-narrow t) ; for dynamic scoping
(defconst org-narrow-column-arrow "=>"
"Used as display property in narrowed table columns.")
;;;###autoload
(defun org-table-align ()
@ -790,17 +787,19 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(goto-char beg)
(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 " *| *"))
(align-cookie?
(save-excursion
(re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*\\(?:|\\|$\\)"
end t)))
;; Table's rows. Rules are replaced by nil. Trailing
;; spaces are removed.
(lines (mapcar
(lambda (l)
(and (not (string-match-p org-table-hline-regexp l))
l))
(split-string (buffer-substring beg end) "\n" t "[ \t]")))
;; List of lists of data fields.
(fields (mapcar (lambda (l) (org-split-string l "[ \t]*|[ \t]*"))
(remq nil lines)))
;; Compute number of fields in the longest line. If the
;; table contains no field, create a default table.
@ -811,58 +810,23 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; A list of empty strings to fill any short rows on output.
(emptycells (make-list maxfields ""))
lengths typenums)
;; Check for special formatting.
;; Compute alignment and width for each column.
(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))
(let* ((column (mapcar (lambda (x) (or (nth i x) ""))
fields))
(falign
(and align-cookie?
(cl-some (lambda (cell)
(and (string-match "\\`<\\([lrc]\\)[0-9]*>\\'"
cell)
(match-string 1 cell)))
column))))
;; Get the maximum width for each column.
(push (apply #'max 1 (mapcar #'org-string-width column))
lengths)
;; Get the fraction of numbers among non-empty cells to
;; decide about alignment of the column.
;; If there is no alignment cookie, 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))
@ -911,29 +875,16 @@ edit. Full value is:\n"
(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.
;; Replace modified lines only.
(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)))
(if (equal previous line)
(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))))))
@ -2093,8 +2044,7 @@ toggle `org-table-follow-field-mode'."
(arg
(let ((b (save-excursion (skip-chars-backward "^|") (point)))
(e (save-excursion (skip-chars-forward "^|\r\n") (point))))
(remove-text-properties b e '(org-cwidth t invisible t
display t intangible t))
(remove-text-properties b e '(invisible t intangible t))
(if (and (boundp 'font-lock-mode) font-lock-mode)
(font-lock-fontify-block))))
(t
@ -2121,9 +2071,7 @@ toggle `org-table-follow-field-mode'."
(setq word-wrap t)
(goto-char (setq p (point-max)))
(insert (org-trim field))
(remove-text-properties p (point-max)
'(invisible t org-cwidth t display t
intangible t))
(remove-text-properties p (point-max) '(invisible t intangible t))
(goto-char p)
(setq-local org-finish-function 'org-table-finish-edit-field)
(setq-local org-window-configuration cw)
@ -4667,15 +4615,12 @@ FACE, when non-nil, for the highlight."
(concat orgtbl-line-start-regexp "\\|"
auto-fill-inhibit-regexp)
orgtbl-line-start-regexp))
(add-to-invisibility-spec '(org-cwidth))
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
(org-restart-font-lock))
(easy-menu-add orgtbl-mode-menu))
(t
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
(org-table-cleanup-narrow-column-properties)
(org-remove-from-invisibility-spec '(org-cwidth))
(remove-hook 'before-change-functions 'org-before-change-function t)
(when (fboundp 'font-lock-remove-keywords)
(font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
@ -4683,19 +4628,6 @@ FACE, when non-nil, for the highlight."
(easy-menu-remove orgtbl-mode-menu)
(force-mode-line-update 'all))))
(defun org-table-cleanup-narrow-column-properties ()
"Remove all properties related to narrow-column invisibility."
(let ((s (point-min)))
(while (setq s (text-property-any s (point-max)
'display org-narrow-column-arrow))
(remove-text-properties s (1+ s) '(display t)))
(setq s (point-min))
(while (setq s (text-property-any s (point-max) 'org-cwidth 1))
(remove-text-properties s (1+ s) '(org-cwidth t)))
(setq s (point-min))
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
(remove-text-properties s (1+ s) '(invisible t)))))
(defun orgtbl-make-binding (fun n &rest keys)
"Create a function for binding in the table minor mode.
FUN is the command to call inside a table. N is used to create a unique

View File

@ -5439,7 +5439,6 @@ The following commands are available:
(org-load-modules-maybe)
(org-install-agenda-files-menu)
(when org-descriptive-links (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-cwidth))
(add-to-invisibility-spec '(org-hide-block . t))
(setq-local outline-regexp org-outline-regexp)
(setq-local outline-level 'org-outline-level)
@ -6163,16 +6162,6 @@ Also refresh fontification if needed."
(when (memq 'radio org-highlight-links)
(org-restart-font-lock)))))
(defun org-hide-wide-columns (limit)
(let (s e)
(setq s (text-property-any (point) (or limit (point-max))
'org-cwidth t))
(when s
(setq e (next-single-property-change s 'org-cwidth))
(add-text-properties s e '(invisible org-cwidth))
(goto-char e)
t)))
(defvar org-latex-and-related-regexp nil
"Regular expression for highlighting LaTeX, entities and sub/superscript.")
@ -6347,7 +6336,6 @@ needs to be inserted at a specific position in the font-lock sequence.")
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
;; Macro
'(org-fontify-macros)
'(org-hide-wide-columns (0 nil append))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
org-todo-regexp)

View File

@ -1435,19 +1435,6 @@
"* H\n<point>#+BEGIN: columnview :format \"%ITEM(Name)\"\n#+END:"
(let ((org-columns-default-format "%ITEM")) (org-update-dblock))
(buffer-substring-no-properties (point) (point-max)))))
;; Test `:width' parameter
(should
(equal
"#+BEGIN: columnview :width t
| ITEM | A |
|------------+---|
| H | |
| <10> | |
#+END:"
(org-test-with-temp-text
"* H\n<point>#+BEGIN: columnview :width t\n#+END:"
(let ((org-columns-default-format "%10ITEM %A")) (org-update-dblock))
(buffer-substring-no-properties (point) (point-max)))))
;; When inserting ITEM values, make sure to clean sensitive
;; contents, like unique targets or forbidden inline src-blocks.
(should