Function: calcFunc-pcont

calcFunc-pcont is an autoloaded and byte-compiled function defined in calc-poly.el.gz.

Signature

(calcFunc-pcont EXPR &optional VAR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-poly.el.gz
(defun calcFunc-pcont (expr &optional var)
  (cond ((Math-primp expr)
	 (cond ((Math-zerop expr) 1)
	       ((Math-messy-integerp expr) (math-trunc expr))
	       ((Math-objectp expr) expr)
	       ((or (equal expr var) (not var)) 1)
	       (t expr)))
	((eq (car expr) '*)
	 (math-mul (calcFunc-pcont (nth 1 expr) var)
		   (calcFunc-pcont (nth 2 expr) var)))
	((eq (car expr) '/)
	 (math-div (calcFunc-pcont (nth 1 expr) var)
		   (calcFunc-pcont (nth 2 expr) var)))
	((and (eq (car expr) '^) (Math-natnump (nth 2 expr)))
	 (math-pow (calcFunc-pcont (nth 1 expr) var) (nth 2 expr)))
	((memq (car expr) '(neg polar))
	 (calcFunc-pcont (nth 1 expr) var))
	((consp var)
	 (let ((p (math-is-polynomial expr var)))
	   (if p
	       (let ((lead (nth (1- (length p)) p))
		     (cont (math-poly-gcd-list p)))
		 (if (math-guess-if-neg lead)
		     (math-neg cont)
		   cont))
	     1)))
	((memq (car expr) '(+ - cplx sdev))
	 (let ((cont (calcFunc-pcont (nth 1 expr) var)))
	   (if (eq cont 1)
	       1
	     (let ((c2 (calcFunc-pcont (nth 2 expr) var)))
	       (if (and (math-negp cont)
			(if (eq (car expr) '-) (math-posp c2) (math-negp c2)))
		   (math-neg (math-poly-gcd cont c2))
		 (math-poly-gcd cont c2))))))
	(var expr)
	(t 1)))