Lines Matching defs:calc
0 ;;; calc-prog.el --- user programmability functions for Calc
30 ;; This file is autoloaded from calc-ext.el.
32 (require 'calc-ext)
33 (require 'calc-macs)
36 (defun calc-equal-to (arg)
38 (calc-wrapper
40 (calc-enter-result arg "eq" (cons 'calcFunc-eq (calc-top-list-n arg)))
41 (calc-binary-op "eq" 'calcFunc-eq arg))))
43 (defun calc-remove-equal (arg)
45 (calc-wrapper
46 (calc-unary-op "rmeq" 'calcFunc-rmeq arg)))
48 (defun calc-not-equal-to (arg)
50 (calc-wrapper
52 (calc-enter-result arg "neq" (cons 'calcFunc-neq (calc-top-list-n arg)))
53 (calc-binary-op "neq" 'calcFunc-neq arg))))
55 (defun calc-less-than (arg)
57 (calc-wrapper
58 (calc-binary-op "lt" 'calcFunc-lt arg)))
60 (defun calc-greater-than (arg)
62 (calc-wrapper
63 (calc-binary-op "gt" 'calcFunc-gt arg)))
65 (defun calc-less-equal (arg)
67 (calc-wrapper
68 (calc-binary-op "leq" 'calcFunc-leq arg)))
70 (defun calc-greater-equal (arg)
72 (calc-wrapper
73 (calc-binary-op "geq" 'calcFunc-geq arg)))
75 (defun calc-in-set (arg)
77 (calc-wrapper
78 (calc-binary-op "in" 'calcFunc-in arg)))
80 (defun calc-logical-and (arg)
82 (calc-wrapper
83 (calc-binary-op "land" 'calcFunc-land arg 1)))
85 (defun calc-logical-or (arg)
87 (calc-wrapper
88 (calc-binary-op "lor" 'calcFunc-lor arg 0)))
90 (defun calc-logical-not (arg)
92 (calc-wrapper
93 (calc-unary-op "lnot" 'calcFunc-lnot arg)))
95 (defun calc-logical-if ()
97 (calc-wrapper
98 (calc-enter-result 3 "if" (cons 'calcFunc-if (calc-top-list-n 3)))))
104 (defun calc-timing (n)
106 (calc-wrapper
107 (calc-change-mode 'calc-timing n nil t)
108 (message (if calc-timing
112 (defun calc-pass-errors ()
117 (let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15)))
119 (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
123 (error (error "The calc-do function has been modified; unable to patch"))))
125 (defun calc-user-define ()
129 (if (= (calc-user-function-classify key) 0)
137 "calc-"))))
138 (let* ((kmap (calc-user-key-map))
144 (defun calc-user-undefine ()
148 (if (= (calc-user-function-classify key) 0)
150 (let* ((kmap (calc-user-key-map)))
159 ;; it is used in calc-user-define-variable.
162 ;; calc-user-formula-alist is local to calc-user-define-formula,
163 ;; calc-user-define-compostion and calc-finish-formula-edit,
164 ;; but is used by calc-fix-user-formula.
165 (defvar calc-user-formula-alist)
167 (defun calc-user-define-formula ()
169 (calc-wrapper
170 (let* ((form (calc-top 1))
175 func calc-user-formula-alist is-symb)
180 (calc-default-formula-arglist form)
184 (if (= (calc-user-function-classify key) 0)
193 odef (assq key (calc-user-key-map)))
200 (concat "Define M-x command name (default calc-"
206 "calc-")))
208 (string-equal cmd "calc-"))
209 (setq cmd (concat "calc-User-" keyname)))
210 (setq cmd-base (and (string-match "\\`calc-\\(.+\\)\\'" cmd)
218 (if (get cmd 'calc-user-defn)
255 (if (get func 'calc-user-defn)
267 (setq calc-user-formula-alist arglist)
270 (setq calc-user-formula-alist
277 (and (not (calc-subsetp calc-user-formula-alist arglist))
280 (setq is-symb (and calc-user-formula-alist
284 (setq calc-user-formula-alist
288 x))) calc-user-formula-alist))
291 (require 'calc-macs)
296 (list 'calc-wrapper
297 (list 'calc-enter-result
298 (length calc-user-formula-alist)
306 (list 'calc-top-list-n
307 (length calc-user-formula-alist)))))))
308 (put cmd 'calc-user-defn t)))
309 (let ((body (list 'math-normalize (calc-fix-user-formula form))))
312 (list 'lambda calc-user-formula-alist)
316 calc-user-formula-alist))
318 (put func 'calc-user-defn form)
321 (let* ((kmap (calc-user-key-map))
328 (defun calc-default-formula-arglist (form)
335 (calc-default-formula-arglist-step (cdr form)))))
337 (defun calc-default-formula-arglist-step (l)
340 (calc-default-formula-arglist (car l))
341 (calc-default-formula-arglist-step (cdr l)))))
343 (defun calc-subsetp (a b)
346 (calc-subsetp (cdr a) b))))
348 (defun calc-fix-user-formula (f)
355 calc-user-formula-alist))
361 (list 'let '((calc-simplify-mode nil))
362 (list 'math-normalize (calc-fix-user-formula (nth 1 f)))))
365 (list 'math-simplify (calc-fix-user-formula (nth 1 f))))
369 (calc-fix-user-formula (nth 1 f))))
373 (mapcar 'calc-fix-user-formula (cdr f)))))))
376 (defun calc-user-define-composition ()
378 (calc-wrapper
379 (if (eq calc-language 'unform)
381 (let* ((comp (calc-top 1))
394 (calc-user-formula-alist nil))
396 (if (setq entry (assq calc-language comps))
398 (calc-default-formula-arglist comp)
402 (setq calc-user-formula-alist
409 (and (not (calc-subsetp calc-user-formula-alist arglist))
412 (or (setq entry (assq calc-language comps))
414 (cons (setq entry (list calc-language)) comps)))
415 (or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry)))
418 (list (length calc-user-formula-alist))) (cdr entry))))
420 (list 'lambda calc-user-formula-alist (calc-fix-user-formula comp))))
421 (calc-pop-stack 1)
422 (calc-do-refresh))))
425 (defun calc-user-define-kbd-macro (arg)
431 (if (= (calc-user-function-classify key) 0)
437 (concat "calc-User-"
451 'calc-execute-kbd-macro)))))
454 (put cmd 'calc-user-defn t)
460 (list 'calc-execute-kbd-macro
465 (let* ((kmap (calc-user-key-map))
472 (defun calc-edit-user-syntax ()
474 (calc-wrapper
475 (let ((lang calc-language))
476 (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
483 (calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
485 (calc-show-edit-buffer))
487 (defvar calc-original-buffer)
489 (defun calc-finish-user-syntax-edit (lang)
490 (let ((tab (calc-read-parse-table calc-original-buffer lang))
491 (entry (assq lang calc-user-parse-tables)))
494 (car (setq calc-user-parse-tables
495 (cons (list lang) calc-user-parse-tables))))
498 (setq calc-user-parse-tables
499 (delq entry calc-user-parse-tables)))))
500 (switch-to-buffer calc-original-buffer))
502 ;; The variable calc-lang is local to calc-write-parse-table, but is
503 ;; used by calc-write-parse-table-part which is called by
504 ;; calc-write-parse-table. The variable is also local to
505 ;; calc-read-parse-table, but is used by calc-fix-token-name which
506 ;; is called (indirectly) by calc-read-parse-table.
507 (defvar calc-lang)
509 (defun calc-write-parse-table (tab calc-lang)
512 (calc-write-parse-table-part (car (car p)))
519 (defun calc-write-parse-table-part (p)
524 (not (memq calc-lang '(tex latex))))
542 (calc-write-parse-table-part (nth 1 (car p)))
545 (calc-write-parse-table-part (list (car (nth 2 (car p)))))
549 (defun calc-read-parse-table (calc-buf calc-lang)
557 (p (calc-read-parse-table-part ":=[\n\t ]+" ":=")))
568 (set-buffer calc-buf)
569 (let ((calc-user-parse-tables nil)
570 (calc-language nil)
572 (calc-hashes-used 0))
584 (defun calc-fix-token-name (name &optional unquoted)
587 ((and (equal name "{") (memq calc-lang '(tex latex eqn)))
589 ((and (equal name "}") (memq calc-lang '(tex latex eqn)))
591 ((and (equal name "&") (memq calc-lang '(tex latex)))
603 (defun calc-read-parse-table-part (term eterm)
614 (let ((p (calc-read-parse-table-part "}" "}")))
627 (setq sep (calc-fix-token-name sep))
635 (setq quoted (calc-fix-token-name (read (current-buffer)))
651 (setq part (nconc part (list (calc-fix-token-name
665 (defun calc-user-define-invocation ()
669 (setq calc-invocation-macro last-kbd-macro)
672 (defun calc-user-define-edit ()
673 (interactive) ; but no calc-wrapper!
677 (def (or (assq key (calc-user-key-map))
678 (assq (upcase key) (calc-user-key-map))
679 (assq (downcase key) (calc-user-key-map))
687 (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
691 (calc-edit-mode
692 (list 'calc-edit-macro-finish-edit cmdname kys)
698 (calc-edit-format-macro-buffer)
699 (calc-show-edit-buffer)))
700 (t (let* ((func (calc-stack-command-p cmd))
703 (get func 'calc-user-defn)))
707 (if (and defn (calc-valid-formula-func func))
709 (calc-wrapper
710 (calc-edit-mode
711 (list 'calc-finish-formula-edit (list 'quote func))
720 (calc-show-edit-buffer))
725 (defvar calc-edit-top)
727 (defun calc-edit-macro-repeats ()
728 (goto-char calc-edit-top)
739 (defun calc-edit-macro-adjust-buffer ()
740 (calc-edit-macro-repeats)
741 (goto-char calc-edit-top)
744 (goto-char calc-edit-top)
749 (defun calc-edit-macro-command ()
759 (defun calc-edit-macro-command-type ()
774 (defun calc-edit-macro-combine-alg-ent ()
776 (let ((line (calc-edit-macro-command))
777 (type (calc-edit-macro-command-type))
782 (setq curline (calc-edit-macro-command))
788 (setq curline (calc-edit-macro-command)))
799 (insert "RET\t\t\t;; calc-enter\n"))))
801 (defun calc-edit-macro-combine-ext-command ()
803 (let ((cmdbeg (calc-edit-macro-command))
805 (type (calc-edit-macro-command-type))
810 (setq curline (calc-edit-macro-command))
816 (setq curline (calc-edit-macro-command)))
826 (insert "RET\t\t\t;; calc-enter\n"))))
828 (defun calc-edit-macro-combine-var-name ()
830 (let ((line (calc-edit-macro-command))
836 (insert line "\t\t\t;; calc quick variable\n")
837 (setq curline (calc-edit-macro-command))
843 (setq curline (calc-edit-macro-command)))
851 (insert ";; calc variable\n")
853 (insert "RET\t\t\t;; calc-enter\n")))))
855 (defun calc-edit-macro-combine-digits ()
857 (let ((line (calc-edit-macro-command))
861 (while (string-equal (calc-edit-macro-command-type) "calcDigit-start")
862 (setq line (concat line (calc-edit-macro-command)))
867 (insert ";; calc digits\n")))
869 (defun calc-edit-format-macro-buffer ()
871 (calc-edit-macro-adjust-buffer)
872 (goto-char calc-edit-top)
873 (let ((type (calc-edit-macro-command-type)))
877 (string-equal type "calc-algebraic-entry")
878 (string-equal type "calc-auto-algebraic-entry"))
879 (calc-edit-macro-combine-alg-ent))
880 ((string-equal type "calc-execute-extended-command")
881 (calc-edit-macro-combine-ext-command))
883 (calc-edit-macro-combine-digits))
885 (string-equal type "calc-store")
886 (string-equal type "calc-store-into")
887 (string-equal type "calc-store-neg")
888 (string-equal type "calc-store-plus")
889 (string-equal type "calc-store-minus")
890 (string-equal type "calc-store-div")
891 (string-equal type "calc-store-times")
892 (string-equal type "calc-store-power")
893 (string-equal type "calc-store-concat")
894 (string-equal type "calc-store-inv")
895 (string-equal type "calc-store-dec")
896 (string-equal type "calc-store-incr")
897 (string-equal type "calc-store-exchange")
898 (string-equal type "calc-unstore")
899 (string-equal type "calc-recall")
900 (string-equal type "calc-let")
901 (string-equal type "calc-permanent-variable"))
903 (calc-edit-macro-combine-var-name))
905 (string-equal type "calc-copy-variable")
906 (string-equal type "calc-copy-special-constant")
907 (string-equal type "calc-declare-variable"))
909 (calc-edit-macro-combine-var-name)
910 (calc-edit-macro-combine-var-name))
912 (setq type (calc-edit-macro-command-type))))
913 (goto-char calc-edit-top))
917 (defun calc-edit-macro-pre-finish-edit ()
918 (goto-char calc-edit-top)
924 (defun calc-edit-macro-finish-edit (cmdname key)
929 (calc-edit-macro-pre-finish-edit)
930 (let* ((str (buffer-substring calc-edit-top (point-max)))
937 (list 'calc-execute-kbd-macro
942 (defun calc-finish-formula-edit (func)
944 (str (buffer-substring calc-edit-top (point-max)))
946 (body (calc-valid-formula-func func)))
947 (set-buffer calc-original-buffer)
955 (let ((calc-user-formula-alist (nth 1 (symbol-function func))))
956 (calc-fix-user-formula val)))
957 (put func 'calc-user-defn val))))
959 (defun calc-valid-formula-func (func)
971 (defun calc-get-user-defn ()
973 (calc-wrapper
976 (def (or (assq key (calc-user-key-map))
977 (assq (upcase key) (calc-user-key-map))
978 (assq (downcase key) (calc-user-key-map))
985 (t (let* ((func (calc-stack-command-p cmd))
988 (get func 'calc-user-defn))))
991 (and (calc-valid-formula-func func)
997 (calc-enter-result 0 "gdef" defn))
1001 (defun calc-user-define-permanent ()
1003 (calc-wrapper
1004 (message "Record in %s the command: z-" calc-settings-file)
1006 (def (or (assq key (calc-user-key-map))
1007 (assq (upcase key) (calc-user-key-map))
1008 (assq (downcase key) (calc-user-key-map))
1015 calc-settings-file)
1027 calc-settings-file)
1028 obarray 'fboundp nil "calc-"))))
1031 calc-settings-file)))
1041 "\n(put 'calc-define '"
1046 (get cmd 'calc-user-defn))
1048 (and (eq (car-safe (nth 3 fcmd)) 'calc-execute-kbd-macro)
1063 " 'calc-user-defn '"
1064 (prin1-to-string (get cmd 'calc-user-defn))
1066 (setq func (calc-stack-command-p cmd))
1071 (get func 'calc-user-defn)
1083 " 'calc-user-defn '"
1084 (prin1-to-string (get func 'calc-user-defn))
1103 (insert " (define-key calc-mode-map "
1111 (defun calc-stack-command-p (cmd)
1114 (calc-stack-command-p (symbol-function cmd)))
1117 (setq cmd (or (assq 'calc-wrapper cmd)
1118 (assq 'calc-slow-wrapper cmd)))
1119 (setq cmd (assq 'calc-enter-result cmd))
1125 (defun calc-call-last-kbd-macro (arg)
1131 (calc-execute-kbd-macro last-kbd-macro arg))
1133 (defun calc-execute-kbd-macro (mac arg &rest prefix)
1134 (if calc-keep-args-flag
1135 (calc-keep-args))
1143 (if calc-executing-macro
1145 (calc-slow-wrapper
1146 (let ((old-stack-whole (copy-sequence calc-stack))
1147 (old-stack-top calc-stack-top)
1149 (old-refresh-count calc-refresh-count))
1151 (let ((calc-executing-macro mac))
1153 (calc-select-buffer)
1154 (let ((new-stack (reverse calc-stack))
1161 (calc-record-list (if (> (length new-stack) 1)
1165 (calc-record-undo (list 'set 'saved-stack-top old-stack-top))
1167 (calc-record-undo (list 'pop 1 (mapcar 'car old-stack))))
1168 (let ((calc-stack old-stack-whole)
1169 (calc-stack-top 0))
1170 (calc-cursor-stack-index (length old-stack)))
1172 (= old-refresh-count calc-refresh-count))
1176 (calc-record-undo (list 'push 1))
1179 (calc-renumber-stack))
1181 (calc-record-undo (list 'push 1))
1183 (calc-refresh))
1184 (calc-record-undo (list 'set 'saved-stack-top 0)))))))))
1186 (defun calc-push-list-in-macro (vals m sels)
1188 (mm (+ (or m 1) calc-stack-top)))
1190 (setcdr (nthcdr (- mm 2) calc-stack)
1191 (cons entry (nthcdr (1- mm) calc-stack)))
1192 (setq calc-stack (cons entry calc-stack)))))
1194 (defun calc-pop-stack-in-macro (n mm)
1196 (setcdr (nthcdr (- mm 2) calc-stack)
1197 (nthcdr (+ n mm -1) calc-stack))
1198 (setq calc-stack (nthcdr n calc-stack))))
1201 (defun calc-kbd-if ()
1203 (calc-wrapper
1204 (let ((cond (calc-top-n 1)))
1205 (calc-pop-stack 1)
1211 (calc-kbd-skip-to-else-if t)))))
1213 (defun calc-kbd-else-if ()
1215 (calc-kbd-if))
1217 (defun calc-kbd-skip-to-else-if (else-okay)
1242 (defun calc-kbd-end-if ()
1247 (defun calc-kbd-else ()
1251 (calc-kbd-skip-to-else-if nil))
1254 (defun calc-kbd-repeat ()
1257 (calc-wrapper
1258 (setq count (math-trunc (calc-top-n 1)))
1265 (calc-pop-stack 1))
1266 (calc-kbd-loop count)))
1268 (defun calc-kbd-for (dir)
1271 (calc-wrapper
1272 (setq init (calc-top-n 2)
1273 final (calc-top-n 1))
1276 (calc-pop-stack 2))
1277 (calc-kbd-loop nil init final (and dir (prefix-numeric-value dir)))))
1279 (defun calc-kbd-loop (rpt-count &optional initial final dir)
1324 (calc-wrapper
1332 (calc-push counter)))
1335 (if (math-is-true (calc-top-n 1))
1338 (calc-pop-stack 1))
1343 (let ((step (calc-top-n 1)))
1344 (calc-pop-stack 1)
1350 (defun calc-kbd-end-repeat ()
1354 (defun calc-kbd-end-for ()
1358 (defun calc-kbd-end-loop ()
1362 (defun calc-kbd-break ()
1364 (calc-wrapper
1365 (let ((cond (calc-top-n 1)))
1366 (calc-pop-stack 1)
1371 (defvar calc-kbd-push-level 0)
1385 (defun calc-kbd-push (arg)
1387 (calc-wrapper
1399 (calc-internal-prec (if defs 12 calc-internal-prec))
1400 (calc-word-size (if defs 32 calc-word-size))
1401 (calc-angle-mode (if defs 'deg calc-angle-mode))
1402 (calc-simplify-mode (if defs nil calc-simplify-mode))
1403 (calc-algebraic-mode (if arg nil calc-algebraic-mode))
1404 (calc-incomplete-algebraic-mode (if arg nil
1405 calc-incomplete-algebraic-mode))
1406 (calc-symbolic-mode (if defs nil calc-symbolic-mode))
1407 (calc-matrix-mode (if defs nil calc-matrix-mode))
1408 (calc-prefer-frac (if defs nil calc-prefer-frac))
1409 (calc-complex-mode (if defs nil calc-complex-mode))
1410 (calc-infinite-mode (if defs nil calc-infinite-mode))
1435 (let ((calc-kbd-push-level 0))
1437 (let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
1441 (defun calc-kbd-pop ()
1443 (if (> calc-kbd-push-level 0)
1450 ;; (defun calc-kbd-report (msg)
1452 ;; (calc-wrapper
1453 ;; (math-working msg (calc-top-n 1))))
1455 (defun calc-kbd-query ()
1459 (msg (calc-top 1)))
1463 (calc-wrapper
1464 (calc-pop-stack 1)
1465 (calc-alg-entry nil (and (not (equal msg "")) msg))))))
1590 (if (assq (car-safe a) calc-tweak-eqn-table)
1629 (assq (car a) calc-tweak-eqn-table))))
1644 (calc-record-why "*Dimension error" e1))
1649 (calc-record-why "*Dimension error" e2))
1675 (let ((calc-simplify-mode 'none))
1790 (require 'calc-macs)
1819 (intern (concat "calc-"
1830 '(calc-slow-wrapper)
1841 (list 'calc-enter-result
1847 (list 'calc-top-list-n
1860 (list 'calc-top-list-n
1865 (intern (concat "calc-" (symbol-name func)))
1870 (cons 'calc-wrapper body))))))
2362 (provide 'calc-prog)
2365 ;;; calc-prog.el ends here