[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calc/calc-prog.el [lexbind]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calc/calc-prog.el [lexbind] |
|
Date: |
Wed, 08 Dec 2004 19:33:17 -0500 |
Index: emacs/lisp/calc/calc-prog.el
diff -c emacs/lisp/calc/calc-prog.el:1.4.4.2
emacs/lisp/calc/calc-prog.el:1.4.4.3
*** emacs/lisp/calc/calc-prog.el:1.4.4.2 Tue Oct 14 23:35:48 2003
--- emacs/lisp/calc/calc-prog.el Wed Dec 8 23:36:21 2004
***************
*** 3,10 ****
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <address@hidden>
! ;; Maintainers: D. Goel <address@hidden>
! ;; Colin Walters <address@hidden>
;; This file is part of GNU Emacs.
--- 3,9 ----
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <address@hidden>
! ;; Maintainer: Jay Belanger <address@hidden>
;; This file is part of GNU Emacs.
***************
*** 27,40 ****
;;; Code:
-
;; This file is autoloaded from calc-ext.el.
- (require 'calc-ext)
(require 'calc-macs)
- (defun calc-Need-calc-prog () nil)
-
(defun calc-equal-to (arg)
(interactive "P")
--- 26,36 ----
;;; Code:
;; This file is autoloaded from calc-ext.el.
+ (require 'calc-ext)
(require 'calc-macs)
(defun calc-equal-to (arg)
(interactive "P")
***************
*** 157,162 ****
--- 153,168 ----
(error "No such user key is defined"))
kmap))))
+
+ ;; math-integral-cache-state is originally declared in calcalg2.el,
+ ;; it is used in calc-user-define-variable.
+ (defvar math-integral-cache-state)
+
+ ;; calc-user-formula-alist is local to calc-user-define-formula,
+ ;; calc-user-define-compostion and calc-finish-formula-edit,
+ ;; but is used by calc-fix-user-formula.
+ (defvar calc-user-formula-alist)
+
(defun calc-user-define-formula ()
(interactive)
(calc-wrapper
***************
*** 164,170 ****
(arglist nil)
(is-lambda (and (eq (car-safe form) 'calcFunc-lambda)
(>= (length form) 2)))
! odef key keyname cmd cmd-base func alist is-symb)
(if is-lambda
(setq arglist (mapcar (function (lambda (x) (nth 1 x)))
(nreverse (cdr (reverse (cdr form)))))
--- 170,176 ----
(arglist nil)
(is-lambda (and (eq (car-safe form) 'calcFunc-lambda)
(>= (length form) 2)))
! odef key keyname cmd cmd-base func calc-user-formula-alist is-symb)
(if is-lambda
(setq arglist (mapcar (function (lambda (x) (nth 1 x)))
(nreverse (cdr (reverse (cdr form)))))
***************
*** 238,273 ****
(and cmd (symbol-name cmd))
(format "%05d" (% (random) 10000)))))))
(if is-lambda
! (setq alist arglist)
(while
(progn
! (setq alist (read-from-minibuffer "Function argument list: "
! (if arglist
! (prin1-to-string arglist)
! "()")
! minibuffer-local-map
! t))
! (and (not (calc-subsetp alist arglist))
(not (y-or-n-p
"Okay for arguments that don't appear in formula to be
ignored? "))))))
! (setq is-symb (and alist
func
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
! (setq alist (mapcar (function (lambda (x)
! (or (cdr (assq x '((nil . arg-nil)
! (t . arg-t))))
! x))) alist))
(if cmd
(progn
! (calc-need-macros)
(fset cmd
(list 'lambda
'()
'(interactive)
(list 'calc-wrapper
(list 'calc-enter-result
! (length alist)
(let ((name (symbol-name (or func cmd))))
(and (string-match
"\\([^-][^-]?[^-]?[^-]?\\)[^-]*\\'"
--- 244,281 ----
(and cmd (symbol-name cmd))
(format "%05d" (% (random) 10000)))))))
(if is-lambda
! (setq calc-user-formula-alist arglist)
(while
(progn
! (setq calc-user-formula-alist
! (read-from-minibuffer "Function argument list: "
! (if arglist
! (prin1-to-string arglist)
! "()")
! minibuffer-local-map
! t))
! (and (not (calc-subsetp calc-user-formula-alist arglist))
(not (y-or-n-p
"Okay for arguments that don't appear in formula to be
ignored? "))))))
! (setq is-symb (and calc-user-formula-alist
func
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
! (setq calc-user-formula-alist
! (mapcar (function (lambda (x)
! (or (cdr (assq x '((nil . arg-nil)
! (t . arg-t))))
! x))) calc-user-formula-alist))
(if cmd
(progn
! (require 'calc-macs)
(fset cmd
(list 'lambda
'()
'(interactive)
(list 'calc-wrapper
(list 'calc-enter-result
! (length calc-user-formula-alist)
(let ((name (symbol-name (or func cmd))))
(and (string-match
"\\([^-][^-]?[^-]?[^-]?\\)[^-]*\\'"
***************
*** 276,291 ****
(list 'cons
(list 'quote func)
(list 'calc-top-list-n
! (length alist)))))))
(put cmd 'calc-user-defn t)))
(let ((body (list 'math-normalize (calc-fix-user-formula form))))
(fset func
(append
! (list 'lambda alist)
(and is-symb
(mapcar (function (lambda (v)
(list 'math-check-const v t)))
! alist))
(list body))))
(put func 'calc-user-defn form)
(setq math-integral-cache-state nil)
--- 284,299 ----
(list 'cons
(list 'quote func)
(list 'calc-top-list-n
! (length
calc-user-formula-alist)))))))
(put cmd 'calc-user-defn t)))
(let ((body (list 'math-normalize (calc-fix-user-formula form))))
(fset func
(append
! (list 'lambda calc-user-formula-alist)
(and is-symb
(mapcar (function (lambda (v)
(list 'math-check-const v t)))
! calc-user-formula-alist))
(list body))))
(put func 'calc-user-defn form)
(setq math-integral-cache-state nil)
***************
*** 324,330 ****
(memq (setq temp (or (cdr (assq (nth 1 f) '((nil . arg-nil)
(t . arg-t))))
(nth 1 f)))
! alist))
temp)
((or (math-constp f) (eq (car f) 'var))
(list 'quote f))
--- 332,338 ----
(memq (setq temp (or (cdr (assq (nth 1 f) '((nil . arg-nil)
(t . arg-t))))
(nth 1 f)))
! calc-user-formula-alist))
temp)
((or (math-constp f) (eq (car f) 'var))
(list 'quote f))
***************
*** 356,362 ****
(comps (get func 'math-compose-forms))
entry entry2
(arglist nil)
! (alist nil))
(if (math-zerop comp)
(if (setq entry (assq calc-language comps))
(put func 'math-compose-forms (delq entry comps)))
--- 364,370 ----
(comps (get func 'math-compose-forms))
entry entry2
(arglist nil)
! (calc-user-formula-alist nil))
(if (math-zerop comp)
(if (setq entry (assq calc-language comps))
(put func 'math-compose-forms (delq entry comps)))
***************
*** 364,385 ****
(setq arglist (sort arglist 'string-lessp))
(while
(progn
! (setq alist (read-from-minibuffer "Composition argument list: "
! (if arglist
! (prin1-to-string arglist)
! "()")
! minibuffer-local-map
! t))
! (and (not (calc-subsetp alist arglist))
(y-or-n-p
"Okay for arguments that don't appear in formula to be
invisible? "))))
(or (setq entry (assq calc-language comps))
(put func 'math-compose-forms
(cons (setq entry (list calc-language)) comps)))
! (or (setq entry2 (assq (length alist) (cdr entry)))
(setcdr entry
! (cons (setq entry2 (list (length alist))) (cdr entry))))
! (setcdr entry2 (list 'lambda alist (calc-fix-user-formula comp))))
(calc-pop-stack 1)
(calc-do-refresh))))
--- 372,396 ----
(setq arglist (sort arglist 'string-lessp))
(while
(progn
! (setq calc-user-formula-alist
! (read-from-minibuffer "Composition argument list: "
! (if arglist
! (prin1-to-string arglist)
! "()")
! minibuffer-local-map
! t))
! (and (not (calc-subsetp calc-user-formula-alist arglist))
(y-or-n-p
"Okay for arguments that don't appear in formula to be
invisible? "))))
(or (setq entry (assq calc-language comps))
(put func 'math-compose-forms
(cons (setq entry (list calc-language)) comps)))
! (or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry)))
(setcdr entry
! (cons (setq entry2
! (list (length calc-user-formula-alist))) (cdr
entry))))
! (setcdr entry2
! (list 'lambda calc-user-formula-alist (calc-fix-user-formula
comp))))
(calc-pop-stack 1)
(calc-do-refresh))))
***************
*** 445,450 ****
--- 456,463 ----
lang)))
(calc-show-edit-buffer))
+ (defvar calc-original-buffer)
+
(defun calc-finish-user-syntax-edit (lang)
(let ((tab (calc-read-parse-table calc-original-buffer lang))
(entry (assq lang calc-user-parse-tables)))
***************
*** 458,463 ****
--- 471,483 ----
(delq entry calc-user-parse-tables)))))
(switch-to-buffer calc-original-buffer))
+ ;; The variable calc-lang is local to calc-write-parse-table, but is
+ ;; used by calc-write-parse-table-part which is called by
+ ;; calc-write-parse-table. The variable is also local to
+ ;; calc-read-parse-table, but is used by calc-fix-token-name which
+ ;; is called (indirectly) by calc-read-parse-table.
+ (defvar calc-lang)
+
(defun calc-write-parse-table (tab calc-lang)
(let ((p tab))
(while p
***************
*** 876,882 ****
(goto-char (+ start (nth 1 val)))
(error (nth 2 val))))
(setcar (cdr body)
! (let ((alist (nth 1 (symbol-function func))))
(calc-fix-user-formula val)))
(put func 'calc-user-defn val))))
--- 896,902 ----
(goto-char (+ start (nth 1 val)))
(error (nth 2 val))))
(setcar (cdr body)
! (let ((calc-user-formula-alist (nth 1 (symbol-function func))))
(calc-fix-user-formula val)))
(put func 'calc-user-defn val))))
***************
*** 1277,1296 ****
(defvar calc-kbd-push-level 0)
(defun calc-kbd-push (arg)
(interactive "P")
(calc-wrapper
(let* ((defs (and arg (> (prefix-numeric-value arg) 0)))
! (var-q0 (and (boundp 'var-q0) var-q0))
! (var-q1 (and (boundp 'var-q1) var-q1))
! (var-q2 (and (boundp 'var-q2) var-q2))
! (var-q3 (and (boundp 'var-q3) var-q3))
! (var-q4 (and (boundp 'var-q4) var-q4))
! (var-q5 (and (boundp 'var-q5) var-q5))
! (var-q6 (and (boundp 'var-q6) var-q6))
! (var-q7 (and (boundp 'var-q7) var-q7))
! (var-q8 (and (boundp 'var-q8) var-q8))
! (var-q9 (and (boundp 'var-q9) var-q9))
(calc-internal-prec (if defs 12 calc-internal-prec))
(calc-word-size (if defs 32 calc-word-size))
(calc-angle-mode (if defs 'deg calc-angle-mode))
--- 1297,1329 ----
(defvar calc-kbd-push-level 0)
+
+ ;; The variables var-q0 through var-q9 are the "quick" variables.
+ (defvar var-q0 nil)
+ (defvar var-q1 nil)
+ (defvar var-q2 nil)
+ (defvar var-q3 nil)
+ (defvar var-q4 nil)
+ (defvar var-q5 nil)
+ (defvar var-q6 nil)
+ (defvar var-q7 nil)
+ (defvar var-q8 nil)
+ (defvar var-q9 nil)
+
(defun calc-kbd-push (arg)
(interactive "P")
(calc-wrapper
(let* ((defs (and arg (> (prefix-numeric-value arg) 0)))
! (var-q0 var-q0)
! (var-q1 var-q1)
! (var-q2 var-q2)
! (var-q3 var-q3)
! (var-q4 var-q4)
! (var-q5 var-q5)
! (var-q6 var-q6)
! (var-q7 var-q7)
! (var-q8 var-q8)
! (var-q9 var-q9)
(calc-internal-prec (if defs 12 calc-internal-prec))
(calc-word-size (if defs 32 calc-word-size))
(calc-angle-mode (if defs 'deg calc-angle-mode))
***************
*** 1613,1619 ****
((eq (car a) 'var)
(if (memq (nth 2 a) '(var-inf var-uinf var-nan)) 12 100))
((eq (car a) 'vec) (if (math-matrixp a) 102 101))
! (t (math-calcFunc-to-var func))))
(defun calcFunc-integer (a)
(if (Math-integerp a)
--- 1646,1652 ----
((eq (car a) 'var)
(if (memq (nth 2 a) '(var-inf var-uinf var-nan)) 12 100))
((eq (car a) 'vec) (if (math-matrixp a) 102 101))
! (t (math-calcFunc-to-var (car a)))))
(defun calcFunc-integer (a)
(if (Math-integerp a)
***************
*** 1675,1681 ****
;;; Compiling Lisp-like forms to use the math library.
(defun math-do-defmath (func args body)
! (calc-need-macros)
(let* ((fname (intern (concat "calcFunc-" (symbol-name func))))
(doc (if (stringp (car body)) (list (car body))))
(clargs (mapcar 'math-clean-arg args))
--- 1708,1714 ----
;;; Compiling Lisp-like forms to use the math library.
(defun math-do-defmath (func args body)
! (require 'calc-macs)
(let* ((fname (intern (concat "calcFunc-" (symbol-name func))))
(doc (if (stringp (car body)) (list (car body))))
(clargs (mapcar 'math-clean-arg args))
***************
*** 1868,1874 ****
(list (cons 'catch (cons '(quote math-return) body)))
body)))
! (defun math-define-body (body exp-env)
(math-define-list body))
(defun math-define-list (body &optional quote)
--- 1901,1912 ----
(list (cons 'catch (cons '(quote math-return) body)))
body)))
! ;; The variable math-exp-env is local to math-define-body, but is
! ;; used by math-define-exp, which is called (indirectly) by
! ;; by math-define-body.
! (defvar math-exp-env)
!
! (defun math-define-body (body math-exp-env)
(math-define-list body))
(defun math-define-list (body &optional quote)
***************
*** 1897,1903 ****
(if (and (consp (nth 1 exp))
(eq (car (nth 1 exp)) 'lambda))
(cons 'quote
! (math-define-lambda (nth 1 exp) exp-env))
exp))
((memq func '(let let* for foreach))
(let ((head (nth 1 exp))
--- 1935,1941 ----
(if (and (consp (nth 1 exp))
(eq (car (nth 1 exp)) 'lambda))
(cons 'quote
! (math-define-lambda (nth 1 exp) math-exp-env))
exp))
((memq func '(let let* for foreach))
(let ((head (nth 1 exp))
***************
*** 1914,1920 ****
(math-define-body body
(nconc
(math-define-let-env head)
! exp-env)))))))
((and (memq func '(setq setf))
(math-complicated-lhs (cdr exp)))
(if (> (length exp) 3)
--- 1952,1958 ----
(math-define-body body
(nconc
(math-define-let-env head)
! math-exp-env)))))))
((and (memq func '(setq setf))
(math-complicated-lhs (cdr exp)))
(if (> (length exp) 3)
***************
*** 1925,1931 ****
(cons (nth 1 exp)
(math-define-body (cdr (cdr exp))
(cons (nth 1 exp)
! exp-env)))))
((eq func 'cond)
(cons func
(math-define-cond (cdr exp))))
--- 1963,1969 ----
(cons (nth 1 exp)
(math-define-body (cdr (cdr exp))
(cons (nth 1 exp)
! math-exp-env)))))
((eq func 'cond)
(cons func
(math-define-cond (cdr exp))))
***************
*** 2023,2035 ****
(cons func args))
(t
(cons cfunc args)))))))))
! (t (cons func args)))))
((symbolp exp)
(let ((prim (assq exp math-prim-vars))
(name (symbol-name exp)))
(cond (prim
(cdr prim))
! ((memq exp exp-env)
exp)
((string-match "-" name)
exp)
--- 2061,2073 ----
(cons func args))
(t
(cons cfunc args)))))))))
! (t (cons func (math-define-list (cdr exp))))))) ;;args
((symbolp exp)
(let ((prim (assq exp math-prim-vars))
(name (symbol-name exp)))
(cond (prim
(cdr prim))
! ((memq exp math-exp-env)
exp)
((string-match "-" name)
exp)
***************
*** 2242,2246 ****
--- 2280,2286 ----
(math-read-expr-level (nth 3 op)) (nth 1 x))
(throw 'syntax "Syntax error"))))))
+ (provide 'calc-prog)
+
;;; arch-tag: 4c5a183b-c9e5-4632-bb3f-e41a764518b0
;;; calc-prog.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/calc/calc-prog.el [lexbind],
Miles Bader <=