X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/615a3b8d0d2c88cd664f1e0beb5a32b5b8e08f90..82e2a1f054cc0306494d1194036af4c5d7301caf:/lisp/calc/calc.el diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 60a84bdff3..517161a616 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,6 +1,6 @@ ;;; calc.el --- the GNU Emacs calculator -;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc. ;; Author: David Gillespie ;; Maintainer: Jay Belanger @@ -199,7 +199,7 @@ (declare-function calc-div-fractions "calc-frac" (a b)) (declare-function math-div-objects-fancy "calc-arith" (a b)) (declare-function math-div-symb-fancy "calc-arith" (a b)) -(declare-function math-compose-expr "calccomp" (a prec)) +(declare-function math-compose-expr "calccomp" (a prec &optional div)) (declare-function math-comp-width "calccomp" (c)) (declare-function math-composition-to-string "calccomp" (c &optional width)) (declare-function math-stack-value-offset-fancy "calccomp" ()) @@ -222,7 +222,7 @@ (defgroup calc nil - "GNU Calc." + "Advanced desk calculator and mathematical tool." :prefix "calc-" :tag "Calc" :group 'applications) @@ -418,6 +418,14 @@ in normal mode." :group 'calc :type 'boolean) +(defcustom calc-ensure-consistent-units + nil + "If non-nil, make sure new units are consistent with current units +when converting units." + :group 'calc + :version "24.3" + :type 'boolean) + (defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." @@ -431,27 +439,33 @@ If `calc-show-selections' is non-nil, then selected sub-formulas are shown by displaying the rest of the formula in `calc-nonselected-face'. If `calc-show-selections' is nil, then selected sub-formulas are shown by displaying the sub-formula in `calc-selected-face'." + :version "24.1" :group 'calc :type 'boolean) (defcustom calc-lu-field-reference "20 uPa" "The default reference level for logarithmic units (field)." + :version "24.1" :group 'calc :type '(string)) (defcustom calc-lu-power-reference "mW" "The default reference level for logarithmic units (power)." + :version "24.1" :group 'calc :type '(string)) (defcustom calc-note-threshold "1" "The number of cents that a frequency should be near a note to be identified as that note." + :version "24.1" :type 'string :group 'calc) +(defvar math-format-date-cache) ; calc-forms.el + (defface calc-nonselected-face '((t :inherit shadow :slant italic)) @@ -687,11 +701,11 @@ If `C' is present, display outer brackets for matrices (centered).") (defcalcmodevar calc-previous-modulo nil "Most recently used value of M in a modulo form.") -(defcalcmodevar calc-simplify-mode nil +(defcalcmodevar calc-simplify-mode 'alg "Type of simplification applied to results. If `none', results are not simplified when pushed on the stack. If `num', functions are simplified only when args are constant. -If nil, only fast simplifications are applied. +If nil, only limited simplifications are applied. If `binary', `math-clip' is applied if appropriate. If `alg', `math-simplify' is applied. If `ext', `math-simplify-extended' is applied. @@ -773,7 +787,9 @@ If nil, selections displayed but ignored.") "M-D-Y< H:mm:SSpp>" "D-M-Y< h:mm:SS>" "j<, h:mm:SS>" - "YYddd< hh:mm:ss>")) + "YYddd< hh:mm:ss>" + "ZYYY-MM-DD Www< hh:mm>" + "IYYY-Iww-w")) (defcalcmodevar calc-autorange-units nil "If non-nil, automatically set unit prefixes to keep units in a reasonable range.") @@ -813,7 +829,7 @@ If nil, selections displayed but ignored.") Used by `calc-user-invocation'.") (defcalcmodevar calc-show-banner t - "*If non-nil, show a friendly greeting above the stack.") + "If non-nil, show a friendly greeting above the stack.") (defconst calc-local-var-list '(calc-stack calc-stack-top @@ -901,35 +917,6 @@ Used by `calc-user-invocation'.") (defvar calc-embedded-mode-hook nil "Hook run when starting embedded mode.") -;; Set up the autoloading linkage. -(let ((name (and (fboundp 'calc-dispatch) - (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) - (nth 1 (symbol-function 'calc-dispatch)))) - (p load-path)) - - ;; If Calc files exist on the load-path, we're all set. - (while (and p (not (file-exists-p - (expand-file-name "calc-misc.elc" (car p))))) - (setq p (cdr p))) - (or p - - ;; If Calc is autoloaded using a path name, look there for Calc files. - ;; This works for both relative ("calc/calc.elc") and absolute paths. - (and name (file-name-directory name) - (let ((p2 load-path) - (name2 (concat (file-name-directory name) - "calc-misc.elc"))) - (while (and p2 (not (file-exists-p - (expand-file-name name2 (car p2))))) - (setq p2 (cdr p2))) - (when p2 - (setq load-path (nconc load-path - (list - (directory-file-name - (file-name-directory - (expand-file-name - name (car p2)))))))))))) - ;; The following modes use specially-formatted data. (put 'calc-mode 'mode-class 'special) (put 'calc-trail-mode 'mode-class 'special) @@ -1003,7 +990,7 @@ Used by `calc-user-invocation'.") (defvar calc-quick-prev-results nil "Previous results from Quick Calc.") (defvar calc-said-hello nil - "Non-nil if the welcomd message has been displayed.") + "Non-nil if the welcome message has been displayed.") (defvar calc-executing-macro nil "Non-nil if a keyboard macro is executing from the \"K\" key.") (defvar calc-any-selections nil @@ -1235,7 +1222,8 @@ Used by `calc-user-invocation'.") (glob (current-global-map)) (loc (current-local-map))) (or (input-pending-p) (message "%s" prompt)) - (let ((key (calc-read-key t))) + (let ((key (calc-read-key t)) + (input-method-function nil)) (calc-unread-command (cdr key)) (unwind-protect (progn @@ -1341,12 +1329,12 @@ Notations: 3.14e6 3.14 * 10^6 \\{calc-mode-map} " (interactive) - (mapc (function + (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) (kill-all-local-variables) (use-local-map (if (eq calc-algebraic-mode 'total) (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) - (mapc (function (lambda (v) (make-local-variable v))) calc-local-var-list) + (mapc #'make-local-variable calc-local-var-list) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) @@ -1383,7 +1371,7 @@ Notations: 3.14e6 3.14 * 10^6 (if calc-buffer-list (setq calc-stack (copy-sequence calc-stack))) (add-to-list 'calc-buffer-list (current-buffer) t)) -(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks +(defvar calc-check-defines 'calc-check-defines) ; Suitable for run-hooks. (defun calc-check-defines () (if (symbol-plist 'calc-define) (let ((plist (copy-sequence (symbol-plist 'calc-define)))) @@ -1745,10 +1733,10 @@ See calc-keypad for details." ((eq calc-simplify-mode 'num) "NumSimp ") ((eq calc-simplify-mode 'binary) (format "BinSimp%d " calc-word-size)) - ((eq calc-simplify-mode 'alg) "AlgSimp ") + ((eq calc-simplify-mode 'alg) "") ((eq calc-simplify-mode 'ext) "ExtSimp ") ((eq calc-simplify-mode 'units) "UnitSimp ") - (t "")) + (t "BasicSimp ")) ;; Display modes (cond ((= calc-number-radix 10) "") @@ -1931,8 +1919,7 @@ See calc-keypad for details." (delete-region (point) (point-max)))) (calc-set-command-flag 'renum-stack)))))) -(defvar sel-mode) -(defun calc-get-stack-element (x) +(defun calc-get-stack-element (x &optional sel-mode) (cond ((eq sel-mode 'entry) x) ((eq sel-mode 'sel) @@ -1949,9 +1936,9 @@ See calc-keypad for details." (defun calc-top (&optional n sel-mode) (or n (setq n 1)) (calc-check-stack n) - (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))) + (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack) sel-mode)) -(defun calc-top-n (&optional n sel-mode) ; in case precision has changed +(defun calc-top-n (&optional n sel-mode) ; In case precision has changed. (math-check-complete (calc-normalize (calc-top n sel-mode)))) (defun calc-top-list (&optional n m sel-mode) @@ -1962,7 +1949,8 @@ See calc-keypad for details." (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) calc-stack)))) (setcdr (nthcdr (1- n) top) nil) - (nreverse (mapcar 'calc-get-stack-element top))))) + (nreverse + (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) (defun calc-top-list-n (&optional n m sel-mode) (mapcar 'math-check-complete @@ -2036,6 +2024,50 @@ See calc-keypad for details." (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) +;; Dates that are built-in options for `calc-gregorian-switch' should be +;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. +(defcustom calc-gregorian-switch nil + "The first day the Gregorian calendar is used by Calc's date forms. +This is `nil' (the default) if the Gregorian calendar is the only one used. +Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use +the Gregorian calendar; Calc will use the Julian calendar for earlier dates. +The dates in which different regions of the world began to use the +Gregorian calendar vary quite a bit, even within a single country. +If you want Calc's date forms to switch between the Julian and +Gregorian calendar, you can specify the date or choose from several +common choices. Some of these choices should be taken with a grain +of salt; for example different parts of France changed calendars at +different times, and Sweden's change to the Gregorian calendar was +complicated. Also, the boundaries of the countries were different at +the times of the calendar changes than they are now. +The Vatican decided that the Gregorian calendar should take effect +on 15 October 1582 (Gregorian), and many Catholic countries made +the change then. Great Britain and its colonies had the Gregorian +calendar take effect on 14 September 1752 (Gregorian); this includes +the United States." + :group 'calc + :version "24.4" + :type '(choice (const :tag "Always use the Gregorian calendar" nil) + (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) + (const :tag "1582-12-20 - France" (1582 12 20 577802)) + (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807)) + (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195)) + (const :tag "1587-11-01 - Hungary" (1587 11 1 579579)) + (const :tag "1700-03-01 - Denmark" (1700 3 1 620607)) + (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924)) + (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797)) + (const :tag "1753-03-01 - Sweden" (1753 3 1 639965)) + (const :tag "1918-02-14 - Russia" (1918 2 14 700214)) + (const :tag "1919-04-14 - Romania" (1919 4 14 700638)) + (list :tag "(YEAR MONTH DAY)" + (integer :tag "Year") + (integer :tag "Month (integer)") + (integer :tag "Day"))) + :set (lambda (symbol value) + (set-default symbol value) + (setq math-format-date-cache nil) + (calc-refresh))) + ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned () @@ -2571,7 +2603,11 @@ largest Emacs integer.") ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] (defvar math-normalize-a) +(defvar math-normalize-error nil + "Non-nil if the last call the `math-normalize' returned an error.") + (defun math-normalize (math-normalize-a) + (setq math-normalize-error nil) (cond ((not (consp math-normalize-a)) (if (integerp math-normalize-a) @@ -2660,31 +2696,38 @@ largest Emacs integer.") (fboundp (car math-normalize-a)))) (apply (car math-normalize-a) args))))) (wrong-number-of-arguments + (setq math-normalize-error t) (calc-record-why "*Wrong number of arguments" (cons (car math-normalize-a) args)) nil) (wrong-type-argument + (setq math-normalize-error t) (or calc-next-why (calc-record-why "Wrong type of argument" (cons (car math-normalize-a) args))) nil) (args-out-of-range + (setq math-normalize-error t) (calc-record-why "*Argument out of range" (cons (car math-normalize-a) args)) nil) (inexact-result + (setq math-normalize-error t) (calc-record-why "No exact representation for result" (cons (car math-normalize-a) args)) nil) (math-overflow + (setq math-normalize-error t) (calc-record-why "*Floating-point overflow occurred" (cons (car math-normalize-a) args)) nil) (math-underflow + (setq math-normalize-error t) (calc-record-why "*Floating-point underflow occurred" (cons (car math-normalize-a) args)) nil) (void-variable + (setq math-normalize-error t) (if (eq (nth 1 err) 'var-EvalRules) (progn (setq var-EvalRules nil)