Function: math-do-defmath

math-do-defmath is an autoloaded and byte-compiled function defined in calc-prog.el.gz.

Signature

(math-do-defmath FUNC ARGS BODY)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-prog.el.gz
;;;; User-programmability.

;;; 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))
		  (prog1 (list (car body))
		    (setq body (cdr body)))))
	 (clargs (mapcar 'math-clean-arg args))
	 (inter (if (and (consp (car body))
			 (eq (car (car body)) 'interactive))
		    (prog1 (car body)
		      (setq body (cdr body))))))
    (setq body (math-define-function-body body clargs))
    `(progn
       ,(if inter
	    (if (or (> (length inter) 2)
		    (integerp (nth 1 inter)))
		(let ((hasprefix nil) (hasmulti nil))
		  (when (stringp (nth 1 inter))
		    (cond ((equal (nth 1 inter) "p")
			   (setq hasprefix t))
			  ((equal (nth 1 inter) "m")
			   (setq hasmulti t))
			  (t (error
			      "Can't handle interactive code string \"%s\""
			      (nth 1 inter))))
		    (setq inter (cdr inter)))
		  (unless (integerp (nth 1 inter))
		    (error "Expected an integer in interactive specification"))
		  `(defun ,(intern (concat "calc-" (symbol-name func)))
		     ,(if (or hasprefix hasmulti) '(&optional n) ())
		     ,@doc
		     (interactive ,@(if (or hasprefix hasmulti) '("P")))
		     (calc-slow-wrapper
		      ,@(if hasmulti
			    `((setq n (if n
					  (prefix-numeric-value n)
					,(nth 1 inter)))))
		      (calc-enter-result
		       ,(if hasmulti 'n (nth 1 inter))
		       ,(nth 2 inter)
		       ,(if hasprefix
			    `(append '(,fname)
				     (calc-top-list-n ,(nth 1 inter))
				     (and n
					  (list
					   (math-normalize
					    (prefix-numeric-value n)))))
			  `(cons ',fname
				 (calc-top-list-n
				  ,(if hasmulti
				       'n
				     (nth 1 inter)))))))))
	      `(defun ,(intern (concat "calc-" (symbol-name func))) ,clargs
		 ,@doc
		 ,inter
		 (calc-wrapper ,@body))))
       (defun ,fname ,clargs
	 ,@doc
	 ,@(math-do-arg-list-check args nil nil)
	 ,@body))))