X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6e9ddbb313cf7db66550f93a74cbba12e39e93c0..9fcd66daf819294168e86ea5eb50c241b1d9fa11:/lisp/calc/calc-ext.el diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 818b19757b..67d0c2701d 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,6 +1,6 @@ ;;; calc-ext.el --- various extension functions for Calc -;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie ;; Maintainer: Jay Belanger @@ -61,7 +61,7 @@ (declare-function math-vector-is-string "calccomp" (a)) (declare-function math-vector-to-string "calccomp" (a &optional quoted)) (declare-function math-format-radix-float "calc-bin" (a prec)) -(declare-function math-compose-expr "calccomp" (a prec)) +(declare-function math-compose-expr "calccomp" (a prec &optional div)) (declare-function math-abs "calc-arith" (a)) (declare-function math-format-bignum-binary "calc-bin" (a)) (declare-function math-format-bignum-octal "calc-bin" (a)) @@ -460,6 +460,7 @@ (define-key calc-mode-map "mD" 'calc-default-simplify-mode) (define-key calc-mode-map "mE" 'calc-ext-simplify-mode) (define-key calc-mode-map "mF" 'calc-settings-file-name) + (define-key calc-mode-map "mI" 'calc-basic-simplify-mode) (define-key calc-mode-map "mM" 'calc-more-recursion-depth) (define-key calc-mode-map "mN" 'calc-num-simplify-mode) (define-key calc-mode-map "mO" 'calc-no-simplify-mode) @@ -560,6 +561,7 @@ (define-key calc-mode-map "ud" 'calc-define-unit) (define-key calc-mode-map "ue" 'calc-explain-units) (define-key calc-mode-map "ug" 'calc-get-unit-definition) + (define-key calc-mode-map "un" 'calc-convert-exact-units) (define-key calc-mode-map "up" 'calc-permanent-units) (define-key calc-mode-map "ur" 'calc-remove-units) (define-key calc-mode-map "us" 'calc-simplify-units) @@ -1095,11 +1097,11 @@ calc-tan calc-tanh calc-to-degrees calc-to-radians) ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode calc-always-load-extensions calc-auto-recompute calc-auto-why -calc-bin-simplify-mode calc-break-vectors calc-center-justify -calc-default-simplify-mode calc-display-raw calc-eng-notation -calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors -calc-full-vectors calc-get-modes calc-group-char calc-group-digits -calc-infinite-mode calc-left-justify calc-left-label +calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors +calc-center-justify calc-default-simplify-mode calc-display-raw +calc-eng-notation calc-ext-simplify-mode calc-fix-notation +calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char +calc-group-digits calc-infinite-mode calc-left-justify calc-left-label calc-line-breaking calc-line-numbering calc-matrix-brackets calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode @@ -1175,7 +1177,8 @@ calc-trail-scroll-right calc-trail-yank) ("calc-undo" calc-last-args calc-redo) ("calc-units" calc-autorange-units calc-base-units -calc-convert-temperature calc-convert-units calc-define-unit +calc-convert-temperature calc-convert-units +calc-convert-exact-units calc-define-unit calc-enter-units-table calc-explain-units calc-extract-units calc-get-unit-definition calc-permanent-units calc-quick-units calc-remove-units calc-simplify-units calc-undefine-unit @@ -1996,51 +1999,36 @@ calc-kill calc-kill-region calc-yank)))) (cache-val (intern (concat (symbol-name name) "-cache"))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) - (list 'progn -; (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'defvar cache-prec - `(cond - ((consp ,init) (math-numdigs (nth 1 ,init))) - (,init - (nth 1 (math-numdigs (eval ,init)))) - (t - -100))) - (list 'defvar cache-val - `(cond - ((consp ,init) ,init) - (,init (eval ,init)) - (t ,init))) - (list 'defvar last-prec -100) - (list 'defvar last-val nil) - (list 'setq 'math-cache-list - (list 'cons - (list 'quote cache-prec) - (list 'cons - (list 'quote last-prec) - 'math-cache-list))) - (list 'defun - name () - (list 'or - (list '= last-prec 'calc-internal-prec) - (list 'setq - last-val - (list 'math-normalize - (list 'progn - (list 'or - (list '>= cache-prec - 'calc-internal-prec) - (list 'setq - cache-val - (list 'let - '((calc-internal-prec - (+ calc-internal-prec - 4))) - form) - cache-prec - '(+ calc-internal-prec 2))) - cache-val)) - last-prec 'calc-internal-prec)) - last-val)))) + `(progn +; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) + (defvar ,cache-prec (cond + ((consp ,init) (math-numdigs (nth 1 ,init))) + (,init + (nth 1 (math-numdigs (eval ,init)))) + (t + -100))) + (defvar ,cache-val (cond ((consp ,init) ,init) + (,init (eval ,init)) + (t ,init))) + (defvar ,last-prec -100) + (defvar ,last-val nil) + (setq math-cache-list + (cons ',cache-prec + (cons ',last-prec + math-cache-list))) + (defun ,name () + (or (= ,last-prec calc-internal-prec) + (setq ,last-val + (math-normalize + (progn (or (>= ,cache-prec calc-internal-prec) + (setq ,cache-val + (let ((calc-internal-prec + (+ calc-internal-prec 4))) + ,form) + ,cache-prec (+ calc-internal-prec 2))) + ,cache-val)) + ,last-prec calc-internal-prec)) + ,last-val)))) (put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] @@ -2959,50 +2947,6 @@ If X is not an error form, return 1." (and x sigma (math-scalarp x) (math-anglep sigma) (list 'sdev x sigma)))) - ;; Hours (or degrees) - ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s) - (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s)) - (let* ((hours (math-match-substring s 1)) - (minsec (math-match-substring s 2)) - (hours (math-read-number hours)) - (minsec (if (> (length minsec) 0) (math-read-number minsec) 0))) - (and hours minsec - (math-num-integerp hours) - (not (math-negp hours)) (not (math-negp minsec)) - (cond ((math-num-integerp minsec) - (and (Math-lessp minsec 60) - (list 'hms hours minsec 0))) - ((and (eq (car-safe minsec) 'hms) - (math-zerop (nth 1 minsec))) - (math-add (list 'hms hours 0 0) minsec)) - (t nil))))) - - ;; Minutes - ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s) - (let* ((minutes (math-match-substring s 1)) - (seconds (math-match-substring s 2)) - (minutes (math-read-number minutes)) - (seconds (if (> (length seconds) 0) (math-read-number seconds) 0))) - (and minutes seconds - (math-num-integerp minutes) - (not (math-negp minutes)) (not (math-negp seconds)) - (cond ((math-realp seconds) - (and (Math-lessp minutes 60) - (list 'hms 0 minutes seconds))) - ((and (eq (car-safe seconds) 'hms) - (math-zerop (nth 1 seconds)) - (math-zerop (nth 2 seconds))) - (math-add (list 'hms 0 minutes 0) seconds)) - (t nil))))) - - ;; Seconds - ((string-match "^\\([^\"#^]+\\)[sS\"]$" s) - (let ((seconds (math-read-number (math-match-substring s 1)))) - (and seconds (math-realp seconds) - (not (math-negp seconds)) - (Math-lessp seconds 60) - (list 'hms 0 0 seconds)))) - ;; Integer+fraction with explicit radix ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s) (let ((radix (string-to-number (math-match-substring s 1))) @@ -3075,6 +3019,50 @@ If X is not an error form, return 1." (let ((digs (math-match-substring s 1))) (math-read-radix digs 16))) + ;; Hours (or degrees) + ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s) + (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s)) + (let* ((hours (math-match-substring s 1)) + (minsec (math-match-substring s 2)) + (hours (math-read-number hours)) + (minsec (if (> (length minsec) 0) (math-read-number minsec) 0))) + (and hours minsec + (math-num-integerp hours) + (not (math-negp hours)) (not (math-negp minsec)) + (cond ((math-num-integerp minsec) + (and (Math-lessp minsec 60) + (list 'hms hours minsec 0))) + ((and (eq (car-safe minsec) 'hms) + (math-zerop (nth 1 minsec))) + (math-add (list 'hms hours 0 0) minsec)) + (t nil))))) + + ;; Minutes + ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s) + (let* ((minutes (math-match-substring s 1)) + (seconds (math-match-substring s 2)) + (minutes (math-read-number minutes)) + (seconds (if (> (length seconds) 0) (math-read-number seconds) 0))) + (and minutes seconds + (math-num-integerp minutes) + (not (math-negp minutes)) (not (math-negp seconds)) + (cond ((math-realp seconds) + (and (Math-lessp minutes 60) + (list 'hms 0 minutes seconds))) + ((and (eq (car-safe seconds) 'hms) + (math-zerop (nth 1 seconds)) + (math-zerop (nth 2 seconds))) + (math-add (list 'hms 0 minutes 0) seconds)) + (t nil))))) + + ;; Seconds + ((string-match "^\\([^\"#^]+\\)[sS\"]$" s) + (let ((seconds (math-read-number (math-match-substring s 1)))) + (and seconds (math-realp seconds) + (not (math-negp seconds)) + (Math-lessp seconds 60) + (list 'hms 0 0 seconds)))) + ;; Fraction using "/" instead of ":" ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s) (math-read-number (concat (math-match-substring s 1) ":" @@ -3497,7 +3485,7 @@ If X is not an error form, return 1." (substring str i)))) str)) -;;; Users can redefine this in their .emacs files. +;;; Users can redefine this in their init files. (defvar calc-keypad-user-menu nil "If non-nil, this describes an additional menu for calc-keypad. It should contain a list of three rows.