summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-07-10 13:35:00 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-09-06 15:18:37 +0200
commit23a2fde6feb193a6076e2cb506360fb4e981d925 (patch)
tree7ed4ec3801070d6a358448d418a996950fd9f591
parent6d6a30d4cd682732ba40328bbeb96122a50f96ff (diff)
downloadorg-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.el9
-rw-r--r--lisp/org-table.el132
-rw-r--r--lisp/org.el12
-rw-r--r--testing/lisp/test-org-colview.el13
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