99 |
(setq kill-ring (cons shortbuf kill-ring)) |
(setq kill-ring (cons shortbuf kill-ring)) |
100 |
(if (> (length kill-ring) kill-ring-max) |
(if (> (length kill-ring) kill-ring-max) |
101 |
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) |
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) |
102 |
(setq kill-ring-yank-pointer kill-ring)))) |
(setq kill-ring-yank-pointer kill-ring))))) |
|
) |
|
103 |
|
|
104 |
(defun calc-do-calc-eval (str separator args) |
(defun calc-do-calc-eval (str separator args) |
105 |
(calc-check-defines) |
(calc-check-defines) |
237 |
(and buf (or separator ", ")) |
(and buf (or separator ", ")) |
238 |
(math-format-value (car res) 1000)) |
(math-format-value (car res) 1000)) |
239 |
res (cdr res))) |
res (cdr res))) |
240 |
buf)))))))) |
buf))))))))) |
|
) |
|
241 |
|
|
242 |
(defun calc-eval-error (msg) |
(defun calc-eval-error (msg) |
243 |
(if (and (boundp 'calc-eval-error) |
(if (and (boundp 'calc-eval-error) |
245 |
(if (eq calc-eval-error 'string) |
(if (eq calc-eval-error 'string) |
246 |
(nth 1 msg) |
(nth 1 msg) |
247 |
(error "%s" (nth 1 msg))) |
(error "%s" (nth 1 msg))) |
248 |
msg) |
msg)) |
|
) |
|
249 |
|
|
250 |
|
|
251 |
;;;; Reading an expression in algebraic form. |
;;;; Reading an expression in algebraic form. |
252 |
|
|
253 |
(defun calc-auto-algebraic-entry (&optional prefix) |
(defun calc-auto-algebraic-entry (&optional prefix) |
254 |
(interactive "P") |
(interactive "P") |
255 |
(calc-algebraic-entry prefix t) |
(calc-algebraic-entry prefix t)) |
|
) |
|
256 |
|
|
257 |
(defun calc-algebraic-entry (&optional prefix auto) |
(defun calc-algebraic-entry (&optional prefix auto) |
258 |
(interactive "P") |
(interactive "P") |
259 |
(calc-wrapper |
(calc-wrapper |
260 |
(let ((calc-language (if prefix nil calc-language)) |
(let ((calc-language (if prefix nil calc-language)) |
261 |
(math-expr-opers (if prefix math-standard-opers math-expr-opers))) |
(math-expr-opers (if prefix math-standard-opers math-expr-opers))) |
262 |
(calc-alg-entry (and auto (char-to-string last-command-char))))) |
(calc-alg-entry (and auto (char-to-string last-command-char)))))) |
|
) |
|
263 |
|
|
264 |
(defun calc-alg-entry (&optional initial prompt) |
(defun calc-alg-entry (&optional initial prompt) |
265 |
(let* ((sel-mode nil) |
(let* ((sel-mode nil) |
288 |
(setq alg-exp (cdr alg-exp) |
(setq alg-exp (cdr alg-exp) |
289 |
nvals (cdr nvals) |
nvals (cdr nvals) |
290 |
calc-dollar-used 0))) |
calc-dollar-used 0))) |
291 |
(calc-handle-whys))) |
(calc-handle-whys)))) |
|
) |
|
292 |
|
|
293 |
(defun calc-do-alg-entry (&optional initial prompt no-normalize) |
(defun calc-do-alg-entry (&optional initial prompt no-normalize) |
294 |
(let* ((calc-buffer (current-buffer)) |
(let* ((calc-buffer (current-buffer)) |
326 |
(setq calc-aborted-prefix "alg'") |
(setq calc-aborted-prefix "alg'") |
327 |
(or no-normalize |
(or no-normalize |
328 |
(and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) |
(and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) |
329 |
alg-exp)) |
alg-exp))) |
|
) |
|
330 |
|
|
331 |
(defun calcAlg-plus-minus () |
(defun calcAlg-plus-minus () |
332 |
(interactive) |
(interactive) |
333 |
(if (calc-minibuffer-contains ".* \\'") |
(if (calc-minibuffer-contains ".* \\'") |
334 |
(insert "+/- ") |
(insert "+/- ") |
335 |
(insert " +/- ")) |
(insert " +/- "))) |
|
) |
|
336 |
|
|
337 |
(defun calcAlg-mod () |
(defun calcAlg-mod () |
338 |
(interactive) |
(interactive) |
342 |
(if calc-previous-modulo |
(if calc-previous-modulo |
343 |
(insert (math-format-flat-expr calc-previous-modulo 0)) |
(insert (math-format-flat-expr calc-previous-modulo 0)) |
344 |
(beep)) |
(beep)) |
345 |
(insert "mod ")) |
(insert "mod "))) |
|
) |
|
346 |
|
|
347 |
(defun calcAlg-previous () |
(defun calcAlg-previous () |
348 |
(interactive) |
(interactive) |
350 |
(if calc-previous-alg-entry |
(if calc-previous-alg-entry |
351 |
(insert calc-previous-alg-entry) |
(insert calc-previous-alg-entry) |
352 |
(beep)) |
(beep)) |
353 |
(insert "'")) |
(insert "'"))) |
|
) |
|
354 |
|
|
355 |
(defun calcAlg-equals () |
(defun calcAlg-equals () |
356 |
(interactive) |
(interactive) |
358 |
(calcAlg-enter) |
(calcAlg-enter) |
359 |
(if (consp alg-exp) |
(if (consp alg-exp) |
360 |
(progn (setq prefix-arg (length alg-exp)) |
(progn (setq prefix-arg (length alg-exp)) |
361 |
(calc-unread-command ?=)))) |
(calc-unread-command ?=))))) |
|
) |
|
362 |
|
|
363 |
(defun calcAlg-escape () |
(defun calcAlg-escape () |
364 |
(interactive) |
(interactive) |
366 |
(save-excursion |
(save-excursion |
367 |
(calc-select-buffer) |
(calc-select-buffer) |
368 |
(use-local-map calc-mode-map)) |
(use-local-map calc-mode-map)) |
369 |
(calcAlg-enter) |
(calcAlg-enter)) |
|
) |
|
370 |
|
|
371 |
(defun calcAlg-edit () |
(defun calcAlg-edit () |
372 |
(interactive) |
(interactive) |
376 |
(insert "`") |
(insert "`") |
377 |
(setq alg-exp (minibuffer-contents)) |
(setq alg-exp (minibuffer-contents)) |
378 |
(and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) |
(and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) |
379 |
(exit-minibuffer)) |
(exit-minibuffer))) |
|
) |
|
380 |
(setq calc-plain-entry nil) |
(setq calc-plain-entry nil) |
381 |
|
|
382 |
(defun calcAlg-enter () |
(defun calcAlg-enter () |
398 |
'((incomplete vec)) |
'((incomplete vec)) |
399 |
exp)) |
exp)) |
400 |
(and (> (length str) 0) (setq calc-previous-alg-entry str)) |
(and (> (length str) 0) (setq calc-previous-alg-entry str)) |
401 |
(exit-minibuffer))) |
(exit-minibuffer)))) |
|
) |
|
402 |
|
|
403 |
(defun calcAlg-blink-matching-open () |
(defun calcAlg-blink-matching-open () |
404 |
(let ((oldpos (point)) |
(let ((oldpos (point)) |
424 |
(lsh (char-after (1- oldpos)) 8))) |
(lsh (char-after (1- oldpos)) 8))) |
425 |
(blink-matching-open)) |
(blink-matching-open)) |
426 |
(aset (syntax-table) (char-after blinkpos) saved))) |
(aset (syntax-table) (char-after blinkpos) saved))) |
427 |
(blink-matching-open))) |
(blink-matching-open)))) |
|
) |
|
428 |
|
|
429 |
|
|
430 |
(defun calc-alg-digit-entry () |
(defun calc-alg-digit-entry () |
434 |
((eq last-command-char ?#) (format "%d#" calc-number-radix)) |
((eq last-command-char ?#) (format "%d#" calc-number-radix)) |
435 |
((eq last-command-char ?_) "-") |
((eq last-command-char ?_) "-") |
436 |
((eq last-command-char ?@) "0@ ") |
((eq last-command-char ?@) "0@ ") |
437 |
(t (char-to-string last-command-char)))) |
(t (char-to-string last-command-char))))) |
|
) |
|
438 |
|
|
439 |
(defun calcDigit-algebraic () |
(defun calcDigit-algebraic () |
440 |
(interactive) |
(interactive) |
441 |
(if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") |
(if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") |
442 |
(calcDigit-key) |
(calcDigit-key) |
443 |
(setq calc-digit-value (minibuffer-contents)) |
(setq calc-digit-value (minibuffer-contents)) |
444 |
(exit-minibuffer)) |
(exit-minibuffer))) |
|
) |
|
445 |
|
|
446 |
(defun calcDigit-edit () |
(defun calcDigit-edit () |
447 |
(interactive) |
(interactive) |
448 |
(calc-unread-command) |
(calc-unread-command) |
449 |
(setq calc-digit-value (minibuffer-contents)) |
(setq calc-digit-value (minibuffer-contents)) |
450 |
(exit-minibuffer) |
(exit-minibuffer)) |
|
) |
|
451 |
|
|
452 |
|
|
453 |
;;; Algebraic expression parsing. [Public] |
;;; Algebraic expression parsing. [Public] |
469 |
(list 'error exp-old-pos val) |
(list 'error exp-old-pos val) |
470 |
(if (equal exp-token 'end) |
(if (equal exp-token 'end) |
471 |
val |
val |
472 |
(list 'error exp-old-pos "Syntax error"))))) |
(list 'error exp-old-pos "Syntax error")))))) |
|
) |
|
473 |
|
|
474 |
(defun math-read-expr-list () |
(defun math-read-expr-list () |
475 |
(let* ((exp-keep-spaces nil) |
(let* ((exp-keep-spaces nil) |
480 |
(let ((rest (list (math-read-expr-level 0)))) |
(let ((rest (list (math-read-expr-level 0)))) |
481 |
(setcdr last rest) |
(setcdr last rest) |
482 |
(setq last rest))) |
(setq last rest))) |
483 |
val) |
val)) |
|
) |
|
484 |
|
|
485 |
(setq calc-user-parse-table nil) |
(setq calc-user-parse-table nil) |
486 |
(setq calc-last-main-parse-table nil) |
(setq calc-last-main-parse-table nil) |
507 |
(length y))))) |
(length y))))) |
508 |
"\\|") |
"\\|") |
509 |
calc-last-main-parse-table mtab |
calc-last-main-parse-table mtab |
510 |
calc-last-lang-parse-table ltab)))) |
calc-last-lang-parse-table ltab))))) |
|
) |
|
511 |
|
|
512 |
(defun math-find-user-tokens (p) ; uses "toks" |
(defun math-find-user-tokens (p) ; uses "toks" |
513 |
(while p |
(while p |
531 |
(math-find-user-tokens (nth 1 (car p))) |
(math-find-user-tokens (nth 1 (car p))) |
532 |
(or (eq (car (car p)) '\?) |
(or (eq (car (car p)) '\?) |
533 |
(math-find-user-tokens (nth 2 (car p)))))) |
(math-find-user-tokens (nth 2 (car p)))))) |
534 |
(setq p (cdr p))) |
(setq p (cdr p)))) |
|
) |
|
535 |
|
|
536 |
(defun math-read-token () |
(defun math-read-token () |
537 |
(if (>= exp-pos (length exp-str)) |
(if (>= exp-pos (length exp-str)) |
699 |
(setq ch ?\,)) |
(setq ch ?\,)) |
700 |
(setq exp-token 'punc |
(setq exp-token 'punc |
701 |
exp-data (char-to-string ch) |
exp-data (char-to-string ch) |
702 |
exp-pos (1+ exp-pos)))))) |
exp-pos (1+ exp-pos))))))) |
|
) |
|
703 |
|
|
704 |
|
|
705 |
(defun math-read-expr-level (exp-prec &optional exp-term) |
(defun math-read-expr-level (exp-prec &optional exp-term) |
767 |
x |
x |
768 |
(math-read-expr-level (nth 3 op) exp-term)))) |
(math-read-expr-level (nth 3 op) exp-term)))) |
769 |
first nil)) |
first nil)) |
770 |
x) |
x)) |
|
) |
|
771 |
|
|
772 |
(defun calc-check-user-syntax (&optional x prec) |
(defun calc-check-user-syntax (&optional x prec) |
773 |
(let ((p calc-user-parse-table) |
(let ((p calc-user-parse-table) |
853 |
exp-data save-exp-data |
exp-data save-exp-data |
854 |
exp-pos save-exp-pos))))))) |
exp-pos save-exp-pos))))))) |
855 |
(setq p (cdr p))) |
(setq p (cdr p))) |
856 |
(and p match)) |
(and p match))) |
|
) |
|
857 |
|
|
858 |
(defun calc-match-user-syntax (p &optional term) |
(defun calc-match-user-syntax (p &optional term) |
859 |
(let ((matches nil) |
(let ((matches nil) |
912 |
exp-token save-exp-token |
exp-token save-exp-token |
913 |
exp-data save-exp-data |
exp-data save-exp-data |
914 |
matches "Failed")) |
matches "Failed")) |
915 |
matches) |
matches)) |
|
) |
|
916 |
|
|
917 |
(defconst math-alg-inequalities |
(defconst math-alg-inequalities |
918 |
'(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq |
'(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq |
922 |
(if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) |
(if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) |
923 |
(math-remove-dashes |
(math-remove-dashes |
924 |
(concat (math-match-substring x 1) "#" (math-match-substring x 2))) |
(concat (math-match-substring x 1) "#" (math-match-substring x 2))) |
925 |
x) |
x)) |
|
) |
|
926 |
|
|
927 |
(defun math-restore-dashes (x) |
(defun math-restore-dashes (x) |
928 |
(if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x) |
(if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x) |
929 |
(math-restore-dashes |
(math-restore-dashes |
930 |
(concat (math-match-substring x 1) "-" (math-match-substring x 2))) |
(concat (math-match-substring x 1) "-" (math-match-substring x 2))) |
931 |
x) |
x)) |
|
) |
|
932 |
|
|
933 |
(defun math-read-if (cond op) |
(defun math-read-if (cond op) |
934 |
(let ((then (math-read-expr-level 0))) |
(let ((then (math-read-expr-level 0))) |
935 |
(or (equal exp-data ":") |
(or (equal exp-data ":") |
936 |
(throw 'syntax "Expected ':'")) |
(throw 'syntax "Expected ':'")) |
937 |
(math-read-token) |
(math-read-token) |
938 |
(list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))) |
(list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) |
|
) |
|
939 |
|
|
940 |
(defun math-factor-after () |
(defun math-factor-after () |
941 |
(let ((exp-pos exp-pos) |
(let ((exp-pos exp-pos) |
945 |
(and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) |
(and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) |
946 |
(assoc (concat "u" exp-data) math-expr-opers)) |
(assoc (concat "u" exp-data) math-expr-opers)) |
947 |
(eq (nth 2 (assoc exp-data math-expr-opers)) -1) |
(eq (nth 2 (assoc exp-data math-expr-opers)) -1) |
948 |
(assoc exp-data '(("(") ("[") ("{"))))) |
(assoc exp-data '(("(") ("[") ("{")))))) |
|
) |
|
949 |
|
|
950 |
(defun math-read-factor () |
(defun math-read-factor () |
951 |
(let (op) |
(let (op) |
1127 |
((equal exp-data "<") |
((equal exp-data "<") |
1128 |
(calc-extensions) |
(calc-extensions) |
1129 |
(math-read-angle-brackets)) |
(math-read-angle-brackets)) |
1130 |
(t (throw 'syntax "Expected a number")))) |
(t (throw 'syntax "Expected a number"))))) |
|
) |
|
|
|
|
|
|
|
1131 |
|
|
1132 |
|
;;; calc-aent.el ends here |