diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-07-10 13:35:00 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-09-06 15:18:37 +0200 |
commit | 23a2fde6feb193a6076e2cb506360fb4e981d925 (patch) | |
tree | 7ed4ec3801070d6a358448d418a996950fd9f591 | |
parent | 6d6a30d4cd682732ba40328bbeb96122a50f96ff (diff) | |
download | org-mode-23a2fde6feb193a6076e2cb506360fb4e981d925.tar.gz |
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.
-rw-r--r-- | lisp/org-colview.el | 9 | ||||
-rw-r--r-- | lisp/org-table.el | 132 | ||||
-rw-r--r-- | lisp/org.el | 12 | ||||
-rw-r--r-- | testing/lisp/test-org-colview.el | 13 |
4 files changed, 32 insertions, 134 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 71beee9..679cb5a 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -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))) diff --git a/lisp/org-table.el b/lisp/org-table.el index c14ff01..35af9cb 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -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 diff --git a/lisp/org.el b/lisp/org.el index 4ba4d8e..74b82ae 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -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) diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el index 85c1bcf..a842013 100644 --- a/testing/lisp/test-org-colview.el +++ b/testing/lisp/test-org-colview.el @@ -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 |