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:
parent
fd1d2992f6
commit
0618aeafb3
|
@ -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)
|
||||
|
|
|
@ -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))) ?\ ))
|
||||
|
|
35
lisp/org.el
35
lisp/org.el
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue