From 0618aeafb39dbf78e753348eaeaddbb7f8104cd0 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Thu, 3 Jun 2010 10:24:04 +0200 Subject: [PATCH] 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. --- lisp/org-compat.el | 12 ++++++++++++ lisp/org-table.el | 14 ++++++++++---- lisp/org.el | 35 ++++++++++++++++++++++------------- 3 files changed, 44 insertions(+), 17 deletions(-) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index ffab8b7c1..2ead4a366 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -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) diff --git a/lisp/org-table.el b/lisp/org-table.el index 13de67071..3c63e70f5 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -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))) ?\ )) diff --git a/lisp/org.el b/lisp/org.el index c3d7d71cb..a81ee593e 100644 --- a/lisp/org.el +++ b/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