diff options
Diffstat (limited to 'lisp/calc')
46 files changed, 1294 insertions, 499 deletions
diff --git a/lisp/calc/.arch-inventory b/lisp/calc/.arch-inventory deleted file mode 100644 index e4e8f8239ce..00000000000 --- a/lisp/calc/.arch-inventory +++ /dev/null @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(.*-loaddefs)\.el$ - -# arch-tag: 5258f69e-459b-449b-bdd7-bdbd5f948cb9 diff --git a/lisp/calc/README b/lisp/calc/README index 0b759ff9bbc..308b5115aa2 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -1,13 +1,11 @@ -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 - Free Software Foundation, Inc. +Copyright (C) 2001-2011 Free Software Foundation, Inc. See the end of the file for license conditions. This directory contains Calc, an advanced desk calculator for GNU Emacs. -"Calc" Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +"Calc" Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. Written by: Dave Gillespie @@ -72,6 +70,23 @@ opinions. Summary of changes to "Calc" ------- -- ------- -- ---- +Emacs 24.1 + +* Support for musical notes added. + +* Support for logarithmic units added. + +* Calc no longer uses the tex prefix for TeX specific unit +names when using TeX or LaTeX mode. + +* Added option to highlight selections using faces. + +* Gave `calc-histogram' the option of using a vector to determine the bins. + +* Added "O" option prefix. + +* Used "O" prefix to "d r" (`calc-radix') to turn on twos-complement mode. + Emacs 23.2 * Added twos-complement display. diff --git a/lisp/calc/README.prev b/lisp/calc/README.prev index 2f74223252b..69da211efc2 100644 --- a/lisp/calc/README.prev +++ b/lisp/calc/README.prev @@ -1,5 +1,4 @@ -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 - Free Software Foundation, Inc. +Copyright (C) 2001-2011 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index ca8a2feff1c..00e07aba6a5 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -1,7 +1,6 @@ ;;; calc-aent.el --- algebraic entry functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -315,10 +314,24 @@ The value t means abort and give an error message.") calc-dollar-used 0))) (calc-handle-whys)))) -(defvar calc-alg-ent-map nil +(defvar calc-alg-ent-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "'" 'calcAlg-previous) + (define-key map "`" 'calcAlg-edit) + (define-key map "\C-m" 'calcAlg-enter) + (define-key map "\C-j" 'calcAlg-enter) + map) "The keymap used for algebraic entry.") -(defvar calc-alg-ent-esc-map nil +(defvar calc-alg-ent-esc-map + (let ((map (make-keymap)) + (i 33)) + (set-keymap-parent map esc-map) + (while (< i 127) + (define-key map (vector i) 'calcAlg-escape) + (setq i (1+ i))) + map) "The keymap used for escapes in algebraic entry.") (defvar calc-alg-exp) @@ -326,19 +339,8 @@ The value t means abort and give an error message.") ;;;###autoload (defun calc-do-alg-entry (&optional initial prompt no-normalize history) (let* ((calc-buffer (current-buffer)) - (blink-paren-function 'calcAlg-blink-matching-open) + (blink-matching-check-function 'calcAlg-blink-matching-check) (calc-alg-exp 'error)) - (unless calc-alg-ent-map - (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) - (define-key calc-alg-ent-map "'" 'calcAlg-previous) - (define-key calc-alg-ent-map "`" 'calcAlg-edit) - (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) - (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) - (let ((i 33)) - (setq calc-alg-ent-esc-map (copy-keymap esc-map)) - (while (< i 127) - (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) - (setq i (1+ i))))) (define-key calc-alg-ent-map "\e" nil) (if (eq calc-algebraic-mode 'total) (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) @@ -430,18 +432,9 @@ The value t means abort and give an error message.") exp)) (exit-minibuffer)))) -(defun calcAlg-blink-matching-open () - (let ((rightpt (point)) - (leftpt nil) - (rightchar (preceding-char)) - leftchar - rightsyntax - leftsyntax) - (save-excursion - (condition-case () - (setq leftpt (scan-sexps rightpt -1) - leftchar (char-after leftpt)) - (error nil))) +(defun calcAlg-blink-matching-check (leftpt rightpt) + (let ((rightchar (char-before rightpt)) + (leftchar (if leftpt (char-after leftpt)))) (if (and leftpt (or (and (= rightchar ?\)) (= leftchar ?\[)) @@ -450,20 +443,9 @@ The value t means abort and give an error message.") (save-excursion (goto-char leftpt) (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) - (let ((leftsaved (aref (syntax-table) leftchar)) - (rightsaved (aref (syntax-table) rightchar))) - (unwind-protect - (progn - (cond ((= leftchar ?\[) - (aset (syntax-table) leftchar (cons 4 ?\))) - (aset (syntax-table) rightchar (cons 5 ?\[))) - (t - (aset (syntax-table) leftchar (cons 4 ?\])) - (aset (syntax-table) rightchar (cons 5 ?\()))) - (blink-matching-open)) - (aset (syntax-table) leftchar leftsaved) - (aset (syntax-table) rightchar rightsaved))) - (blink-matching-open)))) + ;; [2..5) perfectly valid! + nil + (blink-matching-check-mismatch leftpt rightpt)))) ;;;###autoload (defun calc-alg-digit-entry () @@ -510,6 +492,7 @@ The value t means abort and give an error message.") ("≥" ">=") ("≦" "<=") ("≧" ">=") + ("µ" "μ") ;; fractions ("¼" "(1:4)") ; 1/4 ("½" "(1:2)") ; 1/2 @@ -608,9 +591,9 @@ in Calc algebraic input.") (setq math-exp-str (math-remove-percentsigns math-exp-str))) (if calc-language-input-filter (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) - (while (setq math-exp-token + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) - (setq math-exp-str + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) @@ -675,11 +658,11 @@ in Calc algebraic input.") (cond ((and (stringp (car p)) (or (> (length (car p)) 1) (equal (car p) "$") (equal (car p) "\"")) - (string-match "[^a-zA-Z0-9]" (car p))) + (string-match "[^a-zA-Zα-ωΑ-Ω0-9]" (car p))) (let ((s (regexp-quote (car p)))) - (if (string-match "\\`[a-zA-Z0-9]" s) + (if (string-match "\\`[a-zA-Zα-ωΑ-Ω0-9]" s) (setq s (concat "\\<" s))) - (if (string-match "[a-zA-Z0-9]\\'" s) + (if (string-match "[a-zA-Zα-ωΑ-Ω0-9]\\'" s) (setq s (concat s "\\>"))) (or (assoc s math-toks) (progn @@ -711,22 +694,24 @@ in Calc algebraic input.") (math-read-token))) ((and (memq ch calc-user-token-chars) (let ((case-fold-search nil)) - (eq (string-match + (eq (string-match calc-user-tokens math-exp-str math-exp-pos) math-exp-pos))) (setq math-exp-token 'punc math-expr-data (math-match-substring math-exp-str 0) math-exp-pos (match-end 0))) ((or (and (>= ch ?a) (<= ch ?z)) - (and (>= ch ?A) (<= ch ?Z))) - (string-match + (and (>= ch ?A) (<= ch ?Z)) + (and (>= ch ?α) (<= ch ?ω)) + (and (>= ch ?Α) (<= ch ?Ω))) + (string-match (cond ((and (memq calc-language calc-lang-allow-underscores) (memq calc-language calc-lang-allow-percentsigns)) - "[a-zA-Z0-9_'#]*") + "[a-zA-Zα-ωΑ-Ω0-9_'#]*") ((memq calc-language calc-lang-allow-underscores) - "[a-zA-Z0-9_#]*") - (t "[a-zA-Z0-9'#]*")) + "[a-zA-Zα-ωΑ-Ω0-9_#]*") + (t "[a-zA-Zα-ωΑ-Ω0-9'#]*")) math-exp-str math-exp-pos) (setq math-exp-token 'symbol math-exp-pos (match-end 0) @@ -742,19 +727,19 @@ in Calc algebraic input.") (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) math-exp-pos) (or (eq math-exp-pos 0) - (and (not (memq calc-language + (and (not (memq calc-language calc-lang-allow-underscores)) - (eq (string-match "[^])}\"a-zA-Z0-9'$]_" + (eq (string-match "[^])}\"a-zA-Zα-ωΑ-Ω0-9'$]_" math-exp-str (1- math-exp-pos)) (1- math-exp-pos)))))) (or (and (memq calc-language calc-lang-c-type-hex) (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) - (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" + (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Zα-ωΑ-Ω:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" math-exp-str math-exp-pos)) (setq math-exp-token 'number math-expr-data (math-match-substring math-exp-str 0) math-exp-pos (match-end 0))) - ((and (setq adfn + ((and (setq adfn (assq ch (get calc-language 'math-lang-read-symbol))) (eval (nth 1 adfn))) (eval (nth 2 adfn))) @@ -807,8 +792,8 @@ in Calc algebraic input.") (defun math-read-expr-level (exp-prec &optional exp-term) (let* ((math-expr-opers (math-expr-ops)) - (x (math-read-factor)) - (first t) + (x (math-read-factor)) + (first t) op op2) (while (and (or (and calc-user-parse-table (setq op (calc-check-user-syntax x exp-prec)) @@ -829,8 +814,8 @@ in Calc algebraic input.") (memq math-exp-token '(symbol number dollar hash)) (equal math-expr-data "(") (and (equal math-expr-data "[") - (not (equal - (get calc-language + (not (equal + (get calc-language 'math-function-open) "[")) (not (and math-exp-keep-spaces (eq (car-safe x) 'vec))))) @@ -1138,8 +1123,8 @@ If the current Calc language does not use placeholders, return nil." (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) - (if (and (memq calc-language - calc-lang-parens-are-subscripts) + (if (and (memq calc-language + calc-lang-parens-are-subscripts) args (require 'calc-ext) (let ((calc-matrix-mode 'scalar)) @@ -1181,7 +1166,7 @@ If the current Calc language does not use placeholders, return nil." (substring (symbol-name (cdr v)) 4)) (cdr v)))))) - (while (and (memq calc-language + (while (and (memq calc-language calc-lang-brackets-are-subscripts) (equal math-expr-data "[")) (math-read-token) @@ -1281,8 +1266,8 @@ If the current Calc language does not use placeholders, return nil." (provide 'calc-aent) ;; Local variables: +;; coding: utf-8 ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: 5599e45d-e51e-44bb-9a20-9f4ed8c96c32 ;;; calc-aent.el ends here diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 453aa78712e..728acf5b0f1 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -1,7 +1,6 @@ ;;; calc-alg.el --- algebraic functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1659,11 +1658,11 @@ ;; math-is-poly-rec. (defvar math-is-poly-degree) (defvar math-is-poly-loose) -(defvar var) +(defvar math-var) -(defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose) +(defun math-is-polynomial (expr math-var &optional math-is-poly-degree math-is-poly-loose) (let* ((math-poly-base-variable (if math-is-poly-loose - (if (eq math-is-poly-loose 'gen) var '(var XXX XXX)) + (if (eq math-is-poly-loose 'gen) math-var '(var XXX XXX)) math-poly-base-variable)) (poly (math-is-poly-rec expr math-poly-neg-powers))) (and (or (null math-is-poly-degree) @@ -1672,11 +1671,11 @@ (defun math-is-poly-rec (expr negpow) (math-poly-simplify - (or (cond ((or (equal expr var) + (or (cond ((or (equal expr math-var) (eq (car-safe expr) '^)) (let ((pow 1) (expr expr)) - (or (equal expr var) + (or (equal expr math-var) (setq pow (nth 2 expr) expr (nth 1 expr))) (or (eq math-poly-mult-powers 1) @@ -1690,7 +1689,7 @@ (equal math-poly-mult-powers (nth 1 m)) (setq math-poly-mult-powers (nth 1 m))) - (or (equal expr var) + (or (equal expr math-var) (eq math-poly-mult-powers 1)) (car m))))) (if (consp pow) @@ -1698,7 +1697,7 @@ (setq pow (math-to-simple-fraction pow)) (and (eq (car-safe pow) 'frac) math-poly-frac-powers - (equal expr var) + (equal expr math-var) (setq math-poly-frac-powers (calcFunc-lcm math-poly-frac-powers (nth 2 pow)))))) @@ -1706,10 +1705,10 @@ (setq pow (math-mul pow math-poly-frac-powers))) (if (integerp pow) (if (and (= pow 1) - (equal expr var)) + (equal expr math-var)) (list 0 1) (if (natnump pow) - (let ((p1 (if (equal expr var) + (let ((p1 (if (equal expr math-var) (list 0 1) (math-is-poly-rec expr nil))) (n pow) @@ -1749,7 +1748,7 @@ math-is-poly-degree)) (math-poly-mul p1 p2)))))) ((eq (car expr) '/) - (and (or (not (math-poly-depends (nth 2 expr) var)) + (and (or (not (math-poly-depends (nth 2 expr) math-var)) (and negpow (math-is-poly-rec (nth 2 expr) nil) (setq math-poly-neg-powers @@ -1759,13 +1758,13 @@ (mapcar (function (lambda (x) (math-div x (nth 2 expr)))) p1)))) ((and (eq (car expr) 'calcFunc-exp) - (equal var '(var e var-e))) - (math-is-poly-rec (list '^ var (nth 1 expr)) negpow)) + (equal math-var '(var e var-e))) + (math-is-poly-rec (list '^ math-var (nth 1 expr)) negpow)) ((and (eq (car expr) 'calcFunc-sqrt) math-poly-frac-powers) (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow)) (t nil)) - (and (or (not (math-poly-depends expr var)) + (and (or (not (math-poly-depends expr math-var)) math-is-poly-loose) (not (eq (car expr) 'vec)) (list expr))))) @@ -1914,5 +1913,4 @@ (provide 'calc-alg) -;; arch-tag: 52e7dcdf-9688-464d-a02b-4bbe789348d0 ;;; calc-alg.el ends here diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index bec3c0661cc..a557e5fb92d 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -1,7 +1,6 @@ ;;; calc-arith.el --- arithmetic functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -3067,5 +3066,4 @@ (provide 'calc-arith) -;; arch-tag: 6c396b5b-14c6-40ed-bb2a-7cc2e8111465 ;;; calc-arith.el ends here diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index dcf0245d93e..20b4a9db5e2 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -1,7 +1,6 @@ ;;; calc-bin.el --- binary functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -175,7 +174,7 @@ the size of a Calc bignum digit.") (progn (calc-change-mode (list 'calc-number-radix 'calc-twos-complement-mode) - (list n (and (or (= n 2) (= n 8) (= n 16)) arg)) t) + (list n (or arg (calc-is-option))) t) ;; also change global value so minibuffer sees it (setq-default calc-number-radix calc-number-radix)) (setq n calc-number-radix)) @@ -845,6 +844,8 @@ the size of a Calc bignum digit.") (len (length num))) (if (< len digs) (setq num (concat (make-string (- digs len) ?0) num)))) + (when calc-group-digits + (setq num (math-group-float num))) (concat (number-to-string calc-number-radix) "##" @@ -852,5 +853,4 @@ the size of a Calc bignum digit.") (provide 'calc-bin) -;; arch-tag: f6dba7bc-53b2-41ae-919c-c266ab0ca8b3 ;;; calc-bin.el ends here diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index a282a4fbf2c..da5bae69803 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -1,7 +1,6 @@ ;;; calc-comb.el --- combinatoric functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1027,5 +1026,4 @@ (provide 'calc-comb) -;; arch-tag: 1d75ee9b-0815-42bd-a321-bb3dc001cc02 ;;; calc-comb.el ends here diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index 88df0c385f2..f2e0c493144 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -1,7 +1,6 @@ ;;; calc-cplx.el --- Complex number functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -355,5 +354,4 @@ (provide 'calc-cplx) -;; arch-tag: de73a331-941c-4507-ae76-46c76adc70dd ;;; calc-cplx.el ends here diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 74ab819de3f..f011d187a42 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -1,7 +1,6 @@ ;;; calc-embed.el --- embed Calc in a buffer -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1382,5 +1381,4 @@ The command \\[yank] can retrieve it from there." ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: 1b8f311e-fba1-40d3-b8c3-1d6f68fd26fc ;;; calc-embed.el ends here diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index c806b84fd57..9ea773fbb98 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,7 +1,6 @@ ;;; calc-ext.el --- various extension functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -104,6 +103,7 @@ (define-key calc-mode-map "J" 'calc-conj) (define-key calc-mode-map "L" 'calc-ln) (define-key calc-mode-map "N" 'calc-eval-num) + (define-key calc-mode-map "O" 'calc-option) (define-key calc-mode-map "P" 'calc-pi) (define-key calc-mode-map "Q" 'calc-sqrt) (define-key calc-mode-map "R" 'calc-round) @@ -135,8 +135,6 @@ (define-key calc-mode-map "\C-w" 'calc-kill-region) (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) (define-key calc-mode-map "\M-\C-w" 'kill-ring-save) - (define-key calc-mode-map "\C-_" 'calc-undo) - (define-key calc-mode-map "\C-xu" 'calc-undo) (define-key calc-mode-map "\M-\C-m" 'calc-last-args) (define-key calc-mode-map "a" nil) @@ -423,6 +421,20 @@ (define-key calc-mode-map "kP" 'calc-utpp) (define-key calc-mode-map "kT" 'calc-utpt) + (define-key calc-mode-map "l" nil) + (define-key calc-mode-map "lq" 'calc-lu-quant) + (define-key calc-mode-map "ld" 'calc-db) + (define-key calc-mode-map "ln" 'calc-np) + (define-key calc-mode-map "l+" 'calc-lu-plus) + (define-key calc-mode-map "l-" 'calc-lu-minus) + (define-key calc-mode-map "l*" 'calc-lu-times) + (define-key calc-mode-map "l/" 'calc-lu-divide) + (define-key calc-mode-map "ls" 'calc-spn) + (define-key calc-mode-map "lm" 'calc-midi) + (define-key calc-mode-map "lf" 'calc-freq) + + (define-key calc-mode-map "l?" 'calc-l-prefix-help) + (define-key calc-mode-map "m" nil) (define-key calc-mode-map "m?" 'calc-m-prefix-help) (define-key calc-mode-map "ma" 'calc-algebraic-mode) @@ -931,7 +943,11 @@ calc-store-value calc-var-name) ("calc-stuff" calc-explain-why calcFunc-clean calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) - ("calc-units" calcFunc-usimplify + ("calc-units" calcFunc-usimplify calcFunc-lufadd calcFunc-lupadd +calcFunc-lufsub calcFunc-lupsub calcFunc-lufmul calcFunc-lupmul +calcFunc-lufdiv calcFunc-lupdiv calcFunc-lufquant calcFunc-lupquant +calcFunc-dbfield calcFunc-dbpower calcFunc-npfield +calcFunc-nppower calcFunc-spn calcFunc-midi calcFunc-freq math-build-units-table math-build-units-table-buffer math-check-unit-name math-convert-temperature math-convert-units math-extract-units math-remove-units math-simplify-units @@ -959,7 +975,7 @@ math-read-brackets math-reduce-cols math-reduce-vec math-transpose) ("calc-yank" calc-alg-edit calc-clean-newlines calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit -calc-copy-to-register calc-insert-register +calc-copy-to-register calc-insert-register calc-append-to-register calc-prepend-to-register calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) @@ -988,7 +1004,7 @@ calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) ("calc-bin" calc-and calc-binary-radix calc-clip calc-twos-complement-mode -calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros +calc-decimal-radix calc-diff calc-hex-radix calc-leading-zeros calc-lshift-arith calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size calc-xor) @@ -1045,10 +1061,11 @@ calc-graph-zero-x calc-graph-zero-y) calc-d-prefix-help calc-describe-function calc-describe-key calc-describe-key-briefly calc-describe-variable calc-f-prefix-help calc-full-help calc-g-prefix-help calc-help-prefix -calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help +calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help calc-option-prefix-help calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help -calc-t-prefix-help calc-u-prefix-help calc-v-prefix-help) +calc-t-prefix-help calc-u-prefix-help calc-l-prefix-help +calc-v-prefix-help) ("calc-incom" calc-begin-complex calc-begin-vector calc-comma calc-dots calc-end-complex calc-end-vector calc-semi) @@ -1155,14 +1172,17 @@ calc-trail-kill calc-trail-last calc-trail-marker calc-trail-next calc-trail-out calc-trail-previous calc-trail-scroll-left calc-trail-scroll-right calc-trail-yank) - ("calc-undo" calc-last-args calc-redo calc-undo) + ("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-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 -calc-view-units-table) +calc-view-units-table calc-lu-quant calc-db +calc-np calc-lu-plus calc-lu-minus +calc-lu-times calc-lu-divide calc-spn calc-midi +calc-freq) ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm calc-conj-transpose calc-cons calc-cross calc-kron calc-diag @@ -1408,9 +1428,18 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-hyperbolic-flag) calc-hyperbolic-flag)) - (msg (if hyp-flag - "Inverse Hyperbolic..." - "Inverse..."))) + (opt-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-option-flag) + calc-option-flag)) + (msg + (cond + ((and opt-flag hyp-flag) "Option Inverse Hyperbolic...") + (hyp-flag "Inverse Hyperbolic...") + (opt-flag "Option Inverse...") + (t "Inverse...")))) (calc-fancy-prefix 'calc-inverse-flag msg n))) (defconst calc-fancy-prefix-map @@ -1489,9 +1518,18 @@ calc-kill calc-kill-region calc-yank)))) (with-current-buffer calc-main-buffer calc-inverse-flag) calc-inverse-flag)) - (msg (if inv-flag - "Inverse Hyperbolic..." - "Hyperbolic..."))) + (opt-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-option-flag) + calc-option-flag)) + (msg + (cond + ((and opt-flag inv-flag) "Option Inverse Hyperbolic...") + (opt-flag "Option Hyperbolic...") + (inv-flag "Inverse Hyperbolic...") + (t "Hyperbolic...")))) (calc-fancy-prefix 'calc-hyperbolic-flag msg n))) (defun calc-hyperbolic-func () @@ -1504,6 +1542,31 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-is-hyperbolic () calc-hyperbolic-flag) +(defun calc-option (&optional n) + (interactive "P") + (let* ((inv-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-inverse-flag) + calc-inverse-flag)) + (hyp-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-hyperbolic-flag) + calc-hyperbolic-flag)) + (msg + (cond + ((and hyp-flag inv-flag) "Option Inverse Hyperbolic...") + (hyp-flag "Option Hyperbolic...") + (inv-flag "Option Inverse...") + (t "Option...")))) + (calc-fancy-prefix 'calc-option-flag msg n))) + +(defun calc-is-option () + calc-option-flag) + (defun calc-keep-args (&optional n) (interactive "P") (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n)) @@ -1658,8 +1721,8 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-execute-extended-command (n) (interactive "P") (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) - (cmd (intern - (completing-read prompt obarray 'commandp t "calc-" + (cmd (intern + (completing-read prompt obarray 'commandp t "calc-" 'calc-extended-command-history)))) (setq prefix-arg n) (command-execute cmd))) @@ -3239,7 +3302,7 @@ If X is not an error form, return 1." (concat "-" (math-format-flat-expr (nth 1 a) 1000))) (t (concat (math-remove-dashes - (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" + (if (string-match "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'" (symbol-name (car a))) (math-match-substring (symbol-name (car a)) 1) (symbol-name (car a)))) @@ -3425,7 +3488,8 @@ If X is not an error form, return 1." (defun math-group-float (str) ; [X X] (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str))) - (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) + (g (if (integerp calc-group-digits) (math-abs calc-group-digits) + (if (memq calc-number-radix '(2 16)) 4 3))) (i pt)) (if (and (integerp calc-group-digits) (< calc-group-digits 0)) (while (< (setq i (+ (1+ i) g)) (length str)) @@ -3455,5 +3519,8 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") (provide 'calc-ext) -;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e +;; Local variables: +;; coding: utf-8 +;; End: + ;;; calc-ext.el ends here diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index 78eb1447ec1..2e1d072dfb8 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -1,7 +1,6 @@ ;;; calc-fin.el --- financial functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -410,5 +409,4 @@ (provide 'calc-fin) -;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b ;;; calc-fin.el ends here diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 2d94455cb9e..912bbc7f78d 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1,7 +1,6 @@ ;;; calc-forms.el --- data format conversion functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1922,5 +1921,4 @@ and ends on the last Sunday of October at 2 a.m." (provide 'calc-forms) -;; arch-tag: a3d8f33b-9508-4043-8060-d02b8c9c750c ;;; calc-forms.el ends here diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 701ec676e6b..30894b406b5 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -1,7 +1,6 @@ ;;; calc-frac.el --- fraction functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -205,18 +204,33 @@ n temp)) (math-div n d))) - - (defun calcFunc-fdiv (a b) ; [R I I] [Public] - (if (Math-num-integerp a) - (if (Math-num-integerp b) - (if (Math-zerop b) - (math-reject-arg a "*Division by zero") - (math-make-frac (math-trunc a) (math-trunc b))) - (math-reject-arg b 'integerp)) - (math-reject-arg a 'integerp))) + (cond + ((Math-num-integerp a) + (cond + ((Math-num-integerp b) + (if (Math-zerop b) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-trunc a) (math-trunc b)))) + ((eq (car-safe b) 'frac) + (if (Math-zerop (nth 1 b)) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-mul (math-trunc a) (nth 2 b)) (nth 1 b)))) + (t (math-reject-arg b 'integerp)))) + ((eq (car-safe a) 'frac) + (cond + ((Math-num-integerp b) + (if (Math-zerop b) + (math-reject-arg a "*Division by zero") + (math-make-frac (cadr a) (math-mul (nth 2 a) (math-trunc b))))) + ((eq (car-safe b) 'frac) + (if (Math-zerop (nth 1 b)) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-mul (nth 1 a) (nth 2 b)) (math-mul (nth 2 a) (nth 1 b))))) + (t (math-reject-arg b 'integerp)))) + (t + (math-reject-arg a 'integerp)))) (provide 'calc-frac) -;; arch-tag: 89d65274-0b3b-42d8-aacd-eaf86da5b4ea ;;; calc-frac.el ends here diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 780dc2acfc3..e065493562e 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -1,7 +1,6 @@ ;;; calc-funcs.el --- well-known functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1009,5 +1008,4 @@ (provide 'calc-funcs) -;; arch-tag: 421ddb7a-550f-4dda-a31c-06638ebfc43a ;;; calc-funcs.el ends here diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index e16b8ac11ec..d5d8f0aaf35 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1,7 +1,6 @@ ;;; calc-graph.el --- graph output functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -433,7 +432,7 @@ (while (memq (preceding-char) '(?\s ?\t)) (forward-char -1)) (if (eq (preceding-char) ?\,) - (delete-backward-char 1)))) + (delete-char -1)))) (with-current-buffer calcbuf (setq cache-env (list calc-angle-mode calc-complex-mode @@ -575,16 +574,16 @@ (setq calc-graph-xstep 1) (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))) (or (math-realp calc-graph-yvalue) - (let ((arglist nil)) + (let ((math-arglist nil)) (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) (calc-default-formula-arglist calc-graph-yvalue) - (or arglist + (or math-arglist (error "%s does not contain any unassigned variables" calc-graph-yname)) - (and (cdr arglist) + (and (cdr math-arglist) (error "%s contains more than one variable: %s" - calc-graph-yname arglist)) + calc-graph-yname math-arglist)) (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue - (math-build-var-name (car arglist)) + (math-build-var-name (car math-arglist)) '(var DUMMY var-DUMMY))))) (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache)) (delq calc-graph-ycache calc-graph-data-cache) @@ -736,17 +735,17 @@ calc-graph-zp calc-graph-yvalue calc-graph-xvec t)) (or (math-realp calc-graph-yvalue) - (let ((arglist nil)) + (let ((math-arglist nil)) (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) (calc-default-formula-arglist calc-graph-yvalue) - (setq arglist (sort arglist 'string-lessp)) - (or (cdr arglist) + (setq math-arglist (sort math-arglist 'string-lessp)) + (or (cdr math-arglist) (error "%s does not contain enough unassigned variables" calc-graph-yname)) - (and (cdr (cdr arglist)) - (error "%s contains too many variables: %s" calc-graph-yname arglist)) + (and (cdr (cdr math-arglist)) + (error "%s contains too many variables: %s" calc-graph-yname math-arglist)) (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue (mapcar 'math-build-var-name - arglist) + math-arglist) '((var DUMMY var-DUMMY) (var DUMMY2 var-DUMMY2)))))) (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)) @@ -1506,5 +1505,4 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (provide 'calc-graph) -;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2 ;;; calc-graph.el ends here diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 8b3bee088e7..427cf6ba233 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -1,7 +1,6 @@ ;;; calc-help.el --- help display functions for Calc, -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -128,7 +127,7 @@ C-w Describe how there is no warranty for Calc." (dig2 (char-after (match-beginning 3)))) (delete-region (match-end 1) (match-end 0)) (goto-char (match-beginning 1)) - (delete-backward-char 1) + (delete-char -1) (delete-char 5) (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) (goto-char (point-min))))) @@ -446,6 +445,7 @@ C-w Describe how there is no warranty for Calc." '(calc-inverse-prefix-help calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help + calc-option-prefix-help calc-a-prefix-help calc-b-prefix-help calc-c-prefix-help @@ -455,6 +455,7 @@ C-w Describe how there is no warranty for Calc." calc-h-prefix-help calc-j-prefix-help calc-k-prefix-help + calc-l-prefix-help calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help @@ -512,6 +513,11 @@ C-w Describe how there is no warranty for Calc." "I H + a S (general invert func); v h (rtail)") "inverse-hyperbolic" nil)) +(defun calc-option-prefix-help () + (interactive) + (calc-do-prefix-help + '("") + "option" nil)) (defun calc-f-prefix-help () (interactive) @@ -663,6 +669,14 @@ C-w Describe how there is no warranty for Calc." "SHIFT + stat: + (sum), - (asum), * (prod), # (count)") "units/stat" ?u)) +(defun calc-l-prefix-help () + (interactive) + (calc-do-prefix-help + '("Quantity, DB level, Np level" + "+, -, *, /" + "Scientific pitch notation, Midi number, Frequency" + ) + "log units" ?l)) (defun calc-v-prefix-help () (interactive) @@ -682,5 +696,4 @@ C-w Describe how there is no warranty for Calc." (provide 'calc-help) -;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686 ;;; calc-help.el ends here diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index 8087182612b..a9cf89e6058 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -1,7 +1,6 @@ ;;; calc-incom.el --- complex data type input functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -176,9 +175,9 @@ (defun calc-digit-dots () (if (eq calc-prev-char ?.) (progn - (delete-backward-char 1) + (delete-char -1) (if (calc-minibuffer-contains ".*\\.\\'") - (delete-backward-char 1)) + (delete-char -1)) (setq calc-prev-char 'dots last-command-event 32) (if calc-prev-prev-char @@ -188,7 +187,7 @@ (erase-buffer)) (exit-minibuffer))) ;; just ignore extra decimal point, anticipating ".." - (delete-backward-char 1))) + (delete-char -1))) (defun calc-dots () (interactive) @@ -230,5 +229,4 @@ (provide 'calc-incom) -;; arch-tag: b8001270-4dc7-481b-a3e3-a952e19b390d ;;; calc-incom.el ends here diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index 1188e882ab7..cc10d9e993c 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -1,7 +1,6 @@ ;;; calc-keypd.el --- mouse-capable keypad input for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -390,9 +389,7 @@ (interactive) (unless (eq major-mode 'calc-keypad-mode) (error "Must be in *Calc Keypad* buffer for this command")) - (let* ((row (save-excursion - (beginning-of-line) - (count-lines (point-min) (point)))) + (let* ((row (count-lines (point-min) (point-at-bol))) (y (/ row 2)) (x (/ (current-column) (if (>= y 4) 6 5))) radix frac inv @@ -619,5 +616,4 @@ (provide 'calc-keypd) -;; arch-tag: 4ba0d360-2bb6-40b8-adfa-eb373765b3f9 ;;; calc-keypd.el ends here diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index f6e269589ed..7e3a08a1459 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1,7 +1,6 @@ ;;; calc-lang.el --- calc language functions -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -214,7 +213,7 @@ (put 'pascal 'math-lang-read-symbol '((?\$ (eq (string-match - "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" + "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)" math-exp-str math-exp-pos) math-exp-pos) (setq math-exp-token 'number @@ -312,7 +311,7 @@ (put 'fortran 'math-lang-read-symbol '((?\. - (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." + (eq (string-match "\\.[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω]?\\." math-exp-str math-exp-pos) math-exp-pos) (setq math-exp-token 'punc math-expr-data (upcase (math-match-substring math-exp-str 0)) @@ -335,7 +334,7 @@ (add-to-list 'calc-lang-allow-underscores 'fortran) (add-to-list 'calc-lang-parens-are-subscripts 'fortran) -;; The next few variables are local to math-read-exprs in calc-aent.el +;; The next few variables are local to math-read-exprs in calc-aent.el ;; and math-read-expr in calc-ext.el, but are set in functions they call. (defvar math-exp-token) @@ -379,12 +378,12 @@ ((= n 1) (message "TeX language mode with \\hbox{func}(\\hbox{var})")) ((> n 1) - (message + (message "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices")) ((= n -1) (message "TeX language mode with \\func(\\hbox{var})")) ((< n -1) - (message + (message "TeX language mode with \\func(\\hbox{var}) and multiline matrices"))))) (defun calc-latex-language (n) @@ -399,12 +398,12 @@ ((= n 1) (message "LaTeX language mode with \\text{func}(\\text{var})")) ((> n 1) - (message + (message "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices")) ((= n -1) (message "LaTeX language mode with \\func(\\text{var})")) ((< n -1) - (message + (message "LaTeX language mode with \\func(\\text{var}) and multiline matrices"))))) (put 'tex 'math-lang-name "TeX") @@ -498,7 +497,7 @@ (intv . math-compose-tex-intv))) (put 'tex 'math-variable-table - '( + '( ;; The Greek letters ( \\alpha . var-alpha ) ( \\beta . var-beta ) @@ -540,6 +539,16 @@ ( \\Psi . var-Psi ) ( \\omega . var-omega ) ( \\Omega . var-Omega ) + ;; Units + ( pt . var-texpt ) + ( pc . var-texpc ) + ( bp . var-texbp ) + ( dd . var-texdd ) + ( cc . var-texcc ) + ( sp . var-texsp ) + ( pint . var-pt ) + ( parsec . var-pc) + ;; Others ( \\ell . var-ell ) ( \\infty . var-inf ) @@ -603,9 +612,9 @@ '((?\\ (< math-exp-pos (1- (length math-exp-str))) (progn - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}" math-exp-str math-exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)" math-exp-str math-exp-pos)) (setq math-exp-token 'symbol math-exp-pos (match-end 0) @@ -630,7 +639,7 @@ (defun math-compose-tex-matrix (a &optional ltx) (if (cdr a) - (cons (append (math-compose-vector (cdr (car a)) " & " 0) + (cons (append (math-compose-vector (cdr (car a)) " & " 0) (if ltx '(" \\\\ ") '(" \\cr "))) (math-compose-tex-matrix (cdr a) ltx)) (list (math-compose-vector (cdr (car a)) " & " 0)))) @@ -691,7 +700,7 @@ (defun math-compose-tex-var (a prec) (if (and calc-language-option (not (= calc-language-option 0)) - (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" + (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" (symbol-name (nth 1 a)))) (if (eq calc-language 'latex) (format "\\text{%s}" (symbol-name (nth 1 a))) @@ -702,7 +711,7 @@ (let (left right) (if (and calc-language-option (not (= calc-language-option 0)) - (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) + (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" func)) (if (< (prefix-numeric-value calc-language-option) 0) (setq func (format "\\%s" func)) (setq func (if (eq calc-language 'latex) @@ -722,7 +731,7 @@ (setq left "{" right "}")) (t (setq left calc-function-open right calc-function-close))) - (list 'horiz func + (list 'horiz func left (math-compose-vector (cdr a) ", " 0) right))) @@ -824,11 +833,11 @@ '((?\\ (< math-exp-pos (1- (length math-exp-str))) (progn - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}" math-exp-str math-exp-pos) - (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" + (string-match "\\\\text *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}" math-exp-str math-exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)" math-exp-str math-exp-pos)) (setq math-exp-token 'symbol math-exp-pos (match-end 0) @@ -866,7 +875,7 @@ (and right (setq math-exp-str (copy-sequence math-exp-str)) (aset math-exp-str right ?\])))))))))) - + (defun math-latex-parse-frac (f val) (let (numer denom) (setq numer (car (math-read-expr-list))) @@ -988,7 +997,7 @@ (cdr (math-transpose a))) '("}"))))) -(put 'eqn 'math-var-formatter +(put 'eqn 'math-var-formatter (function (lambda (a prec) (let (v) @@ -1011,7 +1020,7 @@ (intern (substring (symbol-name (nth 2 a)) 0 -1)))) prec) (symbol-name (nth 1 a)))))))) - + (defconst math-eqn-special-funcs '( calcFunc-log calcFunc-ln calcFunc-exp @@ -1022,7 +1031,7 @@ calcFunc-arcsin calcFunc-arccos calcFunc-arctan calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) -(put 'eqn 'math-func-formatter +(put 'eqn 'math-func-formatter (function (lambda (func a) (let (left right) @@ -1035,8 +1044,8 @@ (not (math-tex-expr-is-flat (nth 1 a)))) (setq left "{left ( " right " right )}")) - - ((and + + ((and (memq (car a) math-eqn-special-funcs) (= (length a) 2) (or (Math-realp (nth 1 a)) @@ -1069,7 +1078,7 @@ ("above" punc ","))) (put 'eqn 'math-lang-adjust-words - (function + (function (lambda () (let ((code (assoc math-expr-data math-eqn-ignore-words))) (cond ((null code)) @@ -1189,21 +1198,21 @@ ( Gamma . var-gamma))) (put 'yacas 'math-parse-table - '((("Deriv(" 0 ")" 0) + '((("Deriv(" 0 ")" 0) calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) - (("D(" 0 ")" 0) + (("D(" 0 ")" 0) calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA)) - (("Integrate(" 0 ")" 0) + (("Integrate(" 0 ")" 0) calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA)) - (("Integrate(" 0 "," 0 "," 0 ")" 0) - calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) + (("Integrate(" 0 "," 0 "," 0 ")" 0) + calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA) (var ArgB var-ArgB) (var ArgC var-ArgC)) - (("Subst(" 0 "," 0 ")" 0) - calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) + (("Subst(" 0 "," 0 ")" 0) + calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA) (var ArgB var-ArgB)) - (("Taylor(" 0 "," 0 "," 0 ")" 0) - calcFunc-taylor (var ArgD var-ArgD) - (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) + (("Taylor(" 0 "," 0 "," 0 ")" 0) + calcFunc-taylor (var ArgD var-ArgD) + (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB)) (var ArgC var-ArgC)))) (put 'yacas 'math-oper-table @@ -1356,7 +1365,7 @@ (math-compose-expr (nth 2 a) -1) (if (not (nth 3 a)) ")" - (concat + (concat "," (math-compose-expr (nth 3 a) -1) "," @@ -1393,7 +1402,7 @@ '(("+" + 100 100) ("-" - 100 134) ("*" * 120 120) - ("." * 130 129) + ("." * 130 129) ("/" / 120 120) ("u-" neg -1 180) ("u+" ident -1 180) @@ -1494,9 +1503,9 @@ (nth 3 args)))) (put 'maxima 'math-parse-table - '((("if" 0 "then" 0 "else" 0) - calcFunc-if - (var ArgA var-ArgA) + '((("if" 0 "then" 0 "else" 0) + calcFunc-if + (var ArgA var-ArgA) (var ArgB var-ArgB) (var ArgC var-ArgC)))) @@ -1572,7 +1581,7 @@ (lambda (a) (list 'horiz "matrix(" - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) ")")))) @@ -1734,7 +1743,7 @@ order to Calc's." (nth 0 args)))) (put 'giac 'math-parse-table - '((("set" 0) + '((("set" 0) calcFunc-rdup (var ArgA var-ArgA)))) @@ -1748,7 +1757,7 @@ order to Calc's." "Compose the arguments to a Calc function in reverse order. This is used for various language modes which have functions in reverse order to Calc's." - (list 'horiz (nth 1 fn) + (list 'horiz (nth 1 fn) "(" (math-compose-expr (nth 2 a) 0) "," @@ -1770,7 +1779,7 @@ order to Calc's." (list 'horiz (math-compose-expr (nth 1 a) 1000) "[" - (math-compose-expr + (math-compose-expr (calc-normalize (list '- (nth 2 a) 1)) 0) "]"))))) @@ -2001,7 +2010,7 @@ order to Calc's." (list 'horiz "matrix(" math-comp-left-bracket - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) math-comp-right-bracket @@ -2044,9 +2053,9 @@ order to Calc's." (defvar math-read-big-baseline) (defvar math-read-big-h2) -;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 -;; are local to math-read-big-rec, but are used by math-read-big-char, -;; math-read-big-emptyp and math-read-big-balance which are called by +;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 +;; are local to math-read-big-rec, but are used by math-read-big-char, +;; math-read-big-emptyp and math-read-big-balance which are called by ;; math-read-big-rec. ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, ;; which calls math-read-big-balance. @@ -2055,40 +2064,40 @@ order to Calc's." (defvar math-rb-v1) (defvar math-rb-v2) -(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 +(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 &optional baseline prec short) (or prec (setq prec 0)) ;; Clip whitespace above or below. - (while (and (< math-rb-v1 math-rb-v2) + (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) (setq math-rb-v1 (1+ math-rb-v1))) - (while (and (< math-rb-v1 math-rb-v2) + (while (and (< math-rb-v1 math-rb-v2) (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) (setq math-rb-v2 (1- math-rb-v2))) ;; If formula is a single line high, normal parser can handle it. (if (<= math-rb-v2 (1+ math-rb-v1)) (if (or (<= math-rb-v2 math-rb-v1) - (> math-rb-h1 (length (setq math-rb-v2 + (> math-rb-h1 (length (setq math-rb-v2 (nth math-rb-v1 math-read-big-lines))))) (math-read-big-error math-rb-h1 math-rb-v1) (setq math-read-big-baseline math-rb-v1 math-read-big-h2 math-rb-h2 math-rb-v2 (nth math-rb-v1 math-read-big-lines) - math-rb-h2 (math-read-expr - (substring math-rb-v2 math-rb-h1 + math-rb-h2 (math-read-expr + (substring math-rb-v2 math-rb-h1 (min math-rb-h2 (length math-rb-v2))))) (if (eq (car-safe math-rb-h2) 'error) - (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) + (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) math-rb-v1 (nth 2 math-rb-h2)) math-rb-h2)) ;; Clip whitespace at left or right. - (while (and (< math-rb-h1 math-rb-h2) + (while (and (< math-rb-h1 math-rb-h2) (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) (setq math-rb-h1 (1+ math-rb-h1))) - (while (and (< math-rb-h1 math-rb-h2) + (while (and (< math-rb-h1 math-rb-h2) (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) (setq math-rb-h2 (1- math-rb-h2))) @@ -2107,7 +2116,7 @@ order to Calc's." (/= (aref line math-rb-h1) ?\ ) (if (and (= (aref line math-rb-h1) ?\-) ;; Make sure it's not a minus sign. - (or (and (< (1+ math-rb-h1) len) + (or (and (< (1+ math-rb-h1) len) (= (aref line (1+ math-rb-h1)) ?\-)) (/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) @@ -2166,7 +2175,7 @@ order to Calc's." ;; Binomial coefficient. ((and (= other-char ?\() (= (math-read-big-char (1+ math-rb-h1) v) ?\ ) - (= (string-match "( *)" (nth v math-read-big-lines) + (= (string-match "( *)" (nth v math-read-big-lines) math-rb-h1) math-rb-h1)) (setq h (match-end 0)) (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) @@ -2180,7 +2189,7 @@ order to Calc's." ;; Minus sign. ((= other-char ?\-) - (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 + (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 math-rb-h2 math-rb-v2 v 250 t)) v math-read-big-baseline h math-read-big-h2)) @@ -2199,10 +2208,10 @@ order to Calc's." (if (= sep ?\]) (math-read-big-error (1- h) v "Expected `)'")) (if (= sep ?\)) - (setq p (math-read-big-rec + (setq p (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) (setq hmid (math-read-big-balance h v "(") - p (list p + p (list p (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) h hmid) (cond ((= sep ?\.) @@ -2301,9 +2310,11 @@ order to Calc's." ;; Variable name or function call. ((or (and (>= other-char ?a) (<= other-char ?z)) - (and (>= other-char ?A) (<= other-char ?Z))) + (and (>= other-char ?A) (<= other-char ?Z)) + (and (>= other-char ?α) (<= other-char ?ω)) + (and (>= other-char ?Α) (<= other-char ?Ω))) (setq line (nth v math-read-big-lines)) - (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1) + (string-match "\\([a-zA-Zα-ωΑ-Ω'_]+\\) *" line math-rb-h1) (setq h (match-end 1) widest (match-end 0) p (math-match-substring line 1)) @@ -2345,7 +2356,7 @@ order to Calc's." (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) - ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; + ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; ;; baseline = v. (if baseline (or (= v baseline) @@ -2387,12 +2398,12 @@ order to Calc's." (cond ((eq (nth 3 widest) -1) (setq p (list (nth 1 widest) p))) ((equal (car widest) "?") - (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 + (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2 baseline nil t))) (or (= (math-read-big-char math-read-big-h2 baseline) ?\:) (math-read-big-error math-read-big-h2 baseline "Expected `:'")) (setq p (list (nth 1 widest) p y - (math-read-big-rec + (math-read-big-rec (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 baseline (nth 3 widest) t)) h math-read-big-h2))) @@ -2481,5 +2492,8 @@ order to Calc's." (provide 'calc-lang) -;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e +;; Local variables: +;; coding: utf-8 +;; End: + ;;; calc-lang.el ends here diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 8da071276fc..f922687e7fa 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -1,7 +1,6 @@ ;;; calc-macs.el --- important macros for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -207,5 +206,4 @@ (provide 'calc-macs) -;; arch-tag: 08ba8ec2-fcff-4b80-a079-ec661bdb057e ;;; calc-macs.el ends here diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 0ffc15d6a43..2ea4de20293 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -1,7 +1,6 @@ ;;; calc-map.el --- higher-order functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -572,7 +571,7 @@ (and nargs forcenargs (/= nargs forcenargs) (>= nargs 0) (error "Must be a %d-argument operator" nargs))) ((memq key '(?\$ ?\')) - (let* ((arglist nil) + (let* ((math-arglist nil) (has-args nil) (record-entry nil) (expr (if (eq key ?\$) @@ -592,13 +591,13 @@ (if (> calc-dollar-used 0) (progn (setq has-args calc-dollar-used - arglist (calc-invent-args has-args)) + math-arglist (calc-invent-args has-args)) (math-multi-subst (car func) - (reverse arglist) - arglist)) + (reverse math-arglist) + math-arglist)) (if (> calc-hashes-used 0) (setq has-args calc-hashes-used - arglist (calc-invent-args has-args))) + math-arglist (calc-invent-args has-args))) (car func)))))) (if (eq (car-safe expr) 'calcFunc-lambda) (setq oper (list "$" (- (length expr) 2) expr) @@ -607,16 +606,16 @@ (progn (calc-default-formula-arglist expr) (setq record-entry t - arglist (sort arglist 'string-lessp)) + math-arglist (sort math-arglist 'string-lessp)) (if calc-verify-arglist - (setq arglist (read-from-minibuffer + (setq math-arglist (read-from-minibuffer "Function argument list: " - (if arglist - (prin1-to-string arglist) + (if math-arglist + (prin1-to-string math-arglist) "()") minibuffer-local-map t))) - (setq arglist (mapcar (function + (setq math-arglist (mapcar (function (lambda (x) (list 'var x @@ -624,10 +623,10 @@ (concat "var-" (symbol-name x)))))) - arglist)))) + math-arglist)))) (setq oper (list "$" - (length arglist) - (append '(calcFunc-lambda) arglist + (length math-arglist) + (append '(calcFunc-lambda) math-arglist (list expr))) done t)) (if record-entry @@ -1274,5 +1273,4 @@ (provide 'calc-map) -;; arch-tag: 980eac49-00e0-4870-b72a-e726b74c7990 ;;; calc-map.el ends here diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index cd1b86d6b9f..076dab31fd9 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1,7 +1,6 @@ ;;; calc-math.el --- mathematical functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1575,7 +1574,7 @@ If this can't be done, return NIL." (if calc-infinite-mode '(neg (var inf var-inf)) (math-reject-arg x "*Logarithm of zero"))) - (calc-symbolic-mode (signal 'inexact-result nil)) + (calc-symbolic-mode (signal 'inexact-result nil)) ((Math-numberp x) (math-with-extra-prec 2 (let ((xf (math-float x))) @@ -2165,5 +2164,4 @@ If this can't be done, return NIL." (provide 'calc-math) -;; arch-tag: c7367e8e-d0b8-4f70-8577-2fb3f31dbb4c ;;; calc-math.el ends here diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index 40f8ff9987a..d8099b0aadc 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -1,6 +1,6 @@ ;;; calc-menu.el --- a menu for Calc -;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2011 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -960,6 +960,111 @@ (require 'calc-units) (call-interactively 'calc-view-units-table)) :keys "u V"] + (list "Logarithmic Units" + ["Convert (1:) to dB (power)" + (progn + (require 'calc-units) + (call-interactively 'calc-db)) + :keys "l d" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to dB (power) with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t)) + (call-interactively 'calc-db))) + :keys "O l d" + :active (>= (calc-stack-size) 2)] + ["Convert (1:) to Np (power)" + (progn + (require 'calc-units) + (call-interactively 'calc-np)) + :keys "l n" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to Np (power) with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t)) + (call-interactively 'calc-np))) + :keys "O l n" + :active (>= (calc-stack-size) 2)] + ["Convert (1:) to power quantity" + (progn + (require 'calc-units) + (call-interactively 'calc-lu-quant)) + :keys "l q" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to power quantity with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t)) + (call-interactively 'calc-lu-quant))) + :keys "O l q" + :active (>= (calc-stack-size) 2)] + "----" + ["Convert (1:) to dB (field)" + (progn + (require 'calc-units) + (let ((calc-hyperbolic-flag t)) + (call-interactively 'calc-db))) + :keys "H l d" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to dB (field) with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t) + (calc-hyperbolic-flag t)) + (call-interactively 'calc-db))) + :keys "O H l d" + :active (>= (calc-stack-size) 2)] + ["Convert (1:) to Np (field)" + (progn + (require 'calc-units) + (let ((calc-hyperbolic-flag t)) + (call-interactively 'calc-np))) + :keys "H l n" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to Np (field) with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t) + (calc-hyperbolic-flag t)) + (call-interactively 'calc-np))) + :keys "O H l d" + :active (>= (calc-stack-size) 2)] + ["Convert (1:) to field quantity" + (progn + (require 'calc-units) + (let ((calc-hyperbolic-flag t)) + (call-interactively 'calc-lu-quant))) + :keys "H l q" + :active (>= (calc-stack-size) 1)] + ["Convert (2:) to field quantity with reference level (1:)" + (progn + (require 'calc-units) + (let ((calc-option-flag t) + (calc-hyperbolic-flag)) + (call-interactively 'calc-lu-quant))) + :keys "O H l q" + :active (>= (calc-stack-size) 2)]) + (list "Musical Notes" + ["Convert (1:) to scientific pitch notation" + (progn + (require 'calc-units) + (call-interactively 'calc-spn)) + :keys "l s" + :active (>= (calc-stack-size) 1)] + ["Convert (1:) to midi number" + (progn + (require 'calc-units) + (call-interactively 'calc-midi)) + :keys "l m" + :active (>= (calc-stack-size) 1)] + ["Convert (1:) to frequency" + (progn + (require 'calc-units) + (call-interactively 'calc-freq)) + :keys "l f" + :active (>= (calc-stack-size) 1)]) "----" ["Help on Units" (calc-info-goto-node "Units")]) @@ -1461,4 +1566,3 @@ (provide 'calc-menu) -;; arch-tag: 9612c86a-cd4f-4baa-ab0b-40af7344d21f diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index ea9210cef76..db86c08422e 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -1,7 +1,6 @@ ;;; calc-misc.el --- miscellaneous functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004 -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -35,6 +34,7 @@ (declare-function calc-inv-hyp-prefix-help "calc-help" ()) (declare-function calc-inverse-prefix-help "calc-help" ()) (declare-function calc-hyperbolic-prefix-help "calc-help" ()) +(declare-function calc-option-prefix-help "calc-help" ()) (declare-function calc-explain-why "calc-stuff" (why &optional more)) (declare-function calc-clear-command-flag "calc-ext" (f)) (declare-function calc-roll-down-with-selections "calc-sel" (n m)) @@ -219,7 +219,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). (let ((msgs '("Press `h' for complete help; press `?' repeatedly for a summary" "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit" - "Letter keys: SHIFT + Undo, reDo; Keep-args; Inverse, Hyperbolic" + "Letter keys: SHIFT + Undo, reDo; Keep-args; Inverse, Hyperbolic, Option" "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB" "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi" "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro" @@ -245,20 +245,22 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). (calc-inv-hyp-prefix-help) (calc-inverse-prefix-help)) (calc-hyperbolic-prefix-help)) - (setq calc-help-phase - (if (eq this-command last-command) - (% (1+ calc-help-phase) (1+ (length msgs))) - 0)) - (let ((msg (nth calc-help-phase msgs))) - (message "%s" (if msg - (concat msg ":" - (make-string (- (apply 'max - (mapcar 'length - msgs)) - (length msg)) 32) - " [?=MORE]") - ""))))))) - + (if calc-option-flag + (calc-option-prefix-help) + (setq calc-help-phase + (if (eq this-command last-command) + (% (1+ calc-help-phase) (1+ (length msgs))) + 0)) + (let ((msg (nth calc-help-phase msgs))) + (message "%s" (if msg + (concat msg ":" + (make-string (- (apply 'max + (mapcar 'length + msgs)) + (length msg)) 32) + " [?=MORE]") + "")))))))) + @@ -960,5 +962,4 @@ doing 'M-x toggle-debug-on-error', then reproducing the bug. ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: 7984d9d0-62e5-41dc-afb8-e904b975f250 ;;; calc-misc.el ends here diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index e9edd0c1724..856dfad882d 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -1,7 +1,6 @@ ;;; calc-mode.el --- calculator modes for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -677,5 +676,4 @@ (provide 'calc-mode) -;; arch-tag: ecc70eea-c712-43f2-9085-4205e58d6ddf ;;; calc-mode.el ends here diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 1c2a74d2a8b..5ec15005b48 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -1,7 +1,6 @@ ;;; calc-mtx.el --- matrix functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -233,6 +232,20 @@ (setq math-lud-cache (cons (cons m entry) math-lud-cache))) lud)))) + +(defun math-lud-pivot-check (a) + "Determine a useful value for checking the size of potential pivots +in LUD decomposition." + (cond ((eq (car-safe a) 'mod) + (if (and (math-integerp (nth 1 a)) + (math-integerp (nth 2 a)) + (eq (math-gcd (nth 1 a) (nth 2 a)) 1)) + 1 + 0)) + (t + (math-abs-approx a)))) + + ;;; Numerical Recipes section 2.3; implicit pivoting omitted. (defun math-do-matrix-lud (m) (let* ((lu (math-copy-matrix m)) @@ -262,7 +275,7 @@ (nth j (nth k lu)))) k (1+ k))) (setcar (nthcdr j (nth i lu)) sum) - (let ((dum (math-abs-approx sum))) + (let ((dum (math-lud-pivot-check sum))) (if (Math-lessp big dum) (setq big dum imax i))) @@ -365,5 +378,4 @@ (provide 'calc-mtx) -;; arch-tag: fc0947b1-90e1-4a23-8950-d8ead9c3a306 ;;; calc-mtx.el ends here diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 985d9326fc1..37e6f66c1b1 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -1,6 +1,6 @@ ;;; calc-nlfit.el --- nonlinear curve fitting for Calc -;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2011 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -818,4 +818,3 @@ (provide 'calc-nlfit) -;; arch-tag: 6eba3cd6-f48b-4a84-8174-10c15a024928 diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 94ed8aa0c7f..e16c26eaa19 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -1,7 +1,6 @@ ;;; calc-poly.el --- polynomial functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -663,7 +662,7 @@ (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow) (cdr (cdr facs))))) (cons 'vec (cons (list 'vec fac pow) (cdr facs)))))))) - (math-mul (math-pow fac pow) facs))) + (math-mul (math-pow fac pow) (math-factor-protect facs)))) (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" (let (t1 t2 temp) @@ -1200,5 +1199,4 @@ If no partial fraction representation can be found, return nil." (provide 'calc-poly) -;; arch-tag: d2566c51-2ccc-45f1-8c50-f3462c2953ff ;;; calc-poly.el ends here diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index a925be0bb39..0d3fbe8586a 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1,7 +1,6 @@ ;;; calc-prog.el --- user programmability functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -171,17 +170,17 @@ (interactive) (calc-wrapper (let* ((form (calc-top 1)) - (arglist nil) + (math-arglist nil) (is-lambda (and (eq (car-safe form) 'calcFunc-lambda) (>= (length form) 2))) odef key keyname cmd cmd-base cmd-base-default func calc-user-formula-alist is-symb) (if is-lambda - (setq arglist (mapcar (function (lambda (x) (nth 1 x))) + (setq math-arglist (mapcar (function (lambda (x) (nth 1 x))) (nreverse (cdr (reverse (cdr form))))) form (nth (1- (length form)) form)) (calc-default-formula-arglist form) - (setq arglist (sort arglist 'string-lessp))) + (setq math-arglist (sort math-arglist 'string-lessp))) (message "Define user key: z-") (setq key (read-char)) (if (= (calc-user-function-classify key) 0) @@ -267,17 +266,17 @@ (format "%05d" (% (random) 10000))))))) (if is-lambda - (setq calc-user-formula-alist arglist) + (setq calc-user-formula-alist math-arglist) (while (progn (setq calc-user-formula-alist (read-from-minibuffer "Function argument list: " - (if arglist - (prin1-to-string arglist) + (if math-arglist + (prin1-to-string math-arglist) "()") minibuffer-local-map t)) - (and (not (calc-subsetp calc-user-formula-alist arglist)) + (and (not (calc-subsetp calc-user-formula-alist math-arglist)) (not (y-or-n-p "Okay for arguments that don't appear in formula to be ignored? ")))))) (setq is-symb (and calc-user-formula-alist @@ -328,14 +327,14 @@ (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) (message ""))) -(defvar arglist) ; dynamically bound in all callers +(defvar math-arglist) ; dynamically bound in all callers (defun calc-default-formula-arglist (form) (if (consp form) (if (eq (car form) 'var) - (if (or (memq (nth 1 form) arglist) + (if (or (memq (nth 1 form) math-arglist) (math-const-var form)) () - (setq arglist (cons (nth 1 form) arglist))) + (setq math-arglist (cons (nth 1 form) math-arglist))) (calc-default-formula-arglist-step (cdr form))))) (defun calc-default-formula-arglist-step (l) @@ -394,23 +393,23 @@ (intern (concat "calcFunc-" x)))))))) (comps (get func 'math-compose-forms)) entry entry2 - (arglist nil) + (math-arglist nil) (calc-user-formula-alist nil)) (if (math-zerop comp) (if (setq entry (assq calc-language comps)) (put func 'math-compose-forms (delq entry comps))) (calc-default-formula-arglist comp) - (setq arglist (sort arglist 'string-lessp)) + (setq math-arglist (sort math-arglist 'string-lessp)) (while (progn (setq calc-user-formula-alist (read-from-minibuffer "Composition argument list: " - (if arglist - (prin1-to-string arglist) + (if math-arglist + (prin1-to-string math-arglist) "()") minibuffer-local-map t)) - (and (not (calc-subsetp calc-user-formula-alist arglist)) + (and (not (calc-subsetp calc-user-formula-alist math-arglist)) (y-or-n-p "Okay for arguments that don't appear in formula to be invisible? ")))) (or (setq entry (assq calc-language comps)) @@ -627,7 +626,8 @@ (error "Separator not allowed with { ... }?")) (if (string-match "\\`\"" sep) (setq sep (read-from-string sep))) - (setq sep (calc-fix-token-name sep)) + (if (> (length sep) 0) + (setq sep (calc-fix-token-name sep))) (setq part (nconc part (list (list sym p (and (> (length sep) 0) @@ -2364,5 +2364,4 @@ Redefine the corresponding command." (provide 'calc-prog) -;; arch-tag: 4c5a183b-c9e5-4632-bb3f-e41a764518b0 ;;; calc-prog.el ends here diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index f7c5727a0c9..1498b622e1f 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -1,7 +1,6 @@ ;;; calc-rewr.el --- rewriting functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -2108,5 +2107,4 @@ (provide 'calc-rewr) -;; arch-tag: ca8d7b7d-bff1-4535-90f3-e2241f5e786b ;;; calc-rewr.el ends here diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index d5ebe715c84..fa57a350729 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -1,7 +1,6 @@ ;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -445,5 +444,4 @@ fitparam(n) = x := x ]")) (provide 'calc-rules) -;; arch-tag: 0ed54a52-38f3-4ed7-9ca7-b8ecf8f2febe ;;; calc-rules.el ends here diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index aa9e1d8308a..26834a44598 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -1,7 +1,6 @@ ;;; calc-sel.el --- data selection functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -309,6 +308,8 @@ (setq n (1+ n)))) (calc-clear-command-flag 'position-point))) +(defvar calc-highlight-selections-with-faces) + (defun calc-show-selections (arg) (interactive "P") (calc-wrapper @@ -330,8 +331,12 @@ (setcar (nthcdr 2 calc-selection-cache-entry) nil) (calc-change-current-selection sel))))) (message (if calc-show-selections - "Displaying only selected part of formulas" - "Displaying all but selected part of formulas")))) + (if calc-highlight-selections-with-faces + "De-emphasizing all but selected part of formulas" + "Displaying only selected part of formulas") + (if calc-highlight-selections-with-faces + "Emphasizing selected part of formulas" + "Displaying all but selected part of formulas"))))) ;; The variables calc-final-point-line and calc-final-point-column ;; are declared in calc.el, and are used throughout. @@ -870,5 +875,4 @@ (provide 'calc-sel) -;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2 ;;; calc-sel.el ends here diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 9605a059f17..83ce71a2376 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -1,7 +1,6 @@ ;;; calc-stat.el --- statistical functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -583,5 +582,4 @@ (provide 'calc-stat) -;; arch-tag: 423858e9-8513-489c-9f35-710cd9d9c307 ;;; calc-stat.el ends here diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 16a3d34ea54..2da551ee215 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -1,7 +1,6 @@ ;;; calc-store.el --- value storage functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -197,12 +196,12 @@ (minibuffer-completion-predicate (lambda (x) (boundp (intern (concat "var-" x))))) (minibuffer-completion-confirm t)) - (read-from-minibuffer - prompt nil calc-var-name-map nil + (read-from-minibuffer + prompt nil calc-var-name-map nil 'calc-read-var-name-history))))) (setq calc-aborted-prefix "") (and (not (equal var "var-")) - (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var) + (if (string-match "\\`\\([-a-zA-Zα-ωΑ-Ω0-9]+\\) *:?=" var) (if (null calc-given-value-flag) (error "Assignment is not allowed in this command") (let ((svar (intern (substring var 0 (match-end 1))))) @@ -677,5 +676,8 @@ (provide 'calc-store) -;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e +;; Local variables: +;; coding: utf-8 +;; End: + ;;; calc-store.el ends here diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 2078080d6f8..0558d8d2285 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -1,7 +1,6 @@ ;;; calc-stuff.el --- miscellaneous functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -295,5 +294,4 @@ With a prefix, push that prefix as a number onto the stack." (provide 'calc-stuff) -;; arch-tag: 789332ef-a178-49d3-8fb7-5d7ed7e21f56 ;;; calc-stuff.el ends here diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index c4620610721..eec4cd2af58 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -1,7 +1,6 @@ ;;; calc-trail.el --- functions for manipulating the Calc "trail" -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -108,20 +107,28 @@ (defun calc-trail-isearch-forward () (interactive) (calc-with-trail-buffer - (save-window-excursion - (select-window (get-buffer-window (current-buffer))) - (let ((search-exit-char ?\r)) - (isearch-forward))) - (calc-trail-here))) + (let ((win (get-buffer-window (current-buffer))) + pos) + (save-window-excursion + (select-window win) + (isearch-forward) + (setq pos (point))) + (goto-char pos) + (set-window-point win pos) + (calc-trail-here)))) (defun calc-trail-isearch-backward () (interactive) (calc-with-trail-buffer - (save-window-excursion - (select-window (get-buffer-window (current-buffer))) - (let ((search-exit-char ?\r)) - (isearch-backward))) - (calc-trail-here))) + (let ((win (get-buffer-window (current-buffer))) + pos) + (save-window-excursion + (select-window win) + (isearch-backward) + (setq pos (point))) + (goto-char pos) + (set-window-point win pos) + (calc-trail-here)))) (defun calc-trail-yank (arg) (interactive "P") @@ -173,5 +180,4 @@ (provide 'calc-trail) -;; arch-tag: 59b76655-d882-4aab-a3ee-b83870e530d0 ;;; calc-trail.el ends here diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 72cc2e62f7c..9168d9b0947 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -1,7 +1,6 @@ ;;; calc-undo.el --- undo functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -32,6 +31,7 @@ ;;; Undo. +;;;###autoload (defun calc-undo (n) (interactive "p") (when calc-executing-macro @@ -148,5 +148,4 @@ (provide 'calc-undo) -;; arch-tag: eeb485d2-fb3d-454a-9d79-450af1f50d6c ;;; calc-undo.el ends here diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 2f650fc2e08..43cb5828e85 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1,7 +1,6 @@ ;;; calc-units.el --- unit conversion functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -36,13 +35,13 @@ ;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch) ;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov) -;;; Updated April 2002 by Jochen Küpper +;;; Updated April 2002 by Jochen Küpper ;;; Updated August 2007, using ;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html) ;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) ;;; ESUWM (Encyclopaedia of Scientific Units, Weights and -;;; Measures, by François Cardarelli) +;;; Measures, by François Cardarelli) ;;; All conversions are exact unless otherwise noted. (defvar math-standard-units @@ -57,23 +56,23 @@ "149597870691 m (*)") ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) ( lyr "c yr" "Light Year" ) - ( pc "3.0856775854*10^16 m" "Parsec" nil + ( pc "3.0856775854*10^16 m" "Parsec (**)" nil "3.0856775854 10^16 m (*)") ;; (approx) ESUWM ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( fur "660 ft" "Furlong") ( mu "1 um" "Micron" ) ( mil "(1/1000) in" "Mil" ) - ( point "(1/72) in" "Point (1/72 inch)" ) + ( point "(1/72) in" "Point (PostScript convention)" ) ( Ang "10^(-10) m" "Angstrom" ) ( mfi "mi+ft+in" "Miles + feet + inches" ) ;; TeX lengths - ( texpt "(100/7227) in" "Point (TeX conventions)" ) - ( texpc "12 texpt" "Pica" ) - ( texbp "point" "Big point (TeX conventions)" ) - ( texdd "(1238/1157) texpt" "Didot point" ) - ( texcc "12 texdd" "Cicero" ) - ( texsp "(1/65536) texpt" "Scaled TeX point" ) + ( texpt "(100/7227) in" "Point (TeX convention) (**)" ) + ( texpc "12 texpt" "Pica (TeX convention) (**)" ) + ( texbp "point" "Big point (TeX convention) (**)" ) + ( texdd "(1238/1157) texpt" "Didot point (TeX convention) (**)" ) + ( texcc "12 texdd" "Cicero (TeX convention) (**)" ) + ( texsp "(1/65536) texpt" "Scaled TeX point (TeX convention) (**)" ) ;; Area ( hect "10000 m^2" "*Hectare" ) @@ -86,7 +85,7 @@ ( l "L" "Liter" ) ( gal "4 qt" "US Gallon" ) ( qt "2 pt" "Quart" ) - ( pt "2 cup" "Pint" ) + ( pt "2 cup" "Pint (**)" ) ( cup "8 ozfl" "Cup" ) ( ozfl "2 tbsp" "Fluid Ounce" ) ( floz "2 tbsp" "Fluid Ounce" ) @@ -210,6 +209,7 @@ "1.602176487 10^-19 C (*)") ;;(approx) CODATA ( V "W/A" "Volt" ) ( ohm "V/A" "Ohm" ) + ( Ω "ohm" "Ohm" ) ( mho "A/V" "Mho" ) ( S "A/V" "Siemens" ) ( F "C/V" "Farad" ) @@ -259,7 +259,9 @@ "6.62606896 10^-34 J s (*)") ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact ( mu0 "4 pi 10^(-7) H/m" "Permeability of vacuum") ;; Exact + ( μ0 "mu0" "Permeability of vacuum") ;; Exact ( eps0 "1 / (mu0 c^2)" "Permittivity of vacuum" ) + ( ε0 "eps0" "Permittivity of vacuum" ) ( G "6.67428*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil "6.67428 10^-11 m^3/(kg s^2) (*)") ( Nav "6.02214179*10^(23) / mol" "Avogadro's constant" nil @@ -272,12 +274,16 @@ "1.674927211 10^-27 kg (*)") ( mmu "1.88353130*10^(-28) kg" "Muon rest mass" nil "1.88353130 10^-28 kg (*)") + ( mμ "mmu" "Muon rest mass" nil + "1.88353130 10^-28 kg (*)") ( Ryd "10973731.568527 /m" "Rydberg's constant" nil "10973731.568527 /m (*)") ( k "1.3806504*10^(-23) J/K" "Boltzmann's constant" nil "1.3806504 10^-23 J/K (*)") ( alpha "7.2973525376*10^(-3)" "Fine structure constant" nil "7.2973525376 10^-3 (*)") + ( α "alpha" "Fine structure constant" nil + "7.2973525376 10^-3 (*)") ( muB "927.400915*10^(-26) J/T" "Bohr magneton" nil "927.400915 10^-26 J/T (*)") ( muN "5.05078324*10^(-27) J/T" "Nuclear magneton" nil @@ -289,7 +295,10 @@ ( R0 "8.314472 J/(mol K)" "Molar gas constant" nil "8.314472 J/(mol K) (*)") ( V0 "22.710981*10^(-3) m^3/mol" "Standard volume of ideal gas" nil - "22.710981 10^-3 m^3/mol (*)"))) + "22.710981 10^-3 m^3/mol (*)") + ;; Logarithmic units + ( Np nil "*Neper") + ( dB "(ln(10)/20) Np" "decibel"))) (defvar math-additional-units nil @@ -316,6 +325,7 @@ that the combined units table will be rebuilt.") ( ?c (^ 10 -2) "Centi" ) ( ?m (^ 10 -3) "Milli" ) ( ?u (^ 10 -6) "Micro" ) + ( ?μ (^ 10 -6) "Micro" ) ( ?n (^ 10 -9) "Nano" ) ( ?p (^ 10 -12) "Pico" ) ( ?f (^ 10 -15) "Femto" ) @@ -581,8 +591,8 @@ If EXPR is nil, return nil." (let ((name (or (nth 2 u) (symbol-name (car u))))) (if (eq (aref name 0) ?\*) (setq name (substring name 1))) - (if (string-match "[^a-zA-Z0-9']" name) - (if (string-match "^[a-zA-Z0-9' ()]*$" name) + (if (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name) + (if (string-match "^[a-zA-Zα-ωΑ-Ω0-9' ()]*$" name) (while (setq pos (string-match "[ ()]" name)) (setq name (concat (substring name 0 pos) (if (eq (aref name pos) 32) "-" "") @@ -592,7 +602,7 @@ If EXPR is nil, return nil." (setq name (concat (nth 2 (assq (aref (symbol-name (nth 1 expr)) 0) math-unit-prefixes)) - (if (and (string-match "[^a-zA-Z0-9']" name) + (if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name) (not (memq (car u) '(mHg gf)))) (concat "-" name) (downcase name))))) @@ -863,6 +873,7 @@ If EXPR is nil, return nil." (or (eq (nth 1 expr) 'pi) (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) + ((equal expr '(calcFunc-ln 10))) (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) @@ -949,7 +960,10 @@ If EXPR is nil, return nil." (if (eq base 'pi) (math-pi) expr))) - (if (Math-primp expr) + (if (or + (Math-primp expr) + (and (eq (car-safe expr) 'calcFunc-subscr) + (eq (car-safe (nth 1 expr)) 'var))) expr (cons (car expr) (mapcar 'math-to-standard-rec (cdr expr)))))) @@ -1523,7 +1537,12 @@ If EXPR is nil, return nil." (indent-to 15) (insert " " (nth 2 u) "\n") (while (eq (car (car (setq uptr (cdr uptr)))) 0))) - (insert "\n")) + (insert "\n\n") + (insert "(**) When in TeX or LaTeX display mode, the TeX specific unit\n" + "names will not use the `tex' prefix; the unit name for a\n" + "TeX point will be `pt' instead of `texpt', for example.\n" + "To avoid conflicts, the unit names for pint and parsec will\n" + "be `pint' and `parsec' instead of `pt' and `pc'.")) (view-mode) (message "Formatting units table...done")) (setq math-units-table-buffer-valid t) @@ -1538,11 +1557,528 @@ If EXPR is nil, return nil." (pop-to-buffer (get-buffer "*Units Table*")) (display-buffer (get-buffer "*Units Table*"))))) +;;; Logarithmic units functions + +(defvar math-logunits '((var dB var-dB) + (var Np var-Np))) + +(defun math-conditional-apply (fn &rest args) + "Evaluate f(args) unless in symbolic mode. +In symbolic mode, return the list (fn args)." + (if calc-symbolic-mode + (cons fn args) + (apply fn args))) + +(defun math-conditional-pow (a b) + "Evaluate a^b unless in symbolic mode. +In symbolic mode, return the list (^ a b)." + (if calc-symbolic-mode + (list '^ a b) + (math-pow a b))) + +(defun math-extract-logunits (expr) + (if (memq (car-safe expr) '(* /)) + (cons (car expr) + (mapcar 'math-extract-logunits (cdr expr))) + (if (memq (car-safe expr) '(^)) + (list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr)) + (if (member expr math-logunits) expr 1)))) + +(defun math-logunits-add (a b neg power) + (let ((aunit (math-simplify (math-extract-logunits a)))) + (if (not (eq (car-safe aunit) 'var)) + (calc-record-why "*Improper logarithmic unit" aunit) + (let* ((units (math-extract-units a)) + (acoeff (math-simplify (math-remove-units a))) + (bcoeff (math-simplify (math-to-standard-units + (list '/ b units) nil)))) + (if (math-units-in-expr-p bcoeff nil) + (calc-record-why "*Inconsistent units" nil) + (if (and neg + (or (math-lessp acoeff bcoeff) + (math-equal acoeff bcoeff))) + (calc-record-why "*Improper coefficients" nil) + (math-mul + (if (equal aunit '(var dB var-dB)) + (let ((coef (if power 10 20))) + (math-mul coef + (math-conditional-apply 'calcFunc-log10 + (if neg + (math-sub + (math-conditional-pow 10 (math-div acoeff coef)) + (math-conditional-pow 10 (math-div bcoeff coef))) + (math-add + (math-conditional-pow 10 (math-div acoeff coef)) + (math-conditional-pow 10 (math-div bcoeff coef))))))) + (let ((coef (if power 2 1))) + (math-div + (math-conditional-apply 'calcFunc-ln + (if neg + (math-sub + (math-conditional-apply 'calcFunc-exp (math-mul coef acoeff)) + (math-conditional-apply 'calcFunc-exp (math-mul coef bcoeff))) + (math-add + (math-conditional-apply 'calcFunc-exp (math-mul coef acoeff)) + (math-conditional-apply 'calcFunc-exp (math-mul coef bcoeff))))) + coef))) + units))))))) + +(defun calcFunc-lufadd (a b) + (math-logunits-add a b nil nil)) + +(defun calcFunc-lupadd (a b) + (math-logunits-add a b nil t)) + +(defun calcFunc-lufsub (a b) + (math-logunits-add a b t nil)) + +(defun calcFunc-lupsub (a b) + (math-logunits-add a b t t)) + +(defun calc-lu-plus (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu-" 'calcFunc-lufsub arg) + (calc-binary-op "lu-" 'calcFunc-lupsub arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu+" 'calcFunc-lufadd arg) + (calc-binary-op "lu+" 'calcFunc-lupadd arg))))) + +(defun calc-lu-minus (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu+" 'calcFunc-lufadd arg) + (calc-binary-op "lu+" 'calcFunc-lupadd arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu-" 'calcFunc-lufsub arg) + (calc-binary-op "lu-" 'calcFunc-lupsub arg))))) + +(defun math-logunits-mul (a b power) + (let (logunit coef units number) + (cond + ((and + (setq logunit (math-simplify (math-extract-logunits a))) + (eq (car-safe logunit) 'var) + (eq (math-simplify (math-extract-units b)) 1)) + (setq coef (math-simplify (math-remove-units a)) + units (math-extract-units a) + number b)) + ((and + (setq logunit (math-simplify (math-extract-logunits b))) + (eq (car-safe logunit) 'var) + (eq (math-simplify (math-extract-units a)) 1)) + (setq coef (math-simplify (math-remove-units b)) + units (math-extract-units b) + number a)) + (t (setq logunit nil))) + (if logunit + (cond + ((equal logunit '(var dB var-dB)) + (math-simplify + (math-mul + (math-add + coef + (math-mul (if power 10 20) + (math-conditional-apply 'calcFunc-log10 number))) + units))) + (t + (math-simplify + (math-mul + (math-add + coef + (math-div (math-conditional-apply 'calcFunc-ln number) (if power 2 1))) + units)))) + (calc-record-why "*Improper units" nil)))) + +(defun math-logunits-divide (a b power) + (let ((logunit (math-simplify (math-extract-logunits a)))) + (if (not (eq (car-safe logunit) 'var)) + (calc-record-why "*Improper logarithmic unit" logunit) + (if (math-units-in-expr-p b nil) + (calc-record-why "*Improper units quantity" b) + (let* ((units (math-extract-units a)) + (coef (math-simplify (math-remove-units a)))) + (cond + ((equal logunit '(var dB var-dB)) + (math-simplify + (math-mul + (math-sub + coef + (math-mul (if power 10 20) + (math-conditional-apply 'calcFunc-log10 b))) + units))) + (t + (math-simplify + (math-mul + (math-sub + coef + (math-div (math-conditional-apply 'calcFunc-ln b) (if power 2 1))) + units))))))))) + +(defun calcFunc-lufmul (a b) + (math-logunits-mul a b nil)) + +(defun calcFunc-lupmul (a b) + (math-logunits-mul a b t)) + +(defun calc-lu-times (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu/" 'calcFunc-lufdiv arg) + (calc-binary-op "lu/" 'calcFunc-lupdiv arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu*" 'calcFunc-lufmul arg) + (calc-binary-op "lu*" 'calcFunc-lupmul arg))))) + +(defun calcFunc-lufdiv (a b) + (math-logunits-divide a b nil)) + +(defun calcFunc-lupdiv (a b) + (math-logunits-divide a b t)) + +(defun calc-lu-divide (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu*" 'calcFunc-lufmul arg) + (calc-binary-op "lu*" 'calcFunc-lupmul arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu/" 'calcFunc-lufdiv arg) + (calc-binary-op "lu/" 'calcFunc-lupdiv arg))))) + +(defun math-logunits-quant (val ref power) + (let* ((units (math-simplify (math-extract-units val))) + (lunit (math-simplify (math-extract-logunits units)))) + (if (not (eq (car-safe lunit) 'var)) + (calc-record-why "*Improper logarithmic unit" lunit) + (let ((runits (math-simplify (math-div units lunit))) + (coeff (math-simplify (math-div val units)))) + (math-mul + (if (equal lunit '(var dB var-dB)) + (math-mul + ref + (math-conditional-pow + 10 + (math-div + coeff + (if power 10 20)))) + (math-mul + ref + (math-conditional-apply 'calcFunc-exp + (if power + (math-mul 2 coeff) + coeff)))) + runits))))) + +(defvar calc-lu-field-reference) +(defvar calc-lu-power-reference) + +(defun calcFunc-lufquant (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-field-reference))) + (math-logunits-quant val ref nil)) + +(defun calcFunc-lupquant (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-power-reference))) + (math-logunits-quant val ref t)) + +(defun calc-lu-quant (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "lupq" 'calcFunc-lufquant arg) + (calc-unary-op "lupq" 'calcFunc-lufquant arg)) + (if (calc-is-option) + (calc-binary-op "lufq" 'calcFunc-lupquant arg) + (calc-unary-op "lufq" 'calcFunc-lupquant arg))))) + +(defun math-logunits-level (val ref db power) + "Compute the value of VAL in decibels or nepers." + (let* ((ratio (math-simplify-units (math-div val ref))) + (ratiou (math-simplify-units (math-remove-units ratio))) + (units (math-simplify (math-extract-units ratio)))) + (math-mul + (if db + (math-mul + (math-mul (if power 10 20) + (math-conditional-apply 'calcFunc-log10 ratiou)) + '(var dB var-dB)) + (math-mul + (math-div (math-conditional-apply 'calcFunc-ln ratiou) (if power 2 1)) + '(var Np var-Np))) + units))) + +(defun calcFunc-dbfield (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-field-reference))) + (math-logunits-level val ref t nil)) + +(defun calcFunc-dbpower (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-power-reference))) + (math-logunits-level val ref t t)) + +(defun calcFunc-npfield (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-field-reference))) + (math-logunits-level val ref nil nil)) + +(defun calcFunc-nppower (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-lu-power-reference))) + (math-logunits-level val ref nil t)) + +(defun calc-db (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "ludb" 'calcFunc-dbfield arg) + (calc-unary-op "ludb" 'calcFunc-dbfield arg)) + (if (calc-is-option) + (calc-binary-op "ludb" 'calcFunc-dbpower arg) + (calc-unary-op "ludb" 'calcFunc-dbpower arg))))) + +(defun calc-np (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "lunp" 'calcFunc-npfield arg) + (calc-unary-op "lunp" 'calcFunc-npfield arg)) + (if (calc-is-option) + (calc-binary-op "lunp" 'calcFunc-nppower arg) + (calc-unary-op "lunp" 'calcFunc-nppower arg))))) + +;;; Musical notes + + +(defvar calc-note-threshold) + +(defun math-midi-round (num) + "Round NUM to an integer N if NUM is within calc-note-threshold cents of N." + (let* ((n (math-round num)) + (diff (math-abs + (math-sub num n)))) + (if (< (math-compare diff + (math-div (math-read-expr calc-note-threshold) 100)) 0) + n + num))) + +(defconst math-notes + '(((var C var-C) . 0) + ((var Csharp var-Csharp) . 1) +; ((var C♯ var-C♯) . 1) + ((var Dflat var-Dflat) . 1) +; ((var Dâ™ var-Dâ™) . 1) + ((var D var-D) . 2) + ((var Dsharp var-Dsharp) . 3) +; ((var D♯ var-D♯) . 3) + ((var E var-E) . 4) + ((var F var-F) . 5) + ((var Fsharp var-Fsharp) . 6) +; ((var F♯ var-F♯) . 6) + ((var Gflat var-Gflat) . 6) +; ((var Gâ™ var-Gâ™) . 6) + ((var G var-G) . 7) + ((var Gsharp var-Gsharp) . 8) +; ((var G♯ var-G♯) . 8) + ((var A var-A) . 9) + ((var Asharp var-Asharp) . 10) +; ((var A♯ var-A♯) . 10) + ((var Bflat var-Bflat) . 10) +; ((var Bâ™ var-Bâ™) . 10) + ((var B var-B) . 11)) + "An alist of notes with their number of semitones above C.") + +(defun math-freqp (freq) + "Non-nil if FREQ is a positive number times the unit Hz. +If non-nil, return the coefficient of Hz." + (let ((freqcoef (math-simplify-units + (math-div freq '(var Hz var-Hz))))) + (if (Math-posp freqcoef) freqcoef))) + +(defun math-midip (num) + "Non-nil if NUM is a possible MIDI note number. +If non-nil, return NUM." + (if (Math-numberp num) num)) + +(defun math-spnp (spn) + "Non-nil if NUM is a scientific pitch note (note + cents). +If non-nil, return a list consisting of the note and the cents coefficient." + (let (note cents rnote rcents) + (if (eq (car-safe spn) '+) + (setq note (nth 1 spn) + cents (nth 2 spn)) + (setq note spn + cents nil)) + (cond + ((and ;; NOTE is a note, CENTS is nil or cents. + (eq (car-safe note) 'calcFunc-subscr) + (assoc (nth 1 note) math-notes) + (integerp (nth 2 note)) + (setq rnote note) + (or + (not cents) + (Math-numberp (setq rcents + (math-simplify + (math-div cents '(var cents var-cents))))))) + (list rnote rcents)) + ((and ;; CENTS is a note, NOTE is cents. + (eq (car-safe cents) 'calcFunc-subscr) + (assoc (nth 1 cents) math-notes) + (integerp (nth 2 cents)) + (setq rnote cents) + (or + (not note) + (Math-numberp (setq rcents + (math-simplify + (math-div note '(var cents var-cents))))))) + (list rnote rcents))))) + +(defun math-freq-to-midi (freq) + "Return the midi note number corresponding to FREQ Hz." + (let ((midi (math-add + 69 + (math-mul + 12 + (calcFunc-log + (math-div freq 440) + 2))))) + (math-midi-round midi))) + +(defun math-spn-to-midi (spn) + "Return the MIDI number corresponding to SPN." + (let* ((note (cdr (assoc (nth 1 (car spn)) math-notes))) + (octave (math-add (nth 2 (car spn)) 1)) + (cents (nth 1 spn)) + (midi (math-add + (math-mul 12 octave) + note))) + (if cents + (math-add midi (math-div cents 100)) + midi))) + +(defun math-midi-to-spn (midi) + "Return the scientific pitch notation corresponding to midi number MIDI." + (let (midin cents) + (if (math-integerp midi) + (setq midin midi + cents nil) + (setq midin (math-floor midi) + cents (math-mul 100 (math-sub midi midin)))) + (let* ((nr ;; This should be (math-idivmod midin 12), but with + ;; better behavior for negative midin. + (if (Math-negp midin) + (let ((dm (math-idivmod (math-neg midin) 12))) + (if (= (cdr dm) 0) + (cons (math-neg (car dm)) 0) + (cons + (math-sub (math-neg (car dm)) 1) + (math-sub 12 (cdr dm))))) + (math-idivmod midin 12))) + (n (math-sub (car nr) 1)) + (note (car (rassoc (cdr nr) math-notes)))) + (if cents + (list '+ (list 'calcFunc-subscr note n) + (list '* cents '(var cents var-cents))) + (list 'calcFunc-subscr note n))))) + +(defun math-freq-to-spn (freq) + "Return the scientific pitch notation corresponding to FREQ Hz." + (math-with-extra-prec 3 + (math-midi-to-spn (math-freq-to-midi freq)))) + +(defun math-midi-to-freq (midi) + "Return the frequency of the note with midi number MIDI." + (list '* + (math-mul + 440 + (math-pow + 2 + (math-div + (math-sub + midi + 69) + 12))) + '(var Hz var-Hz))) + +(defun math-spn-to-freq (spn) + "Return the frequency of the note with scientific pitch notation SPN." + (math-midi-to-freq (math-spn-to-midi spn))) + +(defun calcFunc-spn (expr) + "Return EXPR written as scientific pitch notation + cents." + ;; Get the coeffecient of Hz + (let (note) + (cond + ((setq note (math-freqp expr)) + (math-freq-to-spn note)) + ((setq note (math-midip expr)) + (math-midi-to-spn note)) + ((math-spnp expr) + expr) + (t + (math-reject-arg expr "*Improper expression"))))) + +(defun calcFunc-midi (expr) + "Return EXPR written as a MIDI number." + (let (note) + (cond + ((setq note (math-freqp expr)) + (math-freq-to-midi note)) + ((setq note (math-spnp expr)) + (math-spn-to-midi note)) + ((math-midip expr) + expr) + (t + (math-reject-arg expr "*Improper expression"))))) + +(defun calcFunc-freq (expr) + "Return the frequency corresponding to EXPR." + (let (note) + (cond + ((setq note (math-midip expr)) + (math-midi-to-freq note)) + ((setq note (math-spnp expr)) + (math-spn-to-freq note)) + ((math-freqp expr) + expr) + (t + (math-reject-arg expr "*Improper expression"))))) + +(defun calc-freq (arg) + "Return the frequency corresponding to the expression on the stack." + (interactive "P") + (calc-slow-wrapper + (calc-unary-op "freq" 'calcFunc-freq arg))) + +(defun calc-midi (arg) + "Return the MIDI number corresponding to the expression on the stack." + (interactive "P") + (calc-slow-wrapper + (calc-unary-op "midi" 'calcFunc-midi arg))) + +(defun calc-spn (arg) + "Return the scientific pitch notation corresponding to the expression on the stack." + (interactive "P") + (calc-slow-wrapper + (calc-unary-op "spn" 'calcFunc-spn arg))) + + (provide 'calc-units) -;; Local Variables: -;; coding: iso-latin-1 +;; Local variables: +;; coding: utf-8 ;; End: -;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4 ;;; calc-units.el ends here diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index c9ed2a0481d..47ef3241b3e 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1,7 +1,6 @@ ;;; calc-vec.el --- vector functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -451,16 +450,18 @@ (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1)))))) (defun calc-histogram (n) - (interactive "NNumber of bins: ") + (interactive "P") + (unless (natnump n) + (setq n (math-read-expr (read-string "Centers of bins: ")))) (calc-slow-wrapper (if calc-hyperbolic-flag (calc-enter-result 2 "hist" (list 'calcFunc-histogram (calc-top-n 2) (calc-top-n 1) - (prefix-numeric-value n))) + n)) (calc-enter-result 1 "hist" (list 'calcFunc-histogram (calc-top-n 1) - (prefix-numeric-value n)))))) + n))))) (defun calc-transpose (arg) (interactive "P") @@ -758,12 +759,13 @@ (math-reject-arg n "*Index out of range"))))) (defun calcFunc-subscr (mat n &optional m) - (setq mat (calcFunc-mrow mat n)) - (if m - (if (math-num-integerp n) - (calcFunc-mrow mat m) - (calcFunc-mcol mat m)) - mat)) + (if (eq (car-safe mat) 'var) nil + (setq mat (calcFunc-mrow mat n)) + (if m + (if (math-num-integerp n) + (calcFunc-mrow mat m) + (calcFunc-mcol mat m)) + mat))) ;;; Get the Nth column of a matrix. (defun math-mat-col (mat n) @@ -1135,22 +1137,53 @@ (if (Math-vectorp wts) (or (= (length vec) (length wts)) (math-dimension-error))) - (or (natnump n) - (math-reject-arg n 'fixnatnump)) - (let ((res (make-vector n 0)) - (vp vec) - (wvec (Math-vectorp wts)) - (wp wts) - bin) - (while (setq vp (cdr vp)) - (setq bin (car vp)) - (or (natnump bin) - (setq bin (math-floor bin))) - (and (natnump bin) - (< bin n) - (aset res bin (math-add (aref res bin) - (if wvec (car (setq wp (cdr wp))) wts))))) - (cons 'vec (append res nil)))) + (cond ((natnump n) + (let ((res (make-vector n 0)) + (vp vec) + (wvec (Math-vectorp wts)) + (wp wts) + bin) + (while (setq vp (cdr vp)) + (setq bin (car vp)) + (or (natnump bin) + (setq bin (math-floor bin))) + (and (natnump bin) + (< bin n) + (aset res bin + (math-add (aref res bin) + (if wvec (car (setq wp (cdr wp))) wts))))) + (cons 'vec (append res nil)))) + ((Math-vectorp n) ;; n is a vector of midpoints + (let* ((bds (math-vector-avg n)) + (res (make-vector (1- (length n)) 0)) + (vp (cdr vec)) + (wvec (Math-vectorp wts)) + (wp wts) + num) + (while vp + (setq num (car vp)) + (let ((tbds (cdr bds)) + (i 0)) + (while (and tbds (Math-lessp (car tbds) num)) + (setq i (1+ i)) + (setq tbds (cdr tbds))) + (aset res i + (math-add (aref res i) + (if wvec (car (setq wp (cdr wp))) wts)))) + (setq vp (cdr vp))) + (cons 'vec (append res nil)))) + (t + (math-reject-arg n "*Expecting an integer or vector")))) + +;;; Replace a vector [a b c ...] with a vector of averages +;;; [(a+b)/2 (b+c)/2 ...] +(defun math-vector-avg (vec) + (let ((vp (sort (copy-sequence (cdr vec)) 'math-beforep)) + (res nil)) + (while (and vp (cdr vp)) + (setq res (cons (math-div (math-add (car vp) (cadr vp)) 2) res) + vp (cdr vp))) + (cons 'vec (reverse res)))) ;;; Set operations. @@ -1642,5 +1675,4 @@ of two matrices is a matrix." (provide 'calc-vec) -;; arch-tag: 7902a7af-ec69-440a-8635-ebb4db263402 ;;; calc-vec.el ends here diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 18c3393ad08..2360cf00ddc 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -1,7 +1,6 @@ ;;; calc-yank.el --- kill-ring functionality for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -282,11 +281,8 @@ With prefix arg, also delete the region." (setq single t) (setq arg (prefix-numeric-value arg)) (if (= arg 0) - (save-excursion - (beginning-of-line) - (setq top (point)) - (end-of-line) - (setq bot (point))) + (setq top (point-at-bol) + bot (point-at-eol)) (save-excursion (setq top (point)) (forward-line arg) @@ -713,5 +709,4 @@ To cancel the edit, simply kill the *Calc Edit* buffer." ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5 ;;; calc-yank.el ends here diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 8f18b4931b7..41f549cbe2c 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,7 +1,6 @@ ;;; calc.el --- the GNU Emacs calculator -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -419,12 +418,51 @@ in normal mode." :group 'calc :type 'boolean) -(defcustom calc-undo-length +(defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." :group 'calc :type 'integer) +(defcustom calc-highlight-selections-with-faces + nil + "If non-nil, use a separate face to indicate selected sub-formulas. +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'." + :group 'calc + :type 'boolean) + +(defcustom calc-lu-field-reference + "20 uPa" + "The default reference level for logarithmic units (field)." + :group 'calc + :type '(string)) + +(defcustom calc-lu-power-reference + "mW" + "The default reference level for logarithmic units (power)." + :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." + :type 'string + :group 'calc) + +(defface calc-nonselected-face + '((t :inherit shadow + :slant italic)) + "Face used to show the non-selected portion of a formula." + :group 'calc) + +(defface calc-selected-face + '((t :weight bold)) + "Face used to show the selected portion of a formula." + :group 'calc) + (defvar calc-bug-address "jay.p.belanger@gmail.com" "Address of the maintainer of Calc, for use by `report-calc-bug'.") @@ -797,6 +835,7 @@ Used by `calc-user-invocation'.") calc-matrix-mode calc-inverse-flag calc-hyperbolic-flag + calc-option-flag calc-keep-args-flag calc-angle-mode calc-number-radix @@ -926,6 +965,8 @@ Used by `calc-user-invocation'.") "If non-nil, next operation is Inverse.") (defvar calc-hyperbolic-flag nil "If non-nil, next operation is Hyperbolic.") +(defvar calc-option-flag nil + "If non-nil, next operation has Optional behavior.") (defvar calc-keep-args-flag nil "If non-nil, next operation should not remove its arguments from stack.") (defvar calc-function-open "(" @@ -996,9 +1037,12 @@ Used by `calc-user-invocation'.") (defvar math-working-step-2 nil) (defvar var-i '(special-const (math-imaginary 1))) (defvar var-pi '(special-const (math-pi))) +(defvar var-Ï€ '(special-const (math-pi))) (defvar var-e '(special-const (math-e))) (defvar var-phi '(special-const (math-phi))) +(defvar var-φ '(special-const (math-phi))) (defvar var-gamma '(special-const (math-gamma-const))) +(defvar var-γ '(special-const (math-gamma-const))) (defvar var-Modes '(special-const (math-get-modes-vec))) (mapc (lambda (v) (or (boundp v) (set v nil))) @@ -1034,12 +1078,13 @@ Used by `calc-user-invocation'.") (define-key map "\C-j" 'calc-over) (define-key map "\C-y" 'calc-yank) (define-key map [mouse-2] 'calc-yank) + (define-key map [remap undo] 'calc-undo) (mapc (lambda (x) (define-key map (char-to-string x) 'undefined)) "lOW") (mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) - (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz" - ":\\|!()[]<>{},;=~`\C-k\C-w\C-_")) + (concat "ABCDEFGHIJKLMNOPQRSTUVXZabcdfghjkmoprstuvwxyz" + ":\\|!()[]<>{},;=~`\C-k\C-w")) (define-key map "\M-w" 'calc-missing-key) (define-key map "\M-k" 'calc-missing-key) (define-key map "\M-\C-w" 'calc-missing-key) @@ -1227,7 +1272,7 @@ the trail buffer." ;; Eventually, prompt user with a list of buffers using embedded mode. (when (and info-list - (yes-or-no-p + (yes-or-no-p (concat "This Calc stack is being used for embedded mode. Kill anyway?"))) (while info-list (with-current-buffer (car (car info-list)) @@ -1379,8 +1424,7 @@ commands given here will actually operate on the *Calculator* stack." (set (make-local-variable 'calc-main-buffer) buf)) (when (= (buffer-size) 0) (let ((buffer-read-only nil)) - (insert (propertize (concat "Emacs Calculator Trail\n") - 'font-lock-face 'italic)))) + (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))) (run-mode-hooks 'calc-trail-mode-hook)) (defun calc-create-buffer () @@ -1619,6 +1663,7 @@ See calc-keypad for details." (calc-select-buffer) (setq calc-inverse-flag nil calc-hyperbolic-flag nil + calc-option-flag nil calc-keep-args-flag nil))) (when (memq 'do-edit calc-command-flags) (switch-to-buffer (get-buffer-create "*Calc Edit*"))) @@ -1757,6 +1802,7 @@ See calc-keypad for details." (> (calc-stack-size) 0) (calc-top 1 'sel)) "Sel " "") (if calc-display-dirty "Dirty " "") + (if calc-option-flag "Opt " "") (if calc-inverse-flag "Inv " "") (if calc-hyperbolic-flag "Hyp " "") (if calc-keep-args-flag "Keep " "") @@ -1968,7 +2014,7 @@ See calc-keypad for details." (erase-buffer) (when calc-show-banner (insert (propertize "--- Emacs Calculator Mode ---\n" - 'font-lock-face 'italic))) + 'face 'italic))) (while thing (goto-char (point-min)) (when calc-show-banner @@ -2378,7 +2424,7 @@ See calc-keypad for details." (progn (require 'calc-ext) (calc-digit-dots)) - (delete-backward-char 1) + (delete-char -1) (beep) (calc-temp-minibuffer-message " [Bad format]")))))) (setq calc-prev-prev-char calc-prev-char @@ -3401,7 +3447,7 @@ largest Emacs integer.") (Math-lessp a math-half-2-word-size)) (and (Math-integer-negp a) (require 'calc-ext) - (let ((comparison + (let ((comparison (math-compare (Math-integer-neg a) math-half-2-word-size))) (or (= comparison 0) (= comparison -1)))))) @@ -3545,7 +3591,7 @@ largest Emacs integer.") (math-normalize (save-match-data (cond - + ;; Integers (most common case) ((string-match "\\` *\\([0-9]+\\) *\\'" s) (let ((digs (math-match-substring s 1))) @@ -3557,22 +3603,22 @@ largest Emacs integer.") (if (<= (length digs) (* 2 math-bignum-digit-length)) (string-to-number digs) (cons 'bigpos (math-read-bignum digs)))))) - + ;; Clean up the string if necessary ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) (math-read-number (concat (math-match-substring s 1) (math-match-substring s 2)))) - + ;; Plus and minus signs ((string-match "^[-_+]\\(.*\\)$" s) (let ((val (math-read-number (math-match-substring s 1)))) (and val (if (eq (aref s 0) ?+) val (math-neg val))))) - + ;; Forms that require extensions module ((string-match "[^-+0-9eE.]" s) (require 'calc-ext) (math-read-number-fancy s)) - + ;; Decimal point ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) (let ((int (math-match-substring s 1)) @@ -3585,7 +3631,7 @@ largest Emacs integer.") (list 'float (math-add (math-scale-int int flen) frac) (- flen))))))) - + ;; "e" notation ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) (let ((mant (math-match-substring s 1)) @@ -3596,7 +3642,7 @@ largest Emacs integer.") (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) (let ((mant (math-float mant))) (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) - + ;; Syntax error! (t nil))))) @@ -3789,7 +3835,7 @@ See Info node `(calc)Defining Functions'." (setq unread-command-event nil) (setq unread-command-events nil))) -(defcalcmodevar math-2-word-size +(defcalcmodevar math-2-word-size (math-read-number-simple "4294967296") "Two to the power of `calc-word-size'.") @@ -3806,5 +3852,8 @@ See Info node `(calc)Defining Functions'." (provide 'calc) -;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f +;; Local variables: +;; coding: utf-8 +;; End: + ;;; calc.el ends here diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 4a2fb053983..25b51fc89f6 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1,7 +1,6 @@ ;;; calcalg2.el --- more algebraic functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1886,9 +1885,9 @@ ;; math-scan-for-limits. (defvar calc-low) (defvar calc-high) -(defvar var) +(defvar math-var) -(defun calcFunc-table (expr var &optional calc-low calc-high step) +(defun calcFunc-table (expr math-var &optional calc-low calc-high step) (or calc-low (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf))) (or calc-high (setq calc-high calc-low calc-low 1)) @@ -1917,7 +1916,7 @@ (math-working-step-2 (1+ count)) (math-working-step 0)) (setq expr (math-evaluate-expr - (math-expr-subst expr var '(var DUMMY var-DUMMY)))) + (math-expr-subst expr math-var '(var DUMMY var-DUMMY)))) (while (>= count 0) (setq math-working-step (1+ math-working-step) var-DUMMY calc-low @@ -1940,7 +1939,7 @@ (calc-record-why 'integerp calc-high)) (calc-record-why 'integerp calc-low))) (append (list (or math-tabulate-function 'calcFunc-table) - expr var) + expr math-var) (and (not (and (equal calc-low '(neg (var inf var-inf))) (equal calc-high '(var inf var-inf)))) (list calc-low calc-high)) @@ -1950,11 +1949,11 @@ (cond ((Math-primp x)) ((and (eq (car x) 'calcFunc-subscr) (Math-vectorp (nth 1 x)) - (math-expr-contains (nth 2 x) var)) + (math-expr-contains (nth 2 x) math-var)) (let* ((calc-next-why nil) - (low-val (math-solve-for (nth 2 x) 1 var nil)) + (low-val (math-solve-for (nth 2 x) 1 math-var nil)) (high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x))) - var nil)) + math-var nil)) temp) (and low-val (math-realp low-val) high-val (math-realp high-val)) @@ -3669,5 +3668,4 @@ (provide 'calcalg2) -;; arch-tag: f2932ec8-dd63-418b-a542-11a644b9d4c4 ;;; calcalg2.el ends here diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 600d21303c4..a9118964b46 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -1,7 +1,6 @@ ;;; calcalg3.el --- more algebraic functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1928,5 +1927,4 @@ (provide 'calcalg3) -;; arch-tag: ff9f2920-8111-48b5-b3fa-b0682c3e44a6 ;;; calcalg3.el ends here diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 5a7d5d75907..906517ac503 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1,7 +1,6 @@ ;;; calccomp.el --- composition functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -50,19 +49,19 @@ ;;; ;;; (tag X C) Composition C corresponds to sub-expression X -;; math-comp-just and math-comp-comma-spc are local to -;; math-compose-expr, but are used by math-compose-matrix, which is +;; math-comp-just and math-comp-comma-spc are local to +;; math-compose-expr, but are used by math-compose-matrix, which is ;; called by math-compose-expr (defvar math-comp-just) (defvar math-comp-comma-spc) -;; math-comp-vector-prec is local to math-compose-expr, but is used by -;; math-compose-matrix and math-compose-rows, which are called by +;; math-comp-vector-prec is local to math-compose-expr, but is used by +;; math-compose-matrix and math-compose-rows, which are called by ;; math-compose-expr. (defvar math-comp-vector-prec) -;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are -;; local to math-compose-expr, but are used by math-compose-rows, which is +;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are +;; local to math-compose-expr, but are used by math-compose-rows, which is ;; called by math-compose-expr. (defvar math-comp-left-bracket) (defvar math-comp-right-bracket) @@ -100,7 +99,7 @@ (list 'tag a (math-compose-expr a prec)))) ((and (not (consp a)) (not (integerp a))) (concat "'" (prin1-to-string a))) - ((setq spfn (assq (car-safe a) + ((setq spfn (assq (car-safe a) (get calc-language 'math-special-function-table))) (setq spfn (cdr spfn)) (if (consp spfn) @@ -111,12 +110,12 @@ (and (nth 1 calc-frac-format) (Math-integerp a))) (if (and calc-language - (not (memq calc-language + (not (memq calc-language '(flat big unform)))) (let ((aa (math-adjust-fraction a)) (calc-frac-format nil)) (math-compose-expr (list '/ - (if (memq calc-language + (if (memq calc-language calc-lang-slash-idiv) (math-float (nth 1 aa)) (nth 1 aa)) @@ -281,22 +280,22 @@ (cdr a) (if full rows 3) t))))) (if (or calc-full-vectors (< (length a) 7)) - (if (and + (if (and (setq spfn (get calc-language 'math-matrix-formatter)) (math-matrixp a)) (funcall spfn a) (list 'horiz math-comp-left-bracket - (math-compose-vector (cdr a) + (math-compose-vector (cdr a) (concat math-comp-comma " ") math-comp-vector-prec) math-comp-right-bracket)) (list 'horiz math-comp-left-bracket (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) - (concat math-comp-comma " ") + (concat math-comp-comma " ") math-comp-vector-prec) - math-comp-comma + math-comp-comma (if (setq spfn (get calc-language 'math-dots)) (concat " " spfn) " ...") @@ -663,6 +662,8 @@ (and prevc nextc (or (and (>= nextc ?a) (<= nextc ?z)) (and (>= nextc ?A) (<= nextc ?Z)) + (and (>= nextc ?α) (<= nextc ?ω)) + (and (>= nextc ?Α) (<= nextc ?Ω)) (and (>= nextc ?0) (<= nextc ?9)) (memq nextc '(?. ?_ ?# ?\( ?\[ ?\{)) @@ -732,7 +733,7 @@ (not (math-tex-expr-is-flat (nth 1 a)))))) (list 'horiz (if lr "\\left" "") - (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op)) + (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'" (car op)) (substring (car op) 1) (car op)) (if (or lr (> (length (car op)) 2)) " " "") @@ -758,7 +759,7 @@ (t (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op)))) (list 'horiz - (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" + (let ((ops (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'" (car op)) (substring (car op) 1) (car op)))) @@ -806,7 +807,7 @@ (setq func (car func2))) (setq func (math-remove-dashes (if (string-match - "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" + "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'" (symbol-name func)) (math-match-substring (symbol-name func) 1) (symbol-name func)))) @@ -867,7 +868,7 @@ math-comp-vector-prec) (if (= col cols) "" - (concat + (concat math-comp-comma-spc " "))))) a))) res))) @@ -878,7 +879,7 @@ (if (<= count 0) (if (< count 0) (math-compose-rows (cdr a) -1 nil) - (cons (concat + (cons (concat (let ((mdots (get calc-language 'math-dots))) (if mdots (concat " " mdots) @@ -1117,7 +1118,7 @@ (if (memq prec '(196 201)) ")" ""))))) ;; The variables math-svo-c, math-svo-wid and math-svo-off are local -;; to math-stack-value-offset in calc.el, but are used by +;; to math-stack-value-offset in calc.el, but are used by ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. (defvar math-svo-c) (defvar math-svo-wid) @@ -1193,11 +1194,11 @@ ;;; of the formula. ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word, -;; math-comp-level, math-comp-margin and math-comp-buf are local to -;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, +;; math-comp-level, math-comp-margin and math-comp-buf are local to +;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, ;; which is called by math-comp-to-string-flat. -;; math-comp-highlight and math-comp-buf are also local to -;; math-comp-simplify-term and math-comp-simplify respectively, but are used +;; math-comp-highlight and math-comp-buf are also local to +;; math-comp-simplify-term and math-comp-simplify respectively, but are used ;; by math-comp-add-string. (defvar math-comp-full-width) (defvar math-comp-highlight) @@ -1242,7 +1243,7 @@ (cond ((not (consp c)) (if math-comp-highlight (setq c (math-comp-highlight-string c))) - (setq math-comp-word (if (= (length math-comp-word) 0) c + (setq math-comp-word (if (= (length math-comp-word) 0) c (concat math-comp-word c)) math-comp-pos (+ math-comp-pos (length c)))) @@ -1281,12 +1282,7 @@ (let ((prefix "") mrg wid) (setq mrg (aref math-comp-buf-margin i)) (if (> mrg 12) ; indenting too far, go back to far left - (let ((j i) (new (if calc-line-numbering 5 1))) - '(while (<= j math-comp-level) - (aset math-comp-buf-margin j - (+ (aref math-comp-buf-margin j) (- new mrg))) - (setq j (1+ j))) - (setq mrg new))) + (setq mrg (if calc-line-numbering 5 1))) (setq wid (+ (length str) math-comp-margin)) (and (> (length str) 0) (= (aref str 0) ? ) (> (length math-comp-buf) 0) @@ -1337,16 +1333,19 @@ (defun math-comp-highlight-string (s) (setq s (copy-sequence s)) - (let ((i (length s))) - (while (>= (setq i (1- i)) 0) - (or (memq (aref s i) '(32 ?\n)) - (aset s i (if calc-show-selections ?\. ?\#))))) - s) - + (if calc-highlight-selections-with-faces + (if (not calc-show-selections) + (propertize s 'face 'calc-selected-face) + (propertize s 'face 'calc-nonselected-face)) + (let ((i (length s))) + (while (>= (setq i (1- i)) 0) + (or (memq (aref s i) '(32 ?\n)) + (aset s i (if calc-show-selections ?\. ?\#))))) + s)) ;; The variable math-comp-sel-tag is local to calc-find-selected-part -;; in calc-sel.el, but is used by math-comp-sel-flat-term and -;; math-comp-add-string-sel, which are called (indirectly) by +;; in calc-sel.el, but is used by math-comp-sel-flat-term and +;; math-comp-add-string-sel, which are called (indirectly) by ;; calc-find-selected-part. (defvar math-comp-sel-tag) @@ -1666,5 +1665,8 @@ (provide 'calccomp) -;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78 +;; Local variables: +;; coding: utf-8 +;; End: + ;;; calccomp.el ends here diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index dfe79d07a8b..f44da07763f 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -1,7 +1,6 @@ ;;; calcsel2.el --- selection functions for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -300,5 +299,4 @@ (provide 'calcsel2) -;; arch-tag: 7c5b8d65-b8f0-45d9-820d-9930f8ee114b ;;; calcsel2.el ends here |