aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJay Belanger2004-11-24 05:59:23 +0000
committerJay Belanger2004-11-24 05:59:23 +0000
commitfdcf8e2b4adffe610aa4fabc9478d169bdcbb394 (patch)
treea9cc035fb85112ab75cd187d1af7879e1dad3f76
parentc5c56f464faf5f63f6174937d75ae80d92f3a639 (diff)
downloademacs-fdcf8e2b4adffe610aa4fabc9478d169bdcbb394.tar.gz
emacs-fdcf8e2b4adffe610aa4fabc9478d169bdcbb394.zip
(math-svo-c, math-svo-wid, math-svo-off): New variables.
(math-stack-value-offset-fancy): Replace variables c, wid and off by declared variables. (math-comp-just, math-comp-comma-spc): New variables. (math-compose-expr, math-compose-matrix): Replace variable just by declared variable. (math-comp-vector-prec): New variable. (math-compose-expr, math-compose-matrix, math-compose-rows): Replace variable vector-prec by declared variable. (math-comp-left-bracket, math-comp-right-bracket, math-comp-comma): New variables. (math-compose-expr, math-compose-rows): Replace variables left-bracket, right-bracket and comma by declared variables. (math-comp-full-width): New variable. (math-comp-to-string-flat, math-comp-to-string-flat-term): Replace variable full-width by declared variable. (math-comp-sel-tag): Declared it. (math-comp-highlight, math-comp-word, math-comp-level) (math-comp-margin, math-comp-pos, math-comp-buf, math-comp-base) (math-comp-hgt, math-comp-tag, math-comp-hpos, math-comp-vpos): New variables. (math-comp-to-string-flat, math-comp-to-string-flat-term) (math-comp-sel-flat-term): Replace variables comp-highlight, comp-word, comp-level, comp-margin, comp-pos and comp-buf by declared variables. (math-comp-simplify, math-comp-simplify-term, math-comp-add-string) (math-comp-add-string-sel): Replace variables comp-highlight, comp-buf, comp-base, comp-height, comp-tag, comp-hpos and comp-vpos by declared variables.
Diffstat
-rw-r--r--lisp/calc/calccomp.el382
1 files changed, 223 insertions, 159 deletions
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 59bbbebdc0e..0d69602070a 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -3,8 +3,7 @@
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4 4
5;; Author: David Gillespie <daveg@synaptics.com> 5;; Author: David Gillespie <daveg@synaptics.com>
6;; Maintainers: D. Goel <deego@gnufans.org> 6;; Maintainer: Jay Belanger <belanger@truman.edu>
7;; Colin Walters <walters@debian.org>
8 7
9;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
10 9
@@ -62,6 +61,25 @@
62;;; 61;;;
63;;; (tag X C) Composition C corresponds to sub-expression X 62;;; (tag X C) Composition C corresponds to sub-expression X
64 63
64;; math-comp-just and math-comp-comma-spc are local to
65;; math-compose-expr, but are used by math-compose-matrix, which is
66;; called by math-compose-expr
67(defvar math-comp-just)
68(defvar math-comp-comma-spc)
69
70;; math-comp-vector-prec is local to math-compose-expr, but is used by
71;; math-compose-matrix and math-compose-rows, which are called by
72;; math-compose-expr.
73(defvar math-comp-vector-prec)
74
75;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
76;; local to math-compose-expr, but are used by math-compose-rows, which is
77;; called by math-compose-expr.
78(defvar math-comp-left-bracket)
79(defvar math-comp-right-bracket)
80(defvar math-comp-comma)
81
82
65(defun math-compose-expr (a prec) 83(defun math-compose-expr (a prec)
66 (let ((math-compose-level (1+ math-compose-level))) 84 (let ((math-compose-level (1+ math-compose-level)))
67 (cond 85 (cond
@@ -154,21 +172,21 @@
154 (and (setq temp2 (assq nil (cdr temp))) 172 (and (setq temp2 (assq nil (cdr temp)))
155 (funcall (cdr temp2) a)))))))) 173 (funcall (cdr temp2) a))))))))
156 ((eq (car a) 'vec) 174 ((eq (car a) 'vec)
157 (let* ((left-bracket (if calc-vector-brackets 175 (let* ((math-comp-left-bracket (if calc-vector-brackets
158 (substring calc-vector-brackets 0 1) "")) 176 (substring calc-vector-brackets 0 1) ""))
159 (right-bracket (if calc-vector-brackets 177 (math-comp-right-bracket (if calc-vector-brackets
160 (substring calc-vector-brackets 1 2) "")) 178 (substring calc-vector-brackets 1 2) ""))
161 (inner-brackets (memq 'R calc-matrix-brackets)) 179 (inner-brackets (memq 'R calc-matrix-brackets))
162 (outer-brackets (memq 'O calc-matrix-brackets)) 180 (outer-brackets (memq 'O calc-matrix-brackets))
163 (row-commas (memq 'C calc-matrix-brackets)) 181 (row-commas (memq 'C calc-matrix-brackets))
164 (comma-spc (or calc-vector-commas " ")) 182 (math-comp-comma-spc (or calc-vector-commas " "))
165 (comma (or calc-vector-commas "")) 183 (math-comp-comma (or calc-vector-commas ""))
166 (vector-prec (if (or (and calc-vector-commas 184 (math-comp-vector-prec (if (or (and calc-vector-commas
167 (math-vector-no-parens a)) 185 (math-vector-no-parens a))
168 (memq 'P calc-matrix-brackets)) 0 1000)) 186 (memq 'P calc-matrix-brackets)) 0 1000))
169 (just (cond ((eq calc-matrix-just 'right) 'vright) 187 (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
170 ((eq calc-matrix-just 'center) 'vcent) 188 ((eq calc-matrix-just 'center) 'vcent)
171 (t 'vleft))) 189 (t 'vleft)))
172 (break calc-break-vectors)) 190 (break calc-break-vectors))
173 (if (and (memq calc-language '(nil big)) 191 (if (and (memq calc-language '(nil big))
174 (not calc-break-vectors) 192 (not calc-break-vectors)
@@ -177,17 +195,17 @@
177 (and (< (length a) 7) (< (length (nth 1 a)) 7)) 195 (and (< (length a) 7) (< (length (nth 1 a)) 7))
178 (progn (setq break t) nil))) 196 (progn (setq break t) nil)))
179 (if (progn 197 (if (progn
180 (setq vector-prec (if (or (and calc-vector-commas 198 (setq math-comp-vector-prec (if (or (and calc-vector-commas
181 (math-vector-no-parens 199 (math-vector-no-parens
182 (nth 1 a))) 200 (nth 1 a)))
183 (memq 'P calc-matrix-brackets)) 201 (memq 'P calc-matrix-brackets))
184 0 1000)) 202 0 1000))
185 (= (length a) 2)) 203 (= (length a) 2))
186 (list 'horiz 204 (list 'horiz
187 (concat left-bracket left-bracket " ") 205 (concat math-comp-left-bracket math-comp-left-bracket " ")
188 (math-compose-vector (cdr (nth 1 a)) (concat comma " ") 206 (math-compose-vector (cdr (nth 1 a)) (concat math-comp-comma " ")
189 vector-prec) 207 math-comp-vector-prec)
190 (concat " " right-bracket right-bracket)) 208 (concat " " math-comp-right-bracket math-comp-right-bracket))
191 (let* ((rows (1- (length a))) 209 (let* ((rows (1- (length a)))
192 (cols (1- (length (nth 1 a)))) 210 (cols (1- (length (nth 1 a))))
193 (base (/ (1- rows) 2)) 211 (base (/ (1- rows) 2))
@@ -196,17 +214,17 @@
196 (list (append '(vleft) 214 (list (append '(vleft)
197 (list base) 215 (list base)
198 (list (concat (and outer-brackets 216 (list (concat (and outer-brackets
199 (concat left-bracket 217 (concat math-comp-left-bracket
200 " ")) 218 " "))
201 (and inner-brackets 219 (and inner-brackets
202 (concat left-bracket 220 (concat math-comp-left-bracket
203 " ")))) 221 " "))))
204 (make-list (1- rows) 222 (make-list (1- rows)
205 (concat (and outer-brackets 223 (concat (and outer-brackets
206 " ") 224 " ")
207 (and inner-brackets 225 (and inner-brackets
208 (concat 226 (concat
209 left-bracket 227 math-comp-left-bracket
210 " ")))))) 228 " "))))))
211 (math-compose-matrix (cdr a) 1 cols base) 229 (math-compose-matrix (cdr a) 1 cols base)
212 (list (append '(vleft) 230 (list (append '(vleft)
@@ -214,20 +232,20 @@
214 (make-list (1- rows) 232 (make-list (1- rows)
215 (if inner-brackets 233 (if inner-brackets
216 (concat " " 234 (concat " "
217 right-bracket 235 math-comp-right-bracket
218 (and row-commas 236 (and row-commas
219 comma)) 237 math-comp-comma))
220 (if (and outer-brackets 238 (if (and outer-brackets
221 row-commas) 239 row-commas)
222 ";" ""))) 240 ";" "")))
223 (list (concat 241 (list (concat
224 (and inner-brackets 242 (and inner-brackets
225 (concat " " 243 (concat " "
226 right-bracket)) 244 math-comp-right-bracket))
227 (and outer-brackets 245 (and outer-brackets
228 (concat 246 (concat
229 " " 247 " "
230 right-bracket))))))))) 248 math-comp-right-bracket)))))))))
231 (if (and calc-display-strings 249 (if (and calc-display-strings
232 (cdr a) 250 (cdr a)
233 (math-vector-is-string a)) 251 (math-vector-is-string a))
@@ -237,7 +255,6 @@
237 (let* ((full (or calc-full-vectors (< (length a) 7))) 255 (let* ((full (or calc-full-vectors (< (length a) 7)))
238 (rows (if full (1- (length a)) 5)) 256 (rows (if full (1- (length a)) 5))
239 (base (/ (1- rows) 2)) 257 (base (/ (1- rows) 2))
240 (just 'vleft)
241 (calc-break-vectors nil)) 258 (calc-break-vectors nil))
242 (list 'horiz 259 (list 'horiz
243 (cons 'vleft (cons base 260 (cons 'vleft (cons base
@@ -260,26 +277,29 @@
260 (math-matrixp a)) 277 (math-matrixp a))
261 (list 'horiz 278 (list 'horiz
262 "matrix(" 279 "matrix("
263 left-bracket 280 math-comp-left-bracket
264 (math-compose-vector (cdr a) (concat comma " ") 281 (math-compose-vector (cdr a)
265 vector-prec) 282 (concat math-comp-comma " ")
266 right-bracket 283 math-comp-vector-prec)
284 math-comp-right-bracket
267 ")") 285 ")")
268 (list 'horiz 286 (list 'horiz
269 left-bracket 287 math-comp-left-bracket
270 (math-compose-vector (cdr a) (concat comma " ") 288 (math-compose-vector (cdr a)
271 vector-prec) 289 (concat math-comp-comma " ")
272 right-bracket)))) 290 math-comp-vector-prec)
291 math-comp-right-bracket))))
273 (list 'horiz 292 (list 'horiz
274 left-bracket 293 math-comp-left-bracket
275 (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) 294 (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
276 (concat comma " ") vector-prec) 295 (concat math-comp-comma " ")
277 comma (if (eq calc-language 'tex) " \\ldots" " ...") 296 math-comp-vector-prec)
278 comma " " 297 math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...")
298 math-comp-comma " "
279 (list 'break math-compose-level) 299 (list 'break math-compose-level)
280 (math-compose-expr (nth (1- (length a)) a) 300 (math-compose-expr (nth (1- (length a)) a)
281 (if (equal comma "") 1000 0)) 301 (if (equal math-comp-comma "") 1000 0))
282 right-bracket))))))) 302 math-comp-right-bracket)))))))
283 ((eq (car a) 'incomplete) 303 ((eq (car a) 'incomplete)
284 (if (cdr (cdr a)) 304 (if (cdr (cdr a))
285 (cond ((eq (nth 1 a) 'vec) 305 (cond ((eq (nth 1 a) 'vec)
@@ -929,17 +949,18 @@
929 (let ((col 0) 949 (let ((col 0)
930 (res nil)) 950 (res nil))
931 (while (<= (setq col (1+ col)) cols) 951 (while (<= (setq col (1+ col)) cols)
932 (setq res (cons (cons just 952 (setq res (cons (cons math-comp-just
933 (cons base 953 (cons base
934 (mapcar (function 954 (mapcar (function
935 (lambda (r) 955 (lambda (r)
936 (list 'horiz 956 (list 'horiz
937 (math-compose-expr 957 (math-compose-expr
938 (nth col r) 958 (nth col r)
939 vector-prec) 959 math-comp-vector-prec)
940 (if (= col cols) 960 (if (= col cols)
941 "" 961 ""
942 (concat comma-spc " "))))) 962 (concat
963 math-comp-comma-spc " ")))))
943 a))) 964 a)))
944 res))) 965 res)))
945 (nreverse res))) 966 (nreverse res)))
@@ -950,17 +971,17 @@
950 (if (< count 0) 971 (if (< count 0)
951 (math-compose-rows (cdr a) -1 nil) 972 (math-compose-rows (cdr a) -1 nil)
952 (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") 973 (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")
953 comma) 974 math-comp-comma)
954 (math-compose-rows (cdr a) -1 nil))) 975 (math-compose-rows (cdr a) -1 nil)))
955 (cons (list 'horiz 976 (cons (list 'horiz
956 (if first (concat left-bracket " ") " ") 977 (if first (concat math-comp-left-bracket " ") " ")
957 (math-compose-expr (car a) vector-prec) 978 (math-compose-expr (car a) math-comp-vector-prec)
958 comma) 979 math-comp-comma)
959 (math-compose-rows (cdr a) (1- count) nil))) 980 (math-compose-rows (cdr a) (1- count) nil)))
960 (list (list 'horiz 981 (list (list 'horiz
961 (if first (concat left-bracket " ") " ") 982 (if first (concat math-comp-left-bracket " ") " ")
962 (math-compose-expr (car a) vector-prec) 983 (math-compose-expr (car a) math-comp-vector-prec)
963 (concat " " right-bracket))))) 984 (concat " " math-comp-right-bracket)))))
964 985
965(defun math-compose-tex-matrix (a) 986(defun math-compose-tex-matrix (a)
966 (if (cdr a) 987 (if (cdr a)
@@ -1202,15 +1223,21 @@
1202 expr 1223 expr
1203 (if (memq prec '(196 201)) ")" ""))))) 1224 (if (memq prec '(196 201)) ")" "")))))
1204 1225
1226;; The variables math-svo-c, math-svo-wid and math-svo-off are local
1227;; to math-stack-value-offset in calc.el, but are used by
1228;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
1229(defvar math-svo-c)
1230(defvar math-svo-wid)
1231(defvar math-svo-off)
1205 1232
1206(defun math-stack-value-offset-fancy () 1233(defun math-stack-value-offset-fancy ()
1207 (let ((cwid (+ (math-comp-width c)))) 1234 (let ((cwid (+ (math-comp-width math-svo-c))))
1208 (cond ((eq calc-display-just 'right) 1235 (cond ((eq calc-display-just 'right)
1209 (if calc-display-origin 1236 (if calc-display-origin
1210 (setq wid (max calc-display-origin 5)) 1237 (setq math-svo-wid (max calc-display-origin 5))
1211 (if (integerp calc-line-breaking) 1238 (if (integerp calc-line-breaking)
1212 (setq wid calc-line-breaking))) 1239 (setq math-svo-wid calc-line-breaking)))
1213 (setq off (- wid cwid 1240 (setq math-svo-off (- math-svo-wid cwid
1214 (max (- (length calc-right-label) 1241 (max (- (length calc-right-label)
1215 (if (and (integerp calc-line-breaking) 1242 (if (and (integerp calc-line-breaking)
1216 calc-display-origin) 1243 calc-display-origin)
@@ -1222,21 +1249,20 @@
1222 (t 1249 (t
1223 (if calc-display-origin 1250 (if calc-display-origin
1224 (progn 1251 (progn
1225 (setq off (- calc-display-origin (/ cwid 2))) 1252 (setq math-svo-off (- calc-display-origin (/ cwid 2)))
1226 (if (integerp calc-line-breaking) 1253 (if (integerp calc-line-breaking)
1227 (setq off (min off (- calc-line-breaking cwid 1254 (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
1228 (length calc-right-label))))) 1255 (length calc-right-label)))))
1229 (if (>= off 0) 1256 (if (>= math-svo-off 0)
1230 (setq wid (max wid (+ off cwid))))) 1257 (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
1231 (if (integerp calc-line-breaking) 1258 (if (integerp calc-line-breaking)
1232 (setq wid calc-line-breaking)) 1259 (setq math-svo-wid calc-line-breaking))
1233 (setq off (/ (- wid cwid) 2))))) 1260 (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
1234 (and (integerp calc-line-breaking) 1261 (and (integerp calc-line-breaking)
1235 (or (< off 0) 1262 (or (< math-svo-off 0)
1236 (and calc-display-origin 1263 (and calc-display-origin
1237 (> calc-line-breaking calc-display-origin))) 1264 (> calc-line-breaking calc-display-origin)))
1238 (setq wid calc-line-breaking)))) 1265 (setq math-svo-wid calc-line-breaking))))
1239
1240 1266
1241 1267
1242;;; Convert a composition to string form, with embedded \n's if necessary. 1268;;; Convert a composition to string form, with embedded \n's if necessary.
@@ -1273,40 +1299,59 @@
1273;;; lines if necessary, choosing break points according to the structure 1299;;; lines if necessary, choosing break points according to the structure
1274;;; of the formula. 1300;;; of the formula.
1275 1301
1276(defun math-comp-to-string-flat (c full-width) 1302;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
1303;; math-comp-level, math-comp-margin and math-comp-buf are local to
1304;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
1305;; which is called by math-comp-to-string-flat.
1306;; math-comp-highlight and math-comp-buf are also local to
1307;; math-comp-simplify-term and math-comp-simplify respectively, but are used
1308;; by math-comp-add-string.
1309(defvar math-comp-full-width)
1310(defvar math-comp-highlight)
1311(defvar math-comp-word)
1312(defvar math-comp-level)
1313(defvar math-comp-margin)
1314(defvar math-comp-buf)
1315;; The variable math-comp-pos is local to math-comp-to-string-flat, but
1316;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term,
1317;; which are called by math-comp-to-string-flat.
1318(defvar math-comp-pos)
1319
1320(defun math-comp-to-string-flat (c math-comp-full-width)
1277 (if math-comp-sel-hpos 1321 (if math-comp-sel-hpos
1278 (let ((comp-pos 0)) 1322 (let ((math-comp-pos 0))
1279 (math-comp-sel-flat-term c)) 1323 (math-comp-sel-flat-term c))
1280 (let ((comp-buf "") 1324 (let ((math-comp-buf "")
1281 (comp-word "") 1325 (math-comp-word "")
1282 (comp-pos 0) 1326 (math-comp-pos 0)
1283 (comp-margin 0) 1327 (math-comp-margin 0)
1284 (comp-highlight (and math-comp-selected calc-show-selections)) 1328 (math-comp-highlight (and math-comp-selected calc-show-selections))
1285 (comp-level -1)) 1329 (math-comp-level -1))
1286 (math-comp-to-string-flat-term '(set -1 0)) 1330 (math-comp-to-string-flat-term '(set -1 0))
1287 (math-comp-to-string-flat-term c) 1331 (math-comp-to-string-flat-term c)
1288 (math-comp-to-string-flat-term '(break -1)) 1332 (math-comp-to-string-flat-term '(break -1))
1289 (let ((str (aref math-comp-buf-string 0)) 1333 (let ((str (aref math-comp-buf-string 0))
1290 (prefix "")) 1334 (prefix ""))
1291 (and (> (length str) 0) (= (aref str 0) ? ) 1335 (and (> (length str) 0) (= (aref str 0) ? )
1292 (> (length comp-buf) 0) 1336 (> (length math-comp-buf) 0)
1293 (let ((k (length comp-buf))) 1337 (let ((k (length math-comp-buf)))
1294 (while (not (= (aref comp-buf (setq k (1- k))) ?\n))) 1338 (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1295 (aset comp-buf k ? ) 1339 (aset math-comp-buf k ? )
1296 (if (and (< (1+ k) (length comp-buf)) 1340 (if (and (< (1+ k) (length math-comp-buf))
1297 (= (aref comp-buf (1+ k)) ? )) 1341 (= (aref math-comp-buf (1+ k)) ? ))
1298 (progn 1342 (progn
1299 (aset comp-buf (1+ k) ?\n) 1343 (aset math-comp-buf (1+ k) ?\n)
1300 (setq prefix " ")) 1344 (setq prefix " "))
1301 (setq prefix "\n")))) 1345 (setq prefix "\n"))))
1302 (concat comp-buf prefix str))))) 1346 (concat math-comp-buf prefix str)))))
1303 1347
1304(defun math-comp-to-string-flat-term (c) 1348(defun math-comp-to-string-flat-term (c)
1305 (cond ((not (consp c)) 1349 (cond ((not (consp c))
1306 (if comp-highlight 1350 (if math-comp-highlight
1307 (setq c (math-comp-highlight-string c))) 1351 (setq c (math-comp-highlight-string c)))
1308 (setq comp-word (if (= (length comp-word) 0) c (concat comp-word c)) 1352 (setq math-comp-word (if (= (length math-comp-word) 0) c
1309 comp-pos (+ comp-pos (length c)))) 1353 (concat math-comp-word c))
1354 math-comp-pos (+ math-comp-pos (length c))))
1310 1355
1311 ((eq (car c) 'horiz) 1356 ((eq (car c) 'horiz)
1312 (while (setq c (cdr c)) 1357 (while (setq c (cdr c))
@@ -1315,83 +1360,83 @@
1315 ((eq (car c) 'set) 1360 ((eq (car c) 'set)
1316 (if (nth 1 c) 1361 (if (nth 1 c)
1317 (progn 1362 (progn
1318 (setq comp-level (1+ comp-level)) 1363 (setq math-comp-level (1+ math-comp-level))
1319 (if (>= comp-level (length math-comp-buf-string)) 1364 (if (>= math-comp-level (length math-comp-buf-string))
1320 (setq math-comp-buf-string (vconcat math-comp-buf-string 1365 (setq math-comp-buf-string (vconcat math-comp-buf-string
1321 math-comp-buf-string) 1366 math-comp-buf-string)
1322 math-comp-buf-margin (vconcat math-comp-buf-margin 1367 math-comp-buf-margin (vconcat math-comp-buf-margin
1323 math-comp-buf-margin) 1368 math-comp-buf-margin)
1324 math-comp-buf-level (vconcat math-comp-buf-level 1369 math-comp-buf-level (vconcat math-comp-buf-level
1325 math-comp-buf-level))) 1370 math-comp-buf-level)))
1326 (aset math-comp-buf-string comp-level "") 1371 (aset math-comp-buf-string math-comp-level "")
1327 (aset math-comp-buf-margin comp-level (+ comp-pos 1372 (aset math-comp-buf-margin math-comp-level (+ math-comp-pos
1328 (or (nth 2 c) 0))) 1373 (or (nth 2 c) 0)))
1329 (aset math-comp-buf-level comp-level (nth 1 c))))) 1374 (aset math-comp-buf-level math-comp-level (nth 1 c)))))
1330 1375
1331 ((eq (car c) 'break) 1376 ((eq (car c) 'break)
1332 (if (not calc-line-breaking) 1377 (if (not calc-line-breaking)
1333 (setq comp-buf (concat comp-buf comp-word) 1378 (setq math-comp-buf (concat math-comp-buf math-comp-word)
1334 comp-word "") 1379 math-comp-word "")
1335 (let ((i 0) str) 1380 (let ((i 0) str)
1336 (if (and (> comp-pos full-width) 1381 (if (and (> math-comp-pos math-comp-full-width)
1337 (progn 1382 (progn
1338 (while (progn 1383 (while (progn
1339 (setq str (aref math-comp-buf-string i)) 1384 (setq str (aref math-comp-buf-string i))
1340 (and (= (length str) 0) (< i comp-level))) 1385 (and (= (length str) 0) (< i math-comp-level)))
1341 (setq i (1+ i))) 1386 (setq i (1+ i)))
1342 (or (> (length str) 0) (> (length comp-buf) 0)))) 1387 (or (> (length str) 0) (> (length math-comp-buf) 0))))
1343 (let ((prefix "") mrg wid) 1388 (let ((prefix "") mrg wid)
1344 (setq mrg (aref math-comp-buf-margin i)) 1389 (setq mrg (aref math-comp-buf-margin i))
1345 (if (> mrg 12) ; indenting too far, go back to far left 1390 (if (> mrg 12) ; indenting too far, go back to far left
1346 (let ((j i) (new (if calc-line-numbering 5 1))) 1391 (let ((j i) (new (if calc-line-numbering 5 1)))
1347 '(while (<= j comp-level) 1392 '(while (<= j math-comp-level)
1348 (aset math-comp-buf-margin j 1393 (aset math-comp-buf-margin j
1349 (+ (aref math-comp-buf-margin j) (- new mrg))) 1394 (+ (aref math-comp-buf-margin j) (- new mrg)))
1350 (setq j (1+ j))) 1395 (setq j (1+ j)))
1351 (setq mrg new))) 1396 (setq mrg new)))
1352 (setq wid (+ (length str) comp-margin)) 1397 (setq wid (+ (length str) math-comp-margin))
1353 (and (> (length str) 0) (= (aref str 0) ? ) 1398 (and (> (length str) 0) (= (aref str 0) ? )
1354 (> (length comp-buf) 0) 1399 (> (length math-comp-buf) 0)
1355 (let ((k (length comp-buf))) 1400 (let ((k (length math-comp-buf)))
1356 (while (not (= (aref comp-buf (setq k (1- k))) ?\n))) 1401 (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1357 (aset comp-buf k ? ) 1402 (aset math-comp-buf k ? )
1358 (if (and (< (1+ k) (length comp-buf)) 1403 (if (and (< (1+ k) (length math-comp-buf))
1359 (= (aref comp-buf (1+ k)) ? )) 1404 (= (aref math-comp-buf (1+ k)) ? ))
1360 (progn 1405 (progn
1361 (aset comp-buf (1+ k) ?\n) 1406 (aset math-comp-buf (1+ k) ?\n)
1362 (setq prefix " ")) 1407 (setq prefix " "))
1363 (setq prefix "\n")))) 1408 (setq prefix "\n"))))
1364 (setq comp-buf (concat comp-buf prefix str "\n" 1409 (setq math-comp-buf (concat math-comp-buf prefix str "\n"
1365 (make-string mrg ? )) 1410 (make-string mrg ? ))
1366 comp-pos (+ comp-pos (- mrg wid)) 1411 math-comp-pos (+ math-comp-pos (- mrg wid))
1367 comp-margin mrg) 1412 math-comp-margin mrg)
1368 (aset math-comp-buf-string i "") 1413 (aset math-comp-buf-string i "")
1369 (while (<= (setq i (1+ i)) comp-level) 1414 (while (<= (setq i (1+ i)) math-comp-level)
1370 (if (> (aref math-comp-buf-margin i) wid) 1415 (if (> (aref math-comp-buf-margin i) wid)
1371 (aset math-comp-buf-margin i 1416 (aset math-comp-buf-margin i
1372 (+ (aref math-comp-buf-margin i) 1417 (+ (aref math-comp-buf-margin i)
1373 (- mrg wid)))))))) 1418 (- mrg wid))))))))
1374 (if (and (= (nth 1 c) (aref math-comp-buf-level comp-level)) 1419 (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level))
1375 (< comp-pos (+ (aref math-comp-buf-margin comp-level) 2))) 1420 (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2)))
1376 () ; avoid stupid breaks, e.g., "1 +\n really_long_expr" 1421 () ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
1377 (let ((str (aref math-comp-buf-string comp-level))) 1422 (let ((str (aref math-comp-buf-string math-comp-level)))
1378 (setq str (if (= (length str) 0) 1423 (setq str (if (= (length str) 0)
1379 comp-word 1424 math-comp-word
1380 (concat str comp-word)) 1425 (concat str math-comp-word))
1381 comp-word "") 1426 math-comp-word "")
1382 (while (< (nth 1 c) (aref math-comp-buf-level comp-level)) 1427 (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level))
1383 (setq comp-level (1- comp-level)) 1428 (setq math-comp-level (1- math-comp-level))
1384 (or (= (length (aref math-comp-buf-string comp-level)) 0) 1429 (or (= (length (aref math-comp-buf-string math-comp-level)) 0)
1385 (setq str (concat (aref math-comp-buf-string comp-level) 1430 (setq str (concat (aref math-comp-buf-string math-comp-level)
1386 str)))) 1431 str))))
1387 (aset math-comp-buf-string comp-level str))))) 1432 (aset math-comp-buf-string math-comp-level str)))))
1388 1433
1389 ((eq (car c) 'tag) 1434 ((eq (car c) 'tag)
1390 (cond ((eq (nth 1 c) math-comp-selected) 1435 (cond ((eq (nth 1 c) math-comp-selected)
1391 (let ((comp-highlight (not calc-show-selections))) 1436 (let ((math-comp-highlight (not calc-show-selections)))
1392 (math-comp-to-string-flat-term (nth 2 c)))) 1437 (math-comp-to-string-flat-term (nth 2 c))))
1393 ((eq (nth 1 c) t) 1438 ((eq (nth 1 c) t)
1394 (let ((comp-highlight nil)) 1439 (let ((math-comp-highlight nil))
1395 (math-comp-to-string-flat-term (nth 2 c)))) 1440 (math-comp-to-string-flat-term (nth 2 c))))
1396 (t (math-comp-to-string-flat-term (nth 2 c))))) 1441 (t (math-comp-to-string-flat-term (nth 2 c)))))
1397 1442
@@ -1405,18 +1450,25 @@
1405 (aset s i (if calc-show-selections ?\. ?\#))))) 1450 (aset s i (if calc-show-selections ?\. ?\#)))))
1406 s) 1451 s)
1407 1452
1453
1454;; The variable math-comp-sel-tag is local to calc-find-selected-part
1455;; in calc-sel.el, but is used by math-comp-sel-flat-term and
1456;; math-comp-add-string-sel, which are called (indirectly) by
1457;; calc-find-selected-part.
1458(defvar math-comp-sel-tag)
1459
1408(defun math-comp-sel-flat-term (c) 1460(defun math-comp-sel-flat-term (c)
1409 (cond ((not (consp c)) 1461 (cond ((not (consp c))
1410 (setq comp-pos (+ comp-pos (length c)))) 1462 (setq math-comp-pos (+ math-comp-pos (length c))))
1411 ((memq (car c) '(set break))) 1463 ((memq (car c) '(set break)))
1412 ((eq (car c) 'horiz) 1464 ((eq (car c) 'horiz)
1413 (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000)) 1465 (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
1414 (math-comp-sel-flat-term (car c)))) 1466 (math-comp-sel-flat-term (car c))))
1415 ((eq (car c) 'tag) 1467 ((eq (car c) 'tag)
1416 (if (<= comp-pos math-comp-sel-cpos) 1468 (if (<= math-comp-pos math-comp-sel-cpos)
1417 (progn 1469 (progn
1418 (math-comp-sel-flat-term (nth 2 c)) 1470 (math-comp-sel-flat-term (nth 2 c))
1419 (if (> comp-pos math-comp-sel-cpos) 1471 (if (> math-comp-pos math-comp-sel-cpos)
1420 (setq math-comp-sel-tag c 1472 (setq math-comp-sel-tag c
1421 math-comp-sel-cpos 1000000))) 1473 math-comp-sel-cpos 1000000)))
1422 (math-comp-sel-flat-term (nth 2 c)))) 1474 (math-comp-sel-flat-term (nth 2 c))))
@@ -1427,35 +1479,47 @@
1427;;; (vleft n "string" "string" "string" ...) 1479;;; (vleft n "string" "string" "string" ...)
1428;;; where 0 <= n < number-of-strings. 1480;;; where 0 <= n < number-of-strings.
1429 1481
1482;; The variables math-comp-base, math-comp-hgt, math-comp-tag,
1483;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify,
1484;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt),
1485;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term
1486;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by
1487;; math-comp-simplify.
1488(defvar math-comp-base)
1489(defvar math-comp-hgt)
1490(defvar math-comp-tag)
1491(defvar math-comp-hpos)
1492(defvar math-comp-vpos)
1493
1430(defun math-comp-simplify (c full-width) 1494(defun math-comp-simplify (c full-width)
1431 (let ((comp-buf (list "")) 1495 (let ((math-comp-buf (list ""))
1432 (comp-base 0) 1496 (math-comp-base 0)
1433 (comp-height 1) 1497 (math-comp-hgt 1)
1434 (comp-hpos 0) 1498 (math-comp-hpos 0)
1435 (comp-vpos 0) 1499 (math-comp-vpos 0)
1436 (comp-highlight (and math-comp-selected calc-show-selections)) 1500 (math-comp-highlight (and math-comp-selected calc-show-selections))
1437 (comp-tag nil)) 1501 (math-comp-tag nil))
1438 (math-comp-simplify-term c) 1502 (math-comp-simplify-term c)
1439 (cons 'vleft (cons comp-base comp-buf)))) 1503 (cons 'vleft (cons math-comp-base math-comp-buf))))
1440 1504
1441(defun math-comp-add-string (s h v) 1505(defun math-comp-add-string (s h v)
1442 (and (> (length s) 0) 1506 (and (> (length s) 0)
1443 (let ((vv (+ v comp-base))) 1507 (let ((vv (+ v math-comp-base)))
1444 (if math-comp-sel-hpos 1508 (if math-comp-sel-hpos
1445 (math-comp-add-string-sel h vv (length s) 1) 1509 (math-comp-add-string-sel h vv (length s) 1)
1446 (if (< vv 0) 1510 (if (< vv 0)
1447 (setq comp-buf (nconc (make-list (- vv) "") comp-buf) 1511 (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf)
1448 comp-base (- v) 1512 math-comp-base (- v)
1449 comp-height (- comp-height vv) 1513 math-comp-hgt (- math-comp-hgt vv)
1450 vv 0) 1514 vv 0)
1451 (if (>= vv comp-height) 1515 (if (>= vv math-comp-hgt)
1452 (setq comp-buf (nconc comp-buf 1516 (setq math-comp-buf (nconc math-comp-buf
1453 (make-list (1+ (- vv comp-height)) "")) 1517 (make-list (1+ (- vv math-comp-hgt)) ""))
1454 comp-height (1+ vv)))) 1518 math-comp-hgt (1+ vv))))
1455 (let ((str (nthcdr vv comp-buf))) 1519 (let ((str (nthcdr vv math-comp-buf)))
1456 (setcar str (concat (car str) 1520 (setcar str (concat (car str)
1457 (make-string (- h (length (car str))) 32) 1521 (make-string (- h (length (car str))) 32)
1458 (if comp-highlight 1522 (if math-comp-highlight
1459 (math-comp-highlight-string s) 1523 (math-comp-highlight-string s)
1460 s)))))))) 1524 s))))))))
1461 1525
@@ -1464,20 +1528,20 @@
1464 (> (+ y h) math-comp-sel-vpos) 1528 (> (+ y h) math-comp-sel-vpos)
1465 (<= x math-comp-sel-hpos) 1529 (<= x math-comp-sel-hpos)
1466 (> (+ x w) math-comp-sel-hpos)) 1530 (> (+ x w) math-comp-sel-hpos))
1467 (setq math-comp-sel-tag comp-tag 1531 (setq math-comp-sel-tag math-comp-tag
1468 math-comp-sel-vpos 10000))) 1532 math-comp-sel-vpos 10000)))
1469 1533
1470(defun math-comp-simplify-term (c) 1534(defun math-comp-simplify-term (c)
1471 (cond ((stringp c) 1535 (cond ((stringp c)
1472 (math-comp-add-string c comp-hpos comp-vpos) 1536 (math-comp-add-string c math-comp-hpos math-comp-vpos)
1473 (setq comp-hpos (+ comp-hpos (length c)))) 1537 (setq math-comp-hpos (+ math-comp-hpos (length c))))
1474 ((memq (car c) '(set break)) 1538 ((memq (car c) '(set break))
1475 nil) 1539 nil)
1476 ((eq (car c) 'horiz) 1540 ((eq (car c) 'horiz)
1477 (while (setq c (cdr c)) 1541 (while (setq c (cdr c))
1478 (math-comp-simplify-term (car c)))) 1542 (math-comp-simplify-term (car c))))
1479 ((memq (car c) '(vleft vcent vright)) 1543 ((memq (car c) '(vleft vcent vright))
1480 (let* ((comp-vpos (+ (- comp-vpos (nth 1 c)) 1544 (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c))
1481 (1- (math-comp-ascent (nth 2 c))))) 1545 (1- (math-comp-ascent (nth 2 c)))))
1482 (widths (mapcar 'math-comp-width (cdr (cdr c)))) 1546 (widths (mapcar 'math-comp-width (cdr (cdr c))))
1483 (maxwid (apply 'max widths)) 1547 (maxwid (apply 'max widths))
@@ -1488,53 +1552,53 @@
1488 (while (setq c (cdr c)) 1552 (while (setq c (cdr c))
1489 (if (eq (car-safe (car c)) 'rule) 1553 (if (eq (car-safe (car c)) 'rule)
1490 (math-comp-add-string (make-string maxwid (nth 1 (car c))) 1554 (math-comp-add-string (make-string maxwid (nth 1 (car c)))
1491 comp-hpos comp-vpos) 1555 math-comp-hpos math-comp-vpos)
1492 (let ((comp-hpos (+ comp-hpos (/ (* bias (- maxwid 1556 (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid
1493 (car widths))) 1557 (car widths)))
1494 2)))) 1558 2))))
1495 (math-comp-simplify-term (car c)))) 1559 (math-comp-simplify-term (car c))))
1496 (and (cdr c) 1560 (and (cdr c)
1497 (setq comp-vpos (+ comp-vpos 1561 (setq math-comp-vpos (+ math-comp-vpos
1498 (+ (math-comp-descent (car c)) 1562 (+ (math-comp-descent (car c))
1499 (math-comp-ascent (nth 1 c)))) 1563 (math-comp-ascent (nth 1 c))))
1500 widths (cdr widths)))) 1564 widths (cdr widths))))
1501 (setq comp-hpos (+ comp-hpos maxwid)))) 1565 (setq math-comp-hpos (+ math-comp-hpos maxwid))))
1502 ((eq (car c) 'supscr) 1566 ((eq (car c) 'supscr)
1503 (let* ((asc (or 1 (math-comp-ascent (nth 1 c)))) 1567 (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
1504 (desc (math-comp-descent (nth 2 c))) 1568 (desc (math-comp-descent (nth 2 c)))
1505 (oldh (prog1 1569 (oldh (prog1
1506 comp-hpos 1570 math-comp-hpos
1507 (math-comp-simplify-term (nth 1 c)))) 1571 (math-comp-simplify-term (nth 1 c))))
1508 (comp-vpos (- comp-vpos (+ asc desc)))) 1572 (math-comp-vpos (- math-comp-vpos (+ asc desc))))
1509 (math-comp-simplify-term (nth 2 c)) 1573 (math-comp-simplify-term (nth 2 c))
1510 (if math-comp-sel-hpos 1574 (if math-comp-sel-hpos
1511 (math-comp-add-string-sel oldh 1575 (math-comp-add-string-sel oldh
1512 (- comp-vpos 1576 (- math-comp-vpos
1513 -1 1577 -1
1514 (math-comp-ascent (nth 2 c))) 1578 (math-comp-ascent (nth 2 c)))
1515 (- comp-hpos oldh) 1579 (- math-comp-hpos oldh)
1516 (math-comp-height c))))) 1580 (math-comp-height c)))))
1517 ((eq (car c) 'subscr) 1581 ((eq (car c) 'subscr)
1518 (let* ((asc (math-comp-ascent (nth 2 c))) 1582 (let* ((asc (math-comp-ascent (nth 2 c)))
1519 (desc (math-comp-descent (nth 1 c))) 1583 (desc (math-comp-descent (nth 1 c)))
1520 (oldv comp-vpos) 1584 (oldv math-comp-vpos)
1521 (oldh (prog1 1585 (oldh (prog1
1522 comp-hpos 1586 math-comp-hpos
1523 (math-comp-simplify-term (nth 1 c)))) 1587 (math-comp-simplify-term (nth 1 c))))
1524 (comp-vpos (+ comp-vpos (+ asc desc)))) 1588 (math-comp-vpos (+ math-comp-vpos (+ asc desc))))
1525 (math-comp-simplify-term (nth 2 c)) 1589 (math-comp-simplify-term (nth 2 c))
1526 (if math-comp-sel-hpos 1590 (if math-comp-sel-hpos
1527 (math-comp-add-string-sel oldh oldv 1591 (math-comp-add-string-sel oldh oldv
1528 (- comp-hpos oldh) 1592 (- math-comp-hpos oldh)
1529 (math-comp-height c))))) 1593 (math-comp-height c)))))
1530 ((eq (car c) 'tag) 1594 ((eq (car c) 'tag)
1531 (cond ((eq (nth 1 c) math-comp-selected) 1595 (cond ((eq (nth 1 c) math-comp-selected)
1532 (let ((comp-highlight (not calc-show-selections))) 1596 (let ((math-comp-highlight (not calc-show-selections)))
1533 (math-comp-simplify-term (nth 2 c)))) 1597 (math-comp-simplify-term (nth 2 c))))
1534 ((eq (nth 1 c) t) 1598 ((eq (nth 1 c) t)
1535 (let ((comp-highlight nil)) 1599 (let ((math-comp-highlight nil))
1536 (math-comp-simplify-term (nth 2 c)))) 1600 (math-comp-simplify-term (nth 2 c))))
1537 (t (let ((comp-tag c)) 1601 (t (let ((math-comp-tag c))
1538 (math-comp-simplify-term (nth 2 c)))))))) 1602 (math-comp-simplify-term (nth 2 c))))))))
1539 1603
1540 1604
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-24 08:41:02 +0000