Mercurial > emacs
comparison lisp/calc/calc-aent.el @ 41039:e65205f993f3
Style cleanup; don't put closing parens on their own line, add "foo.el
ends here" to each file, and update copyright date.
author | Colin Walters <walters@gnu.org> |
---|---|
date | Wed, 14 Nov 2001 08:59:18 +0000 |
parents | e29926a2ef59 |
children | fcd507927105 |
comparison
equal
deleted
inserted
replaced
41038:a882905d8a96 | 41039:e65205f993f3 |
---|---|
97 (if (eq last-command-char 10) | 97 (if (eq last-command-char 10) |
98 (insert shortbuf) | 98 (insert shortbuf) |
99 (setq kill-ring (cons shortbuf kill-ring)) | 99 (setq kill-ring (cons shortbuf kill-ring)) |
100 (if (> (length kill-ring) kill-ring-max) | 100 (if (> (length kill-ring) kill-ring-max) |
101 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) | 101 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) |
102 (setq kill-ring-yank-pointer kill-ring)))) | 102 (setq kill-ring-yank-pointer kill-ring))))) |
103 ) | |
104 | 103 |
105 (defun calc-do-calc-eval (str separator args) | 104 (defun calc-do-calc-eval (str separator args) |
106 (calc-check-defines) | 105 (calc-check-defines) |
107 (catch 'calc-error | 106 (catch 'calc-error |
108 (save-excursion | 107 (save-excursion |
236 (t (while res | 235 (t (while res |
237 (setq buf (concat buf | 236 (setq buf (concat buf |
238 (and buf (or separator ", ")) | 237 (and buf (or separator ", ")) |
239 (math-format-value (car res) 1000)) | 238 (math-format-value (car res) 1000)) |
240 res (cdr res))) | 239 res (cdr res))) |
241 buf)))))))) | 240 buf))))))))) |
242 ) | |
243 | 241 |
244 (defun calc-eval-error (msg) | 242 (defun calc-eval-error (msg) |
245 (if (and (boundp 'calc-eval-error) | 243 (if (and (boundp 'calc-eval-error) |
246 calc-eval-error) | 244 calc-eval-error) |
247 (if (eq calc-eval-error 'string) | 245 (if (eq calc-eval-error 'string) |
248 (nth 1 msg) | 246 (nth 1 msg) |
249 (error "%s" (nth 1 msg))) | 247 (error "%s" (nth 1 msg))) |
250 msg) | 248 msg)) |
251 ) | |
252 | 249 |
253 | 250 |
254 ;;;; Reading an expression in algebraic form. | 251 ;;;; Reading an expression in algebraic form. |
255 | 252 |
256 (defun calc-auto-algebraic-entry (&optional prefix) | 253 (defun calc-auto-algebraic-entry (&optional prefix) |
257 (interactive "P") | 254 (interactive "P") |
258 (calc-algebraic-entry prefix t) | 255 (calc-algebraic-entry prefix t)) |
259 ) | |
260 | 256 |
261 (defun calc-algebraic-entry (&optional prefix auto) | 257 (defun calc-algebraic-entry (&optional prefix auto) |
262 (interactive "P") | 258 (interactive "P") |
263 (calc-wrapper | 259 (calc-wrapper |
264 (let ((calc-language (if prefix nil calc-language)) | 260 (let ((calc-language (if prefix nil calc-language)) |
265 (math-expr-opers (if prefix math-standard-opers math-expr-opers))) | 261 (math-expr-opers (if prefix math-standard-opers math-expr-opers))) |
266 (calc-alg-entry (and auto (char-to-string last-command-char))))) | 262 (calc-alg-entry (and auto (char-to-string last-command-char)))))) |
267 ) | |
268 | 263 |
269 (defun calc-alg-entry (&optional initial prompt) | 264 (defun calc-alg-entry (&optional initial prompt) |
270 (let* ((sel-mode nil) | 265 (let* ((sel-mode nil) |
271 (calc-dollar-values (mapcar 'calc-get-stack-element | 266 (calc-dollar-values (mapcar 'calc-get-stack-element |
272 (nthcdr calc-stack-top calc-stack))) | 267 (nthcdr calc-stack-top calc-stack))) |
291 "") | 286 "") |
292 (list (car nvals))) | 287 (list (car nvals))) |
293 (setq alg-exp (cdr alg-exp) | 288 (setq alg-exp (cdr alg-exp) |
294 nvals (cdr nvals) | 289 nvals (cdr nvals) |
295 calc-dollar-used 0))) | 290 calc-dollar-used 0))) |
296 (calc-handle-whys))) | 291 (calc-handle-whys)))) |
297 ) | |
298 | 292 |
299 (defun calc-do-alg-entry (&optional initial prompt no-normalize) | 293 (defun calc-do-alg-entry (&optional initial prompt no-normalize) |
300 (let* ((calc-buffer (current-buffer)) | 294 (let* ((calc-buffer (current-buffer)) |
301 (blink-paren-function 'calcAlg-blink-matching-open) | 295 (blink-paren-function 'calcAlg-blink-matching-open) |
302 (alg-exp 'error)) | 296 (alg-exp 'error)) |
330 (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error) | 324 (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error) |
331 (setq alg-exp nil))) | 325 (setq alg-exp nil))) |
332 (setq calc-aborted-prefix "alg'") | 326 (setq calc-aborted-prefix "alg'") |
333 (or no-normalize | 327 (or no-normalize |
334 (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) | 328 (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) |
335 alg-exp)) | 329 alg-exp))) |
336 ) | |
337 | 330 |
338 (defun calcAlg-plus-minus () | 331 (defun calcAlg-plus-minus () |
339 (interactive) | 332 (interactive) |
340 (if (calc-minibuffer-contains ".* \\'") | 333 (if (calc-minibuffer-contains ".* \\'") |
341 (insert "+/- ") | 334 (insert "+/- ") |
342 (insert " +/- ")) | 335 (insert " +/- "))) |
343 ) | |
344 | 336 |
345 (defun calcAlg-mod () | 337 (defun calcAlg-mod () |
346 (interactive) | 338 (interactive) |
347 (if (not (calc-minibuffer-contains ".* \\'")) | 339 (if (not (calc-minibuffer-contains ".* \\'")) |
348 (insert " ")) | 340 (insert " ")) |
349 (if (calc-minibuffer-contains ".* mod +\\'") | 341 (if (calc-minibuffer-contains ".* mod +\\'") |
350 (if calc-previous-modulo | 342 (if calc-previous-modulo |
351 (insert (math-format-flat-expr calc-previous-modulo 0)) | 343 (insert (math-format-flat-expr calc-previous-modulo 0)) |
352 (beep)) | 344 (beep)) |
353 (insert "mod ")) | 345 (insert "mod "))) |
354 ) | |
355 | 346 |
356 (defun calcAlg-previous () | 347 (defun calcAlg-previous () |
357 (interactive) | 348 (interactive) |
358 (if (calc-minibuffer-contains "\\`\\'") | 349 (if (calc-minibuffer-contains "\\`\\'") |
359 (if calc-previous-alg-entry | 350 (if calc-previous-alg-entry |
360 (insert calc-previous-alg-entry) | 351 (insert calc-previous-alg-entry) |
361 (beep)) | 352 (beep)) |
362 (insert "'")) | 353 (insert "'"))) |
363 ) | |
364 | 354 |
365 (defun calcAlg-equals () | 355 (defun calcAlg-equals () |
366 (interactive) | 356 (interactive) |
367 (unwind-protect | 357 (unwind-protect |
368 (calcAlg-enter) | 358 (calcAlg-enter) |
369 (if (consp alg-exp) | 359 (if (consp alg-exp) |
370 (progn (setq prefix-arg (length alg-exp)) | 360 (progn (setq prefix-arg (length alg-exp)) |
371 (calc-unread-command ?=)))) | 361 (calc-unread-command ?=))))) |
372 ) | |
373 | 362 |
374 (defun calcAlg-escape () | 363 (defun calcAlg-escape () |
375 (interactive) | 364 (interactive) |
376 (calc-unread-command) | 365 (calc-unread-command) |
377 (save-excursion | 366 (save-excursion |
378 (calc-select-buffer) | 367 (calc-select-buffer) |
379 (use-local-map calc-mode-map)) | 368 (use-local-map calc-mode-map)) |
380 (calcAlg-enter) | 369 (calcAlg-enter)) |
381 ) | |
382 | 370 |
383 (defun calcAlg-edit () | 371 (defun calcAlg-edit () |
384 (interactive) | 372 (interactive) |
385 (if (or (not calc-plain-entry) | 373 (if (or (not calc-plain-entry) |
386 (calc-minibuffer-contains | 374 (calc-minibuffer-contains |
387 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) | 375 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) |
388 (insert "`") | 376 (insert "`") |
389 (setq alg-exp (minibuffer-contents)) | 377 (setq alg-exp (minibuffer-contents)) |
390 (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) | 378 (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) |
391 (exit-minibuffer)) | 379 (exit-minibuffer))) |
392 ) | |
393 (setq calc-plain-entry nil) | 380 (setq calc-plain-entry nil) |
394 | 381 |
395 (defun calcAlg-enter () | 382 (defun calcAlg-enter () |
396 (interactive) | 383 (interactive) |
397 (let* ((str (minibuffer-contents)) | 384 (let* ((str (minibuffer-contents)) |
409 (calc-clear-unread-commands)) | 396 (calc-clear-unread-commands)) |
410 (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") | 397 (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") |
411 '((incomplete vec)) | 398 '((incomplete vec)) |
412 exp)) | 399 exp)) |
413 (and (> (length str) 0) (setq calc-previous-alg-entry str)) | 400 (and (> (length str) 0) (setq calc-previous-alg-entry str)) |
414 (exit-minibuffer))) | 401 (exit-minibuffer)))) |
415 ) | |
416 | 402 |
417 (defun calcAlg-blink-matching-open () | 403 (defun calcAlg-blink-matching-open () |
418 (let ((oldpos (point)) | 404 (let ((oldpos (point)) |
419 (blinkpos nil)) | 405 (blinkpos nil)) |
420 (save-excursion | 406 (save-excursion |
436 (aset (syntax-table) (char-after blinkpos) | 422 (aset (syntax-table) (char-after blinkpos) |
437 (+ (logand saved 255) | 423 (+ (logand saved 255) |
438 (lsh (char-after (1- oldpos)) 8))) | 424 (lsh (char-after (1- oldpos)) 8))) |
439 (blink-matching-open)) | 425 (blink-matching-open)) |
440 (aset (syntax-table) (char-after blinkpos) saved))) | 426 (aset (syntax-table) (char-after blinkpos) saved))) |
441 (blink-matching-open))) | 427 (blink-matching-open)))) |
442 ) | |
443 | 428 |
444 | 429 |
445 (defun calc-alg-digit-entry () | 430 (defun calc-alg-digit-entry () |
446 (calc-alg-entry | 431 (calc-alg-entry |
447 (cond ((eq last-command-char ?e) | 432 (cond ((eq last-command-char ?e) |
448 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e")) | 433 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e")) |
449 ((eq last-command-char ?#) (format "%d#" calc-number-radix)) | 434 ((eq last-command-char ?#) (format "%d#" calc-number-radix)) |
450 ((eq last-command-char ?_) "-") | 435 ((eq last-command-char ?_) "-") |
451 ((eq last-command-char ?@) "0@ ") | 436 ((eq last-command-char ?@) "0@ ") |
452 (t (char-to-string last-command-char)))) | 437 (t (char-to-string last-command-char))))) |
453 ) | |
454 | 438 |
455 (defun calcDigit-algebraic () | 439 (defun calcDigit-algebraic () |
456 (interactive) | 440 (interactive) |
457 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") | 441 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") |
458 (calcDigit-key) | 442 (calcDigit-key) |
459 (setq calc-digit-value (minibuffer-contents)) | 443 (setq calc-digit-value (minibuffer-contents)) |
460 (exit-minibuffer)) | 444 (exit-minibuffer))) |
461 ) | |
462 | 445 |
463 (defun calcDigit-edit () | 446 (defun calcDigit-edit () |
464 (interactive) | 447 (interactive) |
465 (calc-unread-command) | 448 (calc-unread-command) |
466 (setq calc-digit-value (minibuffer-contents)) | 449 (setq calc-digit-value (minibuffer-contents)) |
467 (exit-minibuffer) | 450 (exit-minibuffer)) |
468 ) | |
469 | 451 |
470 | 452 |
471 ;;; Algebraic expression parsing. [Public] | 453 ;;; Algebraic expression parsing. [Public] |
472 | 454 |
473 (defun math-read-exprs (exp-str) | 455 (defun math-read-exprs (exp-str) |
485 (let ((val (catch 'syntax (math-read-expr-list)))) | 467 (let ((val (catch 'syntax (math-read-expr-list)))) |
486 (if (stringp val) | 468 (if (stringp val) |
487 (list 'error exp-old-pos val) | 469 (list 'error exp-old-pos val) |
488 (if (equal exp-token 'end) | 470 (if (equal exp-token 'end) |
489 val | 471 val |
490 (list 'error exp-old-pos "Syntax error"))))) | 472 (list 'error exp-old-pos "Syntax error")))))) |
491 ) | |
492 | 473 |
493 (defun math-read-expr-list () | 474 (defun math-read-expr-list () |
494 (let* ((exp-keep-spaces nil) | 475 (let* ((exp-keep-spaces nil) |
495 (val (list (math-read-expr-level 0))) | 476 (val (list (math-read-expr-level 0))) |
496 (last val)) | 477 (last val)) |
497 (while (equal exp-data ",") | 478 (while (equal exp-data ",") |
498 (math-read-token) | 479 (math-read-token) |
499 (let ((rest (list (math-read-expr-level 0)))) | 480 (let ((rest (list (math-read-expr-level 0)))) |
500 (setcdr last rest) | 481 (setcdr last rest) |
501 (setq last rest))) | 482 (setq last rest))) |
502 val) | 483 val)) |
503 ) | |
504 | 484 |
505 (setq calc-user-parse-table nil) | 485 (setq calc-user-parse-table nil) |
506 (setq calc-last-main-parse-table nil) | 486 (setq calc-last-main-parse-table nil) |
507 (setq calc-last-lang-parse-table nil) | 487 (setq calc-last-lang-parse-table nil) |
508 (setq calc-user-tokens nil) | 488 (setq calc-user-tokens nil) |
525 (function (lambda (x y) | 505 (function (lambda (x y) |
526 (> (length x) | 506 (> (length x) |
527 (length y))))) | 507 (length y))))) |
528 "\\|") | 508 "\\|") |
529 calc-last-main-parse-table mtab | 509 calc-last-main-parse-table mtab |
530 calc-last-lang-parse-table ltab)))) | 510 calc-last-lang-parse-table ltab))))) |
531 ) | |
532 | 511 |
533 (defun math-find-user-tokens (p) ; uses "toks" | 512 (defun math-find-user-tokens (p) ; uses "toks" |
534 (while p | 513 (while p |
535 (cond ((and (stringp (car p)) | 514 (cond ((and (stringp (car p)) |
536 (or (> (length (car p)) 1) (equal (car p) "$") | 515 (or (> (length (car p)) 1) (equal (car p) "$") |
550 calc-user-token-chars))))))) | 529 calc-user-token-chars))))))) |
551 ((consp (car p)) | 530 ((consp (car p)) |
552 (math-find-user-tokens (nth 1 (car p))) | 531 (math-find-user-tokens (nth 1 (car p))) |
553 (or (eq (car (car p)) '\?) | 532 (or (eq (car (car p)) '\?) |
554 (math-find-user-tokens (nth 2 (car p)))))) | 533 (math-find-user-tokens (nth 2 (car p)))))) |
555 (setq p (cdr p))) | 534 (setq p (cdr p)))) |
556 ) | |
557 | 535 |
558 (defun math-read-token () | 536 (defun math-read-token () |
559 (if (>= exp-pos (length exp-str)) | 537 (if (>= exp-pos (length exp-str)) |
560 (setq exp-old-pos exp-pos | 538 (setq exp-old-pos exp-pos |
561 exp-token 'end | 539 exp-token 'end |
719 (setq ch ?\))) | 697 (setq ch ?\))) |
720 (if (and (eq ch ?\&) (eq calc-language 'tex)) | 698 (if (and (eq ch ?\&) (eq calc-language 'tex)) |
721 (setq ch ?\,)) | 699 (setq ch ?\,)) |
722 (setq exp-token 'punc | 700 (setq exp-token 'punc |
723 exp-data (char-to-string ch) | 701 exp-data (char-to-string ch) |
724 exp-pos (1+ exp-pos)))))) | 702 exp-pos (1+ exp-pos))))))) |
725 ) | |
726 | 703 |
727 | 704 |
728 (defun math-read-expr-level (exp-prec &optional exp-term) | 705 (defun math-read-expr-level (exp-prec &optional exp-term) |
729 (let* ((x (math-read-factor)) (first t) op op2) | 706 (let* ((x (math-read-factor)) (first t) op op2) |
730 (while (and (or (and calc-user-parse-table | 707 (while (and (or (and calc-user-parse-table |
788 (math-composite-inequalities x op)) | 765 (math-composite-inequalities x op)) |
789 (t (list (nth 1 op) | 766 (t (list (nth 1 op) |
790 x | 767 x |
791 (math-read-expr-level (nth 3 op) exp-term)))) | 768 (math-read-expr-level (nth 3 op) exp-term)))) |
792 first nil)) | 769 first nil)) |
793 x) | 770 x)) |
794 ) | |
795 | 771 |
796 (defun calc-check-user-syntax (&optional x prec) | 772 (defun calc-check-user-syntax (&optional x prec) |
797 (let ((p calc-user-parse-table) | 773 (let ((p calc-user-parse-table) |
798 (matches nil) | 774 (matches nil) |
799 match rule) | 775 match rule) |
875 (setq exp-old-pos save-exp-old-pos | 851 (setq exp-old-pos save-exp-old-pos |
876 exp-token save-exp-token | 852 exp-token save-exp-token |
877 exp-data save-exp-data | 853 exp-data save-exp-data |
878 exp-pos save-exp-pos))))))) | 854 exp-pos save-exp-pos))))))) |
879 (setq p (cdr p))) | 855 (setq p (cdr p))) |
880 (and p match)) | 856 (and p match))) |
881 ) | |
882 | 857 |
883 (defun calc-match-user-syntax (p &optional term) | 858 (defun calc-match-user-syntax (p &optional term) |
884 (let ((matches nil) | 859 (let ((matches nil) |
885 (save-exp-pos exp-pos) | 860 (save-exp-pos exp-pos) |
886 (save-exp-old-pos exp-old-pos) | 861 (save-exp-old-pos exp-old-pos) |
935 (setq exp-pos save-exp-pos | 910 (setq exp-pos save-exp-pos |
936 exp-old-pos save-exp-old-pos | 911 exp-old-pos save-exp-old-pos |
937 exp-token save-exp-token | 912 exp-token save-exp-token |
938 exp-data save-exp-data | 913 exp-data save-exp-data |
939 matches "Failed")) | 914 matches "Failed")) |
940 matches) | 915 matches)) |
941 ) | |
942 | 916 |
943 (defconst math-alg-inequalities | 917 (defconst math-alg-inequalities |
944 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq | 918 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq |
945 calcFunc-eq calcFunc-neq)) | 919 calcFunc-eq calcFunc-neq)) |
946 | 920 |
947 (defun math-remove-dashes (x) | 921 (defun math-remove-dashes (x) |
948 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) | 922 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) |
949 (math-remove-dashes | 923 (math-remove-dashes |
950 (concat (math-match-substring x 1) "#" (math-match-substring x 2))) | 924 (concat (math-match-substring x 1) "#" (math-match-substring x 2))) |
951 x) | 925 x)) |
952 ) | |
953 | 926 |
954 (defun math-restore-dashes (x) | 927 (defun math-restore-dashes (x) |
955 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x) | 928 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x) |
956 (math-restore-dashes | 929 (math-restore-dashes |
957 (concat (math-match-substring x 1) "-" (math-match-substring x 2))) | 930 (concat (math-match-substring x 1) "-" (math-match-substring x 2))) |
958 x) | 931 x)) |
959 ) | |
960 | 932 |
961 (defun math-read-if (cond op) | 933 (defun math-read-if (cond op) |
962 (let ((then (math-read-expr-level 0))) | 934 (let ((then (math-read-expr-level 0))) |
963 (or (equal exp-data ":") | 935 (or (equal exp-data ":") |
964 (throw 'syntax "Expected ':'")) | 936 (throw 'syntax "Expected ':'")) |
965 (math-read-token) | 937 (math-read-token) |
966 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))) | 938 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) |
967 ) | |
968 | 939 |
969 (defun math-factor-after () | 940 (defun math-factor-after () |
970 (let ((exp-pos exp-pos) | 941 (let ((exp-pos exp-pos) |
971 exp-old-pos exp-token exp-data) | 942 exp-old-pos exp-token exp-data) |
972 (math-read-token) | 943 (math-read-token) |
973 (or (memq exp-token '(number symbol dollar hash string)) | 944 (or (memq exp-token '(number symbol dollar hash string)) |
974 (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) | 945 (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) |
975 (assoc (concat "u" exp-data) math-expr-opers)) | 946 (assoc (concat "u" exp-data) math-expr-opers)) |
976 (eq (nth 2 (assoc exp-data math-expr-opers)) -1) | 947 (eq (nth 2 (assoc exp-data math-expr-opers)) -1) |
977 (assoc exp-data '(("(") ("[") ("{"))))) | 948 (assoc exp-data '(("(") ("[") ("{")))))) |
978 ) | |
979 | 949 |
980 (defun math-read-factor () | 950 (defun math-read-factor () |
981 (let (op) | 951 (let (op) |
982 (cond ((eq exp-token 'number) | 952 (cond ((eq exp-token 'number) |
983 (let ((num (math-read-number exp-data))) | 953 (let ((num (math-read-number exp-data))) |
1155 (calc-extensions) | 1125 (calc-extensions) |
1156 (math-read-brackets nil "}")) | 1126 (math-read-brackets nil "}")) |
1157 ((equal exp-data "<") | 1127 ((equal exp-data "<") |
1158 (calc-extensions) | 1128 (calc-extensions) |
1159 (math-read-angle-brackets)) | 1129 (math-read-angle-brackets)) |
1160 (t (throw 'syntax "Expected a number")))) | 1130 (t (throw 'syntax "Expected a number"))))) |
1161 ) | 1131 |
1162 | 1132 ;;; calc-aent.el ends here |
1163 | |
1164 |