view lisp/calc/calc-macs.el @ 104513:a6a812dd2d88

* cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix. * cedet/semantic/idle.el (semantic-before-idle-scheduler-reparse-hook) (semantic-after-idle-scheduler-reparse-hook): Rename from *-hooks. Make old name an obsolete alias. * cedet/semantic/edit.el (semantic-after-partial-cache-change-hook) (semantic-change-hooks, semantic-edits-new-change-hooks) (semantic-edits-delete-change-hooks) (semantic-edits-move-change-hook) (semantic-edits-reparse-change-hooks) (semantic-edits-incremental-reparse-failed-hooks): Doc fixes. * cedet/semantic/debug.el (semantic-debug-mode): Rename hook symbols. * cedet/semantic/db-mode.el (semanticdb-mode-hook): Rename from semanticdb-mode-hooks. (global-semanticdb-minor-mode): Use the new name. (semanticdb-hooks): Use semantic-init-db-hook instead of obsolete alias semantic-init-db-hooks. * cedet/semantic/db-global.el (semanticdb-enable-gnu-global-databases): Use semantic-init-hook instead of obsolete alias semantic-init-hooks. * cedet/semantic/db-file.el (semanticdb-save-database-hook): Rename from semanticdb-save-database-hooks. Make old name an obsolete alias. * cedet/semantic/decorate/mode.el (semantic-decorate-pending-decoration-hook): Rename from semantic-decorate-pending-decoration-hooks. Make old name an obsolete alias. * cedet/srecode/map.el (srecode-map-validate-file-for-mode): Use semantic-init-hook instead of obsolete alias semantic-init-hooks. * cedet/semantic/fw.el (semantic-find-file-noselect): Use semantic-init-hook instead of obsolete alias semantic-init-hooks. * cedet/ede/project-am.el (project-am-with-makefile-current): Use semantic-init-hook instead of obsolete alias semantic-init-hooks. * cedet/semantic/util.el (semantic-describe-buffer): Use semantic-init-hook and semantic-init-db-hook instead of obsolete aliases. * cedet/semantic/util-modes.el (semantic-mode-line-update) (semantic-toggle-minor-mode-globally): Use semantic-init-hook instead of obsolete alias semantic-init-hooks. Synch to Eric Ludlam's upstream CEDET repository: * cedet/semantic/bovine/c.el (semantic-c-parse-token-hack-depth): New var. (semantic-c-parse-lexical-token): Save match data when setting up the secondary parse buffer. Allow recursion. Protect against initializing the major mode from throwing errors, ie user hooks. * cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): Protect installing a major mode from throwing errors.

;;; calc-macs.el --- important macros for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Jay Belanger <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

;; Declare functions which are defined elsewhere.
(declare-function math-zerop "calc-misc" (a))
(declare-function math-negp "calc-misc" (a))
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
(declare-function math-bignum "calc" (a))
(declare-function math-compare-bignum "calc-ext" (a b))


(defmacro calc-wrapper (&rest body)
  `(calc-do (function (lambda ()
			,@body))))

(defmacro calc-slow-wrapper (&rest body)
  `(calc-do
    (function (lambda () ,@body)) (point)))

(defmacro math-showing-full-precision (form)
  `(let ((calc-float-format calc-full-float-format))
     ,form))

(defmacro math-with-extra-prec (delta &rest body)
  `(math-normalize
    (let ((calc-internal-prec (+ calc-internal-prec ,delta)))
      ,@body)))

(defmacro math-working (msg arg)	; [Public]
  `(if (eq calc-display-working-message 'lots)
       (math-do-working ,msg ,arg)))

(defmacro calc-with-default-simplification (&rest body)
  `(let ((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
				  calc-simplify-mode)))
     ,@body))

(defmacro calc-with-trail-buffer (&rest body)
  `(let ((save-buf (current-buffer))
	 (calc-command-flags nil))
     (with-current-buffer (calc-trail-display t)
       (progn
	 (goto-char calc-trail-pointer)
	 ,@body))))

;;; Faster in-line version zerop, normalized values only.
(defsubst Math-zerop (a)		; [P N]
  (if (consp a)
      (and (not (memq (car a) '(bigpos bigneg)))
	   (if (eq (car a) 'float)
	       (eq (nth 1 a) 0)
	     (math-zerop a)))
    (eq a 0)))

(defsubst Math-integer-negp (a)
  (if (consp a)
      (eq (car a) 'bigneg)
    (< a 0)))

(defsubst Math-integer-posp (a)
  (if (consp a)
      (eq (car a) 'bigpos)
    (> a 0)))

(defsubst Math-negp (a)
  (if (consp a)
      (or (eq (car a) 'bigneg)
	  (and (not (eq (car a) 'bigpos))
	       (if (memq (car a) '(frac float))
		   (Math-integer-negp (nth 1 a))
		 (math-negp a))))
    (< a 0)))

(defsubst Math-looks-negp (a)		; [P x] [Public]
  (or (Math-negp a)
      (and (consp a) (or (eq (car a) 'neg)
			 (and (memq (car a) '(* /))
			      (or (math-looks-negp (nth 1 a))
				  (math-looks-negp (nth 2 a))))))))

(defsubst Math-posp (a)
  (if (consp a)
      (or (eq (car a) 'bigpos)
	  (and (not (eq (car a) 'bigneg))
	       (if (memq (car a) '(frac float))
		   (Math-integer-posp (nth 1 a))
		 (math-posp a))))
    (> a 0)))

(defsubst Math-integerp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg))))

(defsubst Math-natnump (a)
  (if (consp a)
      (eq (car a) 'bigpos)
    (>= a 0)))

(defsubst Math-ratp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac))))

(defsubst Math-realp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float))))

(defsubst Math-anglep (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float hms))))

(defsubst Math-numberp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar))))

(defsubst Math-scalarp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar hms))))

(defsubst Math-vectorp (a)
  (and (consp a) (eq (car a) 'vec)))

(defsubst Math-messy-integerp (a)
  (and (consp a)
       (eq (car a) 'float)
       (>= (nth 2 a) 0)))

(defsubst Math-objectp (a)		;  [Public]
  (or (not (consp a))
      (memq (car a)
	    '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))

(defsubst Math-objvecp (a)		;  [Public]
  (or (not (consp a))
      (memq (car a)
	    '(bigpos bigneg frac float cplx polar hms date
		     sdev intv mod vec))))

;;; Compute the negative of A.  [O O; o o] [Public]
(defsubst Math-integer-neg (a)
  (if (consp a)
      (if (eq (car a) 'bigpos)
	  (cons 'bigneg (cdr a))
	(cons 'bigpos (cdr a)))
    (- a)))

(defsubst Math-equal (a b)
  (= (math-compare a b) 0))

(defsubst Math-lessp (a b)
  (= (math-compare a b) -1))

(defsubst Math-primp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg frac float cplx polar
			     hms date mod var))))

(defsubst Math-num-integerp (a)
  (or (not (consp a))
      (memq (car a) '(bigpos bigneg))
      (and (eq (car a) 'float)
	   (>= (nth 2 a) 0))))

(defsubst Math-bignum-test (a)		; [B N; B s; b b]
  (if (consp a)
      a
    (math-bignum a)))

(defsubst Math-equal-int (a b)
  (or (eq a b)
      (and (consp a)
	   (eq (car a) 'float)
	   (eq (nth 1 a) b)
	   (= (nth 2 a) 0))))

(defsubst Math-natnum-lessp (a b)
  (if (consp a)
      (and (consp b)
	   (= (math-compare-bignum (cdr a) (cdr b)) -1))
    (or (consp b)
	(< a b))))

(provide 'calc-macs)

;; arch-tag: 08ba8ec2-fcff-4b80-a079-ec661bdb057e
;;; calc-macs.el ends here