mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-29 18:36:26 +00:00
org-table: Fix table alignment
* lisp/org-table.el (org-table-align): Refactor function fix wrong alignment bug. * lisp/org-compat.el (org-format-transports-properties-p): Remove variable. * testing/lisp/test-org.el (test-org/fill-paragraph): Fix test Reported-by: William Denton <wtd@pobox.com> <http://permalink.gmane.org/gmane.emacs.orgmode/98901>
This commit is contained in:
parent
22c652599c
commit
120dcd1d13
|
@ -40,11 +40,6 @@
|
|||
;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs)
|
||||
;; at compilation time and can therefore optimize code better.
|
||||
(defconst org-xemacs-p (featurep 'xemacs))
|
||||
(defconst org-format-transports-properties-p
|
||||
(let ((x "a"))
|
||||
(add-text-properties 0 1 '(test t) x)
|
||||
(get-text-property 0 'test (format "%s" x)))
|
||||
"Does format transport text properties?")
|
||||
|
||||
(defun org-compatible-face (inherits specs)
|
||||
"Make a compatible face specification.
|
||||
|
|
|
@ -725,198 +725,168 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
|
|||
(defun org-table-align ()
|
||||
"Align the table at point by aligning all vertical bars."
|
||||
(interactive)
|
||||
(let* (
|
||||
;; Limits of table
|
||||
(beg (org-table-begin))
|
||||
(end (copy-marker (org-table-end)))
|
||||
;; Current cursor position
|
||||
(linepos (org-current-line))
|
||||
(colpos (org-table-current-column))
|
||||
(winstart (window-start))
|
||||
(winstartline (org-current-line (min winstart (1- (point-max)))))
|
||||
lines lengths l typenums ty fields maxfields i
|
||||
column
|
||||
(indent "") cnt frac
|
||||
rfmt hfmt
|
||||
(spaces '(1 . 1))
|
||||
(sp1 (car spaces))
|
||||
(sp2 (cdr spaces))
|
||||
(rfmt1 (concat
|
||||
(make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
|
||||
(hfmt1 (concat
|
||||
(make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
|
||||
emptystrings links dates emph raise narrow
|
||||
falign falign1 fmax f1 f2 len c e space)
|
||||
(untabify beg end)
|
||||
(remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
|
||||
;; Check if we have links or dates
|
||||
(let ((beg (org-table-begin))
|
||||
(end (copy-marker (org-table-end)))
|
||||
(linepos (copy-marker (line-beginning-position)))
|
||||
(colpos (org-table-current-column)))
|
||||
;; 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)
|
||||
(setq links (re-search-forward org-bracket-link-regexp end t))
|
||||
(goto-char beg)
|
||||
(setq emph (and org-hide-emphasis-markers
|
||||
(re-search-forward org-emph-re end t)))
|
||||
(goto-char beg)
|
||||
(setq raise (and org-use-sub-superscripts
|
||||
(re-search-forward org-match-substring-regexp end t)))
|
||||
(goto-char beg)
|
||||
(setq dates (and org-display-custom-times
|
||||
(re-search-forward org-ts-regexp-both end t)))
|
||||
;; Make sure the link properties are right
|
||||
(when links (goto-char beg) (while (org-activate-bracket-links end)))
|
||||
;; Make sure the date properties are right
|
||||
(when dates (goto-char beg) (while (org-activate-dates end)))
|
||||
(when emph (goto-char beg) (while (org-do-emphasis-faces end)))
|
||||
(when raise (goto-char beg) (while (org-raise-scripts end)))
|
||||
|
||||
;; Check if we are narrowing any columns
|
||||
(goto-char beg)
|
||||
(setq narrow (and org-table-do-narrow
|
||||
org-format-transports-properties-p
|
||||
(re-search-forward "<[lrc]?[0-9]+>" end t)))
|
||||
(goto-char beg)
|
||||
(setq falign (re-search-forward "<[lrc][0-9]*>" end t))
|
||||
(goto-char beg)
|
||||
;; Get the rows
|
||||
(setq lines (org-split-string
|
||||
(buffer-substring beg end) "\n"))
|
||||
;; Store the indentation of the first line
|
||||
(if (string-match "^ *" (car lines))
|
||||
(setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
|
||||
;; Mark the hlines by setting the corresponding element to nil
|
||||
;; At the same time, we remove trailing space.
|
||||
(setq lines (mapcar (lambda (l)
|
||||
(if (string-match "^ *|-" l)
|
||||
nil
|
||||
(if (string-match "[ \t]+$" l)
|
||||
(substring l 0 (match-beginning 0))
|
||||
l)))
|
||||
lines))
|
||||
;; Get the data fields by splitting the lines.
|
||||
(setq fields (mapcar
|
||||
(lambda (l)
|
||||
(org-split-string l " *| *"))
|
||||
(delq nil (copy-sequence lines))))
|
||||
;; How many fields in the longest line?
|
||||
(condition-case nil
|
||||
(setq maxfields (apply 'max (mapcar 'length fields)))
|
||||
(error
|
||||
(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
|
||||
(setq emptystrings (make-list maxfields ""))
|
||||
;; Check for special formatting.
|
||||
(setq i -1)
|
||||
(while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
|
||||
(setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
|
||||
;; Check if there is an explicit width specified
|
||||
(setq fmax nil)
|
||||
(when (or narrow falign)
|
||||
(setq c column fmax nil falign1 nil)
|
||||
(while c
|
||||
(setq e (pop c))
|
||||
(when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
|
||||
(if (match-end 1) (setq falign1 (match-string 1 e)))
|
||||
(if (and org-table-do-narrow (match-end 2))
|
||||
(setq fmax (string-to-number (match-string 2 e)) c nil))))
|
||||
;; Find fields that are wider than fmax, and shorten them
|
||||
(when fmax
|
||||
(loop for xx in column do
|
||||
(when (and (stringp xx)
|
||||
(> (org-string-width xx) fmax))
|
||||
(org-add-props xx nil
|
||||
(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 (org-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 C-c ` to edit. Full value is:\n"
|
||||
(org-no-properties (copy-sequence xx))))
|
||||
(setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
|
||||
(unless (> f1 1)
|
||||
(user-error "Cannot narrow field starting with wide link \"%s\""
|
||||
(match-string 0 xx)))
|
||||
(setq f2 (length xx))
|
||||
(if (= (org-string-width xx)
|
||||
f2)
|
||||
(setq f2 f1)
|
||||
(setq f2 1)
|
||||
(while (< (org-string-width (substring xx 0 f2))
|
||||
f1)
|
||||
(setq f2 (1+ f2))))
|
||||
(add-text-properties f2 (length xx) (list 'org-cwidth t) xx)
|
||||
(add-text-properties (if (>= (string-width (substring xx (1- f2) f2)) 2)
|
||||
(1- f2) (- f2 2)) f2
|
||||
(list 'display org-narrow-column-arrow)
|
||||
xx)))))
|
||||
;; 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, to decide about alignment of the column
|
||||
(if falign1
|
||||
(push (equal (downcase falign1) "r") typenums)
|
||||
(setq cnt 0 frac 0.0)
|
||||
(loop for x in column do
|
||||
(if (equal x "")
|
||||
nil
|
||||
(setq frac ( / (+ (* frac cnt)
|
||||
(if (string-match org-table-number-regexp x) 1 0))
|
||||
(setq cnt (1+ cnt))))))
|
||||
(push (>= frac org-table-number-fraction) typenums)))
|
||||
(setq lengths (nreverse lengths) typenums (nreverse typenums))
|
||||
(concat
|
||||
(substitute-command-keys
|
||||
"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)
|
||||
(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 (org-string-match-p org-table-number-regexp x)
|
||||
1
|
||||
0))
|
||||
(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))))))))))
|
||||
|
||||
;; Store the alignment of this table, for later editing of single fields
|
||||
(setq org-table-last-alignment typenums
|
||||
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.
|
||||
(when (or links emph raise)
|
||||
(loop for i from 0 upto (1- maxfields) do
|
||||
(setq len (nth i lengths))
|
||||
(loop for j from 0 upto (1- (length fields)) do
|
||||
(setq c (nthcdr i (car (nthcdr j fields))))
|
||||
(if (and (stringp (car c))
|
||||
(or (text-property-any 0 (length (car c))
|
||||
'invisible 'org-link (car c))
|
||||
(text-property-any 0 (length (car c))
|
||||
'org-dwidth t (car c)))
|
||||
(< (org-string-width (car c)) len))
|
||||
(progn
|
||||
(setq space (make-string (- len (org-string-width (car c))) ?\ ))
|
||||
(setcar c (if (nth i typenums)
|
||||
(concat space (car c))
|
||||
(concat (car c) space))))))))
|
||||
|
||||
;; Compute the formats needed for output of the table
|
||||
(setq rfmt (concat indent "|") hfmt (concat indent "|"))
|
||||
(while (setq l (pop lengths))
|
||||
(setq ty (if (pop typenums) "" "-")) ; number types flushright
|
||||
(setq rfmt (concat rfmt (format rfmt1 ty l))
|
||||
hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
|
||||
(setq rfmt (concat rfmt "\n")
|
||||
hfmt (concat (substring hfmt 0 -1) "|\n"))
|
||||
|
||||
(move-marker org-table-aligned-begin-marker (point))
|
||||
;; Replace modified lines only.
|
||||
(dolist (l lines)
|
||||
(let ((line (if l (apply #'format rfmt (append (pop fields) emptystrings))
|
||||
hfmt)))
|
||||
(if (equal (buffer-substring (point) (line-beginning-position 2)) line)
|
||||
(forward-line)
|
||||
(insert line)
|
||||
(delete-region (point) (line-beginning-position 2)))))
|
||||
(move-marker end nil)
|
||||
(move-marker org-table-aligned-end-marker (point))
|
||||
(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)))
|
||||
;; Try to move to the old location
|
||||
(org-goto-line winstartline)
|
||||
(setq winstart (point-at-bol))
|
||||
(org-goto-line linepos)
|
||||
(when (eq (window-buffer (selected-window)) (current-buffer))
|
||||
(set-window-start (selected-window) winstart 'noforce))
|
||||
(org-table-goto-column colpos)
|
||||
(and org-table-overlay-coordinates (org-table-overlay-coordinates))
|
||||
(setq org-table-may-need-update nil)
|
||||
))
|
||||
;; 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)))
|
||||
(goto-char linepos)
|
||||
(org-table-goto-column colpos)
|
||||
(set-marker end nil)
|
||||
(set-marker linepos 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)
|
||||
|
|
|
@ -352,7 +352,7 @@
|
|||
(buffer-string))))
|
||||
(should
|
||||
(equal "#+name: table\n| a |\n"
|
||||
(org-test-with-temp-text "#+name: table\n| a |"
|
||||
(org-test-with-temp-text "#+name: table\n| a |\n"
|
||||
(org-fill-paragraph)
|
||||
(buffer-string))))
|
||||
;; At a paragraph, preserve line breaks.
|
||||
|
|
Loading…
Reference in a new issue