Make raising and lowering not mess up table alignment

* lisp/org-compat.el (org-string-match-p):
(org-looking-at-p): New functions.
* lisp/org-table.el (org-table-align): Handle raised text with
invisible characters.
* lisp/org.el (org-script-display): Add raise properties for tables.
(org-raise-scripts): Handle raising differently inside tables.

Pretty display of subscripts and superscripts no longer messes up
table alignment.  This is achieved by two things:

1. Inside tables, the raised characters are not made smaller, they
   remains at the same size.  Instead they are raise/lowered more, by
   a full half character height to still be clearly readable as
   subscript or superscript.

2. The invisible characters are taken into account when computing the
   field width.
This commit is contained in:
Carsten Dominik 2010-06-03 10:24:04 +02:00
parent fd1d2992f6
commit 0618aeafb3
3 changed files with 44 additions and 17 deletions

View File

@ -313,6 +313,18 @@ TIME defaults to the current time."
(time-to-seconds (or time (current-time)))
(float-time time)))
(defun org-string-match-p (&rest args)
(if (fboundp 'string-match-p)
(apply 'string-match-p args)
(save-match-data
(apply 'string-match args))))
(defun org-looking-at-p (&rest args)
(if (fboundp 'looking-at-p)
(apply 'looking-at-p args)
(save-match-data
(apply 'looking-at-p args))))
; XEmacs does not have `looking-back'.
(if (fboundp 'looking-back)
(defalias 'org-looking-back 'looking-back)

View File

@ -629,7 +629,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
(hfmt1 (concat
(make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
emptystrings links dates emph narrow
emptystrings links dates emph raise narrow
falign falign1 fmax f1 len c e space)
(untabify beg end)
(remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
@ -640,6 +640,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(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
@ -647,6 +650,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; 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)
@ -737,14 +741,16 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; 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)
(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))
(text-property-any 0 (length (car c)) 'invisible 'org-link (car c))
; (string-match org-bracket-link-regexp (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))) ?\ ))

View File

@ -5484,6 +5484,12 @@ If KWD is a number, get the corresponding match group."
org-no-flyspell t)))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
((raise 0.3) (height 0.7))
((raise -0.5))
((raise 0.5)))
"Display properties for showing superscripts and subscripts.")
(defun org-remove-font-lock-display-properties (beg end)
"Remove specific display properties that have been added by font lock.
The will remove the raise properties that are used to show superscripts
@ -5496,10 +5502,6 @@ and subscriipts."
(put-text-property beg next 'display nil))
(setq beg next))))
(defconst org-script-display '(((raise -0.3) (height 0.7))
((raise 0.3) (height 0.7)))
"Display properties for showing superscripts and subscripts.")
(defun org-raise-scripts (limit)
"Add raise properties to sub/superscripts."
(when (and org-pretty-entities org-pretty-entities-include-sub-superscripts)
@ -5508,21 +5510,28 @@ and subscriipts."
org-match-substring-regexp
org-match-substring-with-braces-regexp)
limit t)
(progn
(let* ((pos (point))
(table-p (progn (goto-char (point-at-bol))
(prog1 (org-looking-at-p
org-table-dataline-regexp)
(goto-char pos)))))
(put-text-property (match-beginning 3) (match-end 0)
'display
(if (equal (char-after (match-beginning 2)) ?^)
(nth 1 org-script-display)
(car org-script-display)))
(put-text-property (match-beginning 2) (match-end 2)
'invisible t)
(nth (if table-p 3 1) org-script-display)
(nth (if table-p 2 0) org-script-display)))
(add-text-properties (match-beginning 2) (match-end 2)
(list 'invisible t
'org-dwidth t 'org-dwidth-n 1))
(if (and (eq (char-after (match-beginning 3)) ?{)
(eq (char-before (match-end 3)) ?}))
(progn
(put-text-property (match-beginning 3) (1+ (match-beginning 3))
'invisible t)
(put-text-property (1- (match-end 3)) (match-end 3)
'invisible t)))
(add-text-properties
(match-beginning 3) (1+ (match-beginning 3))
(list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
(add-text-properties
(1- (match-end 3)) (match-end 3)
(list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))
t))))
;;;; Visibility cycling, including org-goto and indirect buffer