Parcourir la source

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.
Carsten Dominik il y a 14 ans
Parent
commit
0618aeafb3
3 fichiers modifiés avec 44 ajouts et 17 suppressions
  1. 12 0
      lisp/org-compat.el
  2. 10 4
      lisp/org-table.el
  3. 22 13
      lisp/org.el

+ 12 - 0
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)

+ 10 - 4
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))) ?\ ))

+ 22 - 13
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