diff options
| author | Ken Raeburn <raeburn@raeburn.org> | 2015-11-01 01:42:21 -0400 |
|---|---|---|
| committer | Ken Raeburn <raeburn@raeburn.org> | 2015-11-01 01:42:21 -0400 |
| commit | 39372e1a1032521be74575bb06f95a3898fbae30 (patch) | |
| tree | 754bd242a23d2358ea116126fcb0a629947bd9ec /lisp/calc | |
| parent | 6a3121904d76e3b2f63007341d48c5c1af55de80 (diff) | |
| parent | e11aaee266da52937a3a031cb108fe13f68958c3 (diff) | |
| download | emacs-39372e1a1032521be74575bb06f95a3898fbae30.tar.gz | |
merge from trunk
Diffstat (limited to 'lisp/calc')
44 files changed, 635 insertions, 417 deletions
diff --git a/lisp/calc/.gitignore b/lisp/calc/.gitignore deleted file mode 100644 index a46b68dccbd..00000000000 --- a/lisp/calc/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.elc -calc-loaddefs.el diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 6b0cfbb55d9..f4754c73e7e 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -1,6 +1,6 @@ ;;; calc-aent.el --- algebraic entry functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -30,6 +30,7 @@ (require 'calc-macs) ;; Declare functions which are defined elsewhere. +(declare-function calc-digit-start-entry "calc" ()) (declare-function calc-refresh-evaltos "calc-ext" (&optional which-var)) (declare-function calc-execute-kbd-macro "calc-prog" (mac arg &rest prefix)) (declare-function math-is-true "calc-ext" (expr)) @@ -52,7 +53,7 @@ "The history list for quick-calc.") ;;;###autoload -(defun calc-do-quick-calc () +(defun calc-do-quick-calc (&optional insert) (require 'calc-ext) (calc-check-defines) (if (eq major-mode 'calc-mode) @@ -108,7 +109,8 @@ (setq buf long)))) (calc-handle-whys) (message "Result: %s" buf))) - (if (eq last-command-event 10) + (if (or insert + (eq last-command-event 10)) (insert shortbuf) (kill-new shortbuf))))) @@ -449,12 +451,7 @@ The value t means abort and give an error message.") ;;;###autoload (defun calc-alg-digit-entry () (calc-alg-entry - (cond ((eq last-command-event ?e) - (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e")) - ((eq last-command-event ?#) (format "%d#" calc-number-radix)) - ((eq last-command-event ?_) "-") - ((eq last-command-event ?@) "0@ ") - (t (char-to-string last-command-event))))) + (calc-digit-start-entry))) ;; The variable calc-digit-value is initially declared in calc.el, ;; but can be set by calcDigit-algebraic and calcDigit-edit. @@ -1056,7 +1053,7 @@ If the current Calc language does not use placeholders, return nil." (defun math-read-if (cond op) (let ((then (math-read-expr-level 0))) (or (equal math-expr-data ":") - (throw 'syntax "Expected ':'")) + (throw 'syntax "Expected `:'")) (math-read-token) (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) @@ -1176,7 +1173,7 @@ If the current Calc language does not use placeholders, return nil." (setq el (cdr el)))) (if (equal math-expr-data "]") (math-read-token) - (throw 'syntax "Expected ']'"))) + (throw 'syntax "Expected `]'"))) val))))) ((eq math-exp-token 'dollar) (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data)))) @@ -1265,7 +1262,6 @@ 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: diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 2240c1c81b3..ebc5ba66ec6 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -1,6 +1,6 @@ ;;; calc-alg.el --- algebraic functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -293,7 +293,7 @@ (Math-objectp a)) ((eq (car a) 'var) (if (eq (car b) 'var) - (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b))) + (string-lessp (nth 1 a) (nth 1 b)) (not (Math-numberp b)))) ((eq (car b) 'var) (Math-numberp a)) ((eq (car a) (car b)) @@ -302,7 +302,7 @@ (and b (or (null a) (math-beforep (car a) (car b))))) - (t (string-lessp (symbol-name (car a)) (symbol-name (car b)))))) + (t (string-lessp (car a) (car b))))) (defsubst math-simplify-extended (a) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index c64a4f49fe8..de27c5684e6 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -1,6 +1,6 @@ ;;; calc-arith.el --- arithmetic functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -2249,7 +2249,7 @@ (defun math-min-list (a b) (if b - (if (or (Math-anglep (car b)) (eq (car b) 'date) + (if (or (Math-anglep (car b)) (eq (caar b) 'date) (and (eq (car (car b)) 'intv) (math-intv-constp (car b))) (math-infinitep (car b))) (math-min-list (math-min a (car b)) (cdr b)) @@ -2279,7 +2279,7 @@ (defun math-max-list (a b) (if b - (if (or (Math-anglep (car b)) (eq (car b) 'date) + (if (or (Math-anglep (car b)) (eq (caar b) 'date) (and (eq (car (car b)) 'intv) (math-intv-constp (car b))) (math-infinitep (car b))) (math-max-list (math-max a (car b)) (cdr b)) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index a159488b935..9a1e524e609 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -1,6 +1,6 @@ ;;; calc-bin.el --- binary functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index e09bef0b5c9..4e52a3b144e 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -1,6 +1,6 @@ ;;; calc-comb.el --- combinatoric functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -815,8 +815,14 @@ (list nil v) '(t)))) ((not (equal n (car math-prime-test-cache))) - (cond ((= (% (nth 1 n) 2) 0) '(nil 2)) - ((= (% (nth 1 n) 5) 0) '(nil 5)) + (cond ((if (consp n) + (= (% (nth 1 n) 2) 0) + (= (% n 2) 0)) + '(nil 2)) + ((if (consp n) + (= (% (nth 1 n) 5) 0) + (= (% n 5) 0)) + '(nil 5)) (t (let ((q n) (sum 0)) (while (not (eq q 0)) (setq sum (% diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index 34297e83a5d..edcd3c21a0b 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -1,6 +1,6 @@ ;;; calc-cplx.el --- Complex number functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 0da9be0d499..d0efe53f6e6 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -1,6 +1,6 @@ ;;; calc-embed.el --- embed Calc in a buffer -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -30,7 +30,8 @@ (require 'calc-macs) ;; Declare functions which are defined elsewhere. -(declare-function thing-at-point-looking-at "thingatpt" (regexp)) +(declare-function thing-at-point-looking-at "thingatpt" + (regexp &optional distance)) (defun calc-show-plain (n) @@ -329,10 +330,12 @@ (if calc-embedded-firsttime-formula (run-hooks 'calc-embedded-new-formula-hook)) (or (eq calc-embedded-quiet t) - (message "Embedded Calc mode enabled; %s to return to normal" - (if calc-embedded-quiet - "Type `C-x * x'" - "Give this command again"))))) + (message (concat + "Embedded Calc mode enabled; " + (if calc-embedded-quiet + "Type `C-x * x'" + "Give this command again") + " to return to normal"))))) (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 2cb5bf450d5..9adf66f23bd 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,6 +1,6 @@ ;;; calc-ext.el --- various extension functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -561,6 +561,7 @@ (define-key calc-mode-map "ud" 'calc-define-unit) (define-key calc-mode-map "ue" 'calc-explain-units) (define-key calc-mode-map "ug" 'calc-get-unit-definition) + (define-key calc-mode-map "un" 'calc-convert-exact-units) (define-key calc-mode-map "up" 'calc-permanent-units) (define-key calc-mode-map "ur" 'calc-remove-units) (define-key calc-mode-map "us" 'calc-simplify-units) @@ -573,6 +574,7 @@ (define-key calc-mode-map "uG" 'calc-vector-geometric-mean) (define-key calc-mode-map "uM" 'calc-vector-mean) (define-key calc-mode-map "uN" 'calc-vector-min) + (define-key calc-mode-map "uR" 'calc-vector-rms) (define-key calc-mode-map "uS" 'calc-vector-sdev) (define-key calc-mode-map "uU" 'calc-undo) (define-key calc-mode-map "uX" 'calc-vector-max) @@ -931,7 +933,7 @@ calc-preserve-point calc-replace-selections calc-replace-sub-formula calc-roll-down-with-selections calc-roll-up-with-selections calc-sel-error) - ("calc-stat" calc-vector-op calcFunc-agmean + ("calc-stat" calc-vector-op calcFunc-agmean calcFunc-rms calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov @@ -1096,10 +1098,10 @@ calc-tan calc-tanh calc-to-degrees calc-to-radians) ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode calc-always-load-extensions calc-auto-recompute calc-auto-why -calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors -calc-center-justify calc-default-simplify-mode calc-display-raw -calc-eng-notation calc-ext-simplify-mode calc-fix-notation -calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char +calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors +calc-center-justify calc-default-simplify-mode calc-display-raw +calc-eng-notation calc-ext-simplify-mode calc-fix-notation +calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char calc-group-digits calc-infinite-mode calc-left-justify calc-left-label calc-line-breaking calc-line-numbering calc-matrix-brackets calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode @@ -1146,8 +1148,8 @@ calc-vector-covariance calc-vector-geometric-mean calc-vector-harmonic-mean calc-vector-max calc-vector-mean calc-vector-mean-error calc-vector-median calc-vector-min calc-vector-pop-covariance calc-vector-pop-sdev -calc-vector-pop-variance calc-vector-product calc-vector-sdev -calc-vector-sum calc-vector-variance) +calc-vector-pop-variance calc-vector-product calc-vector-rms +calc-vector-sdev calc-vector-sum calc-vector-variance) ("calc-store" calc-assign calc-copy-special-constant calc-copy-variable calc-declare-variable @@ -1176,7 +1178,8 @@ calc-trail-scroll-right calc-trail-yank) ("calc-undo" calc-last-args calc-redo) ("calc-units" calc-autorange-units calc-base-units -calc-convert-temperature calc-convert-units calc-define-unit +calc-convert-temperature calc-convert-units +calc-convert-exact-units calc-define-unit calc-enter-units-table calc-explain-units calc-extract-units calc-get-unit-definition calc-permanent-units calc-quick-units calc-remove-units calc-simplify-units calc-undefine-unit @@ -1243,7 +1246,7 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-record-message (tag &rest args) - (let ((msg (apply 'format args))) + (let ((msg (apply #'format-message args))) (message "%s" msg) (calc-record msg tag)) (calc-clear-command-flag 'clear-message)) @@ -1290,6 +1293,7 @@ calc-kill calc-kill-region calc-yank)))) (define-key calc-help-map "?" 'calc-help-for-help) (define-key calc-help-map "\C-h" 'calc-help-for-help)) +(defvar calc-prefix-help-retry nil) (defvar calc-prefix-help-phase 0) (defun calc-do-prefix-help (msgs group key) (if calc-full-help-flag @@ -1297,7 +1301,7 @@ calc-kill calc-kill-region calc-yank)))) (if (cdr msgs) (progn (setq calc-prefix-help-phase - (if (eq this-command last-command) + (if calc-prefix-help-retry (% (1+ calc-prefix-help-phase) (1+ (length msgs))) 0)) (let ((msg (nth calc-prefix-help-phase msgs))) @@ -1318,7 +1322,13 @@ calc-kill calc-kill-region calc-yank)))) (message "%s: %s: %c-" group (car msgs) key) (message "%s: (none) %c-" group key)) (message "%s: %s" group (car msgs)))) - (and key (calc-unread-command key)))) + (let* ((chr (read-char)) + (bnd (local-key-binding (if key (string key chr) (string chr))))) + (setq calc-prefix-help-retry (= chr ??)) + (if bnd + (call-interactively bnd) + (message "%s is undefined" + (key-description (if key (vector key chr) (vector chr)))))))) ;;;; Commands. @@ -1955,7 +1965,7 @@ calc-kill calc-kill-region calc-yank)))) (desc (if (symbolp func) (if (= (logand kind 3) 0) - (format "`%c' = %s" key name) + (format-message "`%c' = %s" key name) (if pos (format "%s%c%s" (downcase (substring name 0 pos)) @@ -1986,7 +1996,7 @@ calc-kill calc-kill-region calc-yank)))) "kbd-macros: [ (if), : (else), | (else-if), ] (end-if)" "kbd-macros: < > (repeat), ( ) (for), { } (loop)" "kbd-macros: / (break)" - "kbd-macros: ` (save), ' (restore)") + "kbd-macros: \\=` (save), \\=' (restore)") "user" ?Z)) @@ -3497,8 +3507,4 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") (provide 'calc-ext) -;; 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 a93a57c79ee..76c34e63ef8 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -1,6 +1,6 @@ ;;; calc-fin.el --- financial functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 77efb1efc84..08fa5ceaa79 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1,6 +1,6 @@ ;;; calc-forms.el --- data format conversion functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -63,7 +63,7 @@ (defun calc-hms-notation (fmt) - (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ") + (interactive "sHours-minutes-seconds format (hms, @ \\=' \", etc.): ") (calc-wrapper (if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt) (progn @@ -273,7 +273,10 @@ (m (math-normalize (nth 2 a))) (s (let ((calc-internal-prec (max (- calc-internal-prec 4) 3))) (math-normalize (nth 3 a))))) - (if (math-negp h) + (if (or + (math-negp h) + (and (= h 0) (math-negp m)) + (and (= h 0) (= m 0) (math-negp s))) (progn (if (math-posp s) (setq s (math-add s -60) @@ -375,15 +378,15 @@ ;;; A numerical date is the number of days since midnight on ;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian). ;;; Emacs's calendar refers to such a date as an absolute date, some Calc function -;;; names also use that terminology. If the date is a non-integer, it represents -;;; a specific date and time. +;;; names also use that terminology. If the date is a non-integer, it represents +;;; a specific date and time. ;;; A "dt" is a list of the form, (year month day), corresponding to ;;; an integer code, or (year month day hour minute second), corresponding ;;; to a non-integer code. (defun math-date-to-gregorian-dt (date) "Return the day (YEAR MONTH DAY) in the Gregorian calendar. -DATE is the number of days since December 31, -1 in the Gregorian calendar." +DATE is the number of days since December 31, -1 in the Gregorian calendar." (let* ((month 1) day (year (math-quotient (math-add date (if (Math-lessp date 711859) @@ -396,7 +399,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar." (setq year (math-add year -1))) (if (eq year 0) (setq year -1)) (setq date (1+ (math-sub date temp))) - (setq temp + (setq temp (if (math-leap-year-p year) [1 32 61 92 122 153 183 214 245 275 306 336 999] [1 32 60 91 121 152 182 213 244 274 305 335 999])) @@ -407,7 +410,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar." (defun math-date-to-julian-dt (date) "Return the day (YEAR MONTH DAY) in the Julian calendar. -DATE is the number of days since December 31, -1 in the Gregorian calendar." +DATE is the number of days since December 31, -1 in the Gregorian calendar." (let* ((month 1) day (year (math-quotient (math-add date (if (Math-lessp date 711859) @@ -420,7 +423,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar." (setq year (math-add year -1))) (if (eq year 0) (setq year -1)) (setq date (1+ (math-sub date temp))) - (setq temp + (setq temp (if (math-leap-year-p year t) [1 32 61 92 122 153 183 214 245 275 306 336 999] [1 32 60 91 121 152 182 213 244 274 305 335 999])) @@ -441,7 +444,7 @@ in the Gregorian calendar and the remaining part determines the time." (date (car parts)) (time (nth 1 parts)) (dt (if (and calc-gregorian-switch - (Math-lessp value + (Math-lessp value (or (nth 3 calc-gregorian-switch) (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch)) @@ -450,7 +453,7 @@ in the Gregorian calendar and the remaining part determines the time." (math-date-to-gregorian-dt date)))) (if (math-integerp value) dt - (append dt + (append dt (list (/ time 3600) (% (/ time 60) 60) @@ -464,13 +467,13 @@ in the Gregorian calendar and the remaining part determines the time." (year (math-add approx (let ((y approx) (sum 0)) - (while (>= (math-compare date + (while (>= (math-compare date (math-absolute-from-iso-dt (setq y (math-add y 1)) 1 1)) 0) (setq sum (+ sum 1))) sum)))) - (list + (list year - (math-add (car (math-idivmod + (math-add (car (math-idivmod (math-sub date (math-absolute-from-iso-dt year 1 1)) 7)) 1) @@ -522,7 +525,7 @@ in the Gregorian calendar and the remaining part determines the time." (defun math-leap-year-p (year &optional julian) "Non-nil if YEAR is a leap year. If JULIAN is non-nil, then use the criterion for leap years -in the Julian calendar, otherwise use the criterion in the +in the Julian calendar, otherwise use the criterion in the Gregorian calendar." (if julian (if (math-negp year) @@ -581,7 +584,7 @@ Recall that DATE is the number of days since December 31, -1 in the Gregorian calendar." (if (eq year 0) (setq year -1)) (let ((yearm1 (math-sub year 1))) - (math-sub + (math-sub ;; Add the number of days of the year and the numbers of days ;; in the previous years (leap year days to be added separately) (math-add (math-day-in-year year month day) @@ -592,9 +595,9 @@ in the Gregorian calendar." (math-sub 365 (math-quotient (math-sub 3 year) 4))))) - ;; Subtract the number of Julian leap years which are not - ;; Gregorian leap years. In C=4N+r centuries, there will - ;; be 3N+r of these days. The following will compute + ;; Subtract the number of Julian leap years which are not + ;; Gregorian leap years. In C=4N+r centuries, there will + ;; be 3N+r of these days. The following will compute ;; 3N+r. (let* ((correction (math-mul (math-quotient yearm1 100) 3)) (res (math-idivmod correction 4))) @@ -609,7 +612,7 @@ Recall that DATE is the number of days since December 31, -1 in the Gregorian calendar." (if (eq year 0) (setq year -1)) (let ((yearm1 (math-sub year 1))) - (math-sub + (math-sub ;; Add the number of days of the year and the numbers of days ;; in the previous years (leap year days to be added separately) (math-add (math-day-in-year year month day) @@ -728,11 +731,11 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." ((eq x 'n) (math-format-number (math-floor math-fd-date))) ((eq x 'J) - (math-format-number + (math-format-number (math-add math-fd-date math-julian-date-beginning))) ((eq x 'j) - (math-format-number (math-add - (math-floor math-fd-date) + (math-format-number (math-add + (math-floor math-fd-date) math-julian-date-beginning-int))) ((eq x 'U) (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) @@ -1079,7 +1082,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (throw 'syntax "Day value is out of range")) (and hour (progn - (if (or (< hour 0) + (if (or (< hour 0) (> hour 24) (and (= hour 24) (not (= minute 0)) @@ -1099,7 +1102,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (throw 'syntax "Weekday value is out of range")) (and hour (progn - (if (or (< hour 0) + (if (or (< hour 0) (> hour 24) (and (= hour 24) (not (= minute 0)) @@ -1435,11 +1438,11 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (defun calcFunc-unixtime (date &optional zone) (if (math-realp date) (progn - (setq date (math-add 719164 (math-div date '(float 864 2)))) + (setq date (math-add 719163 (math-div date '(float 864 2)))) (list 'date (math-sub date (math-div (calcFunc-tzone zone date) '(float 864 2))))) (if (eq (car date) 'date) - (math-add (nth 1 (math-date-parts (nth 1 date) 719164)) + (math-add (nth 1 (math-date-parts (nth 1 date) 719163)) (calcFunc-tzone zone date)) (math-reject-arg date 'datep)))) @@ -1470,7 +1473,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." ;; From cal-dst (defvar calendar-current-time-zone-cache) -(defvar math-calendar-tzinfo +(defvar math-calendar-tzinfo nil "Information about the timezone, retrieved from the calendar.") @@ -1520,7 +1523,7 @@ second, the number of seconds offset for daylight savings." (if (calc-var-value 'var-TimeZone) (calcFunc-tzone (calc-var-value 'var-TimeZone) date) (let ((tzinfo (math-get-calendar-tzinfo))) - (+ (nth 0 tzinfo) + (+ (nth 0 tzinfo) (* (math-cal-daylight-savings-adjust date) (nth 1 tzinfo))))))) (defvar math-daylight-savings-hook 'math-std-daylight-savings) @@ -1556,8 +1559,8 @@ second, the number of seconds offset for daylight savings." (+ (nth 3 dt) (/ (nth 4 dt) 60.0))) (t 0))) - (rounded-abs-date - (+ + (rounded-abs-date + (+ (calendar-absolute-from-gregorian (list (nth 1 dt) (nth 2 dt) (nth 0 dt))) (/ (round (* 60 time)) 60.0 24.0)))) @@ -1697,7 +1700,7 @@ and ends on the last Sunday of October at 2 a.m." (let* ((dt (math-date-to-dt date)) (dim (math-days-in-month (car dt) (nth 1 dt))) (julian (if calc-gregorian-switch - (math-date-to-dt (math-sub + (math-date-to-dt (math-sub (or (nth 3 calc-gregorian-switch) (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch)) 1))))) @@ -1724,14 +1727,14 @@ and ends on the last Sunday of October at 2 a.m." (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day)))) ;; Otherwise do some computations (let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian))))) - (list 'date (math-dt-to-date + (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) - ;; + ;; (if (> tm dim) dim tm))))))) ((and (eq (car dt) (car julian)) (= (nth 1 dt) (nth 1 julian))) - ;; In this case, the current month is truncated because of the switch + ;; In this case, the current month is truncated because of the switch ;; to the Gregorian calendar (list 'date (math-dt-to-date (list (car dt) @@ -1739,7 +1742,7 @@ and ends on the last Sunday of October at 2 a.m." (if (>= day (nth 2 julian)) (nth 2 julian) (1+ day)))))) - (t + (t ;; The default (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))) (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))) @@ -1776,7 +1779,7 @@ and ends on the last Sunday of October at 2 a.m." ;; Otherwise, just make sure the date doesn't go past the end of the year (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day)) (math-dt-to-date (list (car dt) 12 31)))))) - (t + (t (list 'date (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))))) (list 'date (math-add (math-dt-to-date (list (car dt) 1 1)) diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 63288054bb3..830bafed6ce 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -1,6 +1,6 @@ ;;; calc-frac.el --- fraction functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 24dd95d23eb..51922c88099 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -1,6 +1,6 @@ ;;; calc-funcs.el --- well-known functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 16fc6c09dbe..20b0249ec1a 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1,6 +1,6 @@ ;;; calc-graph.el --- graph output functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 2b7b56c3f89..33cb1c1566c 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -1,6 +1,6 @@ ;;; calc-help.el --- help display functions for Calc, -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -30,7 +30,7 @@ (require 'calc-macs) ;; Declare functions which are defined elsewhere. -(declare-function Info-goto-node "info" (nodename &optional fork)) +(declare-function Info-goto-node "info" (nodename &optional fork strict-case)) (declare-function Info-last "info" ()) @@ -239,7 +239,7 @@ C-w Describe how there is no warranty for Calc." (setq prompts (substring prompts 0 (match-beginning 0)))) (if (string-match "\\` +" prompts) (setq prompts (substring prompts (match-end 0)))) - (setq msg (format + (setq msg (format-message "%s: %s%s`%s'%s%s %s%s" (if (string-match "\\`\\(calc-[-a-zA-Z0-9]+\\) *\\(.*\\)\\'" @@ -364,23 +364,21 @@ C-w Describe how there is no warranty for Calc." (error "Can't find `%s' in %s" thing where))) (let (Info-history) (Info-goto-node (buffer-substring (match-beginning 1) (match-end 1)))) - (or (let ((case-fold-search nil)) - (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'" - (or target thing) - (or target thing) - (or target thing)) nil t) - (and not-quoted - (let ((case-fold-search t)) - (search-forward (or target thing) nil t))) - (search-forward (format "`%s'" (or target thing)) nil t) - (search-forward (or target thing) nil t))) - (let ((case-fold-search t)) - (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'" - (or target thing) - (or target thing) - (or target thing)) nil t) - (search-forward (format "`%s'" (or target thing)) nil t) - (search-forward (or target thing) nil t)))) + (let* ((string-target (or target thing)) + (quoted (format "['`‘]%s['’]" (regexp-quote string-target))) + (bracketed (format "\\[%s\\]\\|(%s)\\|\\<The[ \n]%s" + quoted quoted quoted))) + (or (let ((case-fold-search nil)) + (or (re-search-forward bracketed nil t) + (and not-quoted + (let ((case-fold-search t)) + (search-forward string-target nil t))) + (re-search-forward quoted nil t) + (search-forward string-target nil t))) + (let ((case-fold-search t)) + (or (re-search-forward bracketed nil t) + (re-search-forward quoted nil t) + (search-forward string-target nil t))))) (beginning-of-line) (message "Found `%s' in %s" thing where))) @@ -388,7 +386,7 @@ C-w Describe how there is no warranty for Calc." (interactive) (calc-quit) (view-emacs-news) - (re-search-forward "^\*+ .*\\<Calc\\>" nil t)) + (re-search-forward "^\\*+ .*\\<Calc\\>" nil t)) (defvar calc-help-long-names '((?b . "binary/business") (?g . "graphics") @@ -402,11 +400,14 @@ C-w Describe how there is no warranty for Calc." (princ "GNU Emacs Calculator.\n") (princ " By Dave Gillespie.\n") (princ (format " %s\n\n" emacs-copyright)) - (princ "Type `h s' for a more detailed summary.\n") - (princ "Or type `h i' to read the full Calc manual on-line.\n\n") + (princ (format-message "Type `h s' for a more detailed summary.\n")) + (princ (format-message + "Or type `h i' to read the full Calc manual on-line.\n\n")) (princ "Basic keys:\n") (let* ((calc-full-help-flag t)) - (mapc (function (lambda (x) (princ (format " %s\n" x)))) + (mapc (function (lambda (x) (princ (format + " %s\n" + (substitute-command-keys x))))) (nreverse (cdr (reverse (cdr (calc-help)))))) (mapc (function (lambda (prefix) (let ((msgs (condition-case err @@ -415,9 +416,10 @@ C-w Describe how there is no warranty for Calc." (if (car msgs) (princ (if (eq (nth 2 msgs) ?v) - "\n`v' or `V' prefix (vector/matrix) keys: \n" + (format-message + "\n`v' or `V' prefix (vector/matrix) keys: \n") (if (nth 2 msgs) - (format + (format-message "\n`%c' prefix (%s) keys:\n" (nth 2 msgs) (or (cdr (assq (nth 2 msgs) @@ -425,8 +427,11 @@ C-w Describe how there is no warranty for Calc." (nth 1 msgs))) (format "\n%s-modified keys:\n" (capitalize (nth 1 msgs))))))) - (mapcar (function (lambda (x) - (princ (format " %s\n" x)))) + (mapcar (function + (lambda (x) + (princ (format + " %s\n" + (substitute-command-keys x))))) (car msgs))))) '(calc-inverse-prefix-help calc-hyperbolic-prefix-help @@ -541,7 +546,7 @@ C-w Describe how there is no warranty for Calc." '("Select, Additional, Once; eVal, Formula; Rewrite" "More, Less, 1-9, Next, Previous" "Unselect, Clear; Display; Enable; Breakable" - "' (replace), ` (edit), +, -, *, /, RET (grab), DEL" + "\\=' (replace), \\=` (edit), +, -, *, /, RET (grab), DEL" "SHIFT + swap: Left, Right; maybe: Select, Once" "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate" "SHIFT + Negate, & (invert); Unpack") @@ -647,7 +652,7 @@ C-w Describe how there is no warranty for Calc." (defun calc-u-prefix-help () (interactive) (calc-do-prefix-help - '("Simplify, Convert, Temperature-convert, Base-units" + '("Simplify, Convert, coNvert exact, Temperature-convert, Base-units" "Autorange; Remove, eXtract; Explain; View-table; 0-9" "Define, Undefine, Get-defn, Permanent" "SHIFT + View-table-other-window" diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index d86668ce328..b2856b99adc 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -1,6 +1,6 @@ ;;; calc-incom.el --- complex data type input functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index bd24bf7f15d..18e900dc241 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -1,6 +1,6 @@ ;;; calc-keypd.el --- mouse-capable keypad input for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 965cb65e8db..94366060a41 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -1,6 +1,6 @@ ;;; calc-lang.el --- calc language functions -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -94,7 +94,7 @@ (interactive) (calc-wrapper (calc-set-language 'c) - (message "`C' language mode"))) + (message "C language mode"))) (put 'c 'math-oper-table '( ( "u!" calcFunc-lnot -1 1000 ) @@ -1211,7 +1211,7 @@ (interactive) (calc-wrapper (calc-set-language 'yacas) - (message "`Yacas' language mode"))) + (message "Yacas language mode"))) (put 'yacas 'math-vector-brackets "{}") @@ -1427,7 +1427,7 @@ (interactive) (calc-wrapper (calc-set-language 'maxima) - (message "`Maxima' language mode"))) + (message "Maxima language mode"))) (put 'maxima 'math-oper-table '(("+" + 100 100) @@ -1625,7 +1625,7 @@ (interactive) (calc-wrapper (calc-set-language 'giac) - (message "`Giac' language mode"))) + (message "Giac language mode"))) (put 'giac 'math-oper-table '( ( "[" (math-read-giac-subscr) 250 -1 ) @@ -1817,7 +1817,7 @@ order to Calc's." (defun math-read-giac-subscr (x op) (let ((idx (math-read-expr-level 0))) (or (equal math-expr-data "]") - (throw 'syntax "Expected ']'")) + (throw 'syntax "Expected `]'")) (math-read-token) (list 'calcFunc-subscr x (calc-normalize (list '+ idx 1))))) @@ -1954,7 +1954,7 @@ order to Calc's." (progn (math-read-token) (equal math-expr-data "]"))) - (throw 'syntax "Expected ']]'")) + (throw 'syntax "Expected `]]'")) (math-read-token) (list 'calcFunc-subscr x idx))) @@ -2432,7 +2432,8 @@ order to Calc's." (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 `:'")) + (math-read-big-error math-read-big-h2 baseline + "Expected `:'")) (setq p (list (nth 1 widest) p y (math-read-big-rec (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 @@ -2507,7 +2508,8 @@ order to Calc's." (while (> count 0) (if (>= h len) (if what - (math-read-big-error nil v (format "Unmatched `%s'" what)) + (math-read-big-error nil v (format-message + "Unmatched `%s'" what)) (setq count 0)) (if (memq (aref line h) '(?\( ?\[)) (setq count (1+ count)) @@ -2523,8 +2525,4 @@ order to Calc's." (provide 'calc-lang) -;; 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 4b75f8d4ae8..9730d30a86b 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -1,6 +1,6 @@ ;;; calc-macs.el --- important macros for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index cfc5a19701f..d2c9da86a6f 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -1,6 +1,6 @@ ;;; calc-map.el --- higher-order functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -417,6 +417,7 @@ ( ?G 1 calcFunc-vgmean ) ( ?M 1 calcFunc-vmean ) ( ?N 1 calcFunc-vmin ) + ( ?R 1 calcFunc-rms ) ( ?S 1 calcFunc-vsdev ) ( ?X 1 calcFunc-vmax ) ) ( ( ?C 2 calcFunc-vpcov ) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 3b845f563a1..e7d073a9c7a 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1,6 +1,6 @@ ;;; calc-math.el --- mathematical functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index 5120528eaf4..8610090c5d1 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-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2015 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -863,6 +863,13 @@ :keys "I u M" :active (>= (calc-stack-size) 1) :help "The average (arithmetic mean) of the data values as an error form"] + ["rms(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-rms)) + :keys "u R" + :active (>= (calc-stack-size) 1) + :help "The root mean square of the data values"] ["sdev(1:)" (progn (require 'calc-stat) @@ -917,12 +924,13 @@ (call-interactively 'calc-vector-geometric-mean))) :keys "H u G" :active (>= (calc-stack-size) 1)] - ["RMS(1:)" - (progn (require 'calc-arith) - (call-interactively 'calc-abs)) - :keys "A" - :active (>= (calc-stack-size) 1) - :help "The root-mean-square, or quadratic mean"]) + ;; ["RMS(1:)" + ;; (progn (require 'calc-arith) + ;; (call-interactively 'calc-abs)) + ;; :keys "A" + ;; :active (>= (calc-stack-size) 1) + ;; :help "The root-mean-square, or quadratic mean"] + ) ["Abbreviate long vectors" (progn (require 'calc-mode) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 405131937f9..aa0ccb79edd 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -1,6 +1,6 @@ ;;; calc-misc.el --- miscellaneous functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -89,7 +89,7 @@ For use with Embedded mode: N calc-embedded-next. Advance cursor to next known formula in buffer. P calc-embedded-previous. Advance cursor to previous known formula. U calc-embedded-update-formula. Re-evaluate formula at point. - ` calc-embedded-edit. Use calc-edit to edit formula at point. + \\=` calc-embedded-edit. Use calc-edit to edit formula at point. Documentation: I calc-info. Read the Calculator manual in the Emacs Info system. @@ -225,7 +225,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args" "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)" "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)" - "Other keys: ' (alg-entry), = (eval), ` (edit); M-RET (last-args)" + "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)" "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)" "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)" "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)" @@ -253,11 +253,12 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). 0)) (let ((msg (nth calc-help-phase msgs))) (message "%s" (if msg - (concat msg ":" + (concat (substitute-command-keys msg) ":" (make-string (- (apply 'max (mapcar 'length msgs)) - (length msg)) 32) + (length msg)) + ?\ ) " [?=MORE]") "")))))))) @@ -952,7 +953,7 @@ Prompts for bug subject. Leaves you in a mail buffer." nil nil nil "Please describe exactly what actions triggered the bug and the precise symptoms of the bug. If possible, include a backtrace by -doing 'M-x toggle-debug-on-error', then reproducing the bug. +doing `\\[toggle-debug-on-error]', then reproducing the bug. " ))) ;;;###autoload (defalias 'calc-report-bug 'report-calc-bug) diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index c46a2e5f21c..3ed9612f79a 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -1,6 +1,6 @@ ;;; calc-mode.el --- calculator modes for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -258,7 +258,7 @@ (setq calc-display-raw (if calc-display-raw nil (if arg 0 t))) (calc-do-refresh) (if calc-display-raw - (message "Press d ' again to cancel \"raw\" display mode")))) + (message "%s" "Press d ' again to cancel \"raw\" display mode")))) @@ -410,7 +410,7 @@ ((= n 4) 'global) ((= n 5) 'save) (t 'local))) - (message "%s" + (message "%s" (cond ((and (eq calc-mode-save-mode 'local) calc-embedded-info) "Recording mode changes with [calc-mode: ...]") ((eq calc-mode-save-mode 'edit) @@ -446,11 +446,11 @@ (calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode) (list (not calc-algebraic-mode) nil))) (use-local-map calc-mode-map) - (message (if calc-algebraic-mode - "Numeric keys and ( and [ begin algebraic entry" - (if calc-incomplete-algebraic-mode - "Only ( and [ begin algebraic entry" - "No keys except ' and $ begin algebraic entry"))))) + (message "%s" (if calc-algebraic-mode + "Numeric keys and ( and [ begin algebraic entry" + (if calc-incomplete-algebraic-mode + "Only ( and [ begin algebraic entry" + "No keys except ' and $ begin algebraic entry"))))) (defun calc-symbolic-mode (n) (interactive "P") @@ -478,7 +478,7 @@ (cond ((eq arg 0) 'scalar) ((< (prefix-numeric-value arg) 1) (and (< (prefix-numeric-value arg) -1) 'matrix)) - (arg + (arg (if (consp arg) 'sqmatrix (prefix-numeric-value arg))) ((eq calc-matrix-mode 'matrix) 'scalar) diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index b3df0e3fde8..b8c5ff91093 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -1,6 +1,6 @@ ;;; calc-mtx.el --- matrix functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index bd816c1e29c..8e0eb738682 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-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2015 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 07d725c88e7..1dab3c474aa 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -1,6 +1,6 @@ ;;; calc-poly.el --- polynomial functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 4c4d090d7c9..8d97bc69a2d 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1,6 +1,6 @@ ;;; calc-prog.el --- user programmability functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -139,6 +139,7 @@ "calc-")))) (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) func)? (if old (setcdr old func) (setcdr kmap (cons (cons key func) (cdr kmap)))))))) @@ -322,6 +323,7 @@ (if key (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) cmd)? (if old (setcdr old cmd) (setcdr kmap (cons (cons key cmd) (cdr kmap))))))) @@ -467,6 +469,7 @@ (format "z%c" key))))) (let* ((kmap (calc-user-key-map)) (old (assq key kmap))) + ;; FIXME: Why not (define-key kmap (vector key) func)? (if old (setcdr old cmd) (setcdr kmap (cons (cons key cmd) (cdr kmap)))))))) @@ -594,9 +597,9 @@ ",") ((equal name "#") (search-backward "#") - (error "Token '#' is reserved")) + (error "Token `#' is reserved")) ((and unquoted (string-match "#" name)) - (error "Tokens containing '#' must be quoted")) + (error "Tokens containing `#' must be quoted")) ((not (string-match "[^ ]" name)) (search-backward "\"" nil t) (error "Blank tokens are not allowed")) @@ -607,7 +610,7 @@ (quoted nil)) (while (progn (skip-chars-forward "\n\t ") - (if (eobp) (error "Expected '%s'" eterm)) + (if (eobp) (error "Expected `%s'" eterm)) (not (looking-at term))) (cond ((looking-at "%%") (end-of-line)) @@ -615,7 +618,7 @@ (forward-char 2) (let ((p (calc-read-parse-table-part "}" "}"))) (or (looking-at "[+*?]") - (error "Expected '+', '*', or '?'")) + (error "Expected `+', `*', or `?'")) (let ((sym (intern (buffer-substring (point) (1+ (point)))))) (forward-char 1) (looking-at "[^\n\t ]*") @@ -647,7 +650,7 @@ (match-end 1))))))) (goto-char (match-end 0))) ((looking-at ":=[\n\t ]") - (error "Misplaced ':='")) + (error "Misplaced `:='")) (t (looking-at "[^\n\t ]*") (let ((end (match-end 0))) @@ -1284,37 +1287,37 @@ Redefine the corresponding command." (setq rpt-count (if rpt-count (prefix-numeric-value rpt-count) 1000000)) (let* ((count 0) (parts nil) - (body "") + (body (vector)) (open last-command-event) (counter initial) ch) (or executing-kbd-macro (message "Reading loop body...")) (while (>= count 0) - (setq ch (read-char)) - (if (= ch -1) + (setq ch (read-event)) + (if (eq ch -1) (error "Unterminated Z%c in keyboard macro" open)) - (if (= ch ?Z) + (if (eq ch ?Z) (progn - (setq ch (read-char) - body (concat body "Z" (char-to-string ch))) + (setq ch (read-event) + body (vconcat body (vector ?Z ch))) (cond ((memq ch '(?\< ?\( ?\{)) (setq count (1+ count))) ((memq ch '(?\> ?\) ?\})) (setq count (1- count))) ((and (= ch ?/) (= count 0)) - (setq parts (nconc parts (list (concat (substring body 0 -2) - "Z]"))) + (setq parts (nconc parts (list (vconcat (substring body 0 -2) + (vector ?Z ?\]) ))) body "")) ((eq ch 7) (keyboard-quit)))) - (setq body (concat body (char-to-string ch))))) + (setq body (vconcat body (vector ch))))) (if (/= ch (cdr (assq open '( (?\< . ?\>) (?\( . ?\)) (?\{ . ?\}) )))) (error "Mismatched Z%c and Z%c in keyboard macro" open ch)) (or executing-kbd-macro (message "Looping...")) - (setq body (concat (substring body 0 -2) "Z]")) + (setq body (vconcat (substring body 0 -2) (vector ?Z ?\]) )) (and (not executing-kbd-macro) (= rpt-count 1000000) (null parts) @@ -1438,7 +1441,7 @@ Redefine the corresponding command." (let ((calc-kbd-push-level 0)) (execute-kbd-macro (substring body 0 -2)))) (let ((calc-kbd-push-level (1+ calc-kbd-push-level))) - (message "Saving modes; type Z' to restore") + (message "%s" "Saving modes; type Z' to restore") (recursive-edit)))))) (defun calc-kbd-pop () @@ -1447,7 +1450,7 @@ Redefine the corresponding command." (progn (message "Mode settings restored") (exit-recursive-edit)) - (error "Unbalanced Z' in keyboard macro"))) + (error "%s" "Unbalanced Z' in keyboard macro"))) ;; (defun calc-kbd-report (msg) diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 96c657285b9..e57a6b483c8 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -1,6 +1,6 @@ ;;; calc-rewr.el --- rewriting functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index 8dedc257132..4489f66bf99 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -1,6 +1,6 @@ ;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index ad3c0cc6c3d..ec104ee3c53 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -1,6 +1,6 @@ ;;; calc-sel.el --- data selection functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index db8f9d09cc5..a797db2e67d 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -1,6 +1,6 @@ ;;; calc-stat.el --- statistical functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -71,6 +71,11 @@ (calc-vector-op "meae" 'calcFunc-vmeane arg) (calc-vector-op "mean" 'calcFunc-vmean arg))))) +(defun calc-vector-rms (arg) + (interactive "P") + (calc-slow-wrapper + (calc-vector-op "rms" 'calcFunc-rms arg))) + (defun calc-vector-mean-error (arg) (interactive "P") (calc-invert-func) @@ -318,6 +323,12 @@ suminvsqrwts)) (math-div (calcFunc-reduce '(var add var-add) means) len))))))) +(defun calcFunc-rms (a) + "Return the root-mean-square of the vector A." + (math-sqrt + (calcFunc-vmean + (calcFunc-map '(var abssqr var-abssqr) a)))) + (defun math-fix-int-intv (x) (if (math-floatp x) x diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index e5274b21d8b..2684e627883 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -1,6 +1,6 @@ ;;; calc-store.el --- value storage functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -58,8 +58,8 @@ (let ((msg (calc-store-value var (or calc-given-value (calc-top 1)) "" calc-given-value-flag))) - (message (concat "Stored to variable \"%s\"" msg) - (calc-var-name var))))) + (message "Stored to variable \"%s\"%s" + (calc-var-name var) msg)))) (setq var (calc-is-assignments (calc-top 1))) (if var (while var @@ -67,8 +67,8 @@ (calc-store-value (car (car var)) (cdr (car var)) (if (not (cdr var)) "") (if (not (cdr var)) 1)))) - (message (concat "Stored to variable \"%s\"" msg) - (calc-var-name (car (car var))))) + (message "Stored to variable \"%s\"%s" + (calc-var-name (car (car var))) msg)) (setq var (cdr var)))))))) (defun calc-store-plus (&optional var) @@ -422,8 +422,8 @@ (calc-var-name var1))))) (if var2 (let ((msg (calc-store-value var2 value ""))) - (message (concat "Variable \"%s\" copied to \"%s\"" msg) - (calc-var-name var1) (calc-var-name var2)))))))) + (message "Variable \"%s\" copied to \"%s\"%s" + (calc-var-name var1) (calc-var-name var2) msg))))))) (defvar calc-last-edited-variable nil) (defun calc-edit-variable (&optional var) @@ -442,7 +442,8 @@ (setq calc-last-edited-variable var) (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var)) t - (concat "Editing variable `" (calc-var-name var) "'. ")) + (format-message + "Editing variable `%s'" (calc-var-name var))) (and value (insert (math-format-nice-expr value (frame-width)) "\n"))))) (calc-show-edit-buffer)) @@ -609,7 +610,8 @@ (defun calc-insert-permanent-variable (var) (goto-char (point-min)) - (if (search-forward (concat "(setq " (symbol-name var) " '") nil t) + (if (let (case-fold-search) + (search-forward (concat "(setq " (symbol-name var) " '") nil t)) (progn (setq calc-pv-pos (point-marker)) (forward-line -1) @@ -675,8 +677,4 @@ (provide 'calc-store) -;; 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 9535248c8f9..91ef259a109 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -1,6 +1,6 @@ ;;; calc-stuff.el --- miscellaneous functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index 61824882446..9417f7f3fb6 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -1,6 +1,6 @@ ;;; calc-trail.el --- functions for manipulating the Calc "trail" -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index cfae9b3e227..28c1679354c 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -1,6 +1,6 @@ ;;; calc-undo.el --- undo functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 595d875eb6e..a450d8f82a9 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1,6 +1,6 @@ ;;; calc-units.el --- unit conversion functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -422,7 +422,7 @@ If EXPR is nil, return nil." "Put the units in EXPR in the default units table. If COMP or STD is non-nil, put that in the units table instead." (let* ((new-units (or comp std (math-get-units expr))) - (standard-units (math-get-standard-units + (standard-units (math-get-standard-units (cond (comp (math-simplify-units expr)) (std expr) @@ -457,9 +457,9 @@ If COMP or STD is non-nil, put that in the units table instead." (eq (math-get-standard-units expr) 1)))) (let ((uold (or old-units (progn - (setq uoldname + (setq uoldname (if unitscancel - (read-string + (read-string "(The expression is unitless when simplified) Old Units: ") (read-string "Old units: "))) (if (equal uoldname "") @@ -470,6 +470,8 @@ If COMP or STD is non-nil, put that in the units table instead." (if (string-match "\\` */" uoldname) (setq uoldname (concat "1" uoldname))) (math-read-expr uoldname)))))) + (unless (math-units-in-expr-p uold t) + (error "No units specified")) (when (eq (car-safe uold) 'error) (error "Bad format in units expression: %s" (nth 1 uold))) (setq expr (math-mul expr uold)))) @@ -514,6 +516,38 @@ If COMP or STD is non-nil, put that in the units table instead." (math-put-default-units (if noold units res) (if comp units))) (calc-enter-result 1 "cvun" res)))))) +(defun calc-convert-exact-units () + (interactive) + (calc-slow-wrapper + (let* ((expr (calc-top-n 1))) + (unless (math-units-in-expr-p expr t) + (error "No units in expression.")) + (let* ((old-units (math-extract-units expr)) + (defunits (math-get-default-units expr)) + units + (new-units + (read-string (concat "New units" + (if defunits + (concat + " (default " + defunits + "): ") + ": "))))) + (if (and + (string= new-units "") + defunits) + (setq new-units defunits)) + (setq units (math-read-expr new-units)) + (when (eq (car-safe units) 'error) + (error "Bad format in units expression: %s" (nth 2 units))) + (math-check-unit-consistency old-units units) + (let ((res + (list '* (math-mul (math-remove-units expr) + (math-simplify-units + (math-to-standard-units (list '/ old-units units) nil))) + units))) + (calc-enter-result 1 "cvxu" res)))))) + (defun calc-autorange-units (arg) (interactive "P") (calc-wrapper @@ -904,10 +938,12 @@ If COMP or STD is non-nil, put that in the units table instead." (and (consp expr) (if (eq (car expr) 'var) (math-check-unit-name expr) - (and (or sub-exprs - (memq (car expr) '(* / ^))) - (or (math-units-in-expr-p (nth 1 expr) sub-exprs) - (math-units-in-expr-p (nth 2 expr) sub-exprs)))))) + (if (eq (car expr) 'neg) + (math-units-in-expr-p (nth 1 expr) sub-exprs) + (and (or sub-exprs + (memq (car expr) '(* / ^))) + (or (math-units-in-expr-p (nth 1 expr) sub-exprs) + (math-units-in-expr-p (nth 2 expr) sub-exprs))))))) (defun math-only-units-in-expr-p (expr) (and (consp expr) @@ -924,6 +960,8 @@ If COMP or STD is non-nil, put that in the units table instead." (cond ((math-scalarp expr) nil) ((eq (car expr) 'var) (math-check-unit-name expr)) + ((eq (car expr) 'neg) + (math-single-units-in-expr-p (nth 1 expr))) ((eq (car expr) '*) (let ((u1 (math-single-units-in-expr-p (nth 1 expr))) (u2 (math-single-units-in-expr-p (nth 2 expr)))) @@ -941,7 +979,7 @@ If COMP or STD is non-nil, put that in the units table instead." (or (and (eq (car-safe newunits) 'var) (assq (nth 1 newunits) math-standard-units-systems)) - (math-numberp (math-get-units (list '/ expr newunits))))) + (math-numberp (math-get-units (math-to-standard-units (list '/ expr newunits) nil))))) (defun math-check-unit-consistency (expr units) "Give an error if EXPR and UNITS do not have consistent units." @@ -1079,6 +1117,8 @@ If COMP or STD is non-nil, put that in the units table instead." ((eq (car-safe expr) '/) (or (math-find-compatible-unit-rec (nth 1 expr) pow) (math-find-compatible-unit-rec (nth 2 expr) (- pow)))) + ((eq (car-safe expr) 'neg) + (math-find-compatible-unit-rec (nth 1 expr) pow)) ((and (eq (car-safe expr) '^) (integerp (nth 2 expr))) (math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr)))) @@ -1497,6 +1537,8 @@ If COMP or STD is non-nil, put that in the units table instead." ((memq (car-safe expr) '(* /)) (cons (car expr) (mapcar 'math-extract-units (cdr expr)))) + ((eq (car-safe expr) 'neg) + (math-extract-units (nth 1 expr))) ((eq (car-safe expr) '^) (list '^ (math-extract-units (nth 1 expr)) (nth 2 expr))) ((math-check-unit-name expr) expr) @@ -1579,11 +1621,14 @@ If COMP or STD is non-nil, put that in the units table instead." (insert " " (nth 2 u) "\n") (while (eq (car (car (setq uptr (cdr uptr)))) 0))) (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'.")) + (insert + (format-message + (concat + "(**) 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) @@ -2118,8 +2163,4 @@ If non-nil, return a list consisting of the note and the cents coefficient." (provide 'calc-units) -;; Local variables: -;; coding: utf-8 -;; End: - ;;; calc-units.el ends here diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 35ca41832dd..cd157703f49 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1,6 +1,6 @@ ;;; calc-vec.el --- vector functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1107,7 +1107,7 @@ (cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep))) (math-reject-arg vec 'vectorp))) -;; The variable math-grade-vec is local to calcFunc-grade and +;; The variable math-grade-vec is local to calcFunc-grade and ;; calcFunc-rgrade, but is used by math-grade-beforep, which is called ;; by calcFunc-grade and calcFunc-rgrade. (defvar math-grade-vec) @@ -1149,7 +1149,7 @@ (setq bin (math-floor bin))) (and (natnump bin) (< bin n) - (aset res bin + (aset res bin (math-add (aref res bin) (if wvec (car (setq wp (cdr wp))) wts))))) (cons 'vec (append res nil)))) @@ -1167,7 +1167,7 @@ (while (and tbds (Math-lessp (car tbds) num)) (setq i (1+ i)) (setq tbds (cdr tbds))) - (aset res i + (aset res i (math-add (aref res i) (if wvec (car (setq wp (cdr wp))) wts)))) (setq vp (cdr vp))) @@ -1550,7 +1550,7 @@ of two matrices is a matrix." ;; indirectly) by math-read-brackets. (defvar math-rb-close) -;; 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-pos) (defvar math-exp-str) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index d9807e70c92..5105ba9366c 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -1,6 +1,6 @@ ;;; calc-yank.el --- kill-ring functionality for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -107,29 +107,131 @@ (interactive "r") (calc-kill-region top bot t)) +(defun math-number-regexp (radix-num) + "Return a regexp which will match a Calc number base RADIX-NUM." + (let* ((digit-range + (cond + ;; radix 2 to 10 + ((and (<= 2 radix-num) + (>= 10 radix-num)) + (concat "[0-" + (number-to-string (1- radix-num)) + "]")) + ;; radix 11 + ((= 11 radix-num) "[0-9aA]") + ;; radix 12+ + (t + (concat "[0-9" + "a-" (format "%c" (+ (- ?a 11) radix-num)) + "A-" (format "%c" (+ (- ?A 11) radix-num)) + "]")))) + (integer-regexp (concat digit-range "+")) + (decimal-regexp (concat digit-range "+\\." digit-range "*"))) + (concat + " *\\(" + ;; "e" notation + "[-_+]?" decimal-regexp "[eE][-+]?[0-9]+" + "\\|" + "[-_+]?" integer-regexp "[eE][-+]?[0-9]+" + "\\|" + ;; Integer+fractions + "[-_+]?" integer-regexp "*[:/]" integer-regexp "[:/]" integer-regexp + "\\|" + ;; Fractions + "[-_+]?" integer-regexp "[:/]" integer-regexp + "\\|" + ;; Decimal point + "[-_+]?" decimal-regexp + "\\|" + ;; Integers + "[-_+]?" integer-regexp + "\\) *\\(\n\\|\\'\\)"))) + ;; This function uses calc-last-kill if possible to get an exact result, ;; otherwise it just parses the yanked string. ;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96 ;;;###autoload -(defun calc-yank () - (interactive) +(defun calc-yank (radix) + "Yank a value into the Calculator buffer. + +Valid numeric prefixes for RADIX: 0, 2, 6, 8 +No radix notation is prepended for any other numeric prefix. + +If RADIX is 2, prepend \"2#\" - Binary. +If RADIX is 8, prepend \"8#\" - Octal. +If RADIX is 0, prepend \"10#\" - Decimal. +If RADIX is 6, prepend \"16#\" - Hexadecimal. + +If RADIX is a non-nil list (created using \\[universal-argument]), the user +will be prompted to enter the radix in the minibuffer. + +If RADIX is nil or if the yanked string already has a calc radix prefix, the +yanked string will be passed on directly to the Calculator buffer without any +alteration." + (interactive "P") (calc-wrapper (calc-pop-push-record-list 0 "yank" - (let ((thing (if (fboundp 'current-kill) - (current-kill 0 t) - (car kill-ring-yank-pointer)))) - (if (eq (car-safe calc-last-kill) thing) - (cdr calc-last-kill) - (if (stringp thing) - (let ((val (math-read-exprs (calc-clean-newlines thing)))) - (if (eq (car-safe val) 'error) - (progn - (setq val (math-read-exprs thing)) - (if (eq (car-safe val) 'error) - (error "Bad format in yanked data") - val)) - val)))))))) + (let* (radix-num + radix-notation + valid-num-regexp + (thing-raw + (if (fboundp 'current-kill) + (current-kill 0 t) + (car kill-ring-yank-pointer))) + (thing + (if (or (null radix) + ;; Match examples: -2#10, 10\n(10#10,01) + (string-match-p "^[-(]*[0-9]\\{1,2\\}#" thing-raw)) + thing-raw + (progn + (if (listp radix) + (progn + (setq radix-num + (read-number + "Set radix for yanked content (2-36): ")) + (when (not (and (integerp radix-num) + (<= 2 radix-num) + (>= 36 radix-num))) + (error (concat "The radix has to be an " + "integer between 2 and 36.")))) + (setq radix-num + (cond ((eq radix 2) 2) + ((eq radix 8) 8) + ((eq radix 0) 10) + ((eq radix 6) 16) + (t (message + (concat "No radix prepended " + "for invalid *numeric* " + "prefix %0d.") + radix) + nil)))) + (if radix-num + (progn + (setq radix-notation + (concat (number-to-string radix-num) "#")) + (setq valid-num-regexp + (math-number-regexp radix-num)) + ;; Ensure that the radix-notation is prefixed + ;; correctly even for multi-line yanks like below, + ;; 111 + ;; 1111 + (replace-regexp-in-string + valid-num-regexp + (concat radix-notation "\\&") + thing-raw)) + thing-raw))))) + (if (eq (car-safe calc-last-kill) thing-raw) + (cdr calc-last-kill) + (if (stringp thing) + (let ((val (math-read-exprs (calc-clean-newlines thing)))) + (if (eq (car-safe val) 'error) + (progn + (setq val (math-read-exprs thing)) + (if (eq (car-safe val) 'error) + (error "Bad format in yanked data") + val)) + val)))))))) ;;; The Calc set- and get-register commands are modified versions of functions ;;; in register.el @@ -143,16 +245,13 @@ TEXT and CALCVAL are the TEXT and internal structure of stack entries.") "Set the contents of the Calc register REGISTER to (TEXT . CALCVAL), as well as set the contents of the Emacs register REGISTER to TEXT." (set-register register text) - (let ((aelt (assq register calc-register-alist))) - (if aelt - (setcdr aelt (cons text calcval)) - (push (cons register (cons text calcval)) calc-register-alist)))) + (setf (alist-get register calc-register-alist) (cons text calcval))) (defun calc-get-register (reg) "Return the CALCVAL portion of the contents of the Calc register REG, unless the TEXT portion doesn't match the contents of the Emacs register REG, in which case either return the contents of the Emacs register (if it is -text) or `nil'." +text) or nil." (let ((cval (cdr (assq reg calc-register-alist))) (val (cdr (assq reg register-alist)))) (if (stringp val) @@ -163,8 +262,12 @@ text) or `nil'." (defun calc-copy-to-register (register start end &optional delete-flag) "Copy the lines in the region into register REGISTER. -With prefix arg, delete as well." - (interactive "cCopy to register: \nr\nP") +With prefix arg, delete as well. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Copy to register: ") + (region-beginning) (region-end) + current-prefix-arg)) (if (eq major-mode 'calc-mode) (let* ((top-num (calc-locate-cursor-element start)) (top-pos (save-excursion @@ -183,8 +286,10 @@ With prefix arg, delete as well." (copy-to-register register start end delete-flag))) (defun calc-insert-register (register) - "Insert the contents of register REGISTER." - (interactive "cInsert register: ") + "Insert the contents of register REGISTER. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Insert register: "))) (if (eq major-mode 'calc-mode) (let ((val (calc-get-register register))) (calc-wrapper @@ -237,16 +342,24 @@ otherwise the end. If DELETE-FLAG is non-nil, also delete the region." (defun calc-append-to-register (register start end &optional delete-flag) "Copy the lines in the region to the end of register REGISTER. -With prefix arg, also delete the region." - (interactive "cAppend to register: \nr\nP") +With prefix arg, also delete the region. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Append to register: ") + (region-beginning) (region-end) + current-prefix-arg)) (if (eq major-mode 'calc-mode) (calc-add-to-register register start end nil delete-flag) (append-to-register register start end delete-flag))) (defun calc-prepend-to-register (register start end &optional delete-flag) "Copy the lines in the region to the beginning of register REGISTER. -With prefix arg, also delete the region." - (interactive "cPrepend to register: \nr\nP") +With prefix arg, also delete the region. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Prepend to register: ") + (region-beginning) (region-end) + current-prefix-arg)) (if (eq major-mode 'calc-mode) (calc-add-to-register register start end t delete-flag) (prepend-to-register register start end delete-flag))) @@ -588,13 +701,13 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (add-hook 'kill-buffer-hook (lambda () (let ((calc-edit-handler nil)) (calc-edit-finish t)) - (message "(Cancelled)")) t t) + (message "(Canceled)")) t t) (insert (propertize (concat (or title title "Calc Edit Mode. ") - "Press `C-c C-c'" + (format-message "Press `C-c C-c'") (if allow-ret "" " or RET") - " to finish, `C-x k RET' to cancel.\n\n") + (format-message " to finish, `C-x k RET' to cancel.\n\n")) 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t)) (make-local-variable 'calc-edit-top) (setq calc-edit-top (point)))) @@ -669,7 +782,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (interactive) (let ((calc-edit-handler nil)) (calc-edit-finish)) - (message "(Cancelled)")) + (message "(Canceled)")) (defun calc-finish-stack-edit (num) (let ((buf (current-buffer)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 2eeb880c34d..e44226d8702 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,6 +1,6 @@ ;;; calc.el --- the GNU Emacs calculator -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -146,13 +146,15 @@ (declare-function calc-set-language "calc-lang" (lang &optional option no-refresh)) (declare-function calc-edit-finish "calc-yank" (&optional keep)) (declare-function calc-edit-cancel "calc-yank" ()) -(declare-function calc-do-quick-calc "calc-aent" ()) +(declare-function calc-locate-cursor-element "calc-yank" (pt)) +(declare-function calc-do-quick-calc "calc-aent" (&optional insert)) (declare-function calc-do-calc-eval "calc-aent" (str separator args)) (declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) (declare-function calcFunc-unixtime "calc-forms" (date &optional zone)) (declare-function math-parse-date "calc-forms" (math-pd-str)) (declare-function math-lessp "calc-ext" (a b)) (declare-function math-compare "calc-ext" (a b)) +(declare-function math-zerop "calc-misc" (a)) (declare-function calc-embedded-finish-command "calc-embed" ()) (declare-function calc-embedded-select-buffer "calc-embed" ()) (declare-function calc-embedded-mode-line-change "calc-embed" ()) @@ -426,6 +428,14 @@ when converting units." :version "24.3" :type 'boolean) +(defcustom calc-context-sensitive-enter + nil + "If non-nil, the stack element under the cursor will be copied by `calc-enter' +and deleted by `calc-pop'." + :group 'calc + :version "24.4" + :type 'boolean) + (defcustom calc-undo-length 100 "The number of undo steps that will be preserved when Calc is quit." @@ -726,7 +736,7 @@ If hms, angles are in degrees-minutes-seconds.") (defcalcmodevar calc-algebraic-mode nil "If non-nil, numeric entry accepts whole algebraic expressions. -If nil, algebraic expressions must be preceded by \"'\".") +If nil, algebraic expressions must be preceded by \"\\='\".") (defcalcmodevar calc-incomplete-algebraic-mode nil "Like calc-algebraic-mode except only affects ( and [ keys.") @@ -979,11 +989,11 @@ Used by `calc-user-invocation'.") (defvar calc-last-kill nil "The last number killed in calc-mode.") (defvar calc-dollar-values nil - "Values to be used for '$'.") + "Values to be used for `$'.") (defvar calc-dollar-used nil - "The highest order of '$' that occurred.") + "The highest order of `$' that occurred.") (defvar calc-hashes-used nil - "The highest order of '#' that occurred.") + "The highest order of `#' that occurred.") (defvar calc-quick-prev-results nil "Previous results from Quick Calc.") (defvar calc-said-hello nil @@ -1095,20 +1105,18 @@ Used by `calc-user-invocation'.") "The key map for entering Calc digits.") (mapc (lambda (x) - (condition-case err - (progn - (define-key calc-digit-map x 'calcDigit-backspace) - (define-key calc-mode-map x 'calc-pop) - (define-key calc-mode-map - (if (and (vectorp x) (featurep 'xemacs)) - (if (= (length x) 1) - (vector (if (consp (aref x 0)) - (cons 'meta (aref x 0)) - (list 'meta (aref x 0)))) - "\e\C-d") - (vconcat "\e" x)) - 'calc-pop-above)) - (error nil))) + (ignore-errors + (define-key calc-digit-map x 'calcDigit-backspace) + (define-key calc-mode-map x 'calc-pop) + (define-key calc-mode-map + (if (and (vectorp x) (featurep 'xemacs)) + (if (= (length x) 1) + (vector (if (consp (aref x 0)) + (cons 'meta (aref x 0)) + (list 'meta (aref x 0)))) + "\e\C-d") + (vconcat "\e" x)) + 'calc-pop-above))) (if calc-scan-for-dels (append (where-is-internal 'delete-backward-char global-map) (where-is-internal 'backward-delete-char global-map) @@ -1179,25 +1187,24 @@ Used by `calc-user-invocation'.") ;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch) ;;;###autoload -(defun calc-dispatch (&optional arg) +(defun calc-dispatch (&optional _arg) "Invoke the GNU Emacs Calculator. See \\[calc-dispatch-help] for details." - (interactive "P") + (interactive) ; (sit-for echo-keystrokes) - (condition-case err ; look for other keys bound to calc-dispatch - (let ((keys (this-command-keys))) - (unless (or (not (stringp keys)) - (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys) - (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface)) - (when (and (string-match "\\`[\C-@-\C-_]" keys) - (symbolp - (lookup-key calc-dispatch-map (substring keys 0 1)))) - (define-key calc-dispatch-map (substring keys 0 1) nil)) - (define-key calc-dispatch-map keys 'calc-same-interface))) - (error nil)) - (calc-do-dispatch arg)) + (ignore-errors ; look for other keys bound to calc-dispatch + (let ((keys (this-command-keys))) + (unless (or (not (stringp keys)) + (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys) + (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface)) + (when (and (string-match "\\`[\C-@-\C-_]" keys) + (symbolp + (lookup-key calc-dispatch-map (substring keys 0 1)))) + (define-key calc-dispatch-map (substring keys 0 1) nil)) + (define-key calc-dispatch-map keys 'calc-same-interface)))) + (calc-do-dispatch)) (defvar calc-dispatch-help nil) -(defun calc-do-dispatch (arg) +(defun calc-do-dispatch (&optional _arg) "Start the Calculator." (let ((key (calc-read-key-sequence (if calc-dispatch-help @@ -1215,8 +1222,7 @@ Used by `calc-user-invocation'.") (defun calc-read-key-sequence (prompt map) "Read keys, with prompt PROMPT and keymap MAP." - (let ((prompt2 (format "%s " (key-description (this-command-keys)))) - (glob (current-global-map)) + (let ((glob (current-global-map)) (loc (current-local-map))) (or (input-pending-p) (message "%s" prompt)) (let ((key (calc-read-key t)) @@ -1244,7 +1250,6 @@ embedded information from the appropriate buffers and tidy up the trail buffer." (let ((cb (current-buffer)) (info-list nil) - (buflist) ; (plural nil) (cea calc-embedded-active)) ;; Get a list of all buffers using this buffer for @@ -1301,7 +1306,7 @@ This is an RPN calculator featuring arbitrary-precision integer, rational, floating-point, complex, matrix, and symbolic arithmetic. RPN calculation: 2 RET 3 + produces 5. -Algebraic style: ' 2+3 RET produces 5. +Algebraic style: \\=' 2+3 RET produces 5. Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign). @@ -1320,7 +1325,7 @@ Notations: 3.14e6 3.14 * 10^6 [1 .. 4) semi-open interval, 1 <= x < 4 2 +/- 3 (p key) number with mean 2, standard deviation 3 2 mod 3 (M key) number 2 computed modulo 3 - <1 jan 91> Date form (enter using ' key) + <1 jan 91> Date form (enter using \\=' key) \\{calc-mode-map} @@ -1387,7 +1392,12 @@ Notations: 3.14e6 3.14 * 10^6 (calc-check-defines)) (setplist 'calc-define nil))))) -(defun calc-trail-mode (&optional buf) +(defvar calc-trail-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map calc-mode-map) + map)) + +(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail" "Calc Trail mode. This mode is used by the *Calc Trail* buffer, which records all results obtained by the GNU Emacs Calculator. @@ -1397,26 +1407,18 @@ the Trail. This buffer uses the same key map as the *Calculator* buffer; calculator commands given here will actually operate on the *Calculator* stack." - (interactive) - (fundamental-mode) - (use-local-map calc-mode-map) - (setq major-mode 'calc-trail-mode) - (setq mode-name "Calc Trail") (setq truncate-lines t) (setq buffer-read-only t) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (when buf - (set (make-local-variable 'calc-main-buffer) buf)) (when (= (buffer-size) 0) (let ((buffer-read-only nil)) - (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))) - (run-mode-hooks 'calc-trail-mode-hook)) + (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))) (defun calc-create-buffer () "Create and initialize a buffer for the Calculator." (set-buffer (get-buffer-create "*Calculator*")) - (or (eq major-mode 'calc-mode) + (or (derived-mode-p 'calc-mode) (calc-mode)) (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) (when calc-always-load-extensions @@ -1439,44 +1441,43 @@ commands given here will actually operate on the *Calculator* stack." (when (get-buffer-window "*Calc Keypad*") (calc-keypad) (set-buffer (window-buffer))) - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (calc-quit) - (let ((oldbuf (current-buffer))) - (calc-create-buffer) - (setq calc-was-keypad-mode nil) - (if (or (eq full-display t) - (and (null full-display) calc-full-mode)) - (switch-to-buffer (current-buffer) t) - (if (get-buffer-window (current-buffer)) - (select-window (get-buffer-window (current-buffer))) - (if calc-window-hook - (run-hooks 'calc-window-hook) - (let ((w (get-largest-window))) - (if (and pop-up-windows - (> (window-height w) - (+ window-min-height calc-window-height 2))) - (progn - (setq w (split-window w - (- (window-height w) - calc-window-height 2) - nil)) - (set-window-buffer w (current-buffer)) - (select-window w)) - (pop-to-buffer (current-buffer))))))) - (with-current-buffer (calc-trail-buffer) - (and calc-display-trail - (= (window-width) (frame-width)) - (calc-trail-display 1 t))) - (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit") - (run-hooks 'calc-start-hook) - (and (windowp full-display) - (window-point full-display) - (select-window full-display)) - (calc-check-defines) - (when (and calc-said-hello interactive) - (sit-for 2) - (message "")) - (setq calc-said-hello t))))) + (calc-create-buffer) + (setq calc-was-keypad-mode nil) + (if (or (eq full-display t) + (and (null full-display) calc-full-mode)) + (switch-to-buffer (current-buffer) t) + (if (get-buffer-window (current-buffer)) + (select-window (get-buffer-window (current-buffer))) + (if calc-window-hook + (run-hooks 'calc-window-hook) + (let ((w (get-largest-window))) + (if (and pop-up-windows + (> (window-height w) + (+ window-min-height calc-window-height 2))) + (progn + (setq w (split-window w + (- (window-height w) + calc-window-height 2) + nil)) + (set-window-buffer w (current-buffer)) + (select-window w)) + (pop-to-buffer (current-buffer))))))) + (with-current-buffer (calc-trail-buffer) + (and calc-display-trail + (= (window-width) (frame-width)) + (calc-trail-display 1 t))) + (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit") + (run-hooks 'calc-start-hook) + (and (windowp full-display) + (window-point full-display) + (select-window full-display)) + (calc-check-defines) + (when (and calc-said-hello interactive) + (sit-for 2) + (message "")) + (setq calc-said-hello t)))) ;;;###autoload (defun full-calc (&optional interactive) @@ -1490,7 +1491,7 @@ commands given here will actually operate on the *Calculator* stack." (if (and (equal (buffer-name) "*Gnuplot Trail*") (> (recursion-depth) 0)) (exit-recursive-edit) - (if (eq major-mode 'calc-edit-mode) + (if (derived-mode-p 'calc-edit-mode) (calc-edit-finish arg) (if calc-was-keypad-mode (calc-keypad) @@ -1504,13 +1505,13 @@ commands given here will actually operate on the *Calculator* stack." (if (and (equal (buffer-name) "*Gnuplot Trail*") (> (recursion-depth) 0)) (exit-recursive-edit)) - (if (eq major-mode 'calc-edit-mode) + (if (derived-mode-p 'calc-edit-mode) (calc-edit-cancel) (if (and interactive calc-embedded-info (eq (current-buffer) (aref calc-embedded-info 0))) (calc-embedded nil) - (unless (eq major-mode 'calc-mode) + (unless (derived-mode-p 'calc-mode) (calc-create-buffer)) (run-hooks 'calc-end-hook) (if (integerp calc-undo-length) @@ -1543,10 +1544,12 @@ commands given here will actually operate on the *Calculator* stack." (and kbuf (bury-buffer kbuf)))))) ;;;###autoload -(defun quick-calc () - "Do a quick calculation in the minibuffer without invoking full Calculator." - (interactive) - (calc-do-quick-calc)) +(defun quick-calc (&optional insert) + "Do a quick calculation in the minibuffer without invoking full Calculator. +With prefix argument INSERT, insert the result in the current +buffer. Otherwise, the result is copied into the kill ring." + (interactive "P") + (calc-do-quick-calc insert)) ;;;###autoload (defun calc-eval (str &optional separator &rest args) @@ -1631,10 +1634,10 @@ See calc-keypad for details." (if (math-lessp 1 time) (calc-record time "(t)")))) (or (memq 'no-align calc-command-flags) - (eq major-mode 'calc-trail-mode) + (derived-mode-p 'calc-trail-mode) (calc-align-stack-window)) (and (memq 'position-point calc-command-flags) - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (progn (goto-char (point-min)) (forward-line (1- calc-final-point-line)) @@ -1664,7 +1667,7 @@ See calc-keypad for details." (setq calc-command-flags (cons f calc-command-flags)))) (defun calc-select-buffer () - (or (eq major-mode 'calc-mode) + (or (derived-mode-p 'calc-mode) (if calc-main-buffer (set-buffer calc-main-buffer) (let ((buf (get-buffer "*Calculator*"))) @@ -1801,7 +1804,7 @@ See calc-keypad for details." (and calc-embedded-info (calc-embedded-mode-line-change)))))) (defun calc-align-stack-window () - (if (eq major-mode 'calc-mode) + (if (derived-mode-p 'calc-mode) (progn (let ((win (get-buffer-window (current-buffer)))) (if win @@ -1988,11 +1991,11 @@ See calc-keypad for details." (defvar calc-any-evaltos nil) (defun calc-refresh (&optional align) (interactive) - (and (eq major-mode 'calc-mode) + (and (derived-mode-p 'calc-mode) (not calc-executing-macro) - (let* ((buffer-read-only nil) + (let* ((inhibit-read-only t) (save-point (point)) - (save-mark (condition-case err (mark) (error nil))) + (save-mark (ignore-errors (mark))) (save-aligned (looking-at "\\.$")) (thing calc-stack) (calc-any-evaltos nil)) @@ -2016,7 +2019,7 @@ See calc-keypad for details." (calc-align-stack-window) (goto-char save-point)) (if save-mark (set-mark save-mark)))) - (and calc-embedded-info (not (eq major-mode 'calc-mode)) + (and calc-embedded-info (not (derived-mode-p 'calc-mode)) (with-current-buffer (aref calc-embedded-info 1) (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) @@ -2025,7 +2028,7 @@ See calc-keypad for details." ;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. (defcustom calc-gregorian-switch nil "The first day the Gregorian calendar is used by Calc's date forms. -This is `nil' (the default) if the Gregorian calendar is the only one used. +This is nil (the default) if the Gregorian calendar is the only one used. Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use the Gregorian calendar; Calc will use the Julian calendar for earlier dates. The dates in which different regions of the world began to use the @@ -2078,12 +2081,13 @@ the United States." (null (buffer-name calc-trail-buffer))) (save-excursion (setq calc-trail-buffer (get-buffer-create "*Calc Trail*")) - (let ((buf (or (and (not (eq major-mode 'calc-mode)) + (let ((buf (or (and (not (derived-mode-p 'calc-mode)) (get-buffer "*Calculator*")) (current-buffer)))) (set-buffer calc-trail-buffer) - (or (eq major-mode 'calc-trail-mode) - (calc-trail-mode buf))))) + (unless (derived-mode-p 'calc-trail-mode) + (calc-trail-mode) + (set (make-local-variable 'calc-main-buffer) buf))))) (or (and calc-trail-pointer (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) (with-current-buffer calc-trail-buffer @@ -2092,11 +2096,12 @@ the United States." (setq calc-trail-pointer (point-marker)))) calc-trail-buffer) +(defvar calc-can-abbrev-vectors) + (defun calc-record (val &optional prefix) (setq calc-aborted-prefix nil) (or calc-executing-macro - (let* ((mainbuf (current-buffer)) - (buf (calc-trail-buffer)) + (let* ((buf (calc-trail-buffer)) (calc-display-raw nil) (calc-can-abbrev-vectors t) (fval (if val @@ -2152,7 +2157,7 @@ the United States." (defun calc-trail-here () (interactive) - (if (eq major-mode 'calc-trail-mode) + (if (derived-mode-p 'calc-trail-mode) (progn (beginning-of-line) (if (bobp) @@ -2253,44 +2258,60 @@ the United States." (defun calc-enter (n) (interactive "p") - (calc-wrapper - (cond ((< n 0) - (calc-push-list (calc-top-list 1 (- n)))) - ((= n 0) - (calc-push-list (calc-top-list (calc-stack-size)))) - (t - (calc-push-list (calc-top-list n)))))) - + (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point)))))) + (calc-wrapper + (cond ((< n 0) + (calc-push-list (calc-top-list 1 (- n)))) + ((= n 0) + (calc-push-list (calc-top-list (calc-stack-size)))) + (num + (calc-push-list (calc-top-list n num))) + (t + (calc-push-list (calc-top-list n))))) + (if (and calc-context-sensitive-enter (> n 0)) (calc-cursor-stack-index (+ num n))))) (defun calc-pop (n) (interactive "P") - (calc-wrapper - (let* ((nn (prefix-numeric-value n)) - (top (and (null n) (calc-top 1)))) - (cond ((and (null n) - (eq (car-safe top) 'incomplete) - (> (length top) (if (eq (nth 1 top) 'intv) 3 2))) - (calc-pop-push-list 1 (let ((tt (copy-sequence top))) - (setcdr (nthcdr (- (length tt) 2) tt) nil) - (list tt)))) - ((< nn 0) - (if (and calc-any-selections - (calc-top-selected 1 (- nn))) - (calc-delete-selection (- nn)) - (calc-pop-stack 1 (- nn) t))) - ((= nn 0) - (calc-pop-stack (calc-stack-size) 1 t)) - (t - (if (and calc-any-selections - (= nn 1) - (calc-top-selected 1 1)) - (calc-delete-selection 1) - (calc-pop-stack nn))))))) + (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point)))))) + (calc-wrapper + (let* ((nn (prefix-numeric-value n)) + (top (and (null n) (calc-top 1)))) + (cond ((and calc-context-sensitive-enter (> num 1)) + (calc-pop-stack nn num)) + ((and (null n) + (eq (car-safe top) 'incomplete) + (> (length top) (if (eq (nth 1 top) 'intv) 3 2))) + (calc-pop-push-list 1 (let ((tt (copy-sequence top))) + (setcdr (nthcdr (- (length tt) 2) tt) nil) + (list tt)))) + ((< nn 0) + (if (and calc-any-selections + (calc-top-selected 1 (- nn))) + (calc-delete-selection (- nn)) + (calc-pop-stack 1 (- nn) t))) + ((= nn 0) + (calc-pop-stack (calc-stack-size) 1 t)) + (t + (if (and calc-any-selections + (= nn 1) + (calc-top-selected 1 1)) + (calc-delete-selection 1) + (calc-pop-stack nn)))))) + (if calc-context-sensitive-enter (calc-cursor-stack-index (1- num))))) + ;;;; Reading a number using the minibuffer. +(defun calc-digit-start-entry () + (cond ((eq last-command-event ?e) + (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e")) + ((eq last-command-event ?#) (format "%d#" calc-number-radix)) + ((eq last-command-event ?_) "-") + ((eq last-command-event ?@) "0@ ") + (t (char-to-string last-command-event)))) + (defvar calc-buffer) (defvar calc-prev-char) (defvar calc-prev-prev-char) @@ -2301,7 +2322,6 @@ the United States." (if (or calc-algebraic-mode (and (> calc-number-radix 14) (eq last-command-event ?e))) (calc-alg-digit-entry) - (calc-unread-command) (setq calc-aborted-prefix nil) (let* ((calc-digit-value nil) (calc-prev-char nil) @@ -2319,7 +2339,8 @@ the United States." (unwind-protect (progn (define-key global-map "\e" nil) - (read-from-minibuffer "Calc: " "" calc-digit-map)) + (read-from-minibuffer + "Calc: " (calc-digit-start-entry) calc-digit-map)) (define-key global-map "\e" old-esc)))))) (or calc-digit-value (setq calc-digit-value (math-read-number buf))) (if (stringp calc-digit-value) @@ -2758,9 +2779,18 @@ largest Emacs integer.") ;; Coerce integer A to be a bignum. [B S] (defun math-bignum (a) - (if (>= a 0) - (cons 'bigpos (math-bignum-big a)) - (cons 'bigneg (math-bignum-big (- a))))) + (cond + ((>= a 0) + (cons 'bigpos (math-bignum-big a))) + ((= a most-negative-fixnum) + ;; Note: cannot get the negation directly because + ;; (- most-negative-fixnum) is most-negative-fixnum. + ;; + ;; most-negative-fixnum := -most-positive-fixnum - 1 + (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum)) + 1)) + (t + (cons 'bigneg (math-bignum-big (- a)))))) (defun math-bignum-big (a) ; [L s] (if (= a 0) @@ -3017,7 +3047,7 @@ largest Emacs integer.") (defun math-sub-bignum (a b) ; [l l l] (if b (if a - (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum diff) + (let* ((a (copy-sequence a)) (aa a) (borrow nil) diff) (while (and aa b) (if borrow (if (>= (setq diff (- (car aa) (car b))) 1) @@ -3171,7 +3201,8 @@ largest Emacs integer.") aa a) (while (progn (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d)) - c)) math-bignum-digit-size)) + c)) + math-bignum-digit-size)) (setq aa (cdr aa))) (setq c (/ prod math-bignum-digit-size) ss (or (cdr ss) (setcdr ss (list 0))))) @@ -3406,6 +3437,10 @@ largest Emacs integer.") ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy ;; in calccomp.el. +(defvar math-svo-c) +(defvar math-svo-wid) +(defvar math-svo-off) + (defun math-stack-value-offset (math-svo-c) (let* ((num (if calc-line-numbering 4 0)) (math-svo-wid (calc-window-width)) @@ -3891,8 +3926,4 @@ See Info node `(calc)Defining Functions'." (provide 'calc) -;; Local variables: -;; coding: utf-8 -;; End: - ;;; calc.el ends here diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index cd962e7dbed..55064a35528 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1,6 +1,6 @@ ;;; calcalg2.el --- more algebraic functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 564edc66f23..957f12064bd 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -1,6 +1,6 @@ ;;; calcalg3.el --- more algebraic functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 2aa971628b4..119f41993c3 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1,6 +1,6 @@ ;;; calccomp.el --- composition functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -1670,8 +1670,4 @@ (provide 'calccomp) -;; Local variables: -;; coding: utf-8 -;; End: - ;;; calccomp.el ends here diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index f299e6a8b73..ace26847963 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -1,6 +1,6 @@ ;;; calcsel2.el --- selection functions for Calc -;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc. +;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |